Vanilla 3D Noughts and Crosses Enjoy

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