home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib27b.dsk / QUINTIC.bas < prev    next >
BASIC Source File  |  2023-02-26  |  12KB  |  218 lines
  1. 10  REM  **********************
  2. 20  REM  *      QUINTIC       *
  3. 30  REM  * BY J. GESCHWENDER  *
  4. 40  REM  * COPYRIGHT (C) 1986 *
  5. 50  REM  * BY MICROSPARC, INC *
  6. 60  REM  * CONCORD, MA  01742 *
  7. 70  REM  **********************
  8. 80  REM  INITIALIZE
  9. 90  HIMEM: 16128: DIM CX(7),CY(7),P(2),NAME$(2),W$(4):D$ =  CHR$(4)
  10. 100  TEXT : HOME : HTAB 17: PRINT "QUINTIC": PRINT : HTAB 9: PRINT "BY JAMES R. GESCHWENDER"
  11. 110  VTAB 6: PRINT "** COPYRIGHT 1986 BY MICROSPARC, INC. **"
  12. 120 UP = 24576:IN = 25423:CL = 25447:EV = 25526:PI = 25597:CO = 25920:AD = 25941:WH = 25991:DU = 26043:SO = 26078
  13. 130 CAP = 33275:NS = 34816:AC = 34808:AB = 32768:AP = 26624:AW = 34304
  14. 140 EF = 1: ONERR  GOTO 2180
  15. 150  PRINT D$;"BLOAD QUINTIC.SHAPES,A$9200"
  16. 160  POKE 216,0
  17. 170  POKE 232,0: POKE 233,146: SCALE= 1: ROT= 0: HCOLOR= 3
  18. 180 EF = 2: ONERR  GOTO 2180
  19. 190  PRINT D$;"BLOAD QUINTIC.ML"
  20. 200  POKE 216,0
  21. 210  FOR N = 0 TO 7: READ CX(N),CY(N): NEXT : DATA 0,-1,0,1,-1,0,1,0,1,-1,-1,1,-1,-1,1,1
  22. 220  GOSUB 1220:NAME$(2) =  LEFT$(NAME$(2),8)
  23. 230  REM  DRAW DISPLAY
  24. 240 N = 22: HGR2 : FOR X = 22 TO 173  STEP 8: XDRAW N AT X -2,10: XDRAW N AT X -2,178:N = N +1: NEXT 
  25. 250 CX = 213:CY = 13:A$ = "QUINTIC": GOSUB 1660
  26. 260 CX = 219:CY = 29:A$ = "WHITE": GOSUB 1660:CX = 219:CY = 110:A$ = "BLACK": GOSUB 1660
  27. 270 CX = 210:CY = 157:A$ = "CAPTURES": GOSUB 1660:CX = 210:CY = 76: GOSUB 1660
  28. 280 CY = 42:A$ = NAME$(1):CX = 237 -3.5 * LEN(A$): GOSUB 1660:CY = 123:A$ = NAME$(2):CX = 237 -3.5 * LEN(A$): GOSUB 1660
  29. 290 N = 6: FOR Y = 22 TO 173  STEP 8: XDRAW N AT 9,Y: XDRAW N AT 181,Y:N = N +1: IF N = 15  THEN N = 5
  30. 300  NEXT : FOR Y = 94 TO 173  STEP 8: XDRAW 6 AT 3,Y: XDRAW 6 AT 175,Y: NEXT 
  31. 310  FOR N = 0 TO 12: READ X1,Y1,X2,Y2: GOSUB 1620: NEXT : XDRAW 3 AT 213,59
  32. 320  DATA  16,13,172,169,1,1,187,181
  33. 330  DATA  195,1,278,19,198,2,275,18,201,3,272,17,204,4,269,16,207,5,266,15
  34. 340  DATA  202,34,271,44,195,49,278,99,220,54,253,64
  35. 350  DATA  202,115,271,125,195,130,278,181,220,135,253,145
  36. 360  FOR Y = 14 TO 168: HPLOT 17,Y TO 171,Y: IF (Y -3)/8 > INT((Y -3)/8)  THEN  XDRAW 48 AT 17,Y
  37. 370  NEXT 
  38. 380  IF P(2) = 1  THEN 410
  39. 390  CALL WH: REM  COPY WHITE STRATEGY TO BLACK
  40. 400  CALL DU: REM  DUPLICATE COMPUTER STRATEGY
  41. 410  CALL CL: REM  CLEAR BOARD
  42. 420 X = 10:Y = 10:M = 1: POKE CAP +2,5: POKE CAP +4,5:A$ = "J10": GOTO 550
  43. 430 M = M +1:C = C +1 -2 *(C = 2): XDRAW 3 AT 213,59: XDRAW 4 AT 213,140
  44. 440 L =  PEEK( -16384): IF (P(2) = 0  AND V <4)  OR L < >155  THEN 480
  45. 450 CX = 226:CY = 81 *C -19:A$ = "???": GOSUB 1660
  46. 460  POKE  -16368,0:CX = 78:CY = 191:A$ = "PAUSE": GOSUB 1660
  47. 470  GET A$:CX = 78:A$ = "?????": GOSUB 1660
  48. 480  IF P(C) = 0  THEN 570
  49. 490  REM  COMPUTER MOVE
  50. 500  CALL EV,11 +2 *C: REM  EVALUATE OPTIONS (13 IS WHITE)
  51. 510 N = 256 * PEEK(9) + PEEK(8)
  52. 520 PA = N -AW:Y =  INT(PA/19):X = (PA/19 -Y) *19:Y = Y +1:X =  INT(X +1.4)
  53. 530 PR = PA *16 +AP
  54. 540 A$ =  CHR$(X +64) + STR$(Y) + CHR$(32)
  55. 550 CX = 226:CY = 81 *C -19: GOSUB 1660: GOTO 880
  56. 560  REM  PLAYER MOVE
  57. 570 CX = 226:CY = 81 *C -19:A$ = "???": GOSUB 1660:N = 0:CX = 226: IF V = 4  THEN  READ A$: GOSUB 1660: FOR N = 0 TO 999: NEXT : GOTO 650
  58. 580  CALL SO,40 +40 *C,80: REM  TONE FOR NEXT MOVE
  59. 590  XDRAW 50 AT CX,CY: GET A$: GOSUB 600: GOTO 590
  60. 600 A =  ASC(A$): XDRAW 50 AT CX,CY: IF A = 8  AND N >0  THEN N = N -1:CX = CX -7: GOSUB 1660:CX = CX -7: RETURN 
  61. 610  IF A = 13  AND N >0  THEN  POP : GOTO 640
  62. 620  IF N = 3  OR A <48  OR A >90  THEN  RETURN 
  63. 630 W$(N) = A$: GOSUB 1660:N = N +1: RETURN 
  64. 640 A$ = "": FOR Q = 0 TO N -1:A$ = A$ +W$(Q): NEXT 
  65. 650 X =  ASC(A$) -64:Y =  VAL( MID$ (A$,2)): IF X >19  OR Y >19  OR X <1  OR Y <1  THEN 1700
  66. 660 PA = (Y -1) *19 +X -1
  67. 670  IF  PEEK(PA +AB) >0  THEN 1700
  68. 680 PR = PA *16 +AP
  69. 690  IF P(1) = 0  THEN 880
  70. 700  REM  COMPUTER ANALYSIS OF HUMAN STRATEGY
  71. 710  CALL PI,15: REM  PREDICT MOVE
  72. 720 A = 256 * PEEK(9) + PEEK(8)
  73. 730  FOR N = 0 TO 2: FOR Q = 0 TO 3
  74. 740 V =  PEEK(PR +Q +4 *N)
  75. 750  CALL CO,V:V =  PEEK(AC): REM  CONVERT
  76. 760 W =  PEEK(NS +N *256 +V):W = W -(W = 255)
  77. 770  POKE NS +N *256 +V,W +1
  78. 780  NEXT : NEXT 
  79. 790 A = A -AW:PY =  INT(A/19):PX = (A/19 -PY) *19
  80. 800 PY = PY +1:PX =  INT(PX +1.4):A = A *16 +AP
  81. 810  FOR N = 0 TO 2: FOR Q = 0 TO 3
  82. 820 V =  PEEK(A +Q +4 *N)
  83. 830  CALL CO,V:V =  PEEK(AC): REM  CONVERT
  84. 840 W =  PEEK(NS +N *256 +V):W = W +(W = 1)
  85. 850  POKE NS +N *256 +V,W -1
  86. 860  NEXT : NEXT 
  87. 870  REM  CHECK FOR WIN
  88. 880 Q =  PEEK(PR +11 +2 *C):Z =  PEEK(PA +34304 -512 *C): GOSUB 960
  89. 890  IF Q >127  THEN 1040
  90. 900  IF Z = 0  THEN 430
  91. 910  FOR N = 0 TO 7:Q =  PEEK(PR +N)
  92. 920  IF C = 1  THEN  CALL CO,Q:Q =  PEEK(AC): REM  CONVERT
  93. 930  IF Q = 116  OR Q = 244  OR Q = 252  THEN Z =  PEEK(CAP +2 *C): GOSUB 1000: POKE CAP +2 *C,Z -1: IF Z = 1  THEN 1040
  94. 940  NEXT : GOTO 430
  95. 950  REM  RECORD MOVE
  96. 960  XDRAW C AT 14 +X *8,11 +Y *8
  97. 970  CALL UP,X,Y,C +15: REM  UPDATE BOARD
  98. 980  RETURN 
  99. 990  REM  PROCESS CAPTURES
  100. 1000 C1 = C:C = C +1 -2 *(C = 2):CX = 275 -13 *Z:CY = 81 *C1 +3
  101. 1010  FOR Q = 0 TO 1:X = X +CX(N):Y = Y +CY(N): XDRAW C +2 AT CX,CY: GOSUB 960:CY = CY +9: NEXT 
  102. 1020 C = C1:X = X -2 *CX(N):Y = Y -2 *CY(N): RETURN 
  103. 1030  REM  PROCESS WIN
  104. 1040  IF C = 2  AND P(1) +P(2) = 1  THEN  CALL AD: REM  ADOPT NEW STRATEGY
  105. 1050  FOR N = 0 TO 7: FOR Q = 209 TO 258  STEP 7: CALL SO,278 -Q,9: XDRAW 49 AT Q,81 *C -39: NEXT : NEXT 
  106. 1060  IF V = 4  THEN CX = 32:CY = 191:A$ = "RETURN TO CONTINUE": GOSUB 1660: CALL  -678: TEXT : HOME : RESTORE : GOTO 210
  107. 1070 C = C +1 -2 *(C = 2):CX = 0:CY = 191:A$ = "TO PLAY AGAIN PRESS P    TO QUIT PRESS Q": GOSUB 1660
  108. 1080  POKE  -16368,0: GET B$: IF B$ < >"P"  AND B$ < >"Q"  THEN 1080
  109. 1090  HCOLOR= 0: FOR Y = 185 TO 191: HPLOT 0,Y TO 279,Y: NEXT 
  110. 1100  IF B$ = "Q"  THEN 1150
  111. 1110  FOR Y = 81 TO 96: HPLOT 207,Y TO 267,Y: HPLOT 207,Y +81 TO 267,Y +81: NEXT 
  112. 1120  XDRAW 3 AT 213,59: XDRAW 4 AT 213,140
  113. 1130 CX = 226:CY = 62:A$ = "???": GOSUB 1660:CX = 226:CY = 143: GOSUB 1660
  114. 1140  GOTO 360
  115. 1150 EF = 6: ONERR  GOTO 1200
  116. 1160  IF P(1) +P(2) = 1  THEN  PRINT : PRINT D$;"BSAVE";NAME$(1)",A$8E00,L$300"
  117. 1170  POKE 216,0
  118. 1180  TEXT : HOME : VTAB 12: HTAB 13: PRINT "SEE YOU LATER.": VTAB 23
  119. 1190  END 
  120. 1200  TEXT : GOTO 2180
  121. 1210  REM  CHOOSE MODE
  122. 1220  VTAB 1: HTAB 17: PRINT "QUINTIC": VTAB 12: POKE 34,2
  123. 1230 C = 1: PRINT "DO YOU WISH TO PLAY:": HTAB 8: PRINT "1) HUMAN VS. HUMAN"
  124. 1240  HTAB 8: PRINT "2) HUMAN VS. COMPUTER": HTAB 8: PRINT "3) COMPUTER VS. COMPUTER": PRINT 
  125. 1250  PRINT "OR DO YOU WANT:": HTAB 8: PRINT "4) INSTRUCTIONS": PRINT : HTAB 7: INPUT A$
  126. 1260 V =  VAL(A$): IF V >4  OR V <1  THEN 1220
  127. 1270 N =  RND( - PEEK(78)): HOME : ON V GOTO 1280,1430,1310,1740
  128. 1280 P(1) = 0:P(2) = 0
  129. 1290  INPUT "NAME OF PLAYER #1? ";NAME$(1): INPUT "NAME OF PLAYER #2? ";NAME$(2)
  130. 1300  RETURN 
  131. 1310 P(1) = 1:P(2) = 1
  132. 1320  GOSUB 2170: VTAB 10: INPUT "NAME OF COMPUTER PLAYER #1? ";F$: GOSUB 2110: IF NF  THEN  ON (F$ = "?") +1 GOSUB 2160,2150: VTAB 2: HTAB 1: CALL  -958: ON (F$ = "?") +1 GOTO 1220,1320
  133. 1330 NAME$(1) = F$
  134. 1340  GOSUB 2170: VTAB 12: INPUT "NAME OF COMPUTER PLAYER #2? ";F$: GOSUB 2110: IF NF  THEN  ON (F$ = "?") +1 GOSUB 2160,2150: VTAB 2: HTAB 1: CALL  -958: ON (F$ = "?") +1 GOTO 1220,1340
  135. 1350 NAME$(2) = F$
  136. 1360 EF = 3: ONERR  GOTO 2180
  137. 1370  PRINT D$;"BLOAD"NAME$(2)
  138. 1380  CALL WH: REM COPY WHITE STRATEGY TO BLACK
  139. 1390  PRINT D$;"BLOAD"NAME$(1)
  140. 1400  POKE 216,0
  141. 1410  RETURN 
  142. 1420  GOSUB 2160: HOME : GOTO 1220
  143. 1430 P(1) = 1:P(2) = 0
  144. 1440  INPUT "NAME OF HUMAN PLAYER? ";NAME$(2)
  145. 1450  GOSUB 2170: VTAB 6: PRINT "<RETURN> FOR NEW PARTNER.": VTAB 4: INPUT "NAME OF COMPUTER PLAYER? ";F$
  146. 1460  IF F$ = ""  THEN 1530
  147. 1470  GOSUB 2110: IF NF  THEN  ON (F$ = "?") +1 GOSUB 2140,2150: VTAB 4: HTAB 1: CALL  -958: GOTO 1450
  148. 1480 NAME$(1) = F$
  149. 1490 EF = 4: ONERR  GOTO 2180
  150. 1500  PRINT D$;"BLOAD"NAME$(1)
  151. 1510  POKE 216,0
  152. 1520  RETURN 
  153. 1530  GOSUB 2170: VTAB 8: INPUT "WHAT NAME WOULD YOU LIKE? ";F$
  154. 1540  GOSUB 2110: IF NF  THEN  ON (F$ = "?") +1 GOSUB 2140,2150: VTAB 8 -6 *(F$ = "?"): HTAB 1: CALL  -958: GOTO 1530
  155. 1550 NAME$(1) = F$
  156. 1560  CALL IN: REM  INITIALIZE COMPUTER STRATEGY
  157. 1570 EF = 5: ONERR  GOTO 2180
  158. 1580  PRINT D$;"BSAVE"NAME$(1)",A$8E00,L$300"
  159. 1590  POKE 216,0
  160. 1600  RETURN 
  161. 1610  REM  BOX PLOTTER
  162. 1620  HPLOT X1,Y1 TO X1,Y2 TO X2,Y2 TO X2,Y1 TO X1,Y1
  163. 1630  HPLOT X1 +1,Y1 -1 TO X2 -1,Y1 -1: HPLOT X2 +1,Y1 +1 TO X2 +1,Y2 -1
  164. 1640  HPLOT X1 +1,Y2 +1 TO X2 -1,Y2 +1: HPLOT X1 -1,Y1 +1 TO X1 -1,Y2 -1: RETURN 
  165. 1650  REM  SCREEN PRINT
  166. 1660  HCOLOR= 0: FOR W = 1 TO  LEN(A$):A =  ASC( MID$ (A$,W,1))
  167. 1670  DRAW 49 AT CX,CY: IF A >43  THEN  XDRAW A -43 AT CX,CY
  168. 1680 CX = CX +7: NEXT : HCOLOR= 3: RETURN 
  169. 1690  REM  INVALID MOVE
  170. 1700 CX = 54:CY = 191:A$ = "INVALID MOVE": GOSUB 1660
  171. 1710  CALL SO,250,250: REM  ERROR TONE
  172. 1720 CX = 54:A$ = "???? ?? ????": GOSUB 1660: GOTO 570
  173. 1730 CX = 54:A$ = "???? ?? ????": GOSUB 1660: GOTO 580
  174. 1740  HOME : PRINT "PLAYING QUINTIC IS AS SIMPLE AS THIS.": PRINT 
  175. 1750  PRINT "TWO PLAYERS ALTERNATE PLACING STONES ON": PRINT 
  176. 1760  PRINT "THE BOARD UNTIL ONE OF THEM WINS.  THERE"
  177. 1770  PRINT "ARE TWO WAYS TO WIN.  THE FIRST IS TO": PRINT 
  178. 1780  PRINT "GET AN UNBROKEN ROW OF AT LEAST FIVE OF": PRINT 
  179. 1790  PRINT "YOUR STONES EITHER HORIZONTALLY,": PRINT 
  180. 1800  PRINT "VERTICALLY, OR DIAGONALLY.  THE SECOND": PRINT 
  181. 1810  PRINT "WAY IS TO CAPTURE AT LEAST FIVE PAIRS OF"
  182. 1820  PRINT "YOUR OPPONENT'S STONES.": GOSUB 2100
  183. 1830  PRINT "A CAPTURE OCCURS WHEN YOU FLANK A PAIR": PRINT 
  184. 1840  PRINT "OF YOUR OPPONENT'S STONES.  THAT IS,": PRINT 
  185. 1850  PRINT "YOU MUST PLACE STONES SO THAT YOU HAVE": PRINT 
  186. 1860  PRINT "ONE ON EITHER SIDE OF AN ADJACENT PAIR": PRINT 
  187. 1870  PRINT "OF ENEMY STONES.  HERE IS AN EXAMPLE:": PRINT 
  188. 1880  HTAB 18: PRINT "XOO": POKE 1596,88: PRINT 
  189. 1890  PRINT "THE TWO 'O' STONES WOULD BE REMOVED FROM"
  190. 1900  PRINT "BOARD WHEN THE FLASHING 'X' STONE IS": PRINT 
  191. 1910  PRINT "PLAYED.": GOSUB 2100
  192. 1920  PRINT "NOTE THAT IT IS NOT POSSIBLE TO 'CAPTURE"
  193. 1930  PRINT "YOURSELF' BY PLAYING A STONE SO AS TO": PRINT 
  194. 1940  PRINT "FORM A PAIR BETWEEN TWO ENEMY STONES.": PRINT 
  195. 1950  PRINT "WHEN THE FLASHING 'O' STONE IS PLAYED,": PRINT 
  196. 1960  HTAB 18: PRINT "XO X": POKE 1339,79: PRINT 
  197. 1970  PRINT "NO CAPTURE IS SCORED.": GOSUB 2100
  198. 1980  PRINT "A DEMONSTRATION IS PRESENTED HERE TO": PRINT 
  199. 1990  PRINT "ILLUSTRATE WHAT HAS BEEN SAID. WATCH": PRINT 
  200. 2000  PRINT "IT, AND WHEN IT IS FINISHED, YOU SHOULD": PRINT 
  201. 2010  PRINT "KNOW EVERYTHING YOU NEED TO KNOW TO": PRINT 
  202. 2020  PRINT "BEGIN PLAYING.  PRESSING ESCAPE DURING": PRINT 
  203. 2030  PRINT "THE DEMONSTRATION WILL TEMPORARILY HALT": PRINT 
  204. 2040  PRINT "PLAY UNTIL PRESS ANOTHER KEY.": GOSUB 2100
  205. 2050 P(1) = 0:P(2) = 0:NAME$(1) = "TRANSAR":NAME$(2) = "COMPUWIN"
  206. 2060  RETURN 
  207. 2070  DATA   I9,K9,I11,L8,I10,I8,G11,J8,K8,H8,L10
  208. 2080  DATA  J7,I7,J8,J9,H11,J6,K5,K9,H9,H10,J8
  209. 2090  DATA  H7,H9,H8,I8,J8,G10,H10,J7,K6,F11
  210. 2100  VTAB 24: HTAB 10: PRINT "<RETURN TO CONTINUE>";: POKE  -16368,0: CALL  -678: HOME : RETURN 
  211. 2110 NF = 1:LF =  LEN(F$): IF LF <9  AND LF  THEN  FOR NC = 1 TO LF:NA =  ASC( MID$ (F$,NC,1)):NF = ((NA >64  AND NA <91)  OR (NA = 46  AND NC >1)  OR (NA >47  AND NA <58  AND NC >1))  AND NF = 1: NEXT :NF =   NOT NF
  212. 2120  IF  LEFT$(F$,1) = "?"  THEN  HOME : PRINT D$"CATALOG":F$ = "?"
  213. 2130  RETURN 
  214. 2140  VTAB 23: PRINT "NAME MUST BE 8 OR FEWER LETTERS."
  215. 2150  VTAB 24: HTAB 1: PRINT "PRESS <RETURN> TO CONTINUE";: GET Z$: RETURN 
  216. 2160  VTAB 21: HTAB 1: PRINT "USE COMPUTER VS. HUMAN OPTION": PRINT "TO CREATE A NEW COMPUTER PLAYER": GOTO 2150
  217. 2170  VTAB 21: HTAB 1: PRINT "ENTER '?' FOR CATALOG": RETURN 
  218. 2180  CALL  -3288: POKE 216,0: PRINT D$"CLOSE": HOME : VTAB 12: PRINT "ERROR " PEEK(222): PRINT "IN LINE " PEEK(218) +256 * PEEK(219): VTAB 24: PRINT "PRESS <RETURN> TO CONTINUE";: GET Z$: HOME : ON EF GOTO 140,180,1420,1450,1570,1160