Tic Tac Toe in 3D by qbguy

[The Librarian]

Tic Tac Toe in 3D

Author: @qbguy
Source: [abandoned, outdated and now likely malicious qb64 dot net website - don’t go there] Forum
URL: /forum/index.php?topic=56.0]http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=56.0
Version: 2008
Tags: [3d], [game], [ai], [mouse]

Description:
The goal is to get four in a row while preventing the computer from doing the same. Move by clicking the mouse.

Source Code:

Code: QB64: [Select]

1. DECLARE SUB SHOWWIN (C%, R%, p%, COLOUR%)
2. DECLARE SUB MAKEMOVE (X%, Y%, Z%, COLOUR%)
3. DECLARE SUB GETMOVE (X%, Y%, Z%)
4. DEFINT A-Z
5. DIM E(7), PEEKB(1999)
6. RANDOMIZE TIMER
7. CLS
8. GOSUB INIT
9. E(1) = 254: E(2) = 18: E(3) = 2: E(4) = 1: E(5) = 2: E(6) = 66: E(7) = 255
10. Q = 564: G = 628: L = 768
11. FOR K = G TO G + 63
12.     PEEKB(K) = 128
13. NEXT
14. FOR K = S TO S + 75
15.     PEEKB(K) = 128
16. NEXT
17. 100 CALL GETMOVE(C, R, p)
18. X = 16 * (p - 1) + 4 * (R - 1) + C - 1
19. IF PEEKB(G + X) <> 128 THEN GOTO 100
20. CALL MAKEMOVE(C, R, p, 1)
21. M = -1: GOSUB 1000
22. GOSUB 2000
23. IF W THEN CALL SHOWWIN(C, R, p, 1): END
24. IF T THEN LOCATE 15, 33: PRINT " --- Tie game --- ": END
25. GOSUB 3000
26. M = 1: GOSUB 1000
27. GOSUB 2000
28. GOSUB 7000
29. IF W THEN CALL SHOWWIN(C, R, p, 4): END
30. IF T THEN LOCATE 15, 33: PRINT " --- Tie game --- ": END
31. GOTO 100
32.  
33. 1000
34. PEEKB(G + X) = 128 + M
35. FOR K = L TO L + 303
36.     IF PEEKB(K) <> X THEN GOTO 1001
37.     Y = S + (K - L) \ 4: V = PEEKB(Y)
38.     IF V = 0 THEN GOTO 1001
39.     V = V - 128
40.     IF V = 0 THEN
41.         V = M + 128
42.     ELSE
43.         IF (SGN(V) = SGN(M)) THEN
44.             V = V + M + 128
45.         ELSE
46.             V = 0
47.         END IF
48.     END IF
49.     PEEKB(Y) = V
50. 1001 NEXT
51. RETURN
52.  
53. 2000
54. W = 0: T = 1
55. FOR K = S TO S + 75
56.     V = PEEKB(K)
57.     IF V THEN T = 0
58.     IF ABS(V - 128) = 4 THEN W = 1
59. NEXT
60. RETURN
61.  
62. 3000
63. FOR K = Q TO Q + 63
64.     PEEKB(K) = 0
65. NEXT
66. FOR K = S TO S + 75
67.     N = PEEKB(K) - 128
68.     IF N = -128 THEN GOTO 3002
69.     Z = E(N + 4)
70.     F = L + 4 * (K - S)
71.     FOR J = F TO F + 3
72.         X = PEEKB(J)
73.         IF PEEKB(G + X) <> 128 THEN GOTO 3001
74.         V = PEEKB(Q + X)
75.         IF V >= 254 THEN GOTO 3001
76.         V = V + Z: IF Z >= 254 THEN V = Z
77.         IF V > 255 THEN V = 255
78.         PEEKB(Q + X) = V
79.    3001 NEXT
80. 3002 NEXT
81. V9 = 0
82. FOR K = 0 TO 63
83.     V = PEEKB(Q + K)
84.     IF V > 64 AND V < 128 THEN V = V - 64
85.     IF V > 16 AND V < 32 THEN V = V - 16
86.     IF V > V9 THEN V9 = V
87.     PEEKB(Q + K) = V
88. NEXT
89. IF V9 < 32 THEN GOTO 4000
90. 3800 X = 0
91. DO
92.     IF PEEKB(Q + X) = V9 THEN RETURN
93.     X = X + 1
94. LOOP
95. 4000 P4 = 16
96. FOR K = L TO L + 287 STEP 16
97.     p = 0
98.     FOR J = K TO K + 15
99.         p = p + PEEKB(PEEKB(J) + G) - 128
100.     NEXT
101.     IF p > P4 THEN GOTO 4002
102.     IF p < P4 THEN
103.         P4 = p: V4 = 0: N4 = 0
104.     END IF
105.     FOR J = K TO K + 15
106.         X1 = PEEKB(J)
107.         V = PEEKB(Q + X1)
108.         IF V = 0 THEN GOTO 4001
109.         IF V < V4 THEN GOTO 4001
110.         IF V > V4 THEN
111.             V4 = V: N4 = 1
112.         ELSE
113.             N4 = N4 + 1
114.             IF INT(RND(1) * N4) <> 0 THEN GOTO 4001
115.         END IF
116.         X = X1
117.    4001 NEXT
118. 4002 NEXT
119. IF V4 = 0 THEN GOTO 3800
120. RETURN
121.  
122. 7000
123. p = X \ 16 + 1
124. X = X - 16 * (p - 1)
125. R = X \ 4 + 1
126. C = (X MOD 4) + 1
127. CALL MAKEMOVE(C, R, p, 4)
128. RETURN
129.  
130.  
131. INIT:
132. L = 768
133. FOR K = 0 TO 63
134.     PEEKB(L + K) = K
135. NEXT
136. L = L + 64
137. a = 4: B = 16
138. FOR S = 1 TO 4
139.     GOSUB 19000
140. NEXT
141. a = 16: B = 1
142. FOR S = 1 TO 13 STEP 4
143.     GOSUB 19000
144. NEXT
145. S = 1: a = 5: B = 16: GOSUB 19000
146. S = 13: a = -3: B = 16: GOSUB 19000
147. S = 1: a = 20: B = 1: GOSUB 19000
148. S = 49: a = -12: B = 1: GOSUB 19000
149. S = 1: a = 17: B = 4: GOSUB 19000
150. S = 49: a = -15: B = 4: GOSUB 19000
151. S = 1: D = 21: GOSUB 18000
152. S = 16: D = 11: GOSUB 18000
153. S = 4: D = 19: GOSUB 18000
154. S = 13: D = 13: GOSUB 18000
155. GOSUB DRAWBD
156. RETURN
157.  
158. 18000
159. FOR K = S TO S + 3 * D STEP D
160.     PEEKB(L) = K - 1: L = L + 1
161. NEXT
162. RETURN
163.  
164. 19000
165. FOR J = S TO S + 3 * B STEP B
166.     FOR K = J TO J + 3 * a STEP a
167.         PEEKB(L) = K - 1: L = L + 1
168.     NEXT
169. NEXT
170. RETURN
171.  
172. DRAWBD:
173. SCREEN 12
174. LINE (0, 0)-(639, 479), 7, BF
175. LINE (23, 23)-(616, 456), 0, B
176. LINE (24, 24)-(615, 455), 14, BF
177. Y = 130: GOSUB GRID
178. Y = 230: GOSUB GRID
179. Y = 330: GOSUB GRID
180. Y = 430: GOSUB GRID
181. PAINT (24, 24), 3, 0
182. RETURN
183.  
184. GRID:
185. FOR K = 0 TO 4
186.     LINE (120 + 20 * K, Y - 20 * K)-(440 + 20 * K, Y - 20 * K), 0
187.     LINE (120 + 80 * K, Y)-(200 + 80 * K, Y - 80), 0
188.     LINE (117 - K, Y + 2)-(201 - K, Y - 82), 0
189.     LINE (437 + K, Y + 2)-(521 + K, Y - 82), 0
190. NEXT
191. FOR K = 0 TO 1
192.     LINE (117 - K, Y + K + 1)-(437 + K, Y + K + 1), 0
193.     LINE (201 - K, Y - 81 - K)-(521 + K, Y - 81 - K), 0
194. NEXT
195. RETURN
196.  
197. SUB GETMOVE (X, Y, Z)
198.     GETPOS:
199.     IF INKEY$ = CHR$(27) THEN END
200.     CALL getmouse(XX, YY, ZZ)
201.     Z = (YY - 30) \ 100 + 1
202.     IF Z < 1 OR Z > 4 THEN GOTO GETPOS
203.     Y = ((YY - 30) \ 20) MOD 5
204.     IF Y < 1 OR Y > 4 THEN GOTO GETPOS
205.     IF XX + YY - 150 - 100 * Z < 0 THEN GOTO GETPOS
206.     X = (XX + YY - 150 - 100 * Z) \ 80 + 1
207.     IF X < 1 OR X > 4 THEN GOTO GETPOS
208.     IF ZZ = 0 THEN GOTO GETPOS
209. END SUB
210.  
211. SUB MAKEMOVE (X, Y, Z, COLOUR)
212.     CIRCLE (80 * X - 20 * Y + 170, 100 * Z + 20 * Y - 60), 35, 8, , , 4 * (8 / 35) / 3
213.     PAINT STEP(0, 0), COLOUR, 8
214.     CIRCLE (80 * X - 20 * Y + 170, 100 * Z + 20 * Y - 60), 15, 8, , , 4 * (3 / 15) / 3
215.     PAINT STEP(0, 0), COLOUR + 8, 8
216. END SUB
217.  
218. SUB SHOWWIN (C, R, p, COLOUR)
219.     DIM CC(0 TO 3), RR(0 TO 3), PP(0 TO 3)
220.     FOR DC = -1 TO 1
221.         FOR DR = -1 TO 1
222.             FOR DP = -1 TO 1
223.                 IF DC <> 0 OR DR <> 0 OR DP <> 0 THEN
224.                     NDX = 0
225.                     FOR K = -3 TO 3
226.                         IF C + K * DC < 1 OR C + K * DC > 4 THEN GOTO 1
227.                         IF R + K * DR < 1 OR R + K * DR > 4 THEN GOTO 1
228.                         IF p + K * DP < 1 OR p + K * DP > 4 THEN GOTO 1
229.                         ID = POINT(80 * (C + K * DC) - 20 * (R + K * DR) + 170, 100 * (p + K * DP) + 20 * (R + K * DR) - 60)
230.                         IF ID <> COLOUR + 8 THEN EXIT FOR
231.                         CC(NDX) = C + K * DC
232.                         RR(NDX) = R + K * DR
233.                         PP(NDX) = p + K * DP
234.                         NDX = NDX + 1
235.                         IF NDX = 4 THEN GOTO SHOW
236.                    1 NEXT
237.                 END IF
238.             NEXT
239.         NEXT
240.     NEXT
241.     SHOW:
242.     FOR K = 0 TO 3
243.         CIRCLE (80 * CC(K) - 20 * RR(K) + 170, 100 * PP(K) + 20 * RR(K) - 60), 35, COLOUR + 8, , , 4 * (8 / 35) / 3
244.         PAINT STEP(0, 0), COLOUR + 8
245.         CIRCLE STEP(0, 0), 15, 15, , , 4 * (3 / 15) / 3
246.         PAINT STEP(0, 0), 15
247.     NEXT
248. END SUB
249.  
250. SUB getmouse (x%, y%, b%)
251.     b% = 0
252.     wheel% = 0
253.     DO
254.         IF _MOUSEBUTTON(1) THEN b% = b% OR 1
255.         IF _MOUSEBUTTON(2) THEN b% = b% OR 2
256.         IF _MOUSEBUTTON(3) THEN b% = b% OR 4
257.     LOOP UNTIL _MOUSEINPUT = 0
258.     x% = _MOUSEX
259.     y% = _MOUSEY
260. END SUB
261.