home *** CD-ROM | disk | FTP | other *** search
/ ftp.whtech.com / ftp.whtech.com.tar / ftp.whtech.com / club100 / gam / smartt.ba < prev    next >
Text File  |  2006-10-19  |  5KB  |  121 lines
  1. 1 'SMARTT.BA from CodeWorks Magazine by Steve Kelly, written for GW Basic
  2. 2 'Adapted for the M100 by Dave Thomas, modified by Robert Benson
  3. 40 CLS:PRINT:PRINTTAB(13);"SMART-TAC-TOE"
  4. 50 DEFINT P-Z:DEFSTR A-H
  5. 60 DIM P(9),Q1(9),Q2(8),Q3(2),Q4(8,9),Q5(9),A(2),P1(2,1023)
  6. 70 A(1)=" X ":A(2)=" O "
  7. 80 FOR Z=1 TO 9:READ Q1(Z):NEXT Z:E1=CHR$(30)
  8. 90 FOR Z=1 TO 8:READ Q2(Z):NEXT Z
  9. 100 FOR R2=1 TO 8:FOR X=1 TO 9:READ Q4(R2,X):NEXT X,R2
  10. 110 FOR X=1 TO 9:READ Q5(X):NEXT X:QG=-1
  11. 120 PRINT:PRINT"Use data on Chipmunk disk? Y/N";
  12. 125 A=INPUT$(1):IF A="" GOTO125
  13. 130 IF A="Y" OR A="y" GOTO140 ELSE IF A="N" OR A="n" GOTO160
  14. 135 GOTO125
  15. 140 QS=1:OPEN"0:DATAC.TX" FOR INPUT AS1:INPUT#1,QG,QH,QC,U1
  16. 145 PRINT@160,"Rest easy; about 40 seconds..."
  17. 150 FOR R=0 TO 1023:INPUT#1,P1(0,R),P1(1,R)P1(2,R):NEXT R:CLOSE
  18. 160 PRINT:PRINT"Enter "CHR$(34)"D"CHR$(34)" as MOVE to record new data to disk.";
  19. 170 INPUT"  Press ENTER to continue...";C
  20. 180 '**NEW GAME**
  21. 190 QG=QG+1:Q3(1)=0:Q3(2)=0:FOR X=1 TO 9:P(X)=0:NEXT X: PB(1)=0: PB(2)=0
  22. 200 '*MAIN LOOP*
  23. 210 CLS
  24. 230 PRINT@ 66,"    |   |   ";
  25. 232 PRINT@106," ---+---+---";
  26. 234 PRINT@146,"    |   |   ";
  27. 236 PRINT@186," ---+---+---";
  28. 238 PRINT@226,"    |   |   ";
  29. 240 FOR X=1 TO 9:PRINT@Q1(X),CHR$(27)"p" X CHR$(27)"q";:NEXT X
  30. 250 FOR X=1 TO 9:IF A(P(X))=" " GOTO255 ELSE PRINT@Q1(X),A(P(X));
  31. 255 NEXT X' *PRINT PIECES*
  32. 260 PRINT@1,"# Games:";QG;:PRINT@41,"I won:  ";QC;:PRINT@81,"You won:";QH;:PRINT@241,"Level of play:";U1;
  33. 270 FOR Z1=1 TO 2:FOR Z=1 TO 8' *CHECK FOR WIN*
  34. 280 IF (PB(Z1) AND Q2(Z))=Q2(Z) THEN Q3(Z1)=Z
  35. 290 NEXT Z,Z1:ON SGN(Q3(1))+SGN(Q3(2))*2 GOTO650,730
  36. 300 IF PB(1)+PB(2)=511 GOTO785' *CHECK FOR DRAW*
  37. 310 IF QT=0 THEN QT=1 ELSE QT=0:GOTO430
  38. 320 '***HUMAN'S TURN***
  39. 330 C=INKEY$:IF C<>"" THEN QS=0' *RETURN CONTROL TO KEYBOARD?*
  40. 335 GOSUB880
  41. 340 PRINT@306,"Hit Q to exit";:PRINT@281,"Make your MOVE ";
  42. 345 S=INT(RND(9)*10):IF S=0 GOTO345 ELSE IF QS<>0 GOTO390
  43. 350 '**TIMED INPUT ROUTINE**
  44. 351 T=0
  45. 352 B=INKEY$
  46. 353 IF B=CHR$(8) AND LEN(A)>0 THEN A=LEFT$(A,LEN(A)-1):PRINT B;:GOTO351
  47. 354 IF B=CHR$(13) GOTO390
  48. 355 IF B="D" OR B="d" GOTO370
  49. 356 IF B="Q" OR B="q" THEN MENU
  50. 357 IF VAL(B)=>1 AND VAL(B)<=9 THEN PRINT B;:S=VAL(B):GOTO390
  51. 358 IF T=180 GOTO390 ELSE T=T+1:GOTO352
  52. 360 '**CODE FOR RECORD ON DISK?**
  53. 370 OPEN"0:DATAC.TX" FOR OUTPUT AS1:PRINT#1,QG;QH;QC;U1
  54. 375 PRINT@281,"[umm, this takes `about 45 seconds...]";
  55. 380 FOR R=0 TO 1023:PRINT#1,P1(0,R);P1(1,R);P1(2,R):NEXT R:CLOSE
  56. 385 PRINT@280,SPACE$(39);
  57. 390 IF P(S)=0 THEN P(S)=1:PB(1)=PB(1) OR Q5(S):GOTO250
  58. 400 IF T=180 GOTO345 ELSE GOSUB880
  59. 410 PRINT@281,"NO NO NO...";:FOR Z=1 TO 500*(1-QS):NEXT Z
  60. 415 GOTO330
  61. 420 '***COMPUTER'S TURN***
  62. 430 GOSUB880
  63. 435 PRINT@281,"My turn  ";
  64. 440 R2=8
  65. 450 PB(1)=0:PB(2)=0:FOR X=1 TO 9:PB(P(Q4(R2,X)))=PB(P(Q4(R2,X))) OR Q5(X):NEXT X
  66. 460 Q=PB(1)+PB(2)+1:R1=2*Q+1' *GENERATE HASH CODE*
  67. 470 IF PB(1)=P1(1,Q) AND PB(2)=P1(2,Q) GOTO500
  68. 480 IF P1(1,Q)=0 AND Q<>1 THEN R2=R2-1:IF R2>=1 GOTO450 ELSE 580
  69. 490 Q=(Q+R1) AND 1023:GOTO470
  70. 500 IF P1(0,Q)=511 GOTO650' *CONCEDE IF NO MOVES*
  71. 510 '
  72. 520 FOR Z=1 TO 9:IF (P1(0,Q) AND Q5(Z))=0 THEN X=Z:Z=9
  73. 530 NEXT Z
  74. 540 P(Q4(R2,X))=2:Q3=Q:Q2=X' *PUT O IN CURRENT POSITION*
  75. 550 PB(1)=0:PB(2)=0:FOR X=1 TO 9:PB(P(X))=PB(P(X)) OR Q5(X):NEXT X
  76. 560 GOTO250
  77. 570 '*SIMILAR MOVE NOT FOUND*
  78. 580 U1=U1+1:P1(0,Q)=PB(1) OR PB(2):P1(1,Q)=PB(1):P1(2,Q)=PB(2)
  79. 590 '
  80. 600 FOR Z=1 TO 9:IF (P1(0,Q) AND Q5(Z))=0 THEN X=Z:Z=9
  81. 610 NEXT Z
  82. 620 P(X)=2:PB(2)=PB(2) OR Q5(X):Q3=Q:Q2=X
  83. 630 GOTO230
  84. 640 '**COMPUTER LOSE**
  85. 650 P1(0,Q3)=P1(0,Q3) OR Q5(Q2)' *MASK OFF LOSING MOVE*
  86. 660 QH=QH+1
  87. 670 GOSUB830
  88. 680 GOSUB880
  89. 690 PRINT@281,"I lose";:IF QH<>1 THEN PRINT " again";
  90. 700 IF U1>10 THEN PRINT" - BUT I'm learning";
  91. 710 IF QS=0 GOTO810
  92. 720 '**HUMAN LOSE**
  93. 730 P1(0,Q3)=(NOT(Q5(Q2))) AND 511' *MASK OFF NON-WINNNING MOVES*
  94. 740 QC=QC+1
  95. 750 GOSUB830
  96. 755 GOSUB880
  97. 760 PRINT@281,"I win";:IF QC<>1 THEN PRINT" again";
  98. 770 IF QS=0 GOTO810
  99. 780 '**KAT'S GAME**
  100. 785 GOSUB880
  101. 790 IF QC>QH THEN C="you" ELSE C="I"
  102. 800 PRINT@281,"At least "C" didn't lose!!";
  103. 810 FOR T=1 TO 4500:NEXT T:CLS:GOTO190
  104. 820 '**DISPLAY WIN**
  105. 830 FOR Z=1 TO 7*(1-QS)
  106. 840 FOR X=1 TO 9:IF (Q5(X) AND Q2(Q3(1)+Q3(2)))<>0 THEN PRINT@Q1(X),"   ";
  107. 850 NEXT X
  108. 860 FOR X=1 TO 9:IF A(P(X))<>" X " AND A(P(X))<>" O "GOTO870 ELSE PRINT@Q1(X),A(P(X));
  109. 870 NEXT X:NEXT Z:RETURN
  110. 880 PRINT@281,CHR$(27)"K";:RETURN
  111. 900 '**DATA FOR CHARACTERS**
  112. 1000 DATA 67,71,75,147,151,155,227,231,235
  113. 1010 DATA 7,56,448,73,146,292,273,84
  114. 1020 '**DATA FOR MATRIX INVERSIONS**
  115. 1030 DATA 1,2,3,4,5,6,7,8,9,3,2,1,6,5,4,9,8,7
  116. 1040 DATA 1,4,7,2,5,8,3,6,9,3,6,9,2,5,8,1,4,7
  117. 1050 DATA 9,8,7,6,5,4,3,2,1,7,8,9,4,5,6,1,2,3
  118. 1060 DATA 7,4,1,8,5,2,9,6,3,9,6,3,8,5,2,7,4,1
  119. 1070 '**DATA FOR POWERS OF TWO**
  120. 1080 DATA 1,2,4,8,16,32,64,128,256
  121.