How I convert VERY VERY OLD spaghetti code (example included)

[xra7en]

So I have a love for old PC games. Maybe because it grew up with them and it is also how I learned to program. While the modern games are very nice with all the eye candy, there is just something about having to type activity in your pc to progress a game that just works for me.

This month I am taking on a larger conversion that I ever have when it comes to VERY old code. Some things to note about the exerpt code below, is that my PERSONAL theory on why it is such a mess, is because back in the 70's (and before) there really was not much of a way to distro your programs. You were really just punching in these games SO YOU COULD play. And as such, the devs at the time, (including yourself when you start programing) wanted to make sure that you could not figure out the game while you were typing it in.
Secondly, many computers back then were limited to 1 or 2 character variables. Me personally, I learned with a TIMEX SINCLAIR (2K RAM non MB OR GB 2,000 characters was it!!!) Then I went to the tandy deskmate (One of the FIRST windows - I think GEO WORKS CAME UP NEXT), THEN bypassed the comodore and went with the COLOR COMPUTER I,II, III . OK I digress

Code: QB64: [Select]

1. 3720 IF H2 < 9 THEN 4030
2. 3730 IF H2 < 11 THEN 3870
3. 3740 IF H2 < 13.9 THEN 4670
4. 3750 IF H1 > 10.9 THEN 4780
5. 3760 IF H1 > 8.9 THEN 3820
6.  
7. '// FROM LINE # 4020 ALSO
8. 3770 IF R < 200 * RND THEN 4830
9. 3780 GOSUB 4880
10. 3790 R = ABS(R + Y)
11. 3800 IF R > 5000 THEN 4780
12. 3810 GOTO 1380 ' *** M A I N  L O O P
13.  
14. 3820 IF RND < .5 THEN 3780
15. 3830 GOSUB 4940
16. 3840 R = ABS(R - Y)
17. 3850 IF R > 5000 THEN 4780
18. 3860 GOTO 1380 ' *** M A I N  L O O P
19.  
20.  
21. 3870 IF H1 < 7 THEN 4000
22. 3880 IF H1 < 9 THEN 3770
23. 3890 IF H1 > 10.9 THEN 4780
24. 3900 IF RND < .5 THEN 3820
25. 3910 IF RND < .5 THEN 3960
26.  
27. '//FROM 4010,4060, 4110, 4270, 4290
28. 3920 GOSUB 4980
29. 3930 R = ABS(R + 2 * Y)
30. 3940 IF R > 5000 THEN 4780
31. 3950 GOTO 1380 ' *** M A I N  L O O P
32.  
33. 3960 GOSUB 5040
34. 3970 R = ABS(R - 2 * Y)
35. 3980 IF R > 5000 THEN 4780
36. 3990 GOTO 1380 ' *** M A I N  L O O P
37.  
38. 4000 IF R > 700 THEN 3960
39. 4010 IF R > 200 THEN 3920
40. 4020 GOTO 3770
41.  
42.  
43. 4030 IF H2 < 6 THEN 4200
44. 4040 IF H1 < 7 THEN 4120
45. 4050 IF R < 300 THEN 3960
46. 4060 IF R > 700 THEN 3920
47. 4070 IF H1 > 7.9 THEN 4090
48.  
49. '// FROM 4360
50. 4080 IF fnd(B1) > fnd(B) THEN 3960
51. 4090 IF ABS(B1 - 90) >= ABS(B - 90) - 20 THEN 5080
52. 4100 IF RND < .5 THEN 3960
53. 4110 GOTO 3920
54.  
55. 4120 R9 = h
56. 4130 B9 = B1
57. 4140 GOSUB 6130
58. 4150 R9 = R
59. 4160 B9 = B1
60. 4170 GOSUB 5080
61. 4180 IF F8 > f9 THEN 3960
62. 4190 GOTO 4050
63.  
64. 4200 IF H1 < 7 THEN 4290
65. 4210 IF R > 150 THEN 4240
66. 4220 IF RND < .5 THEN 3830
67. 4230 GOTO 3960
68. 4240 IF R >= 400 THEN 4270
69. 4250 IF ABS(B1) < 30 THEN 5150
70. 4260 GOTO 3830
71.  
72. 4270 IF R > 700 THEN 3920
73. 4280 GOTO 4080
74.  
75.  
76. '// FROM 4200
77. 4290 IF R > 700 THEN 3920
78. 4300 R9 = R
79. 4310 B9 = B1
80. 4320 GOSUB 6080
81. 4330 R9 = R
82. 4340 B9 = B1
83. 4350 GOSUB 6130
84.  
85. 4360 IF f9 > F8 THEN 4080
86. 4370 IF H1 > 6.9 THEN 4390
87. 4380 IF fnd(B1) > fnd(B) THEN 3960
88. 4390 IF ABS(B1 - 90) >= ABS(B - 90) - 20 THEN 5150
89. 4400 GOTO 3960
90.  

Normally you can almost, in your head, when converting an old "typed" game from a bookm pretty much convert it to QB64 pretty easy, since they are at most maybe 50 - 200 lines of code and very easy to follow.  This particular one is almost a 1,000 lines of code incremented by 10.

• First thing I do, when I run across something this big, i just type it in exactly as shown in the book. I do this for a couple reasons, to get to understand the vars, and various chucks that seem to repeat, qb64 does a wonderful job of running almost any game you copy over.
• once the game is typed in - I, of course, play it LOL. So I can see the flow much better
• Once I have a basic (no pun) understanding of the program, I go through it and do a SEARCH AND CHANGE for variable I know what they are and change them to human readable variable - example the var "P". when I find that it means ships power, I will probably change all the P's to "shipsPower", and continue for every var I am pretty sure what they are.
• the "ON GOTO/GOSUB" routines become very easy to deal with. I change those to SELECT CASE and thin for each var, I make a sub for it instead of putting the routine inside the SELECT CASE.  What I mean is, instead of CASE x: [ DO several lines of code for shooting an arrow] I will have it go to SUB shoot_arrow()
• The main game loop I shove into a DO LOOP UNTIL GAMEOVER. 

Now this is very abbreviated version of what I do, but might help someone who likes the old games and wants to play them. Yes you can directly just type the game into QB64 and it will play fine, but later you will find it is NOT readable LOL. We call that "READ-ONCE-CODE"

At the time of this writing, the above code is a mystery to me as to what it does. I have a general idea, but the actual mechanism of the variables and what thye apply to is a mystery.

This is a STAR TREK game I have never seen before and I want to play it. No (text) graphics like all the standard clones of the 70's and 80's this is like ELIZA meets STAR TREK. These games in here have some of the most horrifying spaghetti code I have ever seen. Makes DAVID H. AHL code actually readable LOL


https://www.amazon.com/Tested-Ready-Run-Programs-BASIC/dp/0830610855/ref=sr_1_1?keywords=24+tested+ready+to+run+game+programs+in+basic&qid=1560093358&s=gateway&sr=8-1

[bplus]

Hi xra7en,

You wouldn't happen to have a copy of David AHL's Blackjack typed and running in QB64?

I would like a copy but those magazine prints are hard on my eyes.

Wait... I just found this, is it similar to David's?

Code: QB64: [Select]

1.  
2. '1 REM THIS PROGRAM HAS BEEN MODIFIED TO INCREASE THE BETS
3. 2 REM LINE 340,360 HAVE BEEN CHANGED TO UP THE LIMIT TO 100K
4. 3 REM LINE 345 MODIFIED ALSO LET IT EQUAL THE # OF CHAR THE $ AMT IS
5. 10 PRINT "DO YOU WANT INSTRUCTIONS";
6. 15 INPUT K$
7. 25 IF (LEFT$(K$, 1) <> "Y") AND (LEFT$(K$, 1) <> "y") THEN 85
8. 30 PRINT
9. 35 PRINT
10. 40 PRINT
11. 45 PRINT
12. 50 PRINT "THIS IS A GAME OF BLACKJACK, LAS VEGAS STYLE."
13. 55 PRINT "HERE ARE THE RULES OF THE HOUSE.  THE DEALER"
14. 60 PRINT "MUST HIT ON 16 OR LESS AND WILL STAY ON 17 OR"
15. 65 PRINT "MORE.  YOU MAY SPLIT TWO CARDS IF THEY ARE THE"
16. 70 PRINT "SAME AND PLAY ONE HAND WITH EACH OF THEM.  ALSO,"
17. 75 PRINT "YOU MAY DOUBLE YOUR BET AND RECEIVE EXACTLY ONE "
18. 80 PRINT "MORE CARD ANY TIME ON YOUR FIRST HIT.  THE TYPING"
19. 85 PRINT "INSTRUCTIONS ARE: S-STAND; H-HIT; D-DOUBLE; AND"
20. 90 PRINT "P-SPLIT A PAIR."
21. 91 PRINT "THE HOUSE LIMIT IS $100,000"
22. 95 IF K <> 1 THEN 155
23. 100 PRINT "WHEN THE DEALER HAS AN EXPOSED ACE HE WILL ASK"
24. 105 PRINT "YOU FOR AN INSURANCE BET.  AN INSURANCE BET WILL"
25. 110 PRINT "RISK HALF YOUR BET FOR AN AMOUNT EQUAL TO YOUR BET"
26. 115 PRINT "IF YOU WIN.  YOU WIN IF THE DEALER HAS A BLACKJACK"
27. 120 PRINT "AND LOSE IF HE DOESN''T! THE HOUSE LIMIT IS 50,000>"
28. 125 PRINT "GOOD LUCK.  OH, BY THE WAY, THE DEALER IS NOTED FOR"
29. 130 PRINT "DEALING OFF THE BOTTOM OF THE DECK.  WATCH HIM VERY"
30. 135 PRINT "CLOSELY.  HERE HE IS NOW."
31. 140 PRINT
32. 145 PRINT
33. 150 PRINT
34. 155 LET K = 0
35. 160 LET W1 = 0
36. 165 RANDOMIZE
37. 170 LET N = INT(1945 * RND + 1)
38. 175 PRINT
39. 180 PRINT "ANY TIME YOU WANT ME TO RESHUFFLE THE CARDS SIMPLY"
40. 185 PRINT "TYPE 7777 WHEN I ASK FOR YOUR WAGER AND I''LL BE VERY"
41. 190 PRINT "HAPPY TO OBLIGE.  O.K., HERE IS THE FIRST HAND."
42. 200 LET X = INT(10 * RND)
43. 210 DIM D(52), E(5), V(5), T(5), WA(5)
44. 215 FOR A = 1 TO 52
45.    220 LET D(A) = 0
46. 225 NEXT A
47. 230 DIM Q(52)
48. 235 FOR A = 0 TO 39 STEP 13
49.    240 FOR C = 1 TO 13
50.        245 LET Q(A + C) = C
51.    250 NEXT C
52. 255 NEXT A
53. 260 PRINT
54. 265 LET K = K + 1
55. 270 FOR P = 1 TO 5
56.    275 LET E(P) = 0
57.    280 LET V(P) = 0
58.    285 LET T(P) = 0
59. 290 NEXT P
60. 295 LET V(3) = 1
61. 300 PRINT
62. 305 PRINT
63. 310 PRINT
64. 315 PRINT "WAGER";
65. 320 LET P = 1
66. 325 INPUT W
67. 330 LET WA(2) = W
68. 335 IF W <= 0 THEN 1685
69. 340 IF W <= 100000 THEN 370
70. 345 IF W <> 7777 THEN 360
71. 350 GOSUB 1645
72. 355 GOTO 315
73. 360 PRINT "HEY THE HOUSE LIMIT IS $100 G ''S"
74. 365 GOTO 315
75. 370 PRINT
76. 375 PRINT "I SHOW",
77. 380 GOSUB 865
78. 385 IF E(1) = 0 THEN 395
79. 390 LET V(4) = 1
80. 395 LET V(5) = 1
81. 400 GOSUB 865
82. 405 LET M = X
83. 410 LET P = 2
84. 415 PRINT "FIRST CARD IS",
85. 420 GOSUB 865
86. 425 LET G = X
87. 430 PRINT "NEXT CARD IS",
88. 435 GOSUB 865
89. 440 IF V(2) > 0 THEN 605
90. 445 LET S = X
91. 450 IF V(3) <> 1 THEN 605
92. 455 IF T(P) <> 21 THEN 505
93. 460 PRINT "   ***BLACKJACK***   "
94. 465 PRINT
95. 470 PRINT " THAT''S GETTING A BIT RIDICULOUS::::"
96. 475 PRINT
97. 480 PRINT "MY HOLE CARD WAS ",
98. 485 LET X = M
99. 490 GOSUB 1035
100. 495 LET W1 = W1 + 1.5 * W
101. 500 GOSUB 1335
102. 505 IF V(4) = 0 THEN 570
103. 510 PRINT "INSURANCE ANYONE";
104. 515 INPUT I$
105. 520 PRINT
106. 525 IF LEFT$(I$, 1) <> "y" THEN 570
107. 530 IF T(1) <> 21 THEN 555
108. 535 LET W1 = W1 + W
109. 540 PRINT
110. 545 PRINT "YOU WIN $"; W; " ON YOUR INSURANCE BET"
111. 550 GOTO 570
112. 555 LET W1 = W1 - W / 2
113. 560 PRINT
114. 565 PRINT "YOU LOST $"; W / 2; " ON YOUR INSURANCE BET - I DON''T HAVE BLACKJACK"
115. 570 IF T(1) <> 21 THEN 605
116. 575 PRINT
117. 580 PRINT "**I HAVE BLACKJACK**"
118. 585 PRINT "MY HOLE CARD WAS ",
119. 590 LET X = M
120. 595 GOSUB 1035
121. 600 GOTO 1300
122. 605 IF T(P) <= 21 THEN 650
123. 610 IF E(P) > 0 THEN 640
124. 615 PRINT "YOU BUSTED, ";
125. 620 PRINT "YOUR TOTAL IS "; T(P)
126. 625 LET C1 = T(P) - 5 * (INT(T(P) / 5))
127. 630 IF V(2) = 1 THEN 775
128. 635 GOTO 1175
129. 640 LET E(P) = E(P) - 1
130. 645 LET T(P) = T(P) - 10
131. 650 IF V(1) = 2 THEN 620
132. 655 LET V(3) = V(3) + 1
133. 660 PRINT "WHAT DO YOU WANT TO DO: (S)TAND (H)IT (D)OUBLE S(P)LIT";
134. 661 INPUT I$: V(1) = -1
135. 662 REM CONVERT SYMBOLIC TO NUMERIC INPUT
136. 666 IF (LEFT$(I$, 1) = "S") OR (LEFT$(I$, 1) = "s") THEN V(1) = 0
137. 667 IF (LEFT$(I$, 1) = "H") OR (LEFT$(I$, 1) = "h") THEN V(1) = 1
138. 668 IF (LEFT$(I$, 1) = "D") OR (LEFT$(I$, 1) = "d") THEN V(1) = 2
139. 669 IF (LEFT$(I$, 1) = "P") OR (LEFT$(I$, 1) = "p") THEN V(1) = 3
140. 670 IF V(1) < 0 THEN PRINT "WHAT ?": GOTO 660
141. 671 IF V(1) <> 3 THEN 830
142. 675 IF V(2) > 0 THEN 820
143. 680 IF V(3) <> 2 THEN 820
144. 685 IF Q(G) = Q(S) THEN 700
145. 690 PRINT "NOW IS THAT A PAIR?"
146. 695 GOTO 660
147. 700 LET V(2) = 1
148. 705 IF Q(G) <> 1 THEN 715
149. 710 LET V(1) = 2
150. 715 LET P = 3
151. 720 PRINT "       PLAY HAND ONE NOW"
152. 725 PRINT "FIRST CARD IS ",
153. 730 LET WA(3) = W
154. 735 LET X = G
155. 740 GOSUB 750
156. 745 GOTO 430
157. 750 GOSUB 990
158. 755 GOSUB 1035
159. 760 LET V(3) = 1
160. 765 LET T(P) = C
161. 770 RETURN
162. 775 LET P = 2
163. 780 LET V(2) = 2
164. 785 PRINT "       PLAY HAND TWO NOW"
165. 790 PRINT "FIRST CARD IS",
166. 795 LET X = S
167. 800 GOSUB 750
168. 805 IF Q(G) = 1 THEN 815
169. 810 LET V(1) = 0
170. 815 GOTO 430
171. 820 PRINT "NO SPLITS NOW -- TRY AGAIN"
172. 825 GOTO 660
173. 830 IF V(1) <> 2 THEN 855
174. 835 IF V(3) = 2 THEN 850
175. 840 PRINT "TOO LATE TO DOUBLE, CHARLIE."
176. 845 GOTO 660
177. 850 LET WA(P) = 2 * WA(P)
178. 855 IF V(1) > 0 THEN 430
179. 860 GOTO 620
180. 865 GOSUB 900
181. 870 LET T(P) = T(P) + C
182. 875 IF V(5) = 0 THEN 890
183. 880 LET V(5) = 0
184. 885 RETURN
185. 890 GOSUB 1035
186. 895 RETURN
187. 900 IF R >= 50 THEN 945
188. 905 LET N = 10 * (1 + ABS(COS(N + W1)))
189. 910 FOR A = 1 TO N
190.    915 LET X = INT(53 * RND)
191.    920 IF X = 0 THEN 915
192. 925 NEXT A
193. 930 IF D(X) = 0 THEN 980
194. 935 LET R = R + 1
195. 940 IF R < 50 THEN 900
196. 945 FOR A = 1 TO 52
197.    950 IF D(A) = K THEN 960
198.    955 LET D(A) = 0
199. 960 NEXT A
200. 965 LET R = 0
201. 970 PRINT "   I RESHUFFLED   ";
202. 975 GOTO 900
203. 980 LET R = 0
204. 985 LET D(X) = K
205. 990 IF Q(X) <> 1 THEN 1010
206. 995 LET C = 11
207. 1000 LET E(P) = E(P) + 1
208. 1005 RETURN
209. 1010 IF Q(X) > 10 THEN 1025
210. 1015 LET C = Q(X)
211. 1020 RETURN
212. 1025 LET C = 10
213. 1030 RETURN
214. 1035 GOSUB 1050
215. 1040 GOSUB 1120
216. 1045 RETURN
217. 1050 IF Q(X) <> 1 THEN 1065
218. 1055 PRINT " ACE ";
219. 1060 RETURN
220. 1065 IF Q(X) > 10 THEN 1080
221. 1070 PRINT Q(X); " ";
222. 1075 RETURN
223. 1080 IF Q(X) > 11 THEN 1095
224. 1085 PRINT " JACK ";
225. 1090 RETURN
226. 1095 IF Q(X) > 12 THEN 1110
227. 1100 PRINT " QUEEN ";
228. 1105 RETURN
229. 1110 PRINT " KING ";
230. 1115 RETURN
231. 1120 IF X > 39 THEN 1145
232. 1125 IF X > 26 THEN 1155
233. 1130 IF X > 13 THEN 1165
234. 1135 PRINT "OF SPADES"
235. 1140 RETURN
236. 1145 PRINT "OF CLUBS"
237. 1150 RETURN
238. 1155 PRINT "OF HEARTS"
239. 1160 RETURN
240. 1165 PRINT "OF DIAMONDS"
241. 1170 RETURN
242. 1175 LET P = 2
243. 1180 PRINT "MY HOLE CARD WAS ",
244. 1185 LET X = M
245. 1190 GOSUB 1035
246. 1195 IF T(2) < 22 THEN 1210
247. 1200 IF V(2) = 0 THEN 1300
248. 1205 IF T(3) > 21 THEN 1300
249. 1210 LET P = 1
250. 1215 IF T(1) < 17 THEN 1360
251. 1220 IF T(1) > 17 THEN 1230
252. 1225 IF E(1) > 0 THEN 1360
253. 1230 IF T(1) > 21 THEN 1375
254. 1235 LET P = 2
255. 1240 PRINT "MY TOTAL IS "; T(1)
256. 1245 IF T(P) > 21 THEN 1300
257. 1250 IF T(1) > 21 THEN 1265
258. 1255 IF T(1) > T(P) THEN 1300
259. 1260 IF T(1) = T(P) THEN 1330
260. 1265 LET W1 = W1 + WA(P)
261. 1270 IF C1 > 3 THEN 1445
262. 1275 IF C1 > 2 THEN 1465
263. 1280 IF C1 > 1 THEN 1485
264. 1285 IF C1 > 0 THEN 1505
265. 1290 GOTO 1525
266. 1295 GOTO 1330
267. 1300 LET W1 = W1 - WA(P)
268. 1305 IF C1 > 3 THEN 1545
269. 1310 IF C1 > 2 THEN 1565
270. 1315 IF C1 > 1 THEN 1585
271. 1320 IF C1 > 0 THEN 1605
272. 1325 GOTO 1625
273. 1330 IF V(2) > 0 THEN 1345
274. 1335 GOSUB 1405
275. 1340 GOTO 265
276. 1345 LET P = 3
277. 1350 LET V(2) = 0
278. 1355 GOTO 1245
279. 1360 PRINT "I DRAW",
280. 1365 GOSUB 865
281. 1370 GOTO 1210
282. 1375 IF E(1) = 0 THEN 1395
283. 1380 LET E(1) = E(1) - 1
284. 1385 LET T(1) = T(1) - 10
285. 1390 GOTO 1210
286. 1395 PRINT "I BUSTED*****"
287. 1400 GOTO 1235
288. 1405 IF W1 < 0 THEN 1425
289. 1410 IF W1 = 0 THEN 1435
290. 1415 PRINT "YOU''RE AHEAD $"; W1
291. 1420 RETURN
292. 1425 PRINT "YOU''RE BEHIND $"; W1
293. 1430 RETURN
294. 1435 PRINT "YOU''RE EVEN"
295. 1440 RETURN
296. 1445 PRINT
297. 1450 PRINT "I MUST HAVE DEALT WRONG."
298. 1455 PRINT
299. 1460 GOTO 1330
300. 1465 PRINT
301. 1470 PRINT "YOU LUCKED OUT AGAIN:"
302. 1475 PRINT
303. 1480 GOTO 1330
304. 1485 PRINT
305. 1490 PRINT "YOU MUST HAVE BEEN PEEKING."
306. 1495 PRINT
307. 1500 GOTO 1330
308. 1505 PRINT
309. 1510 PRINT "I COULD LOSE MY JOB THIS WAY."
310. 1515 PRINT
311. 1520 GOTO 1330
312. 1525 PRINT
313. 1530 PRINT "THE CARDS HAVE TURNED AGAINST ME."
314. 1535 PRINT
315. 1540 GOTO 1330
316. 1545 PRINT
317. 1550 PRINT "THE BOTTOM OF THE DECK STRIKES AGAIN."
318. 1555 PRINT
319. 1560 GOTO 1330
320. 1565 PRINT
321. 1570 PRINT "A VICTORY FOR US GOOD GUYS."
322. 1575 PRINT
323. 1580 GOTO 1330
324. 1585 PRINT
325. 1590 PRINT "YOU CAN''T BEAT SKILL."
326. 1595 PRINT
327. 1600 GOTO 1330
328. 1605 PRINT
329. 1610 PRINT "MUST BE MY LUCKY DAY."
330. 1615 PRINT
331. 1620 GOTO 1330
332. 1625 PRINT
333. 1630 PRINT "YOU CAN''T BEAT THE BEST."
334. 1635 PRINT
335. 1640 GOTO 1330
336. 1645 PRINT
337. 1650 PRINT "I''M SUPPOSED TO SHUFFLE, BUT I DON''T KNOW HOW!"
338. 1660 PRINT
339. 1665 RETURN
340. 1685 PRINT
341. 1690 PRINT "WELL, SEE YOU NEXT TIME!"
342. 1700 PRINT
343. 1710 END
344.  

... and it works!

My opinion of why the spaghetti code is so crazy is not because they want to make it hard to understand while typing in but because they did not have modern subs and functions and ways to exit loops or jump around inside loops.

[xra7en]

I have over the years of searching the net, have gathered a collection over 340+ BASIC books in PDF.
however with that said, not sure on the ethics of QB64 forums if it is allowed to share those.

I have pdf file of all these books
https://www.atariarchives.org/

and then another 300+ LOL

Does D.H.A have a blackjack version - I think he doesn in his BIG COMPUTER GAMES

[xra7en]

Hi xra7en,

You wouldn't happen to have a copy of David AHL's Blackjack typed and running in QB64?

I would like a copy but those magazine prints are hard on my eyes.

Lemme see what I can find. I need a break from this spaghetti I am working on LOL
I'll see if i can type a version up

[bplus]

Yeah I found a game here, it looks different, even older than one I posted!
https://www.atariarchives.org/basicgames/showpage.php?page=19

I was curious how it  played, yikes! more than a 2 pages!

Ah! another one from Creative Computing Morristown, NJ

[xra7en]

feel free to join in
This is a scratch built one - DOUBLE DOWN and split IS NOT DONE yet, but you get the idea.
There is some quirky code I have to fix, but hey, this is like a 2hr slam together LOL

Code: QB64: [Select]

1. '// BLACKJACK
2. '// SCRATCH CODED.
3. '// DESIGN:
4. '//     DECK IS SHUFFLED AFTER EVERY HAND
5. '//     DEALER HITS ON 16
6. '//     DEALER STANDS ON 17
7. '//
8. OPTION _EXPLICIT
9.  
10. RANDOMIZE (-TIMER) '                    OLD SCHOOL RANDOMIZER
11.  
12. '// SUITS TILES
13. CONST heart = ""
14. CONST diamond = ""
15. CONST club = ""
16. CONST spade = ""
17.  
18.  
19. '// BOOLEAN HACK
20. CONST TRUE = 1
21. CONST FALSE = 0
22.  
23. '// CREATE BLANK CARD
24. TYPE tCard
25.     cardNum AS INTEGER '                CARD NUMBER IN DECK 1-52
26.     suit AS INTEGER '                   SUITS 1-4
27.     value AS INTEGER '                  VALUE OF THIS CARD
28.     tile AS STRING '                   TILE ART THIS CARD HAS
29.     discarded AS INTEGER '              HAS THIS CARD BEEN DISCARDED
30. END TYPE
31.  
32. TYPE tPLAYER
33.     cash AS INTEGER '                   CASH ON HAND
34.     wins AS INTEGER '                   HOW MANY TIMES WON
35.     bust AS INTEGER '                   BUST COUNT
36.     push AS INTEGER '                   PUSH COUNT
37.     cTotal AS INTEGER '                 RUNNING CARD TOTAL
38.     aceUp AS INTEGER '                  HOW MANY ACES DOES PLAYER HAVE?
39.  
40. END TYPE
41.  
42.  
43.  
44. DIM SHARED GAMEOVER AS INTEGER '        BOOLEAN FOR MONITORING GAME STATUS
45. DIM SHARED I, J AS INTEGER '            GLOBLA LOOP COUNTERS
46. DIM SHARED PLAYER AS tPLAYER '          PLAYER DB
47. DIM SHARED DECK(52) AS tCard '          HERE IS OUR COOL DECK
48. DIM SHARED ROUND_OVER AS INTEGER '      EACH ROUND
49. DIM SHARED DEALER_TOTAL AS INTEGER '    HOW MUCH DOES DEALER HAVE SHOWING
50.  
51.  
52.  
53.  
54. 'GAME_TITLE
55. GAME_INIT
56. GAME_RUN
57. 'GAME_END
58.  
59.  
60. '$INCLUDE: 'UTILS.BI'
61.  
62. SUB GAME_INIT
63.  
64.     NEW_DECK '                          CREATE THE DECK
65.  
66.     GAMEOVER = FALSE '                  GAME IS NOT OVER (JUST STARTING)
67.  
68.     PLAYER.cash = 100 '                 START PLAYER WITH $100
69.     PLAYER.aceUp = 0 '                  PLAYER HAS NO ACES YET
70.  
71. END SUB
72.  
73.  
74. SUB GAME_TITLE
75.  
76. END SUB
77.  
78.  
79. SUB SHOW_CARD (CARDNUM AS INTEGER)
80.  
81.     IF DECK(CARDNUM).value > 10 THEN DECK(CARDNUM).value = 10
82.     IF DECK(CARDNUM).value = 1 THEN
83.         PRINT "A" + DECK(CARDNUM).tile
84.     ELSE
85.         PRINT STR$(DECK(CARDNUM).value) + DECK(CARDNUM).tile
86.     END IF ' IF THIS IS AN ACE
87.  
88.  
89. END SUB
90.  
91. FUNCTION CALC_TOTAL (TOTAL AS INTEGER)
92.     IF TOTAL > 10 THEN TOTAL = 10
93.     IF TOTAL = 1 THEN TOTAL = 11 ' START OFF WITH ACE = 11
94.     CALC_TOTAL = TOTAL
95.  
96. END FUNCTION
97.  
98. SUB BROKE
99.     CLS
100.     PRINT
101.     PRINT "Well it looks like you are out of money!"
102.     PRINT "why not call it a night!"
103.     PRINT
104.     PAUSE
105.     END
106.  
107. END SUB
108.  
109.  
110. SUB GAME_RUN
111.  
112.     DIM CARDNUM AS INTEGER
113.     DIM PlayerTotal(10) AS INTEGER '        TRACK EACH CARD THEY GET
114.     DIM pCOUNT AS INTEGER '                 CARDS IN HAND
115.     DIM ans AS STRING '                     PLAYER CHOICE
116.     DIM BET AS INTEGER '                               PLAYER BET
117.  
118.     DO '                                    START THE GAME
119.  
120.         DO '                                START A NEW HAND
121.             PLAYER.aceUp = 0
122.             PLAYER.cTotal = 0
123.             ROUND_OVER = FALSE
124.             DEALER_TOTAL = 0
125.             pCOUNT = 1
126.             FOR I = 1 TO 10: PlayerTotal(I) = 0: NEXT
127.  
128.  
129.             CLS
130.             IF PLAYER.cash <= 0 THEN BROKE
131.  
132.             PRINT "Cash on hand: "; PLAYER.cash;
133.             PRINT "House Max Bet: 1000" ' TODO: MAKE THIS A VARIABLE
134.  
135.             DO
136.  
137.                 PRINT "Place your bet please: ";: INPUT BET
138.             LOOP UNTIL BET <= PLAYER.cash
139.  
140.             '// SHOW DEALERS CARD UP
141.             CARDNUM = DEAL_A_CARD
142.             PRINT "DEALER UP-CARD: ";
143.             SHOW_CARD (CARDNUM)
144.             DEALER_TOTAL = DEALER_TOTAL + CALC_TOTAL(DECK(CARDNUM).value)
145.             PRINT "Dealer Total: "; DEALER_TOTAL
146.  
147.             '// SHOW PLAYERS CARDS
148.             CARDNUM = DEAL_A_CARD
149.             PRINT
150.             PRINT "PLAYER CARD: ";
151.             SHOW_CARD (CARDNUM)
152.             PlayerTotal(pCOUNT) = CALC_TOTAL(DECK(CARDNUM).value)
153.             IF PlayerTotal(pCOUNT) = 1 THEN PLAYER.aceUp = INC(PLAYER.aceUp)
154.  
155.             pCOUNT = INC(pCOUNT)
156.  
157.  
158.             CARDNUM = DEAL_A_CARD
159.             PRINT "PLAYER CARD: ";
160.             SHOW_CARD (CARDNUM)
161.             PlayerTotal(pCOUNT) = CALC_TOTAL(DECK(CARDNUM).value)
162.             IF PlayerTotal(pCOUNT) = 1 THEN PLAYER.aceUp = INC(PLAYER.aceUp)
163.             pCOUNT = INC(pCOUNT)
164.  
165.             FOR I = 1 TO UBOUND(PLAYERTOTAL)
166.                 PLAYER.cTotal = PLAYER.cTotal + PlayerTotal(I)
167.             NEXT
168.             PRINT
169.             PRINT "Player Showing: "; PLAYER.cTotal
170.             IF PLAYER.cTotal = 21 THEN
171.                 QBJACK (BET)
172.             ELSE
173.  
174.  
175.                 PRINT: PRINT
176.                 PRINT "[S]tand, [H]it, [D]ouble ";
177.                 IF PlayerTotal(1) = PlayerTotal(2) THEN PRINT ", S[p]lit: ";
178.  
179.                 INPUT ans: ans = UCASE$(ans)
180.  
181.                 SELECT CASE ans
182.                     CASE "S": CALL results(DEALER_TOTAL, PLAYER.cTotal, BET)
183.                     CASE "H":
184.                         DO
185.                             CARDNUM = DEAL_A_CARD
186.                             PRINT
187.                             PRINT "Next Card: ";: SHOW_CARD (CARDNUM)
188.                             PlayerTotal(pCOUNT) = CALC_TOTAL(DECK(CARDNUM).value): pCOUNT = INC(pCOUNT)
189.                             PLAYER.cTotal = PLAYER.cTotal + PlayerTotal(pCOUNT - 1)
190.                             PRINT "Player Showing: "; PLAYER.cTotal
191.                             IF PLAYER.cTotal > 21 THEN BUST (BET)
192.                             IF PLAYER.cTotal = 21 THEN WIN (BET) 'NOT SAME AS BLACKJAC
193.                             PRINT
194.                             PRINT "[S]tand or [H]it?";
195.                             INPUT ans: ans = UCASE$(ans)
196.  
197.                         LOOP UNTIL UCASE$(ans) = "S"
198.                         CALL results(DEALER_TOTAL, PLAYER.cTotal, BET)
199.                 END SELECT
200.  
201.             END IF ' NOT QBJACK
202.  
203.  
204.         LOOP UNTIL ROUND_OVER
205.  
206.     LOOP UNTIL GAMEOVER '                   ARE WE DONE PLAYING?
207.  
208. END SUB
209.  
210. SUB PAUSE
211.     PRINT "Press [ENTER] to continue..."
212.     INPUT I
213.  
214. END SUB
215.  
216. SUB BUST (bet AS INTEGER)
217.     PLAYER.cash = PLAYER.cash - bet
218.     PRINT
219.     PRINT "Player BUSTS! Sorry chum! Better luck next time"
220.     ROUND_OVER = TRUE
221.  
222.     PAUSE
223.  
224. END SUB
225.  
226. SUB WIN (bet AS INTEGER)
227.     PLAYER.cash = PLAYER.cash + bet
228.     PRINT
229.     PRINT "Player WINS!! Congradulations!! Keep it up!"
230.     ROUND_OVER = TRUE
231.     PAUSE
232.  
233. END SUB
234.  
235. SUB QBJACK (bet AS INTEGER)
236.     PLAYER.cash = INT(PLAYER.cash * 1.5)
237.     PRINT
238.     PRINT "PLAYER HAS QBJACK!!! ROCK ON!! Don't get cocky!!"
239.     ROUND_OVER = TRUE
240.     PAUSE
241.  
242. END SUB
243.  
244. SUB PUSH
245.     PRINT
246.     PRINT "Player PUSH. No win/loss. Luck!!"
247.     ROUND_OVER = TRUE
248.     PAUSE
249.  
250. END SUB
251.  
252.  
253.  
254. SUB results (dealerTotal, PlayerTotal, bet)
255.     DIM CARDNUM AS INTEGER
256.  
257.     '// player is standing on an odd total
258.     DO
259.         CARDNUM = DEAL_A_CARD
260.         PRINT "DEALER NEXT CARD: ";
261.         SHOW_CARD (CARDNUM)
262.         dealerTotal = dealerTotal + CALC_TOTAL(DECK(CARDNUM).value)
263.         PRINT "Dealer Total: "; dealerTotal
264.         _DELAY (2)
265.         PRINT
266.  
267.     LOOP UNTIL dealerTotal > 16
268.  
269.     SELECT CASE dealerTotal
270.         CASE IS > 21: WIN (bet)
271.         CASE IS = PlayerTotal: PUSH
272.         CASE IS < PlayerTotal: WIN (bet)
273.         CASE IS > PlayerTotal: BUST (bet)
274.  
275.     END SELECT
276.  
277.  
278. END SUB
279.  
280. '//
281. '// DRAW A CARD FROM THE DECK
282. '//
283. FUNCTION DEAL_A_CARD
284.  
285.     DIM X, Y AS INTEGER
286.  
287.     DO
288.         X = INT(RND * 52) + 1
289.  
290.     LOOP UNTIL DECK(X).discarded = 0
291.  
292.     DECK(X).discarded = 1 ' BURN THIS CARD
293.  
294.     DEAL_A_CARD = DECK(X).cardNum
295.  
296.  
297. END SUB
298.  
299. SUB NEW_DECK
300.  
301.     DIM COUNT, VALUE, SUIT AS INTEGER
302.  
303.     COUNT = 1 '                         CARD NUMBER IN THE DECK (1-52)
304.     VALUE = 1 '                         VALUE 1 -13
305.     SUIT = 1 '                          SUIT 1 - 4
306.     FOR I = 1 TO 52
307.         DECK(I).cardNum = COUNT
308.         DECK(I).suit = SUIT
309.         DECK(I).value = VALUE
310.         DECK(I).discarded = 0
311.         SELECT CASE SUIT
312.             CASE 1: DECK(I).tile = club
313.             CASE 2: DECK(I).tile = heart
314.             CASE 3: DECK(I).tile = spade
315.             CASE 4: DECK(I).tile = diamond
316.         END SELECT
317.         COUNT = INC(COUNT)
318.         SUIT = INC(SUIT): IF SUIT > 4 THEN SUIT = 1
319.         VALUE = INC(VALUE): IF VALUE > 13 THEN VALUE = 1
320.  
321.     NEXT
322. END SUB
323.  
324.  

You will also need this code snippet

Code: QB64: [Select]

1. '// DEC(X) -1 TO X
2. '// INC(X) +1 TO X
3. '// DISTANCE: DISTANCE BETWEEN 2 X,Y COORDS
4.  
5. FUNCTION DEC (X AS INTEGER)
6.     '============================================================================
7.     '--- PASCAL FUNCTION: DECREASES X BY 1)
8.     '============================================================================
9.     DEC = X - 1
10. END FUNCTION
11.  
12. FUNCTION INC (X AS INTEGER)
13.     '============================================================================
14.     '--- PASCAL FUNCTION: INCREASE X BY 1)
15.     '============================================================================
16.     INC = X + 1
17. END FUNCTION
18.  
19. FUNCTION DISTANCE (X1, Y1, X2, Y2 AS INTEGER)
20.     '============================================================================
21.     '--- DIST BETWEEN 2 POINTS
22.     '============================================================================
23.     DISTANCE = SQR((X1 - X2) ^ 2 + (Y1 - Y2) ^ 2)
24. END FUNCTION
25.  
26.  
27. FUNCTION yesNo (default AS STRING)
28.     '// @default = when ENTER is pressed what will be the default answer
29.  
30.     DIM ans AS STRING
31.  
32.     DO
33.         ans = INKEY$
34.         ans = LCASE$(ans)
35.     LOOP UNTIL ans = "y" OR ans = "n" OR ans = CHR$(13)
36.     IF ans = CHR$(13) THEN ans = default
37.  
38.     IF ans = "y" THEN
39.         yesNo = 1
40.     ELSE
41.         yesNo = 0
42.     END IF
43.  
44. END SUB
45.  
46. FUNCTION COUNT_TAGS (TEXT AS STRING)
47.     '//
48.     '// RETURNS THE NUMBER OF LORD TAGS IN A STRING
49.     '//
50.     DIM I AS INTEGER
51.     IF LEN(TEXT) = 0 THEN COUNT_TAGS = 0
52.     DIM COUNT AS INTEGER
53.     DIM LENGTH AS INTEGER
54.     LENGTH = LEN(TEXT)
55.     COUNT = 0
56.  
57.     FOR I = 1 TO LENGTH
58.         IF MID$(TEXT, I, 1) = "`" THEN COUNT = COUNT + 1
59.  
60.     NEXT
61.     COUNT_TAGS = COUNT
62.  
63.  
64. END FUNCTION
65.  
66.  
67. SUB CENTER (text AS STRING, row AS INTEGER)
68.     '//
69.     '// CENTER TEXT AS A SPECIFIED ROW
70.     '//
71.     DIM textLen, col AS INTEGER
72.     DIM TAGS AS INTEGER
73.  
74.     IF INSTR(text, "`") >= 1 THEN ' There is a tag
75.  
76.         TAGS = COUNT_TAGS(text) * 2
77.         textLen = INT((LEN(text) - TAGS) / 2)
78.     ELSE
79.         textLen = INT(LEN(text) / 2)
80.  
81.     END IF
82.  
83.     col = 40 - textLen
84.     LOCATE row, col
85.     IF TAGS > 0 THEN
86.         LWRITE text
87.     ELSE
88.         PRINT text
89.     END IF
90.  
91.  
92. END SUB
93.  
94. SUB LWRITE (TXT AS STRING)
95.     DIM i AS INTEGER
96.     '======================================================
97.     '--- THIS IS A POPULAR COLOR ROUTINE BASED ON THE
98.     '--- SETH ABLE L.O.R.D. BBS GAME COLOR FORMATTING
99.     '=====================================================
100.     COLOR 7 ' DEFAULT COLOR
101.     FOR i = 1 TO LEN(TXT$)
102.         ' CHECK FOR A COLOR CHANGE
103.         IF MID$(TXT$, i, 1) = "`" THEN
104.             i = i + 1
105.             SELECT CASE MID$(TXT, i, 1)
106.                 CASE "0": COLOR 10
107.                 CASE "1": COLOR 1
108.                 CASE "2": COLOR 2
109.                 CASE "3": COLOR 3
110.                 CASE "4": COLOR 4
111.                 CASE "5": COLOR 5
112.                 CASE "6": COLOR 6
113.                 CASE "7": COLOR 7
114.                 CASE "8": COLOR 8
115.                 CASE "9": COLOR 9
116.                 CASE "!": COLOR 11
117.                 CASE "@": COLOR 12
118.                 CASE "#": COLOR 13
119.                 CASE "$": COLOR 14
120.                 CASE "%": COLOR 15
121.                 CASE "n": PRINT '           new line
122.                 CASE "t": PRINT , ; '       TAB
123.             END SELECT
124.             i = i + 1
125.  
126.         END IF
127.         PRINT MID$(TXT$, i, 1);
128.     NEXT
129.     PRINT ;
130. END SUB
131.  
132. SUB LWRITELN (TXT AS STRING)
133.     LWRITE (TXT$)
134.     PRINT
135. END SUB
136.  

I might move this to another thread. (mod??)

[bplus]

Hi xra7en,

Your Blackjack start is welcome on the Blackjack thread I started, I like comparing coding techniques.

BTW is that RANDOMIZE (-TIMER) ? or are my eyes going bluey...

Also I am not encountering any problems by just copy / paste the 2nd code into the bottom of the first and commenting out the $INCLUDE line in the first.

Right buggy, I get 21 and congratulated then I am quizzed to Hit or Stand wo any other new info, like a card or a new hand and then I am told I busted... yikes!

[xra7en]

Hi xra7en,

Your Blackjack start is welcome on the Blackjack thread I started, I like comparing coding techniques.

BTW is that RANDOMIZE (-TIMER) ? or are my eyes going bluey...

Also I am not encountering any problems by just copy / paste the 2nd code into the bottom of the first and commenting out the $INCLUDE line in the first.

Right buggy, I get 21 and congratulated then I am quizzed to Hit or Stand wo any other new info, like a card or a new hand and then I am told I busted... yikes!

thanks for taking a look! LOL
yes that is (negative timer) do not remember where I learned that, but it was many years ago. and seemed to produce a better random. But we're talking basic games so, not to big issue.

Ya that "include" is mostly for a LORD color text i use a lot. and a few pascal tweaks that sorta work the way I want.

as far as the blackjack - I was home on break for a bit this weekend , so started a blackjack game - hopefully someone can finish it up, I may tonight, totally slammed with work this week(Im a maint tech for several properties) .  Its not too bad for a "seat-of-the-pants" coding LOL
The loop needs a tweak, I think there needs to be a "ROUND_OVER" true put somewhere, but I got a call so had to run.

If you want I can copy it over to the blackjack thread, I did not know there was one! I used to play BJ as a part time income, but my method got to the point I was winning good, but it was a method you don't want to use live :-)


but thanks for looking!!!!! :-)

[keybone]

I have over the years of searching the net, have gathered a collection over 340+ BASIC books in PDF.
however with that said, not sure on the ethics of QB64 forums if it is allowed to share those.

I have pdf file of all these books
https://www.atariarchives.org/

and then another 300+ LOL

Does D.H.A have a blackjack version - I think he doesn in his BIG COMPUTER GAMES

That's your site? I love that site, been there a million times. :-D

[xra7en]

That's your site? I love that site, been there a million times. :-D

LOL
I left out a word I think wold have clarified this.


I have "ALSO" pdf file of all these books
https://www.atariarchives.org/
as well as another 300+ pdf

Either the books are considered "abandon" or atari archives got permission for all of those to be posted publicly.