Tic Tac Toe in 3D by qbguy

Samples Gallery & Reference > Games

(1/1)

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: ---DECLARE SUB SHOWWIN (C%, R%, p%, COLOUR%)DECLARE SUB MAKEMOVE (X%, Y%, Z%, COLOUR%)DECLARE SUB GETMOVE (X%, Y%, Z%)DEFINT A-ZDIM E(7), PEEKB(1999)RANDOMIZE TIMERCLSGOSUB INITE(1) = 254: E(2) = 18: E(3) = 2: E(4) = 1: E(5) = 2: E(6) = 66: E(7) = 255Q = 564: G = 628: L = 768FOR K = G TO G + 63 PEEKB(K) = 128NEXTFOR K = S TO S + 75 PEEKB(K) = 128NEXT100 CALL GETMOVE(C, R, p)X = 16 * (p - 1) + 4 * (R - 1) + C - 1IF PEEKB(G + X) <> 128 THEN GOTO 100CALL MAKEMOVE(C, R, p, 1)M = -1: GOSUB 1000GOSUB 2000IF W THEN CALL SHOWWIN(C, R, p, 1): ENDIF T THEN LOCATE 15, 33: PRINT " --- Tie game --- ": ENDGOSUB 3000M = 1: GOSUB 1000GOSUB 2000GOSUB 7000IF W THEN CALL SHOWWIN(C, R, p, 4): ENDIF T THEN LOCATE 15, 33: PRINT " --- Tie game --- ": ENDGOTO 100 1000PEEKB(G + X) = 128 + MFOR K = L TO L + 303 IF PEEKB(K) <> X THEN GOTO 1001 Y = S + (K - L) \ 4: V = PEEKB(Y) IF V = 0 THEN GOTO 1001 V = V - 128 IF V = 0 THEN V = M + 128 ELSE IF (SGN(V) = SGN(M)) THEN V = V + M + 128 ELSE V = 0 END IF END IF PEEKB(Y) = V1001 NEXTRETURN 2000W = 0: T = 1FOR K = S TO S + 75 V = PEEKB(K) IF V THEN T = 0 IF ABS(V - 128) = 4 THEN W = 1NEXTRETURN 3000FOR K = Q TO Q + 63 PEEKB(K) = 0NEXTFOR K = S TO S + 75 N = PEEKB(K) - 128 IF N = -128 THEN GOTO 3002 Z = E(N + 4) F = L + 4 * (K - S) FOR J = F TO F + 3 X = PEEKB(J) IF PEEKB(G + X) <> 128 THEN GOTO 3001 V = PEEKB(Q + X) IF V >= 254 THEN GOTO 3001 V = V + Z: IF Z >= 254 THEN V = Z IF V > 255 THEN V = 255 PEEKB(Q + X) = V 3001 NEXT3002 NEXTV9 = 0FOR K = 0 TO 63 V = PEEKB(Q + K) IF V > 64 AND V < 128 THEN V = V - 64 IF V > 16 AND V < 32 THEN V = V - 16 IF V > V9 THEN V9 = V PEEKB(Q + K) = VNEXTIF V9 < 32 THEN GOTO 40003800 X = 0DO IF PEEKB(Q + X) = V9 THEN RETURN X = X + 1LOOP4000 P4 = 16FOR K = L TO L + 287 STEP 16 p = 0 FOR J = K TO K + 15 p = p + PEEKB(PEEKB(J) + G) - 128 NEXT IF p > P4 THEN GOTO 4002 IF p < P4 THEN P4 = p: V4 = 0: N4 = 0 END IF FOR J = K TO K + 15 X1 = PEEKB(J) V = PEEKB(Q + X1) IF V = 0 THEN GOTO 4001 IF V < V4 THEN GOTO 4001 IF V > V4 THEN V4 = V: N4 = 1 ELSE N4 = N4 + 1 IF INT(RND(1) * N4) <> 0 THEN GOTO 4001 END IF X = X1 4001 NEXT4002 NEXTIF V4 = 0 THEN GOTO 3800RETURN 7000p = X \ 16 + 1X = X - 16 * (p - 1)R = X \ 4 + 1C = (X MOD 4) + 1CALL MAKEMOVE(C, R, p, 4)RETURN INIT:L = 768FOR K = 0 TO 63 PEEKB(L + K) = KNEXTL = L + 64a = 4: B = 16FOR S = 1 TO 4 GOSUB 19000NEXTa = 16: B = 1FOR S = 1 TO 13 STEP 4 GOSUB 19000NEXTS = 1: a = 5: B = 16: GOSUB 19000S = 13: a = -3: B = 16: GOSUB 19000S = 1: a = 20: B = 1: GOSUB 19000S = 49: a = -12: B = 1: GOSUB 19000S = 1: a = 17: B = 4: GOSUB 19000S = 49: a = -15: B = 4: GOSUB 19000S = 1: D = 21: GOSUB 18000S = 16: D = 11: GOSUB 18000S = 4: D = 19: GOSUB 18000S = 13: D = 13: GOSUB 18000GOSUB DRAWBDRETURN 18000FOR K = S TO S + 3 * D STEP D PEEKB(L) = K - 1: L = L + 1NEXTRETURN 19000FOR J = S TO S + 3 * B STEP B FOR K = J TO J + 3 * a STEP a PEEKB(L) = K - 1: L = L + 1 NEXTNEXTRETURN DRAWBD:SCREEN 12LINE (0, 0)-(639, 479), 7, BFLINE (23, 23)-(616, 456), 0, BLINE (24, 24)-(615, 455), 14, BFY = 130: GOSUB GRIDY = 230: GOSUB GRIDY = 330: GOSUB GRIDY = 430: GOSUB GRIDPAINT (24, 24), 3, 0RETURN GRID:FOR K = 0 TO 4 LINE (120 + 20 * K, Y - 20 * K)-(440 + 20 * K, Y - 20 * K), 0 LINE (120 + 80 * K, Y)-(200 + 80 * K, Y - 80), 0 LINE (117 - K, Y + 2)-(201 - K, Y - 82), 0 LINE (437 + K, Y + 2)-(521 + K, Y - 82), 0NEXTFOR K = 0 TO 1 LINE (117 - K, Y + K + 1)-(437 + K, Y + K + 1), 0 LINE (201 - K, Y - 81 - K)-(521 + K, Y - 81 - K), 0NEXTRETURN SUB GETMOVE (X, Y, Z) GETPOS: IF INKEY$ = CHR$(27) THEN END CALL getmouse(XX, YY, ZZ) Z = (YY - 30) \ 100 + 1 IF Z < 1 OR Z > 4 THEN GOTO GETPOS Y = ((YY - 30) \ 20) MOD 5 IF Y < 1 OR Y > 4 THEN GOTO GETPOS IF XX + YY - 150 - 100 * Z < 0 THEN GOTO GETPOS X = (XX + YY - 150 - 100 * Z) \ 80 + 1 IF X < 1 OR X > 4 THEN GOTO GETPOS IF ZZ = 0 THEN GOTO GETPOSEND SUB SUB MAKEMOVE (X, Y, Z, COLOUR) CIRCLE (80 * X - 20 * Y + 170, 100 * Z + 20 * Y - 60), 35, 8, , , 4 * (8 / 35) / 3 PAINT STEP(0, 0), COLOUR, 8 CIRCLE (80 * X - 20 * Y + 170, 100 * Z + 20 * Y - 60), 15, 8, , , 4 * (3 / 15) / 3 PAINT STEP(0, 0), COLOUR + 8, 8END SUB SUB SHOWWIN (C, R, p, COLOUR) DIM CC(0 TO 3), RR(0 TO 3), PP(0 TO 3) FOR DC = -1 TO 1 FOR DR = -1 TO 1 FOR DP = -1 TO 1 IF DC <> 0 OR DR <> 0 OR DP <> 0 THEN NDX = 0 FOR K = -3 TO 3 IF C + K * DC < 1 OR C + K * DC > 4 THEN GOTO 1 IF R + K * DR < 1 OR R + K * DR > 4 THEN GOTO 1 IF p + K * DP < 1 OR p + K * DP > 4 THEN GOTO 1 ID = POINT(80 * (C + K * DC) - 20 * (R + K * DR) + 170, 100 * (p + K * DP) + 20 * (R + K * DR) - 60) IF ID <> COLOUR + 8 THEN EXIT FOR CC(NDX) = C + K * DC RR(NDX) = R + K * DR PP(NDX) = p + K * DP NDX = NDX + 1 IF NDX = 4 THEN GOTO SHOW 1 NEXT END IF NEXT NEXT NEXT SHOW: FOR K = 0 TO 3 CIRCLE (80 * CC(K) - 20 * RR(K) + 170, 100 * PP(K) + 20 * RR(K) - 60), 35, COLOUR + 8, , , 4 * (8 / 35) / 3 PAINT STEP(0, 0), COLOUR + 8 CIRCLE STEP(0, 0), 15, 15, , , 4 * (3 / 15) / 3 PAINT STEP(0, 0), 15 NEXTEND SUB SUB getmouse (x%, y%, b%) b% = 0 wheel% = 0 DO IF _MOUSEBUTTON(1) THEN b% = b% OR 1 IF _MOUSEBUTTON(2) THEN b% = b% OR 2 IF _MOUSEBUTTON(3) THEN b% = b% OR 4 LOOP UNTIL _MOUSEINPUT = 0 x% = _MOUSEX y% = _MOUSEYEND SUB

Navigation

[0] Message Index

Go to full version