home *** CD-ROM | disk | FTP | other *** search
/ Run Magazine ReRun 1985 Spring / rerun-1985-spring.d64 / quatro (.txt) < prev    next >
Commodore BASIC  |  2022-09-20  |  7KB  |  249 lines
  1. 100 rem four-in-a row by sol steinberg
  2. 110 dimv(7),g(7,7),n(7)
  3. 120 gosub1930
  4. 130 player=1:goto1400
  5. 140 ift=-1thenreturn
  6. 150 ifq=1thenv(c)=v(c)+100^t:ift=3thenw=c
  7. 160 ifq=-1thenv(c)=v(c)+10*100^(t-1):ift=3thenb=c
  8. 170 return
  9. 180 t=0:fori=0to3:ifg(x+i,y)=qthent=t+1:goto200
  10. 190 ifg(x+i,y)=-qthent=-1:i=3
  11. 200 nexti
  12. 210 goto140
  13. 220 forj=1to4:t=0:fori=0to3
  14. 230 ifg(c,j+i)=qthent=t+1:goto250
  15. 240 ifg(c,j+i)=-qthent=-1:i=3
  16. 250 nexti:gosub140:ift=0thenj=4
  17. 260 nextj:return
  18. 270 t=0:fori=0to3:ifg(x+i,y+i)=qthent=t+1:goto290
  19. 280 ifg(x+i,y+i)=-qthent=-1:i=3
  20. 290 nexti:goto140
  21. 300 t=0:fori=0to3:ifg(x+i,y-i)=qthent=t+1:goto320
  22. 310 ifg(x+i,y-i)=-qthent=-1:i=3
  23. 320 nexti:goto140
  24. 330 print"[144] hmm, let's see... "
  25. 340 ifmove=1ormove=0thenc=int(7*rnd(0))+1:w=0:goto1320
  26. 350 fori=1to7:v(i)=0:nexti:w=0:b=0:ifn(1)=8thenv(1)=-100:goto400
  27. 360 c=1:x=1:y=n(1):q=1:gosub180:q=-1:gosub180
  28. 370 gosub220:q=-q:gosub220
  29. 380 ifn(1)<5thengosub270:q=-q:gosub270
  30. 390 ifn(1)>3thengosub300:q=-q:gosub300
  31. 400 ifn(2)=8thenv(2)=-100:goto500
  32. 410 c=2:y=n(2):forx=1to2:gosub180:nextx
  33. 420 q=-q:forx=1to2:gosub180:nextx
  34. 430 gosub220:q=-q:gosub220
  35. 440 ifn(2)<2orn(2)>5then460
  36. 450 x=1:y=n(2)-1:gosub270:q=-q:gosub270
  37. 460 ifn(2)<5thenx=2:y=n(2):gosub270:q=-q:gosub270
  38. 470 ifn(2)>6orn(2)<3then490
  39. 480 x=1:y=n(2)+1:gosub300:q=-q:gosub300
  40. 490 ifn(2)>3thenx=2:y=n(2):gosub300:q=-q:gosub300
  41. 500 ifn(3)=8thenv(3)=-100:goto640
  42. 510 c=3:y=n(3):forx=1to3:gosub180:nextx
  43. 520 q=-q:forx=1to3:gosub180:nextx
  44. 530 gosub220:q=-q:gosub220
  45. 540 ifn(3)<3orn(3)>6then560
  46. 550 x=1:y=n(3)-2:gosub270:q=-q:gosub270
  47. 560 ifn(3)<2orn(3)>5then580
  48. 570 x=2:y=n(3)-1:gosub270:q=-q:gosub270
  49. 580 ifn(3)<5thenx=3:y=n(3):gosub270:q=-q:gosub270
  50. 590 ifn(3)<2orn(3)>5then610
  51. 600 x=1:y=n(3)+2:gosub300:q=-q:gosub300
  52. 610 ifn(3)<3orn(3)>6then630
  53. 620 x=2:y=n(3)+1:gosub300:q=-q:gosub300
  54. 630 ifn(3)>3thenx=3:y=n(3):gosub300:q=-q:gosub300
  55. 640 ifn(4)=8thenv(4)=-100:goto820
  56. 650 c=4:y=n(4):forx=1to4:gosub180:nextx
  57. 660 q=-q:forx=1to4:gosub180:nextx
  58. 670 gosub220:q=-q:gosub220
  59. 680 ifn(4)<4then700
  60. 690 x=1:y=n(4)-3:gosub270:q=-q:gosub270
  61. 700 ifn(4)<3orn(4)>6then720
  62. 710 x=2:y=n(4)-2:gosub270:q=-q:gosub270
  63. 720 ifn(4)<2orn(4)>5then740
  64. 730 x=3:y=n(4)-1:gosub270:q=-q:gosub270
  65. 740 ifn(4)<5thenx=4:y=n(4):gosub270:q=-q:gosub270
  66. 750 ifn(4)>4then770
  67. 760 x=1:y=n(4)+3:gosub300:q=-q:gosub300
  68. 770 ifn(4)<2orn(4)>5then790
  69. 780 x=2:y=n(4)+2:gosub300:q=-q:gosub300
  70. 790 ifn(4)<3orn(4)>6then810
  71. 800 x=3:y=n(4)+1:gosub300:q=-q:gosub300
  72. 810 ifn(4)>3thenx=4:y=n(4):gosub300:q=-q:gosub300
  73. 820 ifn(5)=8thenv(5)=-100:goto980
  74. 830 c=5:y=n(5):forx=2to4:gosub180:nextx
  75. 840 q=-q:forx=2to4:gosub180:nextx
  76. 850 gosub220:q=-q:gosub220
  77. 860 ifn(5)<4then880
  78. 870 x=2:y=n(5)-3:gosub270:q=-q:gosub270
  79. 880 ifn(5)<3orn(5)>6then900
  80. 890 x=3:y=n(5)-2:gosub270:q=-q:gosub270
  81. 900 ifn(5)<2orn(5)>5then920
  82. 910 x=4:y=n(5)-1:gosub270:q=-q:gosub270
  83. 920 ifn(5)>4then940
  84. 930 x=2:y=n(5)+3:gosub300:q=-q:gosub300
  85. 940 ifn(5)<2orn(5)>5then960
  86. 950 x=3:y=n(5)+2:gosub300:q=-q:gosub300
  87. 960 ifn(5)<3orn(5)>6then980
  88. 970 x=4:y=n(5)+1:gosub300:q=-q:gosub300
  89. 980 ifn(6)=8thenv(6)=-100:goto1100
  90. 990 c=6:y=n(6):forx=3to4:gosub180:nextx
  91. 1000 q=-q:forx=3to4:gosub180:nextx
  92. 1010 gosub220:q=-q:gosub220
  93. 1020 ifn(6)<4then1040
  94. 1030 x=3:y=n(6)-3:gosub270:q=-q:gosub270
  95. 1040 ifn(6)<3orn(6)>6then1060
  96. 1050 x=4:y=n(6)-2:gosub270:q=-q:gosub270
  97. 1060 ifn(6)>4then1080
  98. 1070 x=3:y=n(6)+3:gosub300:q=-q:gosub300
  99. 1080 ifn(6)<2orn(6)>5then1100
  100. 1090 x=4:y=n(6)+2:gosub300:q=-q:gosub300
  101. 1100 ifn(7)=8thenv(7)=-100:goto1170
  102. 1110 c=7:x=4:y=n(7):gosub180:q=-q:gosub180
  103. 1120 gosub220:q=-q:gosub220
  104. 1130 ifn(7)<4then1150
  105. 1140 x=4:y=n(7)-3:gosub270:q=-q:gosub270
  106. 1150 ifn(7)>4then1170
  107. 1160 x=4:y=n(7)+3:gosub300:q=-q:gosub300
  108. 1170 ifw<>0thenc=w:goto1320
  109. 1180 ifb<>0thenc=b:goto1320
  110. 1190 c=1:fori=2to7
  111. 1200 ifv(i)>v(c)thenc=i
  112. 1210 nexti
  113. 1220 ifv(c)<-90orle$="a"orn(c)=7then1320
  114. 1230 n(c)=n(c)+1:g(c,n(c))=-1:q=-1
  115. 1240 gosub2110:g(c,n(c))=0:n(c)=n(c)-1
  116. 1250 ifw=0then1270
  117. 1260 w=0:v(c)=-95:goto1190
  118. 1270 ifle$="p"then1320
  119. 1280 n(c)=n(c)+1:g(c,n(c))=1:q=1
  120. 1290 gosub2110:g(c,n(c))=0:n(c)=n(c)-1
  121. 1300 ifw=0then1320
  122. 1310 w=0:v(c)=-91:goto1190
  123. 1320 print"[144]  computer plays";c
  124. 1330 print"":fori=1to15-2*n(c):print"";:nexti:printtab(c+c+10)"[144] "
  125. 1340 hf=5:gosub2440
  126. 1350 g(c,n(c))=1:n(c)=n(c)+1
  127. 1360 ifw<>0thengosub2490
  128. 1370 ifw<>0thenprint"":print"  computer wins!!!":goto1830
  129. 1380 print"":move=move+1:ifmove=49then1820
  130. 1390 goto1600
  131. 1400 poke53281,5:print"[147]":gosub1870
  132. 1410 print"[147]"
  133. 1420 printtab(11)"[176][195][178][195][178][195][178][195][178][195][178][195][178][195][174]"
  134. 1430 printtab(11)"[194][215][194][215][194][215][194][215][194][215][194][215][194][215][194]"
  135. 1440 printtab(11)"[171][195][219][195][219][195][219][195][219][195][219][195][219][195][179]"
  136. 1450 printtab(11)"[194][215][194][215][194][215][194][215][194][215][194][215][194][215][194]"
  137. 1460 printtab(11)"[171][195][219][195][219][195][219][195][219][195][219][195][219][195][179]"
  138. 1470 printtab(11)"[194][215][194][215][194][215][194][215][194][215][194][215][194][215][194]"
  139. 1480 printtab(11)"[171][195][219][195][219][195][219][195][219][195][219][195][219][195][179]"
  140. 1490 printtab(11)"[194][215][194][215][194][215][194][215][194][215][194][215][194][215][194]"
  141. 1500 printtab(11)"[171][195][219][195][219][195][219][195][219][195][219][195][219][195][179]"
  142. 1510 printtab(11)"[194][215][194][215][194][215][194][215][194][215][194][215][194][215][194]"
  143. 1520 printtab(11)"[171][195][219][195][219][195][219][195][219][195][219][195][219][195][179]"
  144. 1530 printtab(11)"[194][215][194][215][194][215][194][215][194][215][194][215][194][215][194]"
  145. 1540 printtab(11)"[171][195][219][195][219][195][219][195][219][195][219][195][219][195][179]"
  146. 1550 printtab(11)"[194][215][194][215][194][215][194][215][194][215][194][215][194][215][194]"
  147. 1560 printtab(11)"[173][195][177][195][177][195][177][195][177][195][177][195][177][195][189]"
  148. 1570 printtab(11)" 1 2 3 4 5 6 7":print
  149. 1580 player=-player
  150. 1590 ifplayer=1then1700
  151. 1600 print"  red, which column?  [157][157]";
  152. 1610 getc$:ifc$<>""then1610
  153. 1620 getc$:ifc$<"1"orc$>"7"then1620
  154. 1630 c=val(c$):printc:ifn(c)=8thenprint"that column is full!":gosub1910:goto1600
  155. 1640 print"":fori=1to15-2*n(c):print"";:nexti:printtab(c+c+10)" "
  156. 1650 hf=25:gosub2440
  157. 1660 g(c,n(c))=-1
  158. 1670 q=-1:gosub2050:ifw=1then2280
  159. 1680 n(c)=n(c)+1
  160. 1690 print"":move=move+1:ifmove=49then1820
  161. 1700 ifop$="c"then330
  162. 1710 print"[144]black, which column?  [157][157]";
  163. 1720 getc$:ifc$<>""then1720
  164. 1730 getc$:ifc$<"1"orc$>"7"then1730
  165. 1740 c=val(c$):printc:ifn(c)=8thenprint"that column is full!":gosub1910:goto1710
  166. 1750 print"":fori=1to15-2*n(c):print"";:nexti:printtab(c+c+10)"[144] "
  167. 1760 hf=5:gosub2440
  168. 1770 g(c,n(c))=1
  169. 1780 q=1:gosub2050:ifw=1then2300
  170. 1790 n(c)=n(c)+1
  171. 1800 print"":move=move+1:ifmove=49then1820
  172. 1810 goto1600
  173. 1820 print"the game is a draw. nobody wins."
  174. 1830 print"   do you want to play again?"
  175. 1840 geta$:ifa$="y"then1400
  176. 1850 ifa$="n"thenprint"   let's play again real soon!":end
  177. 1860 goto1840
  178. 1870 fori=1to7:n(i)=1
  179. 1880 forj=1to7:g(i,j)=0
  180. 1890 nextj,i:move=0:w=0
  181. 1900 return
  182. 1910 fori=1to1500:nexti:print"[145][145]                                    "
  183. 1920 print"                                  ":print"[145][145]";:return
  184. 1930 print"[147]"
  185. 1940 printtab(13)"four-in-a-row"
  186. 1950 print"do you want instructions?[145]"
  187. 1960 getop$:ifop$="y"then2320
  188. 1970 ifop$<>"n"then1960
  189. 1980 print"do you want to play against the computeror another player (c or p)?";
  190. 1990 getop$:ifop$="p"thenreturn
  191. 2000 ifop$<>"c"then1990
  192. 2010 print"  computer"
  193. 2020 print"level of play - amateur, pro or world   class (a,p or w)?"
  194. 2030 getle$:ifle$="a"orle$="p"orle$="w"thenreturn
  195. 2040 goto2030
  196. 2050 rem test for win before n(c) changes
  197. 2060 w=0
  198. 2070 ifn(c)<4then2110
  199. 2080 j=0:fori=0to3
  200. 2090 j=j+g(c,n(c)-i)
  201. 2100 nexti:ifj=4*qthenw=1:return
  202. 2110 j=0:fori=1to7
  203. 2120 ifg(i,n(c))=qthenj=j+1
  204. 2130 ifg(i,n(c))<>qthenj=0
  205. 2140 ifj=4thenw=1
  206. 2150 nexti:ifw=1thenreturn
  207. 2160 j=0:x=n(c)-c:fori=1to7
  208. 2170 if(x+i)<1or(x+i)>7then2210
  209. 2180 ifg(i,x+i)=qthenj=j+1
  210. 2190 ifg(i,x+i)<>qthenj=0
  211. 2200 ifj=4thenw=1
  212. 2210 nexti:ifw=1thenreturn
  213. 2220 j=0:x=n(c)+c:fori=1to7
  214. 2