home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 206 / 206.d81 / z.gozo1+ (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  16KB  |  651 lines
  1. 1 rem "z.gozo1+" 2001.06.26                   creates gozo ml01
  2. 2 rem gozo ml01 var @ (sc-1)*2+149*256        gozo ml03 var @ (sc-1)*2+192*256
  3. 3 rem gozo ml03 @ 49664                       =================================
  4. 10 v=24320:r=v+7:s=v+11:t=v+19:w=v+66
  5. 12 f=peek(v)
  6. 14 iff>0then28
  7. 16 x=v+1
  8. 18 p=peek(x)
  9. 20 gosub100:rem find move
  10. 26 goto54
  11. 28 x=v+3
  12. 30 b=peek(x)
  13. 32 iff>1then40
  14. 34 gosub308:rem capture?
  15. 38 goto54
  16. 40 iff>2then54
  17. 42 x=v+35
  18. 44 n=peek(x)
  19. 46 gosub336:rem update board
  20. 48 x=v+35
  21. 50 pokex,n
  22. 54 end
  23. 100 rem ********************************        find move
  24. 102 u=v+36
  25. 104 rem --- capture
  26. 106 x=v+35
  27. 108 gosub404:rem e
  28. 110 ife=0then130
  29. 112 i=25
  30. 114 i=i-1
  31. 116 gosub390:rem b
  32. 118 y=w+b
  33. 120 gosub398:rem d
  34. 122 ifd=16then128
  35. 124 gosub308:rem capture?
  36. 126 iff=1then304:yes
  37. 128 ifi>0then114
  38. 130 rem --- whatever (pts>12)
  39. 132 x=v+4
  40. 134 gosub404:rem e
  41. 136 ife=0then154
  42. 138 i=25
  43. 140 i=i-1
  44. 142 gosub390:rem b
  45. 144 ifb=36then140
  46. 146 y=w+b
  47. 148 gosub398:rem d
  48. 150 ifd=16then140
  49. 152 goto304
  50. 154 rem --- init
  51. 156 h=99:k=0
  52. 158 x=v+2
  53. 160 l=peek(x)
  54. 162 x=w+98
  55. 164 forj=1tol
  56. 166 x=x+99
  57. 168 pokex,25
  58. 170 next
  59. 172 rem --- down
  60. 174 k=k+1:w=w+99
  61. 176 rem --- move
  62. 178 n=0
  63. 180 x=w-99:y=x+98:z=w
  64. 182 gosub410:rem copy board
  65. 184 x=w+98
  66. 186 i=peek(x)
  67. 188 ifi>0then198
  68. 190 ifk=lthen300:b (not loss/tie)
  69. 192 ifk>1then280:up
  70. 194 a=g:q=v+815
  71. 196 goto290:log (o win/tie)
  72. 198 i=i-1
  73. 200 pokex,i
  74. 202 gosub390:rem b
  75. 204 ifb=36then184
  76. 206 y=w+b
  77. 208 gosub398:rem d
  78. 210 ifd=16then184
  79. 212 ifk>1then216
  80. 214 a=b
  81. 216 rem --- pattern
  82. 218 gosub336:rem update board
  83. 220 f=1:q=w+73
  84. 222 sys49664:rem lookup
  85. 224 x=10+49152
  86. 226 f=peek(x)
  87. 228 iff=0then234:not found
  88. 230 ifk=1then304:done (win @ top)
  89. 232 goto280:up
  90. 234 rem --- capture
  91. 236 ifk=lthen176:next move (@ bottom)
  92. 238 m=0
  93. 240 ifn=0then266:no captures
  94. 242 i=25
  95. 244 i=i-1
  96. 246 gosub390:rem b
  97. 248 y=w+b
  98. 250 gosub398:rem d
  99. 252 ifd=16then262
  100. 254 gosub308:rem capture?
  101. 256 iff=0then262:no
  102. 258 gosub336:rem update board
  103. 260 m=m+o
  104. 262 ifi>0then244
  105. 264 goto240
  106. 266 ifk>1then276
  107. 268 ifm>hthen276
  108. 270 g=a:h=m
  109. 276 ifm>11then176:next move (loss/tie)
  110. 278 goto172:down
  111. 280 rem --- up
  112. 282 x=w+98
  113. 284 pokex,25
  114. 286 k=k-1:w=w-99
  115. 288 goto176:next move
  116. 290 rem --- log pattern
  117. 292 e=peek(q)
  118. 294 ife=0then300
  119. 295 ife=16then300
  120. 296 f=2
  121. 298 sys49664
  122. 300 rem --- top b
  123. 302 b=a
  124. 304 rem --- done
  125. 306 return
  126. 308 rem ********************************        capture move? no(f=0) yes(f=1)
  127. 310 rem in-b
  128. 312 f=1:j=4
  129. 314 j=j-1:x=r+j
  130. 316 gosub404:rem e
  131. 318 c=b+e:c=c-8:y=w+c
  132. 320 gosub398:rem d
  133. 322 ifd>14then330
  134. 324 x=t+d
  135. 326 gosub404:rem e
  136. 328 ife=3then334
  137. 330 ifj>0then314
  138. 332 f=0
  139. 334 return
  140. 336 rem ********************************        update board
  141. 338 rem in-b,n out-a,n,z
  142. 340 y=w+b
  143. 342 pokey,16
  144. 344 o=0:z=v+61
  145. 346 j=4
  146. 348 j=j-1:x=r+j
  147. 350 gosub404:rem e
  148. 352 c=b+e:c=c-8:y=w+c
  149. 354 gosub398:rem d
  150. 356 ifd>14then382
  151. 358 x=s+j
  152. 360 gosub404:rem e
  153. 362 d=dore
  154. 364 pokey,d
  155. 366 x=t+d
  156. 368 gosub404:rem e
  157. 370 ife<3then382
  158. 372 ife=4then378
  159. 374 n=n+1
  160. 376 goto382
  161. 378 n=n-1:o=o+1:x=z+o
  162. 380 pokex,c
  163. 382 ifj>0then348
  164. 384 f=0:q=w+73
  165. 386 sys49664:rem update patterns
  166. 388 return
  167. 390 rem ********************************        current move
  168. 392 x=u+i
  169. 394 b=peek(x)
  170. 396 return
  171. 398 rem ********************************        d=peek(y)
  172. 400 d=peek(y)
  173. 402 return
  174. 404 rem ********************************        e=peek(x)
  175. 406 e=peek(x)
  176. 408 return
  177. 410 rem ********************************        copy: x=start y=end+1 z=dest
  178. 412 rem - copy mem @ 16528(144+64*256)          - x,y,z @ (sc-1)*2+149*256
  179. 414 poke781,46
  180. 416 poke782,149
  181. 418 sys16528
  182. 420 return
  183. 422 rem ================================
  184. 1000 poke55,128:poke56,149:clr:bs=128+149*256:fl$="gozo ml01":goto1630
  185. 1010 b=peek(ad):ad=ad+1:ifb=32then1010
  186. 1020 return
  187. 1030 aa=ad
  188. 1040 b=peek(aa):aa=aa+1:ifb=32then1040
  189. 1050 return
  190. 1060 gosub1010:ifb<>0thenprintb:goto1730
  191. 1070 return
  192. 1080 n=0
  193. 1090 gosub1010:ifb<48 or b>57 then return
  194. 1100 n=n*10+(b-48):goto1090
  195. 1110 nh=int(nn/256):nl=nn-(nh*256):return
  196. 1120 gosub1110:print mid$(hx$,(nhand240)/16+1,1);mid$(hx$,(nhand15)+1,1);
  197. 1130 printmid$(hx$,(nland240)/16+1,1);mid$(hx$,(nland15)+1,1);:return
  198. 1140 bx=bx+1:ifp<>3 then ml=ml+1:return
  199. 1150 poke ml,z:ml=ml+1:return
  200. 1160 ifp<>1thensp=sp+1:sl=sl+1:return
  201. 1170 pokesp,z:sp=sp+1:sl=sl+1:return
  202. 1180 ifp<>3thenreturn
  203. 1190 dx=dx+1:poke dw,nl:poke dw+1,nh:dw=dw+2:return
  204. 1200 gosub1010:ifb>64then1220
  205. 1210 g=1:ad=ad-1:gosub1080:ad=ad-1:nn=n:goto1240
  206. 1220 gosub1250
  207. 1230 g=0:b=b-65:nn=(b*2)+zv
  208. 1240 b=peek(ad):gosub1110:return
  209. 1250 if(b<65 or b>90)then5360
  210. 1260 return
  211. 1270 z=173:gosub1140:z=nl:gosub1140:z=nh:goto1140
  212. 1280 z=173:gosub1140:z=nl+1:gosub1140:z=nh:goto1140
  213. 1290 z=141:gosub1140:z=nl:gosub1140:z=nh:goto1140
  214. 1300 z=141:gosub1140:z=nl+1:gosub1140:z=nh:goto1140
  215. 1310 z=169:gosub1140:z=nl:goto1140
  216. 1320 z=169:gosub1140:z=nh:goto1140
  217. 1330 z=173:gosub1140:z=vl:gosub1140:z=vh:goto1140
  218. 1340 z=173:gosub1140:z=vl+1:gosub1140:z=vh:goto1140
  219. 1350 z=141:gosub1140:z=vl:gosub1140:z=vh:goto1140
  220. 1360 z=141:gosub1140:z=vl+1:gosub1140:z=vh:goto1140
  221. 1370 nl=ms(h,0):nh=ms(h,1):return
  222. 1380 gosub1140:z=nl:gosub1140:z=nh:goto1140
  223. 1390 gosub1140:z=nl+1:gosub1140:z=nh:goto1140
  224. 1400 gosub1140:z=nl:goto1140
  225. 1410 gosub1140:z=nh:goto1140
  226. 1420 z=165:gosub1140:z=y:goto1140
  227. 1430 z=162:gosub1140:z=y:goto1140
  228. 1440 z=161:gosub1140:z=y:goto1140
  229. 1450 z=145:gosub1140:z=y:goto1140
  230. 1460 z=160:gosub1140:z=y:goto1140
  231. 1470 z=133:gosub1140:z=y:goto1140
  232. 1480 z=56:goto1140
  233. 1490 z=24:goto1140
  234. 1500 z=32:gosub1140:z=yl:gosub1140:z=yh:goto1140
  235. 1510 z=76:gosub1140:z=yl:gosub1140:z=yh:goto1140
  236. 1520 z=233:gosub1140:z=nl:goto1140
  237. 1530 z=233:gosub1140:z=nh:goto1140
  238. 1540 z=105:gosub1140:z=nl:goto1140
  239. 1550 z=105:gosub1140:z=nh:goto1140
  240. 1560 z=237:gosub1140:z=nl:gosub1140:z=nh:goto1140
  241. 1570 z=237:gosub1140:z=nl+1:gosub1140:z=nh:goto1140
  242. 1580 z=109:gosub1140:z=nl:gosub1140:z=nh:goto1140
  243. 1590 z=109:gosub1140:z=nl+1:gosub1140:z=nh:goto1140
  244. 1600 z=y1:gosub1140:z=y2:goto1140
  245. 1610 z=y1:gosub1140:z=y2:gosub1140:z=y3:goto1140
  246. 1620 z=169:gosub1140:z=y:goto1140
  247. 1630 lx=3:xx=0:zp=bs+80:p=1:zm=zp:sk=-1
  248. 1635 zv=149*256:rem variable's start address, for original set zv=679
  249. 1640 dim ll(255,1),fs(6,4),li%(lx,5),ms(5,3),oc%(3,1)
  250. 1650 gosub5440:sys828,232,3
  251. 1660 fori=0tolx:forj=0to5:readli%(i,j):next:next:bx=0:dx=0:f2=0
  252. 1670 ad=peek(43)+peek(44)*256:print"[147]          ***** pass";p;" *****"
  253. 1680 sp=zp:ml=zm
  254. 1690 nm=peek(ad)+peek(ad+1)*256
  255. 1700 ln=peek(ad+2)+peek(ad+3)*256:ifln>999then1740
  256. 1710 print"          compiling line #"mid$(str$(ln),2)
  257. 1720 ifp=2thenll(xx,0)=ln:ll(xx,1)=ml:xx=xx+1
  258. 1730 ad=ad+4:gosub1010:goto1790
  259. 1740 ifp=1thenp=2:zm=sp:r1=zm:la=sp:u1=bx:bx=0:goto1670
  260. 1750 ifp=2thenp=3:zm=la:r2=zm:gosub5420:db=la+bx+4:dw=db:u2=bx:bx=0:goto1670
  261. 1760 u3=bx:gosub4760:print"done!":print:gosub4580
  262. 1770 ifpeek(ml-1)<>96thenz=96:gosub1140
  263. 1780 goto4450
  264. 1790 ifb=136then3610:rem let
  265. 1800 ifb=153then2020:rem print
  266. 1810 ifb=128then2300:rem end
  267. 1820 ifb=137then2170:rem goto
  268. 1830 ifb=141then2230:rem gosub
  269. 1840 ifb=142then2300:rem return
  270. 1850 ifb=139then2320:rem if
  271. 1860 ifb=151then2600:rem poke
  272. 1870 ifb=129then2710:rem for
  273. 1880 ifb=130then2960:rem next
  274. 1890 ifb=135then3320:rem read
  275. 1900 ifb=140then3420:rem restore
  276. 1910 ifb=131then3470:rem data
  277. 1920 ifb=156then3510:rem clr
  278. 1930 ifb=143then2000:rem rem
  279. 1940 ifb=161then3530:rem get
  280. 1950 ifb=158then4300:rem sys
  281. 1960 rem this line assumes let
  282. 1970 ad=ad-1:goto3610
  283. 1980 sysbs:end
  284. 1990 fori=0toxx-1:printll(i,0),ll(i,1):next
  285. 2000 ad=nm:goto1690
  286. 2010 rem handle print
  287. 2020 gosub1010:ifb=199then3250
  288. 2030 ifb>64 then2110
  289. 2040 ifb<>34then2150
  290. 2050 sl=0:nn=sp:gosub1110
  291. 2060 b=peek(ad):ad=ad+1:if((b=0)or(b=34))then2080
  292. 2070 z=b:gosub1160:goto2060
  293. 2080 gosub1310:y=34:gosub1470:gosub1320:y=35:gosub1470
  294. 2090 y=sl:gosub1430:yl=37:yh=171:gosub1500:gosub1010:ifb<>59then2150
  295. 2095 goto2000
  296. 2100 rem handle print <var>
  297. 2110 ifb<65 or b>91 then5360
  298. 2120 b=b-65:nn=(b*2)+zv:gosub1110:gosub1010:w=b
  299. 2130 gosub1280:z=174:gosub1380:yl=205:yh=189:gosub1500:ifw<>59then2150
  300. 2135 goto2000
  301. 2140 rem handle print <cr>
  302. 2150 yl=215:yh=170:gosub1500:goto2000
  303. 2160 rem handle goto <line number>
  304. 2170 gosub1080:if p<>3 then2210
  305. 2180 ifxx=0then5380
  306. 2190 f2=0:fori=0to(xx-1):ifll(i,0)=nthenf2=1:nn=ll(i,1)
  307. 2200 next:iff2=0then5380
  308. 2210 gosub1110:yl=nl:yh=nh:gosub1510:goto2000
  309. 22