home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 206 / 206.d81 / z.gozo3+ (.txt) < prev   
Encoding:
Commodore BASIC  |  2001-01-01  |  16.0 KB  |  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:fori=0to(xx-1):ifll(i,0)=nthenf2=1:nn=ll(i,1)
  291. 2260 next:iff2=0then5380
  292. 2270 gosub1110:z=32:gosub1140:z=nl:gosub1140:z=nh:gosub1140:goto2000
  293. 2280 gosub1110:yl=nl:yh=nh:gosub1500:goto2000
  294. 2290 rem handle return
  295. 2300 z=96:gosub1140:goto2000
  296. 2310 rem handle if
  297. 2320 gosub1010:ifb<65 or b>90 then5360
  298. 2330 b=b-65:nn=(b*2)+zv:gosub1110:vh=nh:vl=nl
  299. 2340 gosub1010
  300. 2350 ifb=177thenf1=1:goto2390:rem >
  301. 2360 ifb=178thenf1=2:goto2390:rem =
  302. 2370 ifb=179thenf1=3:goto2390:rem <
  303. 2380 goto5360:rem syntax error
  304. 2390 f3=0:gosub1010:ifb<65then2420
  305. 2400 gosub1250:f3=1:b=b-65:nn=(b*2)+zv:gosub1110:goto2430
  306. 2410 rem if <var> <=> <num or var>
  307. 2420 ad=ad-1:gosub1080:ad=ad-1:nn=n:gosub1110
  308. 2430 gosub1480:gosub1330:iff3thengosub1560:goto2450
  309. 2440 gosub1520
  310. 2450 y=2:gosub1470:gosub1340:iff3thengosub1570:goto2470
  311. 2460 gosub1530
  312. 2470 y1=5:y2=2:gosub1600
  313. 2480 iff1<>3then2500
  314. 2490 y1=240:y2=5:gosub1600:y1=176:y2=3:gosub1600:goto2530
  315. 2500 iff1<>2then2520
  316. 2510 y1=208:y2=3:gosub1600:goto2530
  317. 2520 y1=144:y2=5:gosub1600:y1=240:y2=3:gosub1600:goto2530
  318. 2530 gosub1010:ifb<>167then5360
  319. 2540 gosub1080:if p<>3 then2580
  320. 2550 ifxx=0then5380
  321. 2560 f2=0:fori=0to(xx-1):ifll(i,0)=nthenf2=1:nn=ll(i,1)
  322. 2570 next:iff2=0then5380
  323. 2580 gosub1110:yl=nl:yh=nh:gosub1510:goto2000
  324. 2590 rem handle poke
  325. 2600 gosub1200:vl=nl:vh=nh:tt=g:gosub1010:ifb<>44then5360
  326. 2610 gosub1200:ifttthen2660
  327. 2620 gosub1330:y=20:gosub1470:gosub1340:y=21:gosub1470
  328. 2630 ifgthengosub1310:goto2650
  329. 2640 gosub1270
  330. 2650 y=0:gosub1430:y1=129:y2=20:gosub1600:goto2000
  331. 2660 ifg=0thengosub1270:goto2680
  332. 2670 gosub1310
  333. 2680 ifvh=0theny=vl:gosub1470:goto2000
  334. 2690 gosub1350:goto2000
  335. 2700 rem handle for
  336. 2710 gosub1010:ifb<65 or b>90 then5360
  337. 2720 b=b-65:nn=(b*2)+zv:gosub1110:vh=nh:vl=nl
  338. 2730 sk=sk+1:fs(sk,3)=nn:fs(sk,4)=0:fs(sk,1)=1
  339. 2740 gosub1010:ifb<>178then5360
  340. 2750 gosub1010:if b>64then2800
  341. 2760 rem start = constant
  342. 2770 ad=ad-1:gosub1080:nn=n:gosub1110:gosub1310:gosub1350:gosub1320:gosub1360
  343. 2780 ad=ad-1:goto2810
  344. 2790 rem start = variable
  345. 2800 b=b-65:nn=(b*2)+zv:gosub1110:gosub1270:gosub1350:gosub1280:gosub1360
  346. 2810 gosub1010:ifb<>164then5360
  347. 2820 gosub1010:if b>64then2860
  348. 2830 rem to = constant
  349. 2840 ad=ad-1:gosub1080:ad=ad-1:fs(sk,0)=n:goto2870
  350. 2850 rem to = variable
  351. 2860 b=b-65:nn=(b*2)+zv:fs(sk,0)=nn:fs(sk,4)=fs(sk,4) or 2
  352. 2870 fs(sk,2)=ml:gosub1010:ifb=0then2000
  353. 2880 rem handle step
  354. 2890 ifb<>169then5360
  355. 2900 gosub1010:if b>64then2940
  356. 2910 rem step = constant
  357. 2920 ad=ad-1:gosub1080:ad=ad-1:fs(sk,1)=n:goto2000
  358. 2930 rem step = variable
  359. 2940 b=b-65:nn=(b*2)+zv:fs(sk,1)=nn:fs(sk,4)=fs(sk,4) or 4 : goto2000
  360. 2950 rem handle next
  361. 2960 ifsk=-1then5390
  362. 2970 nn=fs(sk,3):gosub1110:vl=nl:vh=nh
  363. 2980 nn=fs(sk,1):gosub1110
  364. 2990 gosub1490:gosub1330
  365. 3000 if(fs(sk,4)and4)=4 then3020
  366. 3010 gosub1540:goto3030
  367. 3020 gosub1580
  368. 3030 gosub1350
  369. 3040 gosub1340
  370. 3050 if(fs(sk,4)and4)=4 then3070
  371. 3060 gosub1550:goto3080
  372. 3070 gosub1590
  373. 3080 gosub1360
  374. 3090 nn=fs(sk,2):gosub1110:al=nl:ah=nh
  375. 3100 nn=fs(sk,0):gosub1110
  376. 3110 gosub1480:gosub1330
  377. 3120 if(fs(sk,4)and2)=2 then3140
  378. 3130 gosub1520:goto3150
  379. 3140 gosub1560
  380. 3150 y=2:gosub1470
  381. 3160 gosub1340
  382. 3170 if(fs(sk,4)and2)=2 then3190
  383. 3180 gosub1530:goto3200
  384. 3190 gosub1570
  385. 3200 y1=5:y2=2:gosub1600
  386. 3210 y1=240:y2=2:gosub1600:y1=176:y2=3:gosub1600
  387. 3220 yl=al:yh=ah:gosub1510
  388. 3230 sk=sk-1:goto2000
  389. 3240 rem handle print chr$()
  390. 3250 gosub1010:ifb<>40then5360
  391. 3260 gosub1010:ifb>64then3280
  392. 3270 ad=ad-1:gosub1080:y=(n and 255):gosub1620:goto3300
  393. 3280 b=b-65:nn=(b*2)+zv:gosub1110
  394. 3290 gosub1270
  395. 3300 yl=210:yh=255:gosub1500:gosub1010:ifb<>59then2150
  396. 3305 goto2000
  397. 3310 rem handle read
  398. 3320 ifp<>2 then3370
  399. 3330 ifli%(1,5)=1then3350
  400. 3340 f2=1:nn=la:gosub1110:li%(1,3)=nl:li%(1,4)=nh:li%(1,5)=1:la=la+li%(1,2)
  401. 3350 ifli%(0,5)=1then3370
  402. 3360 nn=la:gosub1110:li%(0,3)=nl:li%(0,4)=nh:li%(0,5)=1:la=la+li%(0,2)
  403. 3370 gosub1010:b=b-65:nn=(b*2)+zv:gosub1110
  404. 3380 yl=li%(1,3):yh=li%(1,4):gosub1500
  405. 3390 gosub1290
  406. 3400 z=142:gosub1390:goto2000
  407. 3410 rem handle restore
  408. 3420 ifp<>2then3450
  409. 3430 ifli%(0,5)=1then3450
  410. 3440 f2=1:nn=la:gosub1110:li%(0,3)=nl:li%(0,4)=nh:li%(0,5)=1:la=la+li%(0,2)
  411. 3450 yl=li%(0,3):yh=li%(0,4):gosub1500:goto2000
  412. 3460 rem handle data
  413. 3470 gosub1010:ad=ad-1:ifb=0then2000
  414. 3480 gosub1080:nn=n:gosub1110:gosub1180:ifb=44then3480
  415. 3490 goto2000
  416. 3500 rem handle clr
  417. 3510 nn=bs+64:gosub1110:yl=nl:yh=nh:gosub1500:goto2000
  418. 3520 rem handle get
  419. 3530 gosub1010:gosub1250
  420. 3540 b=b-65:nn=(b*2)+zv:gosub1110:vh=nh:vl=nl
  421. 3550 yl=228:yh=255:gosub1500:gosub1290
  422. 3560 y=0:gosub1620
  423. 3570 gosub1300:goto2000
  424. 3580 rem
  425. 3590 rem handle let
  426. 3600 rem
  427. 3610 gosub1200:ifgthen5360
  428. 3620 vl=nl:vh=nh
  429. 3630 gosub1010:ifb<>178then5360
  430. 3640 gosub1030
  431. 3650 rem handle functions here
  432. 3660 ifb=194then4350: rem peek
  433. 3670 gosub1200:gosub1010:op=0
  434. 3680 ms(0,0)=nl:ms(0,1)=nh:ms(0,2)=g:ms(0,3)=nn
  435. 3690 if((b=0)or(b=58))thense=b:goto3760
  436. 3700 op=b:ro=b:ifop=175thenop=172
  437. 3710 ifop=176thenop=173
  438. 3720 ifro=172thenop=174
  439. 3730 ifro=173thenop=175
  440. 3740 gosub1200:gosub1010
  441. 3750 ms(1,0)=nl:ms(1,1)=nh:ms(1,2)=g:ms(1,3)=nn:se=b
  442. 3760 ifop<>0then3840
  443. 3770 h=0:gosub1370:ifms(0,2)then3810
  444. 3780 rem <var> = <var>
  445. 3790 gosub1270:gosub1350:gosub1280:gosub1360:goto3820
  446. 3800 rem <var> = <const>
  447. 3810 gosub1310:gosub1350:gosub1320:gosub1360
  448. 3820 ifse=58then3610
  449. 3830 goto2000
  450. 3840 if((op<170)or(op>173))then4070
  451. 3850 rem handle addition & subtraction
  452. 3860 ifms(0,2)+ms(1,2)<>2 then3920
  453. 3870 rem <var> = <const> <+-> <const>
  454. 3880 rem  gosub 500
  455. 3890 ifop=170then nn=ms(0,3)+ms(1,3):gosub1110:goto3810
  456. 3900 ifop=171then nn=ms(0,3)-ms(1,3):gosub1110:goto3810
  457. 3910 goto5360
  458. 3920 ifop=170thenz=24:gosub1140
  459. 3930 ifop=171thenz=56:gosub1140
  460. 3940 h=0:gosub1370:n1=nl:n2=nh:ifms(0,2)thengosub1310:goto3960
  461. 3950 gosub1270
  462. 3960 z=oc%(op-170,ms(1,2)):tt=z
  463. 3970 h=1:gosub1370:n3=nl:n4=nh:ifms(1,2)thengosub1400:goto3990
  464. 3980 gosub1380
  465. 3990 gosub1350
  466. 4000 nl=n1:nh=n2:ifms(0,2)thengosub1320:goto4020
  467. 4010 gosub1280
  468. 4020 z=tt:nl=n3:nh=n4:ifms(1,2)thengosub1410:goto4040
  469. 4030 gosub1390
  470. 4040 gosub1360
  471. 4050 ifse=58then3610
  472. 4060 goto2000
  473. 4070 ifop=175then4130
  474. 4080 ifop<>174then5360
  475. 4090 ifp<>2then4160
  476. 4100 ifli%(3,5)=1then4160
  477. 4110 f2=1:nn=la:gosub1110:li%(3,3)=nl:li%(3,4)=nh:li%(3,5)=1:la=la+li%(3,2)
  478. 4120 goto4160
  479. 4130 ifp<>2then4160
  480. 4140 ifli%(2,5)=1then4160
  481. 4150 f2=1:nn=la:gosub1110:li%(2,3)=nl:li%(2,4)=nh:li%(2,5)=1:la=la+li%(2,2)
  482. 4160 h=0:gosub1370:ifms(0,2)then4180
  483. 4170 gosub1270:y=5:gosub1470:gosub1280:y=6:gosub1470:goto4190
  484. 4180 gosub1310:y=5:gosub1470:gosub1320:y=6:gosub1470
  485. 4190 h=1:gosub1370:ifms(1,2)then4210
  486. 4200 gosub1270:y=3:gosub1470:gosub1280:y=4:gosub1470:goto4220
  487. 4210 gosub1310:y=3:gosub1470:gosub1320:y=4:gosub1470
  488. 4220 ifop=174then4250
  489. 4230 z=32:gosub1140:z=li%(2,3):gosub1140:z=li%(2,4):gosub1140
  490. 4240 y=5:gosub1420:gosub1350:y=6:gosub1420:gosub1360:goto4270
  491. 4250 z=32:gosub1140:z=li%(3,3):gosub1140:z=li%(3,4):gosub1140
  492. 4260 y=163:gosub1420:gosub1350:y=164:gosub1420:gosub1360
  493. 4270 ifse=58then3610
  494. 4280 goto2000
  495. 4290 rem handle sys
  496. 4300 gosub1200:ifgthen4320
  497. 4310 gosub1270:y=20:gosub1470:gosub1280:y=21:gosub1470:goto4330
  498. 4320 gosub1310:y=20:gosub1470:gosub1320:y=21:gosub1470
  499. 4330 z=32:gosub1140:z=48:gosub1140:z=225:gosub1140:goto2000
  500. 4340 rem handle peek
  501. 4350 gosub1010:gosub1010:ifb<>40then5360
  502. 4360 gosub1200:ifgthen4410
  503. 4370 gosub1270:y=20:gosub1470:gosub1280:y=21:gosub1470:y=0:gosub1430:y=20:gosub1440
  504. 4380 gosub1350:nl=0:gosub1310:gosub1360:gosub1010:ifb<>41then5360
  505. 4390 gosub1010:ifb=58then3610
  506. 4400 goto2000
  507. 4410 ifnh=0then4430
  508. 4420 gosub1270:goto4380
  509. 4430 y=nl:gosub1420:goto4380
  510. 4440 rem this is file save routine
  511. 4450 a$=fl$:dv=8
  512. 4455 open15,dv,15:print#15,"s0:"+a$:close15
  513. 4460 nn=dw+2:gosub1110:l=len(a$):ad=0:vl=0:vh=0:i=0
  514. 4470 a$=a$:poke251,peek(71):poke252,peek(72):ad=peek(251)+peek(252)*256
  515. 4480 vl=peek(ad+1):vh=peek(ad+2)
  516. 4490 poke780,8:poke781,8:poke782,1
  517. 4500 sys65466 :rem setlfs
  518. 4510 poke780,l:poke781,vl:poke782,vh
  519. 4520 sys65469 :rem setnam
  520. 4525 th=nh:tl=nl:nn=bs:gosub1110
  521. 4530 poke251,nl:poke252,nh :rem start
  522. 4540 poke780,251:poke781,tl:poke782,th
  523. 4550 sys65496 :rem save
  524. 4560 end
  525. 4570 rem print compile info
  526. 4580 rem print" "fl$" info.":print"press p for printer (device 4),"
  527. 4582 rem print"any other key for screen."
  528. 4584 rem poke198,0:wait198,1:geta$:ifa$="p"then open 4,4,7:cmd 4
  529. 4590 print"start........ "bs
  530. 4600 print"string pool.. "zp
  531. 4610 print"runtime lib.. "sp
  532. 4620 print"code start... "la
  533. 4630 print"code end .... "db-1
  534. 4640 print"code size.... "(db-1)-la"bytes"
  535. 4660 print"data area.... "db
  536. 4670 print"prog end..... "dw+2
  537. 4680 printtab(14);"-------------------"
  538. 4690 print"total size... "(dw+2)-bs"bytes"
  539. 4710 print:print:print"    zip-basic, copyright (c) 2000 by"
  540. 4720 printtab(9);"j & f  publishing inc."
  541. 4730 printtab(10);"all rights reserved"
  542. 4735 rem if a$="p" then print#4:close4
  543. 4740 return
  544. 4750 rem handle runtime library
  545. 4760 print"[147]building runtime library..."
  546. 4770 fori=bstobs+47:pokei,0:next:fori=bs+48tobs+62:pokei,234:next
  547. 4780 pokebs+63,96:pokebs,32:nn=bs+48:gosub1110:pokebs+1,nl:pokebs+2,nh
  548. 4790 read d$:fori=1tolen(d$):pokebs+9+i,asc(mid$(d$,i,1)):next
  549. 4800 fori=bs+64tobs+74:readd:pokei,d:next
  550. 4805 h%=zv/256:pokebs+69,zv-h%*256:pokebs+70,h%:rem variable's start address
  551. 4810 pokebs+51,32:nn=bs+64:gosub1110:pokebs+52,nl:pokebs+53,nh
  552. 4820 poke bs+3,76:nn=la:gosub1110:pokebs+4,nl:pokebs+5,nh
  553. 4830 iff2<>1thenreturn
  554. 4840 fori=0tolx
  555. 4850 ifli%(i,5)<>1 then4900
  556. 4860 rem install library
  557. 4870 sys828,li%(i,0),li%(i,1)
  558. 4880 nt=li%(i,3)+(li%(i,4)*256):nc=li%(i,2)-1
  559. 4890 ff=0:forj=0tonc:readd:ifsgn(d)<>-1then 4896
  560. 4892 if ff=1then ff=0:d=nh:goto4896
  561. 4894 nn=abs(d)+bs:gosub1110:ff=1:d=nl
  562. 4896 pokent+j,d:next
  563. 4900 next
  564. 4910 ifli%(0,5)<>1then4940
  565. 4920 nn=db:gosub1110:pokebs+6,nl:pokebs+7,nh:nn=dw:gosub1110:pokebs+8,nl
  566. 4930 pokebs+9,nh:pokebs+48,32:pokebs+49,li%(0,3):pokebs+50,li%(0,4)
  567. 4940 return
  568. 4950 rem lib array data
  569. 4960 data 176,19,11,0,0,0 :rem restore
  570. 4970 data 206,19,43,0,0,0 :rem read
  571. 4980 data 20,20,59,0,0,0 :rem divide
  572. 4990 data 110,20,48,0,0,0 :rem multiply
  573. 5000 data "zip-basic (c) 2000 j&f publishing"
  574. 5010 data 162,88,169,0,157,167,2,202
  575. 5020 data 16,250,96
  576. 5030 rem this is library restore
  577. 5040 data 173,-6,-1,133,65,173,-7,-1
  578. 5050 data 133,66,96
  579. 5060 rem *** this is library read ***
  580. 5070 data 165,65,205,-8,-1,208,12,165
  581. 5080 data 66,205,-9,-1,208,5,162,13
  582. 5090 data 108,0,3,160,0,177,65,72
  583. 5100 data 200,177,65,170,24,165,65,105
  584. 5110 data 2,133,65,165,66,105,0,133
  585. 5120 data 66,104,96
  586. 5130 rem *** this is library divide ***
  587. 5140 data 165,3,5,4,208,5,162,20
  588. 5150 data 108,0,3,169,0,133,163,133
  589. 5160 data 164,162,16,6,5,38,6,38
  590. 5170 data 163,38,164,56,165,163,229,3
  591. 5180 data 168,165,164,229,4,144,6,230
  592. 5190 data 5,133,164,132,163,202,208,227
  593. 5200 data 165,163,141,217,2,165,164,141
  594. 5210 data 218,2,96
  595. 5220 rem *** library multiply ***
  596. 5230 data 169,0,133,165,133,166,162,16
  597. 5240 data 70,4,102,3,144,11,24,165
  598. 5250 data 165,101,5,133,165,165,166,101
  599. 5260 data 6,106,133,166,102,165,102,164
  600. 5270 data 102,163,202,208,227,165,165
  601. 5280 data 141,217,2,165,166,141,218,2
  602. 5290 data 96
  603. 5360 er$="syntax error":goto5400
  604. 5370 er$="bad command":goto5400
  605. 5380 er$="undef'd statement":goto5400
  606. 5390 er$="next without for":goto5400
  607. 5400 print "[error][146][154] " er$" in line"ln:end
  608. 5410 rem fixup line numbers
  609. 5420 n=r2-r1:ifn=0thenreturn
  610. 5430 fori=0toxx-1:ll(i,1)=ll(i,1)+n:next:return
  611. 5440 poke828,32:poke829,253:poke830,174:poke831,32:poke832,158:poke833,183
  612. 5450 poke834,134:poke835,20:poke836,32:poke837,253:poke838,174:poke839,32
  613. 5460 poke840,158:poke841,183:poke842,134:poke843,21:poke844,32:poke845,19
  614. 5470 poke846,166:poke847,176:poke848,3:poke849,76:poke850,227:poke851,168
  615. 5480 poke852,165:poke853,95:poke854,164:poke855,96:poke856,56:poke857,233
  616. 5490 poke 858,1:poke859,76:poke860,36:poke861,168
  617. 5500 oc%(0,0)=109:oc%(0,1)=105:oc%(1,0)=237:oc%(1,1)=233
  618. 5510 oc%(2,0)=45:oc%(2,1)=41:oc%(3,0)=13:oc%(3,1)=9
  619. 5520 hx$="0123456789abcdef":return
  620. 9998 :
  621. 9999 rem * scratch & save *
  622. 10000 fl$="z.gozo3+":dv=8
  623. 10001 open15,dv,15:print#15,"s0:"+fl$:close15:save fl$,dv:end
  624. 10002 :
  625. 19998 rem * list to printer *
  626. 19999 rem (set to device 4 & emulate)
  627. 20000 p=peek(646):poke646,peek(53281):print"[147]print#1:close1":poke646,p
  628. 20001 poke631,19:poke632,13:poke198,2:open1,4,7:cmd1:list-&999:end
  629.