FotS

This module is part of the original MMBasic library. It is reproduced here with kind permission of Hugh Buckle and Geoff Graham. Be aware it may reference functionality which has changed or is deprecated in the latest versions of MMBasic.

5 CLS
10 PRINT TAB(33);"HIGH - IQ"
15 PRINT:PRINT
20 PRINT TAB(15);"CREATIVE COMPUTING - MODIFIED BY BILL BROWN"
40 DIM B(70),T(9,9)
50 LOCATE 40,70:INPUT"DO YOU REQUIRE INSTRUCTIONS - (Y/N) ";Q$
60 IF Q$ ="N" OR Q$="n" THEN 235
80 PRINT: PRINT"THIS IS A COMPUTERIZED VERSION OF AN OLD EUROPEAN"
90 PRINT "SOLITAIRE GAME OF LOGIC.  THE GAME STARTS WITH A PEGBOARD"
100 PRINT "SHAPED LIKE A CROSS HAVING PEGS IN EVERY HOLE BUT THE"
110 PRINT "CENTER.  THE OBJECT IS TO REMOVE ALL 32 PEGS, OR AS MANY"
120 PRINT "AS POSSIBLE, BY JUMPING INTO AN EMPTY HOLE, THEN REMOVING"
130 PRINT "THE JUMPED PEG."
140 PRINT "THERE ARE SEVERAL DIFFERENT WINNING STRATEGIES FOR PLAYING AND "
150 PRINT "OF OF COURSE, EACH STRATEGY CAN BE PLAYED EIGHT DIFFERENT WAYS"
160 PRINT "ON THE BOARD.  CAN YOU FIND A CONSTANT WINNER?"
161 PRINT "TO TERMINATE THE GAME AT ANY TIME, ENTER '0' WHEN ASKED FOR MOVE"
235 PRINT:INPUT "PRESS [ENTER] TO START";L$
236 CLS
237 GOSUB 1350
240 FOR R=1 TO 9
250 FOR C=1 TO 9
260 IF (R-4)*(R-5)*(R-6)=0 THEN 300
270 IF (C-4)*(C-5)*(C-6)=0 THEN 300
280 T(R,C)=-5
290 GOTO 320
300 IF (R-1)*(C-1)*(R-9)*(C-9)=0 THEN 280
310 t(r,c)=5
320 NEXT C
330 NEXT R
340 T(5,5)=0:GOSUB 560
350 REM ********INPUT MOVE AND CHECK LEGALITY ******
360 FOR W=1 TO 33
370 READ M
380 DATA 13,14,15,22,23,24,29,30,31,32,33,34,35,38,39,40,41
390 DATA 42,43,44,47,48,49,50,51,52,53,58,59,60,67,68,69
400 B(M)=-7:NEXT W
410 B(41)=-3
420 LOCATE 158,360:PRINT "      "
421 LOCATE 50,380:PRINT "              "
425 LOCATE 50,360:INPUT "MOVE WHICH PIECE";Z
426 IF Z=0 THEN 1240
427 IF Z>70 THEN 440
430 IF B(Z)=-7 THEN 450
440 LOCATE 50,400:PRINT "ILLEGAL MOVE,  TRY AGAIN....!"
442 PAUSE 1000
445 LOCATE 50,400:PRINT "                             "
446 GOTO 420
450 LOCATE 50,380:INPUT "TO WHERE";P
455 IF P>70 THEN 440
460 IF B(P)=0 THEN 440
470 IF B(P)=-7 THEN 440
475 IF Z=P THEN 420
480 IF ((Z+P)/2)=INT((Z+P)/2) THEN 500
490 GOTO 440
500 IF (ABS(Z-P)-2)*(ABS(Z-P)-18)<>0 THEN 440
510 GOSUB 730
520 GOSUB 560
530 GOSUB 1000
540 GOTO 420
550 REM
560 REM ******* PRINT BOARD *********
570 FOR X= 1 TO 9
580 FOR Y=1 TO 9
590 IF (X-1)*(X-9)*(Y-1)*(Y-9)=0 THEN 620
600 IF (X-4)*(X-5)*(X-6)=0 THEN 640
610 IF (Y-4)*(Y-5)*(Y-6)=0 THEN 640
620 REM ********* 
630 GOTO 680
640 IF T(X,Y)<>5 THEN 670
650 CIRCLE(Y*40,X*40),8,2,F
660 GOTO 680
670 CIRCLE(Y*40,X*40),8,0,F
680 REM
690 NEXT Y
700 REM
710 NEXT X
720 RETURN
730 REM ******* UPDATE BOARD *******
740 C=1:FOR X=1 TO 9
760 FOR Y=1 TO 9
770 IF C<>Z THEN 960
780 IF C+2<>P THEN 830
790 IF T(X,Y+1)=0 THEN 440
800 T(X,Y+2)=5
810 T(X,Y+1)=0:B(C+1)=-3
820 GOTO 940
830 IF C+18<>P THEN 870
840 IF T(X+1,Y)=0 THEN 440
850 T(X+2,Y)=5:T(X+1,Y)=0:B(C+9)=-3
860 GOTO 940
870 IF C-2<>P THEN 910
880 IF T(X,Y-1)=0 THEN 440
890 T(X,Y-2)=5:T(X,Y-1)=0:B(C-1)=-3
900 GOTO 940
910 IF C-18<>P THEN 960
920 IF T(X-1,Y)=0 THEN 440
930 T(X-2,Y)=5:T(X-1,Y)=0:B(C-9)=-3
940 B(Z)=-3:B(P)=-7
950 T(X,Y)=0: GOTO 990
960 C=C+1
970 NEXT y
980 NEXT x
990 RETURN
1000 REM
1010 F=0
1020 FOR R=2 TO 8
1030 FOR C=2 TO 8
1040 IF T(R,C)<>5 THEN 1220
1050 F=F+1
1060 FOR A=R-1 TO R+1
1070 T=0
1080 FOR B=C-1 TO C+1
1090 T=T+T(A,B)
1100 NEXT B
1110 IF T<>10 THEN 1130
1120 IF T(A,C)<>0 THEN 1330
1130 NEXT A
1140 FOR X=C-1 TO C+1
1150 T=0
1160 FOR Y=R-1 TO R+1
1170 T=T+T(Y,X)
1180 NEXT Y
1190 IF T<>10 THEN 1210
1200 IF T(R,X)<>0 THEN 1330
1210 NEXT X
1220 NEXT C
1230 NEXT R
1240 REM ******* GAME IS OVER *******
1250 LOCATE 50,360:PRINT "THE GAME IS OVER       ";
1260 PRINT "YOU HAD ";F;" PIECES REMAINING"
1270 IF F<> 1 THEN 1300
1280 LOCATE 50,380:PRINT "BRAVE!  YOU MADE A PERFECT SCORE ";
1290 PRINT "SAVE THIS PAPER AS RECORD OF YOU ACCOMPLISHMENTS"
1300 LOCATE 50,400:INPUT "PLAY AGAIN (Y/N) ";A$
1310 IF A$="N" OR A$="n" THEN 1340
1320 RESTORE:GOTO 236
1330 RETURN
1340 LOCATE 180,400:PRINT "SO LONG FOR NOW."
1345 END
1350 LINE(140,60)-(260,340),3,B
1351 LOCATE 141,65:PRINT "13     14     15"
1352 LOCATE 141,105:PRINT "22     23     24"
1353 LOCATE 141,145:PRINT "31     32     33"
1354 LOCATE 141,185:PRINT "40     41     42"
1355 LOCATE 141,225:PRINT "49     50     51"
1356 LOCATE 141,265:PRINT "58     59     60"
1357 LOCATE 141,305:PRINT "67     68     69"
1358 LOCATE 61,145:PRINT "29     30"
1359 LOCATE 61,185:PRINT "38     39"
1360 LINE(60,140)-(340,260),3,B
1361 LOCATE 61,225:PRINT "47     48"
1362 LOCATE 261,145:PRINT "34     35"
1363 LOCATE 261,185:PRINT "43     44"
1364 LOCATE 261,225:PRINT "52     53"
1365 LINE(180,60)-(180,340),3
1366 LINE(220,60)-(220,340),3
1370 LINE(60,180)-(340,180).3
1380 LINE(60,220)-(340,220),3
1385 LINE(100,140)-(100,260),3
1390 LINE(300,140)-(300,260),3
1394 LINE(140,100)-(260,100),3
1396 LINE(140,300)-(260,300),3
1400 LOCATE 135,2:PRINT"_  _ _  __  _  _   _   __"
1401 LOCATE 135,10:PRINT"|  | | |    |  |   |  |  |"
1402 LOCATE 135,18:PRINT"|--| | | -  |--| - |  |  |"
1403 LOCATE 135,26:PRINT"|  | | |  | |  |   |  |  |"
1404 LOCATE 135,34:PRINT"-  - -  --  -  -   -   -\"
1600 RETURN