Updated 31st January 2012

3D Noughts and Crosses the listing in vanilla. Here it is. Mainly bug free in the sense that limited testing has revealed no more obvious bugs. It is still possible that some remain hidden. Or some were introduced when this listing was copied from QD via the scrap to Windows clipboard and pasted in to blogger. Who knows. The only way to find out is to copy the listing back into a QL emulator on your PC.

10 REMark 3d noughts and crosses

20 :

30 :

40 CLEAR

50 :

60 initialise : REMark all game data and variables

70 display_board true% : REMark display empty board - once only

80 REPeat until_no_more_games

90 init_for_new_game

100 REPeat until_end_of_game

110 IF whos_go% = you% THEN

120 move% = get_your_move

130 ELSE

140 move% = generate_my_move

150 END IF

160 update_board(move%): result%=update_game_tables (move%)

170 IF result% <> game_not_over% THEN EXIT until_end_of_game

180 whos_go% = whos_go%*-1

190 END REPeat until_end_of_game

200 new_game% = game_over (result%)

210 IF NOT new_game% THEN EXIT until_no_more_games

220 display_board false%

230 END REPeat until_no_more_games

240 CLOSE#4 : CLOSE#5 : STOP

250 :

260 :

270 DEFine FuNction generate_my_move

280 LOCal i,j,p%,sq%,my2_count%,your2_count%,val,maxval,pathv

290 CLS #5 : PRINT#5," MY MOVE":PRINT#5," ...THINKING"

300 IF moves%<2 THEN

310 PAUSE 75

320 IF board%(1) = 0 THEN RETurn 1

330 IF board%(4) = 0 THEN RETurn 4

340 END IF

350 IF moves% > 4 THEN

360 p%=0

370 FOR i = 1 TO 76

380 IF path_value(i) = me% * 3 THEN RETurn find_square (i)

390 IF path_value(i) = you% * 3 THEN p% = i

400 END FOR i

410 IF p% > 0 THEN RETurn find_square (p%)

420 END IF

430 maxval = -1 : sq% = 0

440 FOR i = 1 TO 64

450 IF board%(i) = 0 THEN

460 val=0 :my2_count%=0 : your2_count%=0

470 FOR j= 1 TO sq_to_path%(i,0)

480 pathv = path_value(sq_to_path%(i,j))

490 IF pathv <> dead% THEN

495 IF pathv = 2 * me% THEN my2_count% = my2_count% + 1

500 IF pathv = 2*you% THEN your2_count%= your2_count% + 1

510 val = val +ABS(pathv) + .2 + 5E-2 * (pathv >0)

520 END IF

530 NEXT j

540 IF my2_count% > 1 THEN RETurn i

550 IF your2_count% > 1 THEN sq% = i * -1

560 IF val >maxval AND sq% >= 0 THEN

570 maxval = val : sq% =i

580 END IF

590 END FOR j

600 END IF

610 END FOR i

620 RETurn ABS(sq%)

630 END DEFine

640 :

650 DEFine FuNction find_square(path%)

660 LOCal i

670 FOR i = 1 TO 4

680 IF board%(winning_paths%(path%,i)) = 0 THEN RETurn winning_paths%(path%,i)

690 END FOR i

700 STOP : REMark software error

710 END DEFine

720 :

730 DEFine PROCedure update_board(m%)

740 board%(m%) = whos_go% : moves% = moves% + 1

750 fill_previous_square

760 print_square m%,(whos_go%+3),1,true%

770 END DEFine

780 :

790 DEFine FuNction update_game_tables (sq%)

800 LOCal i,p%

810 FOR i = 1 TO sq_to_path%(sq%,0)

820 p% = sq_to_path%(sq%,i)

830 IF path_value(p%) <> dead% THEN

840 IF path_value(p%)*whos_go% < 0 THEN

850 path_value(p%) = dead%

860 dead_paths% = dead_paths% + 1

870 IF dead_paths% = 76 THEN RETurn stalemate%

880 ELSE

890 path_value(p%) = path_value(p%) + whos_go%

900 IF path_value(p%) = 4 * whos_go% THEN

910 highlight_winning_path(p%)

920 RETurn whos_go%

930 END IF

940 END IF

950 END IF

960 END FOR i

970 RETurn game_not_over%

980 END DEFine

990 :

1000 DEFine FuNction get_your_move

1010 LOCal x%,x,k%

1020 CLS#5 : PRINT#5," YOUR MOVE"

1026 FOR x = 1 TO 64 : IF board%(x) = 0 THEN x%=x : EXIT x

1040 REPeat until_enter

1050 print_square x%,7,0,false% : x = x%

1060 REPeat get_cursor

1070 k%=CODE(INKEY$(-1))

1080 IF k%= 10 THEN EXIT get_cursor

1090 IF k%= 32 THEN x% = find_next_sq (x%,16) : EXIT get_cursor

1100 IF k%= 192 THEN x% = find_next_sq (x%,-1) : EXIT get_cursor

1110 IF k%= 200 THEN x% = find_next_sq (x%,1) : EXIT get_cursor

1120 IF k%= 216 THEN x% = find_next_sq (x%,4) : EXIT get_cursor

1130 IF k%= 208 THEN x% = find_next_sq (x%,-4) : EXIT get_cursor

1140 END REPeat get_cursor

1150 print_square x,0,0,false%

1160 IF k% = 10 THEN RETurn x%

1170 END REPeat until_enter

1180 END DEFine

1190 :

1200 DEFine FuNction find_next_sq(start%,offset%)

1210 LOCal x%

1220 x%=start% : REMark x% = (start% + offset% + 63) mod 64 +1

1230 REMark if offset% > 0 then offset% = 1 : else offset = -1

1240 IF offset% = 16 THEN x%=(x%+15) DIV 16*16 : offset% = 1

1250 REPeat find_empty_sq

1260 x%=(x%+offset%+63) MOD 64 + 1 : REMark if board%(x%)=0 then return X%

1270 IF board%(x%) = 0 THEN RETurn x%

1280 REMark x% = x% + offset% : if x%= 0 OR x% = 65 then x% = (x% + 63) mod 64 + 1

1290 END REPeat find_empty_sq

1300 END DEFine

1310 :

1320 DEFine PROCedure fill_previous_square

1330 IF prev_ink <> 0 THEN INK#4,prev_ink : print_x% = save_x% : print_y% = save_y% : fill_square 1, false%

1340 END DEFine

1350 :

1360 DEFine PROCedure print_square (sq%,ik%,fill%,half_sq%)

1370 LOCal plane%,col%,row%,locink%

1380 plane% = invert ((sq%-1) DIV 16)

1390 row% = invert (((sq%-1) MOD 16) DIV 4)

1400 col% = (sq%-1) MOD 4

1410 print_x% = x0% + (col%*xsq%)+(row%*(x01%-x0%) DIV 4) : REMark + 5

1420 print_y% = y0% + (plane%*y_diff%) + (row%*ysq%) : REMark + 1

1430 INK#4,ik%

1440 IF half_sq% THEN

1450 save_x% = print_x% : save_y% = print_y% : prev_ink = ik%

1460 END IF

1470 fill_square fill%,half_sq%

1480 INK#4,0

1490 END DEFine

1500 :

1510 DEFine FuNction invert(n%)

1520 IF n%=0 THEN RETurn 3

1530 IF n%=1 THEN RETurn 2

1540 IF n%=2 THEN RETurn 1

1550 RETurn 0

1560 END DEFine

1570 :

1580 DEFine PROCedure fill_square (fill%,half%)

1590 FILL#4,fill%

1600 IF NOT half% THEN

1610 LINE#4,print_x%+3,print_y%+1 TO print_x%+xsq%-1,print_y%+1 TO print_x%+xsq%-3+(x01%-x0%) DIV 4,print_y%+ysq%-1 TO print_x%+1+(x01%-x0%) DIV 4, print_¼y%+ysq%-1 TO print_x%+3,print_y%+1

1620 ELSE

1630 LINE#4,print_x%+3,print_y%+1 TO print_x%+xsq%-1,print_y%+1 TO print_x%+1+(x01%-x0%) DIV 4,print_y%+ysq%-1 TO print_x%+3, print_y%+1

1640 END IF

1650 FILL#4,0

1660 END DEFine

1670 :

1680 DEFine PROCedure highlight_winning_path (path%)

1690 LOCal i%,sq%

1700 FOR i = 1 TO 4

1710 sq%= winning_paths%(path%,i)

1720 print_square winning_paths%(path%,i),7,1,true%

1730 END FOR i

1740 END DEFine

1750 :

1760 DEFine PROCedure init_board_variables

1770 x0%=10 : y0%=4 : x1%=50 : y1%=24 : x01%=30 : x11%=70 : y_diff%=24

1780 xsq%=(x1%-x0%) DIV 4 : ysq% = (y1%-y0%) DIV 4

1790 END DEFine

1800 :

1810 DEFine PROCedure display_board (init%)

1820 prev_ink=0

1830 IF init% THEN

1840 PAPER #4,0 : INK #4,7 : CLS#4

1850 FOR i = 0 TO 3

1860 FOR j = 0 TO 4

1870 fromx% = x0% +(j*(x01%-x0%)DIV 4 ) : fromy% = y0% + (i*y_diff%) + (ysq%*j)

1880 IF j = 0 THEN

1890 FILL #4,1

1900 LINE #4,fromx%,fromy% TO fromx%+x1%-x0%,fromy% TO fromx%+x1%-x0%,fromy%-2 TO fromx%,fromy%-2 TO fromx%,fromy%

1910 FILL #4,0

1920 END IF

1930 LINE #4,fromx%,fromy% TO fromx% + x1%-x0%,fromy%

1940 fromx% = x0% +j * xsq% : fromy% = y0% + i * y_diff%

1950 LINE #4,fromx%,fromy% TO fromx% + x01%-x0%,fromy% + y1%-y0%

1960 IF j = 4 THEN

1970 FILL #4,1

1980 LINE #4,fromx%,fromy% TO fromx%+x01%-x0%,fromy% + y1%-y0% TO fromx%+x01%-x0%,fromy%+y1%-y0%-2 TO fromx%,fromy%-2 TO fromx%,fromy%

1990 FILL #4,0

2000 END IF

2010 END FOR j

2020 END FOR i

2030 ELSE

2040 FOR i = 1 TO 64

2050 IF board%(i) <> 0 THEN print_square i,0,1,false%

2060 END FOR i

2070 END IF

2080 END DEFine

2090 :

2100 DEFine FuNction game_over (res%)

2110 LOCal r% : r% = true%

2120 CLS#5

2130 IF res% = you% THEN PRINT #5," YOU WIN"

2140 IF res% = me% THEN PRINT #5," I WIN"

2150 IF res% = stalemate% THEN PRINT #5," STALEMATE"

2160 PRINT # 5,"ANOTHER GAME? Y/N";

2170 REPeat another_game

2180 q$ = INKEY$(#5,-1)

2190 IF q$ = "y" THEN EXIT another_game

2195 IF q$ = "Y" THEN EXIT another_game

2200 IF q$ = "n" THEN r%= false% : EXIT another_game

2205 IF q$ = "N" THEN r%= false% : EXIT another_game

2210 END REPeat another_game

2220 CLS#5 : RETurn r%

2230 END DEFine

2240 :

2250 DEFine PROCedure init_for_new_game

2260 moves%=0 : dead_paths% = 0

2270 FOR i = 1 TO 76 : path_value(i) = 0 : END FOR i

2280 FOR i = 1 TO 64 : board%(i) = 0 : END FOR i

2290 IF RND < .5 THEN whos_go% = you% : ELSE whos_go% = me%

2300 END DEFine

2310 :

2320 DEFine PROCedure initialise

2330 DIM board%(64),winning_paths%(76,4),sq_to_path%(64,8)

2340 DIM path_value(76)

2350 REMark MODE 4

2360 BORDER#1,0:PAPER#1,0:BORDER#2,0:PAPER#2,0:CLS#1:CLS#2

2370 OPEN#4,scr_226x206a43x0 : BORDER#4,2,4 : PAPER#4,7

2380 OPEN#5,con_226x44a43x211 : BORDER#5,2,4 : PAPER#5,0 : INK#5,7 : CLS#5 : CSIZE#5,2,1

2390 instructions

2400 init_winning_paths

2410 init_board_variables

2420 true% = (1=1) : false% = (1=2)

2430 first%=true% : you% = -1 : me% = 1

2440 game_not_over% = 0

2450 stalemate% = 99

2460 dead% = 99

2470 PRINT#4:PRINT#4:PRINT#4," PRESS ANY KEY WHEN READY":PAUSE

2480 END DEFine

2490 :

2500 DEFine PROCedure init_winning_paths

2510 LOCal x%,no_of_datasets%,first%,sq_inc%,path_inc%,no_of_paths%,val%

2520 x%=1

2530 READ no_of_datasets%

2540 FOR i = 1 TO no_of_datasets%

2550 READ first%,sq_inc%,path_inc%,no_of_paths%

2560 val% = first%

2570 FOR j = 1 TO no_of_paths%

2580 FOR k = 1 TO 4

2590 winning_paths%(x%,k) = val%

2600 sq_to_path%(val%,0) = sq_to_path%(val%,0)+1

2610 sq_to_path%(val%,sq_to_path%(val%,0))=x%

2620 val% = val% + sq_inc%

2630 END FOR k

2640 val% = val% - 4 * sq_inc% +path_inc%

2650 x% = x% + 1

2660 END FOR j

2670 END FOR i

2680 END DEFine

2690 :

2700 DATA 16

2710 DATA 1,1,4,16

2720 DATA 1,4,1,4

2730 DATA 17,4,1,4

2740 DATA 33,4,1,4

2750 DATA 49,4,1,4

2760 DATA 1,15,1,16

2770 DATA 1,5,16,4

2780 DATA 4,3,16,4

2790 DATA 1,17,4,4

2800 DATA 1,20,1,4

2810 DATA 13,12,1,4

2820 DATA 4,15,4,4

2830 DATA 1,21,0,1

2840 DATA 4,19,0,1

2850 DATA 13,13,0,1

2860 DATA 16,11,0,1

2865 :

2870 DEFine PROCedure instructions

2880 CLS#4 : INK#4,0

2890 PRINT#4," 3D NOUGHTS AND CROSSES"

2900 PRINT#4," ======================"

2910 PRINT#4," This is noughts and crosses played"

2920 PRINT#4," on a 4x4x4x4 grid."

2930 PRINT#4," The object of the game is to get 4"

2940 PRINT#4," in a line through the grid."

2950 PRINT#4," When it is your turn to move, use"

2960 PRINT#4," the cursor keys to move the cursor"

2970 PRINT#4," in the indicated direction, or the"

2980 PRINT#4," SPACE bar to move it into the next"

2990 PRINT#4," plane."

3000 PRINT#4," when you have located the desired"

3010 PRINT#4," square,press the ENTER key to make"

3020 PRINT#4," your move. ALL WILL BECOME CLEAR."

3030 PRINT#4

3040 PRINT#4," PLEASE WAIT WHILE I INITIALISE THE"

3050 PRINT#4," COMPUTER VARIABLES AND THE BOARD."

3060 END DEFine