Author Topic: Tic Tac Toe in 3D by qbguy  (Read 2233 times)

Offline The Librarian

  • Moderator
Tic Tac Toe in 3D by qbguy
« on: March 10, 2018, 10:15:17 AM »
Tic Tac Toe in 3D

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

« Last Edit: August 08, 2018, 11:19:10 PM by odin »