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

Offline The Librarian

  • Moderator
Tic Tac Toe in 3D by qbguy
« on: March 10, 2018, 12:15:17 PM »
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: [Select]
DECLARE SUB SHOWWIN (C%, R%, p%, COLOUR%)
DECLARE SUB MAKEMOVE (X%, Y%, Z%, COLOUR%)
DECLARE SUB GETMOVE (X%, Y%, Z%)
DEFINT A-Z
DIM E(7), PEEKB(1999)
RANDOMIZE TIMER
CLS
GOSUB INIT
E(1) = 254: E(2) = 18: E(3) = 2: E(4) = 1: E(5) = 2: E(6) = 66: E(7) = 255
Q = 564: G = 628: L = 768
FOR K = G TO G + 63
    PEEKB(K) = 128
NEXT
FOR K = S TO S + 75
    PEEKB(K) = 128
NEXT
100 CALL GETMOVE(C, R, p)
X = 16 * (p - 1) + 4 * (R - 1) + C - 1
IF PEEKB(G + X) <> 128 THEN GOTO 100
CALL MAKEMOVE(C, R, p, 1)
M = -1: GOSUB 1000
GOSUB 2000
IF W THEN CALL SHOWWIN(C, R, p, 1): END
IF T THEN LOCATE 15, 33: PRINT " --- Tie game --- ": END
GOSUB 3000
M = 1: GOSUB 1000
GOSUB 2000
GOSUB 7000
IF W THEN CALL SHOWWIN(C, R, p, 4): END
IF T THEN LOCATE 15, 33: PRINT " --- Tie game --- ": END
GOTO 100

1000
PEEKB(G + X) = 128 + M
FOR 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) = V
1001 NEXT
RETURN

2000
W = 0: T = 1
FOR K = S TO S + 75
    V = PEEKB(K)
    IF V THEN T = 0
    IF ABS(V - 128) = 4 THEN W = 1
NEXT
RETURN

3000
FOR K = Q TO Q + 63
    PEEKB(K) = 0
NEXT
FOR 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 NEXT
3002 NEXT
V9 = 0
FOR 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) = V
NEXT
IF V9 < 32 THEN GOTO 4000
3800 X = 0
DO
    IF PEEKB(Q + X) = V9 THEN RETURN
    X = X + 1
LOOP
4000 P4 = 16
FOR 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 NEXT
4002 NEXT
IF V4 = 0 THEN GOTO 3800
RETURN

7000
p = X \ 16 + 1
X = X - 16 * (p - 1)
R = X \ 4 + 1
C = (X MOD 4) + 1
CALL MAKEMOVE(C, R, p, 4)
RETURN


INIT:
L = 768
FOR K = 0 TO 63
    PEEKB(L + K) = K
NEXT
L = L + 64
a = 4: B = 16
FOR S = 1 TO 4
    GOSUB 19000
NEXT
a = 16: B = 1
FOR S = 1 TO 13 STEP 4
    GOSUB 19000
NEXT
S = 1: a = 5: B = 16: GOSUB 19000
S = 13: a = -3: B = 16: GOSUB 19000
S = 1: a = 20: B = 1: GOSUB 19000
S = 49: a = -12: B = 1: GOSUB 19000
S = 1: a = 17: B = 4: GOSUB 19000
S = 49: a = -15: B = 4: GOSUB 19000
S = 1: D = 21: GOSUB 18000
S = 16: D = 11: GOSUB 18000
S = 4: D = 19: GOSUB 18000
S = 13: D = 13: GOSUB 18000
GOSUB DRAWBD
RETURN

18000
FOR K = S TO S + 3 * D STEP D
    PEEKB(L) = K - 1: L = L + 1
NEXT
RETURN

19000
FOR J = S TO S + 3 * B STEP B
    FOR K = J TO J + 3 * a STEP a
        PEEKB(L) = K - 1: L = L + 1
    NEXT
NEXT
RETURN

DRAWBD:
SCREEN 12
LINE (0, 0)-(639, 479), 7, BF
LINE (23, 23)-(616, 456), 0, B
LINE (24, 24)-(615, 455), 14, BF
Y = 130: GOSUB GRID
Y = 230: GOSUB GRID
Y = 330: GOSUB GRID
Y = 430: GOSUB GRID
PAINT (24, 24), 3, 0
RETURN

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), 0
NEXT
FOR 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), 0
NEXT
RETURN

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 GETPOS
END 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, 8
END 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
    NEXT
END 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% = _MOUSEY
END SUB

« Last Edit: August 09, 2018, 12:19:10 AM by odin »