Blackjack game (unfortunately variable names compressed)

[qbguy]

Code: QB64: [Select]

1. DECLARE SUB M ()
2. DECLARE SUB N (Y!)
3. DECLARE SUB O ()
4. DECLARE FUNCTION P! (W!)
5. DECLARE FUNCTION Q% ()
6. DECLARE FUNCTION R$ (W!)
7. RANDOMIZE TIMER
8. DIM SHARED A(1 TO 52), B(0 TO 16, 1 TO 16), C(0 TO 16)
9. DIM SHARED D(0 TO 16), E(1 TO 16)
10. DIM SHARED G
11. F = 1000
12. G = 0
13. CALL M
14. CLS
15. DO
16. FOR I = 0 TO 16
17. C(I) = 0
18. FOR J = 1 TO 16
19. B(I, J) = 0
20. E(J) = 0
21. NEXT
22. NEXT
23. PRINT "Your money: "; F
24. E(1) = -1
25. WHILE E(1) < 0 AND E(1) <= 1000
26. INPUT "Wager"; E(1)
27. IF E(1) < 0 THEN PRINT "Bet must be nonnegative."
28. IF E(1) > 1000 THEN PRINT "Max bet $1000."
29. WEND
30. H = 1
31. K = 1
32. N 0
33. N 0
34. N 1
35. N 1
36. O
37. PRINT "Dealer Upcard: "; R$(B(0, 1))
38. PRINT "Your hand:"; R(B(1, 1)); R(B(1, 2))
39. PRINT
40.  
41. IF B(0, 1) = 11 THEN
42. 1 INPUT "Would you like insurance"; X$
43. X$ = UCASE$(LTRIM$(RTRIM$(X$)))
44. SELECT CASE X$
45. CASE "Y", "YES", "AYE", "YUP", "YEAH", "OUI", "JA", "SI"
46. L = .5 * E(1)
47. CASE "N", "NAY", "NOPE", "NO", "NEIN", "NYET", "NON"
48. L = 0
49. CASE ELSE
50. GOTO 1
51. END SELECT
52. END IF
53. IF D(0) = 21 THEN
54. PRINT "Dealer Blackjack."
55. IF D(1) <> 21 THEN F = F - E(1)
56. IF L > 0 THEN
57. PRINT "You get "; L * 2; "from insurance"
58. F = F + L * 2
59. L = 0
60. END IF
61. GOTO 4
62. ELSEIF D(1) = 21 THEN
63. IF L > 0 THEN
64. PRINT "You lose the insurance bet"
65. F = F - L
66. L = 0
67. END IF
68. PRINT "Blackjack!"
69. F = F + E(1) * 1.5
70. GOTO 4
71. ELSEIF L > 0 THEN
72. PRINT "You lose the insurance bet"
73. F = F - L
74. L = 0
75. END IF
76. DO WHILE H <= K
77. 2 LINE INPUT "Your move:"; X$
78. X$ = LTRIM$(RTRIM$(UCASE$(X$)))
79. SELECT CASE X$
80. CASE "HIT", "H"
81. N H
82. O
83. IF D(H) >= 21 THEN H = H + 1
84. CASE "STAND", "S"
85. H = H + 1
86. CASE "DOUBLE", "D"
87. E(H) = E(H) * 2
88. N H
89. O
90. H = H + 1
91. CASE "SPLIT", "P"
92. IF (P(B(H, 1)) <> P(B(H, 2))) OR (C(H) <> 2) THEN
93. PRINT "You cannot split."
94. GOTO 2
95. ELSE
96. B(K + 1, 1) = B(H, 2)
97. C(K + 1) = 1
98. N K + 1
99. B(H, 2) = 0
100. C(H) = 1
101. N H
102. K = K + 1
103. E(K) = E(H)
104. O
105. END IF
106. CASE "QUIT", "Q", "BYE", "ADIOS"
107. SYSTEM
108. CASE ELSE
109. PRINT "Invalid Selection"
110. GOTO 2
111. END SELECT
112. PRINT "Dealer Upcard: "; R$(B(0, 1))
113. FOR I = 1 TO K
114. PRINT "Hand"; I; ": ";
115. FOR J = 1 TO C(I)
116. PRINT R(B(I, J));
117. NEXT
118. IF H = I THEN PRINT "<- Current hand ";
119. PRINT "(Sum ="; D(I); ")"
120. NEXT
121. PRINT
122. LOOP
123. PRINT "Dealer's hand:"; R$(B(0, 1)); R$(B(0, 2));
124. 3 O
125. IF D(0) < 17 THEN
126. T = TIMER + .5
127. WHILE T < TIMER
128. WEND
129. N 0
130. PRINT R$(B(0, C(0)));
131. GOTO 3
132. END IF
133. FOR I = 1 TO K
134. IF D(I) > 21 THEN
135. PRINT "Bust on Y"; I
136. F = F - E(I)
137. ELSEIF D(0) > 21 THEN
138. PRINT "Dealer bust: win on Y"; I
139. F = F + E(I)
140. ELSEIF D(I) > D(0) THEN
141. PRINT "Win on Y"; I
142. F = F + E(I)
143. ELSEIF D(I) < D(0) THEN
144. PRINT "Lose on Y"; I
145. F = F - E(I)
146. ELSE
147. PRINT "Push on Y"; I
148. END IF
149. NEXT
150. 4 LOOP
151.  
152. SUB M
153. FOR I = 1 TO 52
154. A(I) = I
155. NEXT
156. J = 52
157. DO
158. K = INT(J * RND(1)) + 1
159. SWAP A(K), A(J)
160. J = J - 1
161. LOOP WHILE J > 1
162. END SUB
163.  
164. SUB N (Y)
165. C(Y) = C(Y) + 1
166. B(Y, C(Y)) = Q
167. END SUB
168.  
169. SUB O
170. FOR I = 0 TO K + 1
171. T = 0
172. S = 0
173. FOR J = 1 TO C(I)
174. X = P(B(I, J))
175. S = S + X
176. IF X = 11 THEN T = T + 1
177. NEXT
178. DO WHILE (S > 21 AND T > 0)
179. S = S - 10
180. T = T - 1
181. LOOP
182. D(I) = S
183. NEXT
184. END SUB
185.  
186. FUNCTION P (W)
187. V = (W MOD 13) + 1
188. SELECT CASE V
189. CASE 1
190. P = 11
191. CASE 2 TO 10
192. P = V
193. CASE 11 TO 13
194. P = 10
195. END SELECT
196. END FUNCTION
197.  
198. FUNCTION Q%
199. IF G = 52 THEN M: G = 0
200. G = G + 1
201. Q = A(G)
202. END FUNCTION
203.  
204. FUNCTION R$ (W)
205. DIM SUIT AS STRING
206. SUIT = CHR$(((W - 1) \ 13) + 3)
207. V = 1 + (W MOD 13)
208. SELECT CASE V
209. CASE 1
210. R$ = "A" + SUIT + " "
211. CASE 2 TO 10
212. R$ = LTRIM$(STR$(V)) + SUIT + " "
213. CASE 11
214. R$ = "J" + SUIT + " "
215. CASE 12
216. R$ = "Q" + SUIT + " "
217. CASE 13
218. R$ = "K" + SUIT + " "
219. END SELECT
220. END FUNCTION
221.  
222.