home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 139 / 139side2.d64 / morris (.txt) < prev    next >
Encoding:
Commodore BASIC  |  1989-01-01  |  16.7 KB  |  545 lines
  1. 1 poke53281,0:poke53280,0:poke788,52
  2. 2 dv=peek(186):i=rnd(-ti)
  3. 5 sys57812"resource $1c80",dv,0:poke780,0:poke781,128:poke782,28:sys65493
  4. 6 sys57812"morris ml$c000",dv,0:poke780,0:poke781,0:poke782,192:sys65493
  5. 9 rem*
  6. 10 rem*************************
  7. 20 rem* nine men's morris v1.0
  8. 30 rem* by: robert mundschau
  9. 40 rem* last modified 09/15/95
  10. 50 rem*************************
  11. 60 rem*
  12. 99 rem** main caller
  13. 100 gosub 1000:rem* initialize
  14. 110 gosub 2000:rem* draw title
  15. 120 gosub 2500:rem* main menu
  16. 130 rem* handle main menu selection
  17. 140 if m=3 then sys49162:gosub9200:goto110:rem*display game rules
  18. 150 if m=4 then goto 900:rem*loadstar
  19. 199 rem* m=2 start game
  20. 200 gosub 3000:rem* pre-game set-up
  21. 209 rem* main game loop
  22. 210 lt=ct:ct=(ct+1)and1:gosub9300
  23. 220 ifnp(ct)=0then8700:rem*patched code
  24. 299 rem* yes, place a piece.
  25. 300 w1=2:gosub9400:poke1539,176+np(ct):rem* dsply # left
  26. 310 on (pt(ct)+1) gosub 4000,5000
  27. 320 sp%(sn%(cx,cy))=ct:np(ct)=np(ct)-1
  28. 330 gosub8100:gosub9600:rem*appear
  29. 340 goto500
  30. 399 rem* move a piece. (patch return)
  31. 400 w1=8:gosub9400:rem* dsply your move
  32. 405 on (pt(ct)+1) gosub 4200,6000
  33. 410 ifk<>4then430:rem* move was made
  34. 415 gosub8050:gosub9300:w1=11:gosub9400:gosub9200:gosub9300:goto400:rem* cancel
  35. 420 goto8700:rem* entrapment scan
  36. 429 rem*animate move
  37. 430 gosub9350:sp%(sn%(cx,cy))=2:gosub8900:sp%(sn%(ma(k,0),ma(k,1)))=ct
  38. 435 poke2040,sb+4:gosub9650
  39. 440 gosub8200:fort=4to1step-1:poke2040,sb+t:pokes+1,t*3:forw1=1to50:next:next
  40. 450 w1=(ma(k,0)-cx)*2:w2=(ma(k,1)-cy)*2:rem* dot velocity
  41. 460 fort=12to1step-1:pokes+1,t:pokev,peek(v)+w1:pokev+1,peek(v+1)+w2:next
  42. 470 fort=2to4:poke2040,sb+t:forw1=1to75:next:next
  43. 480 cx=ma(k,0):cy=ma(k,1):gosub9650:poke2040,sb+5
  44. 499 rem* check if mill formed
  45. 500 w1=sn%(cx,cy):m%=0
  46. 510 if(sp%(as%(w1,0))=ct)and(sp%(as%(w1,1))=ct)thenm%=m%+1
  47. 520 if(sp%(as%(w1,2))=ct)and(sp%(as%(w1,3))=ct)thenm%=m%+1
  48. 550 if m%=0 then680:rem* no mill
  49. 599 rem* player formed a mill
  50. 600 gosub8300:gosub9300:w1=5:gosub9400:rem* dsply you have formed a mill.
  51. 610 on(pt(ct)+1)gosub 4500,7000
  52. 620 sp%(sn%(cx,cy))=2:rem* remove piece
  53. 630 gosub8150:gosub9950:rem* animate
  54. 640 m%=m%-1:ifm%>0then600
  55. 649 rem* check for winner
  56. 650 gosub9700:rem* piece count
  57. 660 if(w1+np(0))<3thenqf=1:goto700:rem* moon win
  58. 670 if(w2+np(1))<3thenqf=1:goto800:rem* sun win
  59. 679 rem* has q been pressed
  60. 680 if qf>0 then on (lt+1) goto 800,700
  61. 690 goto210:rem* next player
  62. 699 rem* moons win
  63. 700 gosub9000:poke53280,0:gosub8500:printc$(1)pp$(1):w1$=left$(l$,12)
  64. 710 print"[153]"w1$"  the moon has":printw1$"eclipsed the sun"
  65. 720 printw1$"in their contest":printw1$"  for the sky!"
  66. 730 goto825                                      
  67. 799 rem* suns win
  68. 800 gosub9000:poke53280,6:gosub8500:printc$(0)pp$(0):w1$=left$(l$,11)
  69. 810 poke53281,6:print"[153]"w1$"hip! hip! hooray!":printw1$"      the sun"
  70. 820 printw1$"   has won the":printw1$"       day!"
  71. 825 print"press fire or return"
  72. 830 gosub9050:gosub9200:gosub8100:goto110
  73. 899 rem* return to loadstar
  74. 900 w1$=left$(l$,19):print"[147]"w1$c$(0)pp$(0)
  75. 910 print"[155]do you wish to return to loadstar?"
  76. 920 printw1$"[157][157]([153]y[155]/[150]n[155])?":printw1$c$(1)pp$(1)
  77. 930 getm$:ifm$="n"then110
  78. 940 ifm$<>"y"then930
  79. 950 print"[147][154]thank-you for playing 9 men's morris."
  80. 960 print"[153]please check that the disk is ready and"
  81. 965 print"then press return."
  82. 970 gosub 9200:sys49432:rem* irqs off
  83. 980 poke53272,peek(53272)and240or4:poke44,8:poke43,1:poke2048,0
  84. 990 goto40000
  85. 999 rem* initialize
  86. 1000 print"[147]";:poke53272,peek(53272)and240or14
  87. 1010 l$="":d$=""
  88. 1020 fort=0to10step2:print""left$(d$,t);:fork=0to(22-t):poke646,t*2+7
  89. 1030 w1$=left$(l$,t)+left$("@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@",40-t*2)
  90. 1040 fork=0to(22-t*2):printw1$:next:next
  91. 1050 print""left$(l$,11)left$(d$,11)"[159]  setting up...  "
  92. 1059 rem*
  93. 1060 sys 49206:rem* engage irqs
  94. 1065 rem*
  95. 1070 dim gb%(7,7),mf%(7,7),sn%(7,7),as%(24,3),sp%(24),xy%(24,1),pf%(18,1)
  96. 1075 dim ps%(35),cf%(35),cl%(24),ts%(24),mr%(13,17)
  97. 1080 dim jv(31),jx(4),jy(4),pt(1),ma(4,1),np(1)
  98. 1090 dim ms$(13),mc$(1),c$(3),cs$(1),pp$(3),pt$(1)
  99. 1100 mc$(0)="[158]":mc$(1)="[159]":rem* text window color and rvs.
  100. 1110 c$(0)="[158]":c$(1)="[159]"
  101. 1120 pp$(0)="[192][193][157][157][160][161]":pp$(1)="[200][201][157][157][168][169]":pp$(2)="  [157][157]  ":pp$(3)=""
  102. 1130 pt$(0)="[155] person ":pt$(1)="[155]computer"
  103. 1140 cs$(0)="[153]novice":cs$(1)="[129] best "
  104. 1150 mm$(0)="player selection":mm$(1)="computer skill"
  105. 1160 mm$(2)="start game":mm$(3)="game rules":mm$(4)="return to loadstar"
  106. 1170 fort=0to31:jv(t)=4:next:jv(30)=0:jv(29)=2:jv(27)=3:jv(23)=1
  107. 1180 jx(1)=1:jx(3)=-1:jy(0)=-1:jy(2)=1:qf=1
  108. 1199 rem* sprite set-up
  109. 1200 sb=150:v=53248
  110. 1210 pokev+21,1:pokev+16,0:pokev+28,0:pokev+23,30:pokev+27,0:pokev+29,30
  111. 1299 rem* sound set-up
  112. 1300 s=54272:fort=0to24:pokes+t,0:next
  113. 1310 pokes+24,15
  114. 1399 rem* read data
  115. 1400 forcy=0to7:forcx=0to7:readw1:gb%(cx,cy)=w1:next:next
  116. 1410 forcy=0to6:forcx=0to6:readw1:mf%(cx,cy)=w1:next:next
  117. 1420 forcy=0to6:forcx=0to6:readw1:sn%(cx,cy)=w1:next:next
  118. 1430 forcy=0to6:forcx=0to6:w1=sn%(cx,cy):xy%(w1,0)=cx:xy%(w1,1)=cy:next:next
  119. 1439 rem* unpack strings
  120. 1440 fort=0to13:read w1$:w1=len(w1$):w2=1
  121. 1450 ms$(t)=ms$(t)+mid$(w1$,w2,12)+"[157][157][157][157][157][157][157][157][157][157][157][157]":w2=w2+12:ifw2<w1then1450
  122. 1460 next
  123. 1480 fort=1to24:fork=0to3:readw1:as%(t,k)=w1:next:next
  124. 1490 fort=0to18:fork=0to1:readw:pf%(t,k)=w:next:next
  125. 1500 fort=0to35:readw:ps%(t)=w:next
  126. 1510 fort=0to35:readw:cf%(t)=w:next
  127. 1520 fort=1to24:readw:ts%(t)=w:next
  128. 1530 fort=0to17:fork=0to13:readw:mr%(k,t)=w:next:next
  129. 1990 return
  130. 1999 rem* draw title
  131. 2000 gosub9000:print"[147]":poke53280,0:poke53281,0:pokev+21,0
  132. 2010 w1$=""
  133. 2020 printw1$"[220][223][223][223][223][223][223][223][223][223][223][223][223][223][223][223][223][223][223][223][223][223][223][223][223][223][223][221]"
  134. 2030 printw1$"[255][158][207][208][146] [209][210][211][212][213][214][215][216][217]";
  135. 2040 print"[146]  [209][210][218][219][220][221][220][221][255][223][216][217][146][191]"
  136. 2050 printw1$"[255][159][175][176][146] [177][178][179][180][181][182][183][184][185]";
  137. 2060 print"[146]  [177][178][186][187][188][189][188][189][190][191][184][185][146][191]"
  138. 2070 printw1$"[188][190][190][190][190][190][190][190][190][190][190][190][190][190][190][190][190][190][190][190][190][190][190][190][190][190][190][189]"
  139. 2100 w2$=left$(l$,10):printw2$"by: robert mundschau"
  140. 2110 printw1$c$(0)pp$(0)w2$"menu[145]"w2$c$(1)pp$(1)
  141. 2120 printw2$"<"w1$w2$">"
  142. 2130 printw2$"<"w1$w2$">"
  143. 2140 printw1$c$(0)pp$(0)w1$w1$w1$w1$"[145]"c$(1)pp$(1)
  144. 2150 print"use [153]joy2 or [153]crsr keys and [153]return"
  145. 2160 printw1$"to make your selections.";
  146. 2170 return
  147. 2499 rem* main menu
  148. 2500 m=0:gosub2900:gosub9050
  149. 2510 gosub2900:gosub9100
  150. 2520 if(cr=1)and(m>1)then:gosub8250:return
  151. 2530 on j goto 2560,2540,2560,2510
  152. 2540 m=m+jy(j):if(m<0)or(m>4)thenm=m-jy(j)
  153. 2550 goto2510
  154. 2560 on (m+1) goto 2700,2600,2510,2510,2510
  155. 2600 cs=(cs+1)and1:gosub8250:goto2510
  156. 2700 ifj=3thenpt(0)=(pt(0)+1)and1:goto2720
  157. 2710 pt(1)=(pt(1)+1)and1:ifpt(1)+pt(0)=2thenpt(0)=0:goto2730
  158. 2720 if pt(1)+pt(0)=2thenpt(1)=0
  159. 2730 gosub8250:goto2510
  160. 2899 rem* update menu
  161. 2900 print""pt$(pt(0))""pt$(pt(1))
  162. 2910 print""cs$(cs)""cs$(cs)"[145][145][145][145]"
  163. 2920 fort=0to4:w2$="[156]":ifm=tthenw2$=c$(p):p=(p+1)and1
  164. 2930 print w2$:print""mm$(t):next:return
  165. 2999 rem** pre-game setup
  166. 3000 gosub9000:poke53280,2
  167. 3010 sys 49157:rem* draw gameboard
  168. 3020 sp%(0)=3:fort=1to24:sp%(t)=2:next
  169. 3030 np(0)=9:np(1)=9:ct=int(rnd(1)*2):poke2040,sb:pokev+21,31
  170. 3039 rem* sprites for thin red strips
  171. 3040 fort=0to3:pokev+40+t,2:poke2041+t,sb+t+6:next
  172. 3050 pokev+2,79:pokev+3,105:pokev+4,135:pokev+5,105:pokev+6,135:pokev+7,161
  173. 3060 pokev+8,79:pokev+9,161
  174. 3080 print""left$(d$,24)"[155] to quit press (q) during your move ";
  175. 3090 qf=0:gosub9050:return
  176. 3999 rem*** human-where place a piece?
  177. 4000 w1=3:gosub9400:rem* dsply select
  178. 4010 gosub9500:rem* pick space routine
  179. 4020 ifsp%(sn%(cx,cy))=2thenreturn
  180. 4030 gosub9300:w1=4:gosub9400:gosub8000:rem* space not empty!
  181. 4040 goto4000
  182. 4199 rem* human select move
  183. 4200 w1=3:gosub9400:rem* dsply select
  184. 4210 gosub9500:rem* pick space routine
  185. 4220 if sp%(sn%(cx,cy))=ct then4300
  186. 4230 gosub8000:gosub9300:w1=9:gosub9400:rem* dsply invalid select
  187. 4240 goto4200
  188. 4299 rem* move where?
  189. 4300 gosub8250:gosub9300:w1=10:gosub9400:w1=3:gosub9400:rem*dsply move where?
  190. 4310 gosub 8900:k=4:rem* make map
  191. 4320 cx=ma(k,0):cy=ma(k,1):gosub9350
  192. 4330 gosub9100:ifcr=1thencx=ma(4,0):cy=ma(4,1):return
  193. 4340 ifk=4thenk=j:goto4360
  194. 4350 if (j<>4) and (k<>j) then k=4
  195. 4360 ifma(k,0)=-1thenk=4
  196. 4370 goto4320
  197. 4499 rem* human pick piece for capture
  198. 4500 gosub 9500
  199. 4510 ifsp%(sn%(cx,cy))<>ltthen gosub8000:goto 4500:rem* invalid selection
  200. 4520 gosub9800:rem* piece in mill?
  201. 4530 iff1=0thenreturn:rem* no
  202. 4540 gosub9900:rem*yes, are others not?
  203. 4550 iff2>0thenreturn:rem* f2>0=no.
  204. 4560 w1=7:gosub8050:gosub9300:w1=7:gosub 9400:rem* yes,piece protected in mill.
  205. 4570 goto4500:rem* select again.
  206. 4999 rem* computer place a piece
  207. 5000 m%=0:w1=12:gosub9400
  208. 5010 cx=3:cy=3:gosub9350
  209. 5019 rem* pass 1
  210. 5020 fort=1to24
  211. 5030 if sp%(t)<>2then cl%(t)=0:goto5060
  212. 5040 gosub5200:cl%(t)=ps%(w4)
  213. 5050 if cl%(t)=7 then m%=m%+1
  214. 5060 next
  215. 5099 rem* pass 2
  216. 5100 hs=0
  217. 5110 fort=1to24:sc=0:cx=xy%(t,0):cy=xy%(t,1):gosub9350
  218. 5120 on cl%(t) gosub 5500,5550,5600,5650,5700,5750,5800,5850,5900
  219. 5140 sc=pf%(sc,cs)+int(rnd(1)*10)
  220. 5150 if sc>hs then hs=sc:bs=t
  221. 5160 next
  222. 5170 sp=bs:cx=xy%(bs,0):cy=xy%(bs,1):gosub9350
  223. 5180 return
  224. 5199 rem* determine space type
  225. 5200 w1=sp%(as%(t,0)):w2=sp%(as%(t,1))
  226. 5210 gosub5300:w4=w3
  227. 5220 w1=sp%(as%(t,2)):w2=sp%(as%(t,3))
  228. 5230 gosub5300:w4=w4+w3*6
  229. 5240 return
  230. 5299 rem* calc placement situation
  231. 5300 if w1=2 then5400
  232. 5310 if w1=ct then 5350
  233. 5320 if w2=2 then w3=2:return
  234. 5330 if w2=ct then w3=4:return
  235. 5340 w3=5:return
  236. 5350 if w2=2 then w3=1:return
  237. 5360 if w2=ct then w3=3:return
  238. 5370 w3=4:return
  239. 5400 if w2=2 then w3=0:return
  240. 5410 if w2=ct then w3=1:return
  241. 5420 w3=2:return
  242. 5499 rem** determine scoring by class
  243. 5500 sc=1:return
  244. 5550 ifm%>1thensc=4:return
  245. 5560 gosub 5950
  246. 5570 if(w1=0)and(w2=0)then sc=13:return
  247. 5575 if(w1=0)and(w2>0)then sc=12:return
  248. 5580 if(w1>0)and(w2=0)then sc=11:return
  249. 5585 sc=10:return
  250. 5600 sc=18:return
  251. 5650 sc=3:return
  252. 5700 sc=2:return
  253. 5750 sc=14:return
  254. 5800 sc=5:return
  255. 5850 w1=0:fork=0to3:if sp%(as%(t,k))=2thenw1=w1+1
  256. 5860 next:if w1=0then sc=17:return
  257. 5875 if w1=1 then sc=16:return
  258. 5880 sc=15:return
  259. 5900 gosub5950
  260. 5910 if(w1=0)and(w2=0)then sc=9:return
  261. 5920 if(w1=0)and(w2>0)then sc=8:return
  262. 5930 if(w1>0)and(w2=0)then sc=7:return
  263. 5940 sc=6:return
  264. 5949 rem* count n3 and n6's
  265. 5950 w1=0:w2=0:fork=0to3
  266. 5960 ifcl%(as%(t,k))=3thenw1=w1+1
  267. 5970 ifcl%(as%(t,k))=6thenw2=w2+1
  268. 5980 next:return
  269. 5999 rem* comp select move
  270. 6000 w1=12:gosub9400
  271. 6010 gosub 6800:f3=f3+7296:hs=0:bs=0:bd=4
  272. 6020 rf%=6-cs*3:for z=1to24:ifsp%(z)<>ct then6190
  273. 6030 cx=xy%(z,0):cy=xy%(z,1):gosub9350:gosub8900:if f1=0 then 6190
  274. 6040 gosub 6700:ss=peek(f3+w1+ts%(z)*256)
  275. 6050 sp%(z)=2:fork=0to3:if ma(k,0)=-1 then 6180
  276. 6060 w4=sn%(ma(k,0),ma(k,1)):gosub6600
  277. 6065 sc=mr%(ss,peek(8832+w1+ts%(z)*256))+int(rnd(1)*rf%)
  278. 6070 if sc>hs then hs=sc:bs=z:bd=k
  279. 6180 next:sp%(z)=ct
  280. 6190 next
  281. 6200 if bd<>4 then cx=xy%(bs,0):cy=xy%(bs,1)
  282. 6210 k=bd:return
  283. 6599 rem* calc move factor index
  284. 6600 w1=0:fori=0to3
  285. 6610 w2=as%(w4,i):w3=sp%(w2)
  286. 6620 if w3=2 then 6670
  287. 6630 if w3=ct then w3=0:goto6670
  288. 6650 w3=1:if(sp%(as%(w2,0))=lt)and(sp%(as%(w2,1))=lt)then w3=3:goto6670
  289. 6660 if(sp%(as%(w2,2))=lt)and(sp%(as%(w2,3))=lt)then w3=3
  290. 6670 w1=w1+w3*(4^i):next:return
  291. 6699 rem* calc stay factor index
  292. 6700 w1=0:fork=0to3
  293. 6710 w2=as%(z,k):w3=sp%(w2)
  294. 6720 if w3=2 then 6770
  295. 6730 if w3=ct then w3=0:goto6770
  296. 6750 w3=1:if(sp%(as%(w2,0))=lt)and(sp%(as%(w2,1))=lt)then w3=3:goto6770
  297. 6760 if(sp%(as%(w2,2))=lt)and(sp%(as%(w2,3))=lt)then w3=3
  298. 6770 w1=w1+w3*(4^k):next:return
  299. 6799 rem* can enemy form a mill?
  300. 6800 f3=0:forz=1to24
  301. 6810 if sp%(z)=lt then gosub 6900
  302. 6820 next:return
  303. 6899 rem* mill sub-scan routine
  304. 6900 cx=xy%(z,0):cy=xy%(z,1):gosub8900:if f1=0 thenreturn
  305. 6905 sp%(z)=2
  306. 6910 forj=0to3:if ma(j,0)=-1then6970
  307. 6920 cx=ma(j,0):cy=ma(j,1):gosub9350
  308. 6930 w1=sn%(cx,cy)
  309. 6940 if(sp%(as%(w1,0))=lt)and(sp%(as%(w1,1))=lt)then f3 = 768
  310. 6950 if(sp%(as%(w1,2))=lt)and(sp%(as%(w1,3))=lt)then f3 = 768
  311. 6970 next:sp%(z)=lt:return
  312. 6999 rem* comp select capture
  313. 7000 w1=12:gosub9400
  314. 7010 hs=0:bs=0
  315. 7020 fort=1to24
  316. 7030 if sp%(t)<>lt then goto7080
  317. 7040 cx=xy%(t,0):cy=xy%(t,1):gosub9350
  318. 7050 gosub5200:sc=cf%(w4)
  319. 7060 w1=4-cs(ct):sc=cf%(w4)+int(rnd(1)*(w1*4))
  320. 7070 if sc>hs then hs=sc:bs=t
  321. 7080 next
  322. 7090 cx=xy%(bs,0):cy=xy%(bs,1):gosub9350
  323. 7100 return
  324. 7998 rem*** sfx
  325. 7999 rem* buzzer
  326. 8000 pokes+1,9:pokes+5,0:pokes+6,240:pokes+4,33
  327. 8010 fort=1to300:next:pokes+4,32:return
  328. 8049 rem* double buzz
  329. 8050 pokes+1,8:pokes+5,0:pokes+6,240
  330. 8060 fork=1to2:pokes+4,33:fort=1to125:next:pokes+4,32:fort=1to25:next:next
  331. 8070 return
  332. 8099 rem* appear sound
  333. 8100 pokes+1,25:pokes+5,0:pokes+6,250:pokes+15,25:pokes+14,128
  334. 8110 pokes+4,21:pokes+4,20:return
  335. 8149 rem* disappear sound
  336. 8150 pokes+1,5:pokes+5,0:pokes+6,250:pokes+15,5:pokes+14,80
  337. 8160 pokes+4,21:pokes+4,20:return
  338. 8199 rem* move sound
  339. 8200 pokes+1,1:pokes+5,32:pokes+6,250
  340. 8210 pokes+4,17:pokes+4,16:return
  341. 8249 rem* select sound
  342. 8250 pokes+1,30:pokes+5,16:pokes+6,240
  343. 8260 pokes+4,17:fort=1to50:next:pokes+4,16:return
  344. 8299 rem* mill sound
  345. 8300 pokes+8,40:pokes+12,0:pokes+13,250:pokes+1,20
  346. 8310 pokes+11,21:pokes+11,20:return
  347. 8499 rem* draw win screen base
  348. 8500 w1$="[160] [161][157][157][157][157][157][160] [165] [163][157][157][157][157][157][157][160] [165][167][164] [161][157][157][157][157][157][157][157][162] [167] [166] [163][157][157][157][157][157][162] [163]"
  349. 8510 w2$="[160] [161][157][157][157][162] [164] [161][157][157][157][157][157][157][160] [165][166][164] [161][157][157][157][157][157][157][157][162] [167] [166] [163][157][157][157][157][157][162] [163]"
  350. 8520 print"[147]";:fort=1to50:poke1024+int(rnd(1)*40)+int(rnd(1)*19)*40,28:next
  351. 8530 print"[152]"w1$:print""left$(l$,32)w2$""
  352. 8540 printleft$(l$,9)w2$"[145][145][145][145]"w1$
  353. 8550 print""w1$left$(l$,26)"[145][145][145][145]"w2$"":printleft$(l$,9)w2$"[145][145][145][145]"w1$
  354. 8560 print"                                       "
  355. 8570 print"                                       [145][145][145]"
  356. 8580 print"[168][168][168][168][150][169][170][145][157][157][171][172][168][168][168][168][149][173][174][173][174][173][168][168][168][168][150][169][170][145][157][157][171][172][168][168][168][168][149][173][174][173][174][173][168][168][168][168][150][169][170][145][157][157][171][172][168][168][168]"
  357. 8590 fort=0to4:poke2040+t,sb:next:print""left$(l$,19)left$(d$,8);:return
  358. 8699 rem* scan for entrapment (patch)
  359. 8700 f2=0:z=1
  360. 8710 if sp%(z)<>ct then8760
  361. 8720 cx=xy%(z,0):cy=xy%(z,1):w1=mf%(cx,cy):w2=mf%(cy,cx)
  362. 8730 forj=0to3:w3=(cx+w1*jx(j))and7:w4=(cy+w2*jy(j))and7
  363. 8740 ifsp%(sn%(w3,w4))=2 thenf2=1
  364. 8750 next:if f2=1 then400:rem*end patch
  365. 8760 z=z+1:if z<25then8710
  366. 8770 gosub8050:w1=13:gosub9400:gosub9200:qf=1:on(ct+1)goto 700,800:rem* trapped
  367. 8899 rem* potential move assessment
  368. 8900 ma(4,0)=cx:ma(4,1)=cy:f1=0
  369. 8910 fort=0to3:w1=(mf%(cx,cy)*jx(t)+cx)and7:w2=(mf%(cy,cx)*jy(t)+cy)and7
  370. 8920 ifsp%(sn%(w1,w2))<>2thenma(t,0)=-1:goto8940
  371. 8930 ma(t,0)=w1:ma(t,1)=w2:f1=1
  372. 8940 next:return
  373. 8999 rem* blank screen
  374. 9000 poke53265,peek(53265)and239:return
  375. 9049 rem* unblank screen
  376. 9050 poke53265,peek(53265)or16:return
  377. 9099 rem*** human input
  378. 9100 j=peek(56320)and31:if(j<31)thencr=sgn(jand16):cr=(cr+1)and1:j=jv(j):return
  379. 9110 j=4:cr=0:getm$
  380. 9120 ifm$=chr$(13)thencr=1:return
  381. 9130 ifm$="[145]"thenj=0
  382. 9140 ifm$=""thenj=1
  383. 9150 ifm$=""thenj=2
  384. 9160 ifm$="[157]"thenj=3
  385. 9180 if(m$="q")and(qf=0)thenprint"game will quit at end of turn.":qf=1:gosub8100
  386. 9190 return
  387. 9199 rem* wait for fire/return
  388. 9200 gosub9100:ifcr=1then9200
  389. 9210 gosub9100:ifcr=0then9210
  390. 9220 return
  391. 9299 rem* clear window
  392. 9300 print""left$(d$,8):fort=0to12:printleft$(l$,26)mc$(ct)"            ":next
  393. 9310 print""left$(d$,8)
  394. 9320 w1=ct:gosub9400:return
  395. 9349 rem* update cursor
  396. 9350 poke2040,sb:pokev,38+cx*24:pokev+1,64+cy*24:poke2040,sb+5:return
  397. 9399 rem* display message
  398. 9400 printleft$(l$,26)mc$(ct)ms$(w1):return
  399. 9499 rem* human pick a space on board
  400. 9500 cx=3:cy=3:gosub9350:rem*set cursor
  401. 9510 gosub9100:ifcr=1thenreturn
  402. 9520 ifj=4then9510:rem* no movement
  403. 9530 w1=(mf%(cx,cy)*jx(j)+cx)and7:w2=(mf%(cy,cx)*jy(j)+cy)and7
  404. 9540 ifgb%(w1,w2)=3then9510:rem* wall!
  405. 9550 cx=w1:cy=w2:gosub9350
  406. 9560 fort=1to75:next:goto9510
  407. 9599 rem* animate appearance
  408. 9600 fort=0to4:poke2040,sb+t:fork=1to40:next:next
  409. 9610 gosub9650:rem* space fill
  410. 9620 poke2040,sb+5:return
  411. 9649 rem* draw piece on screen
  412. 9650 print""left$(l$,cx*3)left$(d$,cy*3)c$(ct)pp$(sp%(sn%(cx,cy))):return
  413. 9699 rem* on board piece count
  414. 9700 w1=0:w2=0
  415. 9710 fort=1to24:ifsp%(t)=0thenw1=w1+1
  416. 9720 ifsp%(t)=1thenw2=w2+1
  417. 9730 next:return
  418. 9799 rem* check for mill defense local
  419. 9800 w1=sn%(cx,cy):w2=0:f1=0
  420. 9810 if(sp%(as%(w1,0))=lt)and(sp%(as%(w1,1))=lt)thenf1=1
  421. 9820 if(sp%(as%(w1,2))=lt)and(sp%(as%(w1,3))=lt)thenf1=1
  422. 9830 return
  423. 9899 rem* check for mill defense global
  424. 9900 w1=6:gosub9400:f2=1
  425. 9910 fort=1to24:ifsp%(t)<>ltthen9940
  426. 9920 f1=0:if(sp%(as%(t,0))=lt)and(sp%(as%(t,1))=lt)thenf1=1
  427. 9930 if(sp%(as%(t,2))=lt)and(sp%(as%(t,3))=lt)thenf1=1
  428. 9935 f2=f2*f1
  429. 9940 next:return
  430. 9949 rem* animate capture
  431. 9950 poke2040,sb+4:gosub9650
  432. 9960 fort=3to0step-1:poke2040,sb+t:fork=0to40:next:next
  433. 9970 poke2040,sb+5:return
  434. 9999 rem* game board layout data-gb%(,)
  435. 10000 data 2,3,3,2,3,3,2,3
  436. 10010 data 3,2,3,2,3,2,3,3
  437. 10020 data 3,3,2,2,2,3,3,3
  438. 10030 data 2,2,2,3,2,2,2,3
  439. 10040 data 3,3,2,2,2,3,3,3
  440. 10050 data 3,2,3,2,3,2,3,3
  441. 10060 data 2,3,3,2,3,3,2,3
  442. 10070 data 3,3,3,3,3,3,3,3
  443. 10099 rem* xy movement distances-mf%(,)
  444. 10100 data 3,0,0,3,0,0,3
  445. 10110 data 0,2,0,2,0,2,0
  446. 10120 data 0,0,1,1,1,0,0
  447. 10130 data 1,1,1,1,1,1,1
  448. 10140 data 0,0,1,1,1,0,0
  449. 10150 data 0,2,0,2,0,2,0
  450. 10160 data 3,0,0,3,0,0,3
  451. 10199 rem* space converter table-sn%()
  452. 10200 data 23,0,0,5,0,0,20
  453. 10210 data 0,19,0,1,0,16,0
  454. 10220 data 0,0,15,12,24,0,0
  455. 10230 data 11,4,8,0,6,2,9
  456. 10240 data 0,0,22,10,17,0,0
  457. 10250 data 0,14,0,3,0,21,0
  458. 10260 data 18,0,0,7,0,0,13
  459. 10599 rem* message $
  460. 10600 data " #$ sun      %& player:"
  461. 10610 data " ;< moon     => player:"
  462. 10620 data "you have    pieces left to place."
  463. 10630 data "use joy2 or crsr keys toselect."
  464. 10640 data "you must    choose an   empty space!"
  465. 10650 data"a mill has  been formed.now select  an opposing piece for   capture!"
  466. 10660 data "------------please wait.------------"
  467. 10670 data "you may not capture a   piece in a  mill, while others are  not."
  468. 10680 data "it is your  turn to movea piece."
  469. 10690 data "you need to select a    piece to    move!"
  470. 10700 data "move piece  to where?"
  471. 10710 data"your move iscanceled!               press fire  or return to continue."
  472. 10720 data "????????????? thinking ?????????????"
  473. 10730 data"you can not move any of your pieces!            press fire  or return."
  474. 10999 rem* adj space table-as%(,)
  475. 11000 data 5,12,19,16,16,21,6,9
  476. 11010 data 10,7,14,21,19,14,11,8
  477. 11020 data 23,20,1,12,24,17,2,9
  478. 11030 data 13,18,3,10,22,15,4,11
  479. 11040 data 20,13,2,6,17,22,3,7
  480. 11050 data 18,23,4,8,15,24,1,5
  481. 11060 data 9,20,7,18,3,21,4,19
  482. 11070 data 8,22,12,24,1,19,2,21
  483. 11080 data 6,24,10,22,7,13,11,23
  484. 11090 data 4,14,1,16,5,23,9,13
  485. 11100 data 2,16,3,14,10,17,8,15
  486. 11110 data 11,18,5,20,12,15,6,17
  487. 11199 rem* placement factors-pf%(,)
  488. 11200 data -100,-100,53,120
  489. 11210 data 49,105,46,95
  490. 11230 data 43,85,40,75
  491. 11250 data 37,65,34,60
  492. 11270 data 31,55,28,47
  493. 11290 data 25,40,22,35
  494. 11310 data 19,30,16,25
  495. 11330 data 13,20,10,15
  496. 11350 data 7,10,4,5
  497. 11370 data 1,1
  498. 11399 rem* placement situations-ps%()
  499. 11400 data 9,3,6,1,8,5
  500. 11410 data 3,4,2,1,2,5
  501. 11420 data 6,2,7,1,8,5
  502. 11430 data 1,1,1,1,1,1
  503. 11440 data 8,2,8,1,8,5
  504. 11450 data 5,5,5,1,5,5
  505. 11499 rem* capture factors-cf%()
  506. 11500 data 85,100,135,115,95,15
  507. 11510 data 100,110,145,125,101,25
  508. 11520 data 135,145,155,150,140,10
  509. 11530 data 115,125,150,130,120,30
  510. 11540 data 95,105,140,120,90,20
  511. 11550 data 15,25,10,30,20,5
  512. 11599 rem* type of space-ts%()
  513. 11600 data 2,2,2,2,1,1,1,1
  514. 11610 data 1,1,1,1,0,0,0,0
  515. 11620 data 0,0,0,0,0,0,0,0
  516. 11699 rem* movement ranks-mr%(,)
  517. 11700 data 1,2,3,4,5,6,7,8,9,10,11,12,13,14
  518. 11710 data 15,31,47,48,49,50,51,52,53,54,55,215,89,200
  519. 11720 data 16,32,56,68,82,83,84,85,86,87,88,216,98,201
  520. 11730 data 17,33,57,69,126,127,128,129,130,131,132,219,99,204
  521. 11740 data 18,34,58,70,112,113,114,115,116,117,118,220,100,205
  522. 11750 data 19,35,59,71,119,120,121,122,123,124,125,221,101,206
  523. 11760 data 20,36,60,72,140,141,142,143,144,145,146,222,102,207
  524. 11770 data 21,37,61,73,133,134,135,136,137,138,139,218,103,203
  525. 11780 data 22,38,62,74,157,158,159,160,161,154,162,223,104,208
  526. 11790 data 23,39,63,75,163,164,165,166,167,155,168,224,105,209
  527. 11800 data 24,40,64,76,147,148,149,150,151,152,153,217,102,202
  528. 11810 data 25,41,65,77,169,170,171,172,173,156,174,225,107,210
  529. 11820 data 26,42,66,78,175,176,178,179,180,181,182,226,108,211
  530. 11830 data 27,43,67,190,191,192,193,194,195,196,198,227,109,212
  531. 11840 data 28,44,199,229,230,231,232,233,234,235,236,237,227,238
  532. 11850 data 29,45,79,80,90,91,92,93,94,95,96,97,110,213
  533. 11860 data 30,46,81,89,183,184,185,186,187,188,189,228,111,214
  534. 11870 data 248,239,240,241,242,243,244,245,246,249,247,250,251,252
  535. 40000 fori=0to21:poke828+i,8+i:next:poke788,49
  536. 40010 ifdv<8ordv>29ordv=8then40030
  537. 40020 a=peek(828):b=peek(828+dv-8):poke828,b:poke828+dv-8,a
  538. 40030 a$="hello connect":forj=8to29:i=peek(828+j-8):ifi=14thennext
  539. 40040 close2:open2,i,2:close2:ifstthen40060
  540. 40050 close15:open15,i,15,"r0:"+a$+"="+a$:input#15,er:close15:ifer=63then40070
  541. 40060 next:print"[147]":poke53272,23:poke186,8:end
  542. 40070 q$=chr$(34):poke646,peek(53281):print"[147]":poke53272,23
  543. 40080 print"[147]p[207]2048,0:p[207]44,8:p[207]43,1:p[207]56,160:p[207]55,0:clr:l[207]"q$a$q$","i
  544. 40090 print"run:":poke631,13:poke632,13:poke198,2:end
  545.