mmbasic_original:hi_iq_solitaire
Hi-IQ (Solitaire)
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.
HIGHIQ.BAS
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
mmbasic_original/hi_iq_solitaire.txt · Last modified: 2024/01/19 09:39 by 127.0.0.1