This is 3d tic tac toe. You get 4 in a row to win and it is on a 4 by 4 board. Moves are entered as a 3 digit number, where the hundreds digit represents the plane, the tens digit represents the column, and the one's digit represents the row.
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
GetMove:
INPUT "X IN SQUARE: ", X
P = X \ 100: IF P < 1 OR P > 4 THEN GOTO GetMove
X = X - 100 * P: C = X \ 10: IF C < 1 OR C > 4 THEN GOTO GetMove
R = X - 10 * C: IF R < 1 OR R > 4 THEN GOTO GetMove
X = 16 * (P - 1) + 4 * (R - 1) + C - 1
IF PEEKB(G + X) <> 128 THEN GOTO GetMove
M = -1: GOSUB 1000
GOSUB 2000
IF W THEN
PRINT "--- YOU WON ---"
END
END IF
IF T THEN
PRINT "--- TIE ---"
END
END IF
GOSUB 3000
M = 1: GOSUB 1000
GOSUB 2000
GOSUB 7000
GOSUB 9000
IF W THEN
PRINT "--- I WON ---"
END
END IF
IF T THEN
PRINT "--- TIE ---"
END
END IF
GOTO GetMove
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
PRINT "O IN SQUARE "; P; C; R
RETURN
9000
PRINT
FOR R = 4 TO 1 STEP -1
FOR P = 1 TO 4
FOR C = 1 TO 4
X = 16 * (P - 1) + 4 * (R - 1) + C - 1
V = PEEKB(G + X)
IF V = 127 THEN PRINT " X";
IF V = 128 THEN PRINT " -";
IF V = 129 THEN PRINT " 0";
NEXT: PRINT " ";
NEXT: PRINT
NEXT
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
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
DECLARE SUB ENDGAME (X%)
DECLARE SUB MAKEMOVE (X%, Y%, Z%, COLOUR%)
DECLARE SUB GETMOVE (X%, Y%, Z%)
DEFINT A-Z
TYPE REGTYPE
AX AS INTEGER
BX AS INTEGER
CX AS INTEGER
DX AS INTEGER
BP AS INTEGER
SI AS INTEGER
DI AS INTEGER
FLAGS AS INTEGER
END TYPE
DIM SHARED REGS AS REGTYPE
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 ENDGAME(-1)
IF T THEN CALL ENDGAME(0)
GOSUB 3000
M = 1: GOSUB 1000
GOSUB 2000
GOSUB 7000
IF W THEN CALL ENDGAME(1)
IF T THEN CALL ENDGAME(0)
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 (24, 24)-(615, 455), 3, BF
Y = 130: GOSUB GRID
Y = 230: GOSUB GRID
Y = 330: GOSUB GRID
Y = 430: GOSUB GRID
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 ENDGAME (X)
IF X = -1 THEN
X$ = " YOU WON "
ELSEIF X = 0 THEN
X$ = " TIE "
ELSE
X$ = " I WON "
END IF
COL = 40 - LEN(X$) / 2
LOCATE 13, COL
PRINT CHR$(218) + STRING$(LEN(X$), CHR$(196)) + CHR$(191)
LOCATE 14, COL
PRINT CHR$(179) + X$ + CHR$(179)
LOCATE 15, COL
PRINT CHR$(192) + STRING$(LEN(X$), CHR$(196)) + CHR$(217)
END SUB
SUB GETMOVE (X, Y, Z)
REGS.AX = 1
CALL INTERRUPT(&H33, REGS, REGS)
GETPOS:
IF INKEY$ = CHR$(27) THEN END
REGS.AX = 3
CALL INTERRUPT(&H33, REGS, REGS)
Z = (REGS.DX - 30) \ 100 + 1
IF Z < 1 OR Z > 4 THEN GOTO GETPOS
Y = ((REGS.DX - 30) \ 20) MOD 5
IF Y < 1 OR Y > 4 THEN GOTO GETPOS
IF REGS.CX + REGS.DX - 150 - 100 * Z < 0 THEN GOTO GETPOS
X = (REGS.CX + REGS.DX - 150 - 100 * Z) \ 80 + 1
IF X < 1 OR X > 4 THEN GOTO GETPOS
IF REGS.BX = 0 THEN GOTO GETPOS
REGS.AX = 2
CALL INTERRUPT(&H33, REGS, REGS)
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
DECLARE SUB INTERRUPTQB (intnum AS INTEGER, InReg AS ANY, OutReg AS ANY)
DECLARE SUB ENDGAME (X%)
DECLARE SUB MAKEMOVE (X%, Y%, Z%, COLOUR%)
DECLARE SUB GETMOVE (X%, Y%, Z%)
DEFINT A-Z
TYPE RegType
AX AS INTEGER
BX AS INTEGER
CX AS INTEGER
DX AS INTEGER
BP AS INTEGER
SI AS INTEGER
DI AS INTEGER
FLAGS AS INTEGER
END TYPE
DIM SHARED REGS AS RegType
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 ENDGAME(-1)
IF T THEN CALL ENDGAME(0)
GOSUB 3000
M = 1: GOSUB 1000
GOSUB 2000
GOSUB 7000
IF W THEN CALL ENDGAME(1)
IF T THEN CALL ENDGAME(0)
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 (24, 24)-(615, 455), 3, BF
Y = 130: GOSUB GRID
Y = 230: GOSUB GRID
Y = 330: GOSUB GRID
Y = 430: GOSUB GRID
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 ENDGAME (X)
IF X = -1 THEN
X$ = " YOU WON "
ELSEIF X = 0 THEN
X$ = " TIE "
ELSE
X$ = " I WON "
END IF
COL = 40 - LEN(X$) / 2
LOCATE 13, COL
PRINT CHR$(218) + STRING$(LEN(X$), CHR$(196)) + CHR$(191)
LOCATE 14, COL
PRINT CHR$(179) + X$ + CHR$(179)
LOCATE 15, COL
PRINT CHR$(192) + STRING$(LEN(X$), CHR$(196)) + CHR$(217)
END SUB
SUB GETMOVE (X, Y, Z)
REGS.AX = 1
CALL INTERRUPTQB(&H33, REGS, REGS)
GETPOS:
IF INKEY$ = CHR$(27) THEN END
REGS.AX = 3
CALL INTERRUPTQB(&H33, REGS, REGS)
Z = (REGS.DX - 30) \ 100 + 1
IF Z < 1 OR Z > 4 THEN GOTO GETPOS
Y = ((REGS.DX - 30) \ 20) MOD 5
IF Y < 1 OR Y > 4 THEN GOTO GETPOS
IF REGS.CX + REGS.DX - 150 - 100 * Z < 0 THEN GOTO GETPOS
X = (REGS.CX + REGS.DX - 150 - 100 * Z) \ 80 + 1
IF X < 1 OR X > 4 THEN GOTO GETPOS
IF REGS.BX = 0 THEN GOTO GETPOS
REGS.AX = 2
CALL INTERRUPTQB(&H33, REGS, REGS)
END SUB
SUB INTERRUPTQB (intnum AS INTEGER, InReg AS RegType, OutReg AS RegType)
'standard INTERRUPTQB call compatibility with QBasic
'some static variables
STATIC a() AS LONG, bReady AS INTEGER
'If assembler array not created, create it
IF NOT bReady THEN
'don't change anything
I = 50: DIM a(1 TO I) AS LONG
a(1) = &H53EC8B55: a(2) = &H1E575651: a(3) = &H5E8B9C06: a(4) = &HA078B0E
a(5) = &HC70774E4: a(6) = &HE9FFFF07: a(7) = &HEC8300A1: a(8) = &HB3F88A0A
a(9) = &HE85E89CD: a(10) = &HCBEA46C7: a(11) = &H74253C90: a(12) = &H75263C04
a(13) = &HEA46C714: a(14) = &H46C701E8: a(15) = &HC7CB00EC: a(16) = &H2C2EE46
a(17) = &HF046C7: a(18) = &H85E8B90: a(19) = &H5E8B37FF: a(20) = &HE37FF06
a(21) = &H50008FB8: a(22) = &HE85E8D16: a(23) = &H8BDA8C53: a(24) = &H378B0A5E
a(25) = &H8E0C5E8B: a(26) = &H10448B1F: a(27) = &H75FFFF3D: a(28) = &H50C28B02
a(29) = &H3D12448B: a(30) = &H275FFFF: a(31) = &HC08EC28B: a(32) = &H5C8B048B
a(33) = &H44C8B02: a(34) = &H8B06548B: a(35) = &H748B0C7C: a(36) = &H9CCB1F0A
a(37) = &H83EC8B55: a(38) = &H1E5620C5: a(39) = &H89E476C5: a(40) = &H25C8904
a(41) = &H89044C89: a(42) = &H7C890654: a(43) = &H12448C0C: a(44) = &H8F10448F
a(45) = &H448F0A44: a(46) = &HE448F08: a(47) = &H9D0EC483: a(48) = &H5E5F1F07
a(49) = &HCA5D5B59: a(50) = &H9165000A
'Checksum, can be ommited
S1 = 0: S2 = 0: p = VARPTR(a(1)): DEF SEG = VARSEG(a(1))
FOR I = 0 TO 199
S1 = (S1 + PEEK(p + I)) MOD 255: S2 = (S2 + S1) MOD 255
NEXT I
IF S1 OR S2 THEN ERROR 2: intnum = -1: EXIT SUB ' Checksum Error
'End of the checksum
bReady = -1
END IF
'This is where we call our assembler INTERRUPTQB calling function
DEF SEG = VARSEG(a(1))
CALL ABSOLUTE(intnum, VARSEG(InReg), VARPTR(InReg), VARSEG(OutReg), VARPTR(OutReg), 0)
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
DECLARE SUB INTERRUPTQB (intnum AS INTEGER, InReg AS ANY, OutReg AS ANY)
DECLARE SUB SHOWWIN (C%, R%, p%, COLOUR%)
DECLARE SUB MAKEMOVE (X%, Y%, Z%, COLOUR%)
DECLARE SUB GETMOVE (X%, Y%, Z%)
DEFINT A-Z
TYPE RegType
AX AS INTEGER
BX AS INTEGER
CX AS INTEGER
DX AS INTEGER
BP AS INTEGER
SI AS INTEGER
DI AS INTEGER
FLAGS AS INTEGER
END TYPE
DIM SHARED REGS AS RegType
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)
REGS.AX = 1
CALL INTERRUPTQB(&H33, REGS, REGS)
GETPOS:
IF INKEY$ = CHR$(27) THEN END
REGS.AX = 3
CALL INTERRUPTQB(&H33, REGS, REGS)
Z = (REGS.DX - 30) \ 100 + 1
IF Z < 1 OR Z > 4 THEN GOTO GETPOS
Y = ((REGS.DX - 30) \ 20) MOD 5
IF Y < 1 OR Y > 4 THEN GOTO GETPOS
IF REGS.CX + REGS.DX - 150 - 100 * Z < 0 THEN GOTO GETPOS
X = (REGS.CX + REGS.DX - 150 - 100 * Z) \ 80 + 1
IF X < 1 OR X > 4 THEN GOTO GETPOS
IF REGS.BX = 0 THEN GOTO GETPOS
REGS.AX = 2
CALL INTERRUPTQB(&H33, REGS, REGS)
END SUB
SUB INTERRUPTQB (intnum AS INTEGER, InReg AS RegType, OutReg AS RegType)
'standard INTERRUPTQB call compatibility with QBasic
'some static variables
STATIC a() AS LONG, bReady AS INTEGER
'If assembler array not created, create it
IF NOT bReady THEN
'don't change anything
I = 50: DIM a(1 TO I) AS LONG
a(1) = &H53EC8B55: a(2) = &H1E575651: a(3) = &H5E8B9C06: a(4) = &HA078B0E
a(5) = &HC70774E4: a(6) = &HE9FFFF07: a(7) = &HEC8300A1: a(8) = &HB3F88A0A
a(9) = &HE85E89CD: a(10) = &HCBEA46C7: a(11) = &H74253C90: a(12) = &H75263C04
a(13) = &HEA46C714: a(14) = &H46C701E8: a(15) = &HC7CB00EC: a(16) = &H2C2EE46
a(17) = &HF046C7: a(18) = &H85E8B90: a(19) = &H5E8B37FF: a(20) = &HE37FF06
a(21) = &H50008FB8: a(22) = &HE85E8D16: a(23) = &H8BDA8C53: a(24) = &H378B0A5E
a(25) = &H8E0C5E8B: a(26) = &H10448B1F: a(27) = &H75FFFF3D: a(28) = &H50C28B02
a(29) = &H3D12448B: a(30) = &H275FFFF: a(31) = &HC08EC28B: a(32) = &H5C8B048B
a(33) = &H44C8B02: a(34) = &H8B06548B: a(35) = &H748B0C7C: a(36) = &H9CCB1F0A
a(37) = &H83EC8B55: a(38) = &H1E5620C5: a(39) = &H89E476C5: a(40) = &H25C8904
a(41) = &H89044C89: a(42) = &H7C890654: a(43) = &H12448C0C: a(44) = &H8F10448F
a(45) = &H448F0A44: a(46) = &HE448F08: a(47) = &H9D0EC483: a(48) = &H5E5F1F07
a(49) = &HCA5D5B59: a(50) = &H9165000A
'Checksum, can be ommited
S1 = 0: S2 = 0: p = VARPTR(a(1)): DEF SEG = VARSEG(a(1))
FOR I = 0 TO 199
S1 = (S1 + PEEK(p + I)) MOD 255: S2 = (S2 + S1) MOD 255
NEXT I
IF S1 OR S2 THEN ERROR 2: intnum = -1: EXIT SUB ' Checksum Error
'End of the checksum
bReady = -1
END IF
'This is where we call our assembler INTERRUPTQB calling function
DEF SEG = VARSEG(a(1))
CALL ABSOLUTE(intnum, VARSEG(InReg), VARPTR(InReg), VARSEG(OutReg), VARPTR(OutReg), 0)
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
DECLARE SUB SHOWWIN (C%, R%, P%, COLOUR%)
DECLARE SUB MAKEMOVE (X%, Y%, Z%, COLOUR%)
DECLARE SUB GETMOVE (X%, Y%, Z%)
DEFINT A-Z
TYPE REGTYPE
AX AS INTEGER
BX AS INTEGER
CX AS INTEGER
DX AS INTEGER
BP AS INTEGER
SI AS INTEGER
DI AS INTEGER
FLAGS AS INTEGER
END TYPE
DIM SHARED REGS AS REGTYPE
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)
REGS.AX = 1
CALL INTERRUPT(&H33, REGS, REGS)
GETPOS:
IF INKEY$ = CHR$(27) THEN END
REGS.AX = 3
CALL INTERRUPT(&H33, REGS, REGS)
Z = (REGS.DX - 30) \ 100 + 1
IF Z < 1 OR Z > 4 THEN GOTO GETPOS
Y = ((REGS.DX - 30) \ 20) MOD 5
IF Y < 1 OR Y > 4 THEN GOTO GETPOS
IF REGS.CX + REGS.DX - 150 - 100 * Z < 0 THEN GOTO GETPOS
X = (REGS.CX + REGS.DX - 150 - 100 * Z) \ 80 + 1
IF X < 1 OR X > 4 THEN GOTO GETPOS
IF REGS.BX = 0 THEN GOTO GETPOS
REGS.AX = 2
CALL INTERRUPT(&H33, REGS, REGS)
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
In my computer this did not work
I could understand "why?"
I know "BASIC" BUT of primary level
CAN ANY ONE HELP IN THIS problem & give important notes of this language
KINDLY SEND ME AT my friends id plz
E-MAIL ID : [email protected]
Make a batch (BAT) file to run the Library with QB 4.5 as follows.
For Windows 9x & ME use: QB.EXE /L
For Windows XP & NT use: Cmd /C START QB.EXE /L
Run the batch file and QB 4.5 should come up. Interrupt and Absolute calls require the library. Qbasic.exe cannot use Interrupts!
I assume you copied the code to a text file. Use File Menu - Open and change the file search line from *.BAS to *.TXT. Click on the file you made. Then press F5.
Ted
This message has been edited by burger2227 on Jan 30, 2009 8:13 PM