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