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