home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 203 / 203.d81 / z.kb+ (.txt) < prev    next >
Encoding:
Commodore BASIC  |  2001-01-01  |  16.8 KB  |  694 lines
  1. 1 rem "z.kb+" 2001.03.20                  ======================================
  2. 10 r=24927:v=25600:w=25614
  3. 12 f=peek(v)
  4. 14 x=v+1
  5. 16 p=peek(x)
  6. 18 iff=0then48
  7. 20 iff=1then42
  8. 22 x=v+2
  9. 24 a=peek(x)
  10. 26 iff=2then38
  11. 28 x=v+3
  12. 30 b=peek(x)
  13. 32 q=3-p
  14. 34 gosub700
  15. 36 goto50
  16. 38 gosub600
  17. 40 goto50
  18. 42 t=1
  19. 44 gosub500
  20. 46 goto50
  21. 48 gosub100
  22. 50 end
  23. 100 rem ********************************        find "b" (s=2,4,6,8)
  24. 102 x=v+5
  25. 104 s=peek(x)
  26. 106 g=0:o=p:q=p:h=100:t=0:u=w
  27. 108 rem - down
  28. 110 p=q:q=3-p:h=100-h:t=t+1:w=w+126
  29. 112 x=w-126:y=x+115:z=w
  30. 114 gosub900
  31. 116 gosub500:rem "a"
  32. 118 gosub600:rem "b" list
  33. 120 ifn>0then128:rem not win/loss
  34. 122 l=0
  35. 124 ifo=pthen186:rem loss
  36. 126 goto190:rem win
  37. 128 ift>1then138
  38. 130 ifn>1then138
  39. 132 pokez,0
  40. 134 f=50
  41. 136 goto278:rem only move
  42. 138 gosub630:rem "b" sort
  43. 140 x=w+125
  44. 142 pokex,h
  45. 144 rem - next "b"
  46. 146 m=8
  47. 148 x=w-126:y=x+115:z=w
  48. 150 gosub900
  49. 152 x=w+116
  50. 154 l=peek(x)
  51. 156 ifl=0then250:rem up
  52. 158 l=l-1
  53. 160 pokex,l
  54. 162 x=w+117:x=x+l
  55. 164 b=peek(x)
  56. 166 rem - results
  57. 168 x=w+115
  58. 170 a=peek(x)
  59. 172 ift>1then178
  60. 174 x=w+125
  61. 176 pokex,h
  62. 178 gosub700:rem sets m
  63. 180 ifm>2then194:rem not win/loss
  64. 182 ifo=pthen190:rem win
  65. 184 rem - pts for win/loss                      win(99,97,95,93) loss(2,4,6,8)
  66. 186 f=t
  67. 188 goto246:rem loss
  68. 190 f=100-t
  69. 192 goto246:rem win
  70. 194 rem - pts @ "o" move(t=2,4,6,8)             good(>50) neutral(50) bad(<50)
  71. 196 ifo=pthen108:rem down
  72. 198 f=50
  73. 200 e=o-1:e=e*8
  74. 202 x=u+99:x=x+e
  75. 204 i=peek(x)
  76. 206 x=w+99:x=x+e
  77. 208 j=peek(x)
  78. 210 f=f-i:f=f+j
  79. 212 e=8-e
  80. 214 x=u+99:x=x+e
  81. 216 i=peek(x)
  82. 218 x=w+99:x=x+e
  83. 220 k=peek(x)
  84. 222 f=f+i:f=f-k
  85. 224 iff>50then246:rem good enough
  86. 226 iff=50then234:rem neutral
  87. 228 ift>2then234:rem not "xo"
  88. 230 l=0
  89. 232 goto246:rem bad enough
  90. 234 ift<sthen108:rem down
  91. 236 rem . don't xch when behind
  92. 238 ifi=kthen246:rem no xch
  93. 240 ifj>kthen246:rem xch ok - ahead
  94. 242 ifj=kthen246:rem xch ok - equal
  95. 244 f=49
  96. 246 rem - update board pts
  97. 248 gosub300
  98. 250 rem - up
  99. 252 x=w+125
  100. 254 f=peek(x)
  101. 256 ift=1then278:rem top
  102. 258 ifm=2then262:rem win/loss
  103. 260 ifl>0then276:rem not last "b"
  104. 262 p=q:q=3-p:h=100-h:t=t-1:w=w-126
  105. 264 gosub300
  106. 266 ift>1then276:rem not top
  107. 268 x=w+125
  108. 270 f=peek(x)
  109. 272 iff>50then278:rem good enough
  110. 274 gosub320
  111. 276 goto144:rem next "b"
  112. 278 rem -
  113. 280 iff=gthen284
  114. 282 gosub320
  115. 284 return
  116. 300 rem ********************************        update board pts
  117. 302 x=w+125
  118. 304 d=peek(x)
  119. 306 iff=dthen318:rem not min/max
  120. 308 ifo=pthen314:rem "x" move
  121. 310 iff>dthen318:rem not "o" min
  122. 312 goto316
  123. 314 iff<dthen318:rem not "x" max
  124. 316 pokex,f
  125. 318 return
  126. 320 rem ********************************        update best move(t=1)
  127. 322 iff>gthen326
  128. 324 goto352
  129. 326 x=u+126:x=x+115
  130. 328 a=peek(x)
  131. 330 x=x+1
  132. 332 i=peek(x)
  133. 334 x=x+1:x=x+i
  134. 336 b=peek(x)
  135. 338 x=v+2
  136. 340 pokex,a
  137. 342 x=v+3
  138. 344 pokex,b
  139. 346 x=v+4
  140. 348 pokex,f
  141. 350 g=f
  142. 352 return
  143. 500 rem ********************************        "a"
  144. 502 i=0
  145. 504 e=p-1:e=e*8:x=w+99:x=x+e
  146. 506 n=peek(x)
  147. 508 d=t*7:y=r+d
  148. 510 x=y+i
  149. 512 f=peek(x)
  150. 514 iff>nthen518
  151. 516 goto522
  152. 518 i=i+1
  153. 520 goto510
  154. 522 i=f-1:x=w+100:x=x+e:x=x+i
  155. 524 a=peek(x)
  156. 526 x=w+115
  157. 528 pokex,a
  158. 530 return
  159. 600 rem ********************************        "b" list
  160. 602 n=0:y=v+6:z=w+116
  161. 604 fori=0to7
  162. 606 x=y+i
  163. 608 c=peek(x)
  164. 610 b=a+c:b=b-20:x=w+b
  165. 612 d=peek(x)
  166. 614 ifd=0then622
  167. 616 ifd=pthen622
  168. 618 n=n+1:x=z+n
  169. 620 pokex,b
  170. 622 next
  171. 624 pokez,n
  172. 626 return
  173. 630 rem ********************************        sort "b" list
  174. 632 i=n:x=w+117:x=x+n:z=x
  175. 634 i=i-1:x=x-1
  176. 636 b=peek(x)
  177. 638 y=w+b
  178. 640 d=peek(y)
  179. 642 ifd=4then652
  180. 644 z=z-1
  181. 646 ifx=zthen652
  182. 648 y=x+1
  183. 650 gosub920
  184. 652 ifi>0then634
  185. 654 return
  186. 700 rem ********************************        results
  187. 702 m=8
  188. 704 x=w+a
  189. 706 pokex,4
  190. 708 x=w+b
  191. 710 d=peek(x)
  192. 712 pokex,p
  193. 714 y=w+99:e=p-1:e=e*8:y=y+e
  194. 716 n=peek(y)
  195. 718 x=y+n:x=x+1
  196. 720 x=x-1
  197. 722 e=peek(x)
  198. 724 ife=athen728
  199. 726 goto720
  200. 728 pokex,b
  201. 730 ifd=4then754
  202. 732 y=w+99:e=q-1:e=e*8:y=y+e
  203. 734 n=peek(y)
  204. 736 x=y+n:x=x+1:m=n-1
  205. 738 pokey,m
  206. 740 x=x-1
  207. 742 e=peek(x)
  208. 744 ife=bthen748
  209. 746 goto740
  210. 748 z=x:y=y+n:y=y+1:x=x+1
  211. 750 ifx=ythen754
  212. 752 gosub900
  213. 754 return
  214. 900 rem ********************************        copy: x=start y=end+1 z=dest
  215. 902 rem - copy mem @ 16528(64*256+144)          - x,y,z @ 105*256+(sc-1)*2
  216. 904 poke781,46
  217. 906 poke782,105
  218. 908 sys16528
  219. 910 return
  220. 920 rem ********************************        swap: x=start y=end+1 z=dest
  221. 922 rem - swap mem @ 16531(64*256+147)          - x,y,z @ 105*256+(sc-1)*2
  222. 924 poke781,46
  223. 926 poke782,105
  224. 928 sys16531
  225. 930 return
  226. 999 rem ================================
  227. 1000 poke55,96:poke56,105:clr:bs=96+105*256:fl$="kb 6960":goto1630
  228. 1010 b=peek(ad):ad=ad+1:ifb=32then1010
  229. 1020 return
  230. 1030 aa=ad
  231. 1040 b=peek(aa):aa=aa+1:ifb=32then1040
  232. 1050 return
  233. 1060 gosub1010:ifb<>0thenprintb:goto1730
  234. 1070 return
  235. 1080 n=0
  236. 1090 gosub1010:ifb<48 or b>57 then return
  237. 1100 n=n*10+(b-48):goto1090
  238. 1110 nh=int(nn/256):nl=nn-(nh*256):return
  239. 1120 gosub1110:print mid$(hx$,(nhand240)/16+1,1);mid$(hx$,(nhand15)+1,1);
  240. 1130 printmid$(hx$,(nland240)/16+1,1);mid$(hx$,(nland15)+1,1);:return
  241. 1140 bx=bx+1:ifp<>3 then ml=ml+1:return
  242. 1150 poke ml,z:ml=ml+1:return
  243. 1160 ifp<>1thensp=sp+1:sl=sl+1:return
  244. 1170 pokesp,z:sp=sp+1:sl=sl+1:return
  245. 1180 ifp<>3thenreturn
  246. 1190 dx=dx+1:poke dw,nl:poke dw+1,nh:dw=dw+2:return
  247. 1200 gosub1010:ifb>64then1220
  248. 1210 g=1:ad=ad-1:gosub1080:ad=ad-1:nn=n:goto1240
  249. 1220 gosub1250
  250. 1230 g=0:b=b-65:nn=(b*2)+zv
  251. 1240 b=peek(ad):gosub1110:return
  252. 1250 if(b<65 or b>90)then5360
  253. 1260 return
  254. 1270 z=173:gosub1140:z=nl:gosub1140:z=nh:goto1140
  255. 1280 z=173:gosub1140:z=nl+1:gosub1140:z=nh:goto1140
  256. 1290 z=141:gosub1140:z=nl:gosub1140:z=nh:goto1140
  257. 1300 z=141:gosub1140:z=nl+1:gosub1140:z=nh:goto1140
  258. 1310 z=169:gosub1140:z=nl:goto1140
  259. 1320 z=169:gosub1140:z=nh:goto1140
  260. 1330 z=173:gosub1140:z=vl:gosub1140:z=vh:goto1140
  261. 1340 z=173:gosub1140:z=vl+1:gosub1140:z=vh:goto1140
  262. 1350 z=141:gosub1140:z=vl:gosub1140:z=vh:goto1140
  263. 1360 z=141:gosub1140:z=vl+1:gosub1140:z=vh:goto1140
  264. 1370 nl=ms(h,0):nh=ms(h,1):return
  265. 1380 gosub1140:z=nl:gosub1140:z=nh:goto1140
  266. 1390 gosub1140:z=nl+1:gosub1140:z=nh:goto1140
  267. 1400 gosub1140:z=nl:goto1140
  268. 1410 gosub1140:z=nh:goto1140
  269. 1420 z=165:gosub1140:z=y:goto1140
  270. 1430 z=162:gosub1140:z=y:goto1140
  271. 1440 z=161:gosub1140:z=y:goto1140
  272. 1450 z=145:gosub1140:z=y:goto1140
  273. 1460 z=160:gosub1140:z=y:goto1140
  274. 1470 z=133:gosub1140:z=y:goto1140
  275. 1480 z=56:goto1140
  276. 1490 z=24:goto1140
  277. 1500 z=32:gosub1140:z=yl:gosub1140:z=yh:goto1140
  278. 1510 z=76:gosub1140:z=yl:gosub1140:z=yh:goto1140
  279. 1520 z=233:gosub1140:z=nl:goto1140
  280. 1530 z=233:gosub1140:z=nh:goto1140
  281. 1540 z=105:gosub1140:z=nl:goto1140
  282. 1550 z=105:gosub1140:z=nh:goto1140
  283. 1560 z=237:gosub1140:z=nl:gosub1140:z=nh:goto1140
  284. 1570 z=237:gosub1140:z=nl+1:gosub1140:z=nh:goto1140
  285. 1580 z=109:gosub1140:z=nl:gosub1140:z=nh:goto1140
  286. 1590 z=109:gosub1140:z=nl+1:gosub1140:z=nh:goto1140
  287. 1600 z=y1:gosub1140:z=y2:goto1140
  288. 1610 z=y1:gosub1140:z=y2:gosub1140:z=y3:goto1140
  289. 1620 z=169:gosub1140:z=y:goto1140
  290. 1630 lx=3:xx=0:zp=bs+80:p=1:zm=zp:sk=-1
  291. 1635 zv=105*256:rem variable's start address, for original set zv=679
  292. 1640 dim ll(255,1),fs(6,4),li%(lx,5),ms(5,3),oc%(3,1)
  293. 1650 gosub5440:sys828,232,3
  294. 1660 fori=0tolx:forj=0to5:readli%(i,j):next:next:bx=0:dx=0:f2=0
  295. 1670 ad=peek(43)+peek(44)*256:print"[147]          ***** pass";p;" *****"
  296. 1680 sp=zp:ml=zm
  297. 1690 nm=peek(ad)+peek(ad+1)*256
  298. 1700 ln=peek(ad+2)+peek(ad+3)*256:ifln>999then1740
  299. 1710 print"          compiling line #"mid$(str$(ln),2)
  300. 1720 ifp=2thenll(xx,0)=ln:ll(xx,1)=ml:xx=xx+1
  301. 1730 ad=ad+4:gosub1010:goto1790
  302. 1740 ifp=1thenp=2:zm=sp:r1=zm:la=sp:u1=bx:bx=0:goto1670
  303. 1750 ifp=2thenp=3:zm=la:r2=zm:gosub5420:db=la+bx+4:dw=db:u2=bx:bx=0:goto1670
  304. 1760 u3=bx:gosub4760:print"done!":print:gosub4580
  305. 1770 ifpeek(ml-1)<>96thenz=96:gosub1140
  306. 1780 goto4450
  307. 1790 ifb=136then3610:rem let
  308. 1800 ifb=153then2020:rem print
  309. 1810 ifb=128then2300:rem end
  310. 1820 ifb=137then2170:rem goto
  311. 1830 ifb=141then2230:rem gosub
  312. 1840 ifb=142then2300:rem return
  313. 1850 ifb=139then2320:rem if
  314. 1860 ifb=151then2600:rem poke
  315. 1870 ifb=129then2710:rem for
  316. 1880 ifb=130then2960:rem next
  317. 1890 ifb=135then3320:rem read
  318. 1900 ifb=140then3420:rem restore
  319. 1910 ifb=131then3470:rem data
  320. 1920 ifb=156then3510:rem clr
  321. 1930 ifb=143then2000:rem rem
  322. 1940 ifb=161then3530:rem get
  323. 1950 ifb=158then4300:rem sys
  324. 1960 rem this line assumes let
  325. 1970 ad=ad-1:goto3610
  326. 1980 sysbs:end
  327. 1990 fori=0toxx-1:printll(i,0),ll(i,1):next
  328. 2000 ad=nm:goto1690
  329. 2010 rem handle print
  330. 2020 gosub1010:ifb=199then3250
  331. 2030 ifb>64 then2110
  332. 2040 ifb<>34then2150
  333. 2050 sl=0:nn=sp:gosub1110
  334. 2060 b=peek(ad):ad=ad+1:if((b=0)or(b=34))then2080
  335. 2070 z=b:gosub1160:goto2060
  336. 2080 gosub1310:y=34:gosub1470:gosub1320:y=35:gosub1470
  337. 2090 y=sl:gosub1430:yl=37:yh=171:gosub1500:gosub1010:ifb<>59then2150
  338. 2095 goto2000
  339. 2100 rem handle print <var>
  340. 2110 ifb<65 or b>91 then5360
  341. 2120 b=b-65:nn=(b*2)+zv:gosub1110:gosub1010:w=b
  342. 2130 gosub1280:z=174:gosub1380:yl=205:yh=189:gosub1500:ifw<>59then2150
  343. 2135 goto2000
  344. 2140 rem handle print <cr>
  345. 2150 yl=215:yh=170:gosub1500:goto2000
  346. 2160 rem handle goto <line number>
  347. 2170 gosub1080:if p<>3 then2210
  348. 2180 ifxx=0then5380
  349. 2190 f2=0:fori=0to(xx-1):ifll(i,0)=nthenf2=1:nn=ll(i,1)
  350. 2200 next:iff2=0then5380
  351. 2210 gosub1110:yl=nl:yh=nh:gosub1510:goto2000
  352. 2220 rem handle gosub <line number>
  353. 2230 gosub1080:if p<>3 then2210
  354. 2240 ifxx=0then5380
  355. 2250 f2=0:fori=0to(xx-1):ifll(i,0)=nthenf2=1:nn=ll(i,1)
  356. 2260 next:iff2=0then5380
  357. 2270 gosub1110:z=32:gosub1140:z=nl:gosub1140:z=nh:gosub1140:goto2000
  358. 2280 gosub1110:yl=nl:yh=nh:gosub1500:goto2000
  359. 2290 rem handle return
  360. 2300 z=96:gosub1140:goto2000
  361. 2310 rem handle if
  362. 2320 gosub1010:ifb<65 or b>90 then5360
  363. 2330 b=b-65:nn=(b*2)+zv:gosub1110:vh=nh:vl=nl
  364. 2340 gosub1010
  365. 2350 ifb=177thenf1=1:goto2390:rem >
  366. 2360 ifb=178thenf1=2:goto2390:rem =
  367. 2370 ifb=179thenf1=3:goto2390:rem <
  368. 2380 goto5360:rem syntax error
  369. 2390 f3=0:gosub1010:ifb<65then2420
  370. 2400 gosub1250:f3=1:b=b-65:nn=(b*2)+zv:gosub1110:goto2430
  371. 2410 rem if <var> <=> <num or var>
  372. 2420 ad=ad-1:gosub1080:ad=ad-1:nn=n:gosub1110
  373. 2430 gosub1480:gosub1330:iff3thengosub1560:goto2450
  374. 2440 gosub1520
  375. 2450 y=2:gosub1470:gosub1340:iff3thengosub1570:goto2470
  376. 2460 gosub1530
  377. 2470 y1=5:y2=2:gosub1600
  378. 2480 iff1<>3then2500
  379. 2490 y1=240:y2=5:gosub1600:y1=176:y2=3:gosub1600:goto2530
  380. 2500 iff1<>2then2520
  381. 2510 y1=208:y2=3:gosub1600:goto2530
  382. 2520 y1=144:y2=5:gosub1600:y1=240:y2=3:gosub1600:goto2530
  383. 2530 gosub1010:ifb<>167then5360
  384. 2540 gosub1080:if p<>3 then2580
  385. 2550 ifxx=0then5380
  386. 2560 f2=0:fori=0to(xx-1):ifll(i,0)=nthenf2=1:nn=ll(i,1)
  387. 2570 next:iff2=0then5380
  388. 2580 gosub1110:yl=nl:yh=nh:gosub1510:goto2000
  389. 2590 rem handle poke
  390. 2600 gosub1200:vl=nl:vh=nh:tt=g:gosub1010:ifb<>44then5360
  391. 2610 gosub1200:ifttthen2660
  392. 2620 gosub1330:y=20:gosub1470:gosub1340:y=21:gosub1470
  393. 2630 ifgthengosub1310:goto2650
  394. 2640 gosub1270
  395. 2650 y=0:gosub1430:y1=129:y2=20:gosub1600:goto2000
  396. 2660 ifg=0thengosub1270:goto2680
  397. 2670 gosub1310
  398. 2680 ifvh=0theny=vl:gosub1470:goto2000
  399. 2690 gosub1350:goto2000
  400. 2700 rem handle for
  401. 2710 gosub1010:ifb<65 or b>90 then5360
  402. 2720 b=b-65:nn=(b*2)+zv:gosub1110:vh=nh:vl=nl
  403. 2730 sk=sk+1:fs(sk,3)=nn:fs(sk,4)=0:fs(sk,1)=1
  404. 2740 gosub1010:ifb<>178then5360
  405. 2750 gosub1010:if b>64then2800
  406. 2760 rem start = constant
  407. 2770 ad=ad-1:gosub1080:nn=n:gosub1110:gosub1310:gosub1350:gosub1320:gosub1360
  408. 2780 ad=ad-1:goto2810
  409. 2790 rem start = variable
  410. 2800 b=b-65:nn=(b*2)+zv:gosub1110:gosub1270:gosub1350:gosub1280:gosub1360
  411. 2810 gosub1010:ifb<>164then5360
  412. 2820 gosub1010:if b>64then2860
  413. 2830 rem to = constant
  414. 2840 ad=ad-1:gosub1080:ad=ad-1:fs(sk,0)=n:goto2870
  415. 2850 rem to = variable
  416. 2860 b=b-65:nn=(b*2)+zv:fs(sk,0)=nn:fs(sk,4)=fs(sk,4) or 2
  417. 2870 fs(sk,2)=ml:gosub1010:ifb=0then2000
  418. 2880 rem handle step
  419. 2890 ifb<>169then5360
  420. 2900 gosub1010:if b>64then2940
  421. 2910 rem step = constant
  422. 2920 ad=ad-1:gosub1080:ad=ad-1:fs(sk,1)=n:goto2000
  423. 2930 rem step = variable
  424. 2940 b=b-65:nn=(b*2)+zv:fs(sk,1)=nn:fs(sk,4)=fs(sk,4) or 4 : goto2000
  425. 2950 rem handle next
  426. 2960 ifsk=-1then5390
  427. 2970 nn=fs(sk,3):gosub1110:vl=nl:vh=nh
  428. 2980 nn=fs(sk,1):gosub1110
  429. 2990 gosub1490:gosub1330
  430. 3000 if(fs(sk,4)and4)=4 then3020
  431. 3010 gosub1540:goto3030
  432. 3020 gosub1580
  433. 3030 gosub1350
  434. 3040 gosub1340
  435. 3050 if(fs(sk,4)and4)=4 then3070
  436. 3060 gosub1550:goto3080
  437. 3070 gosub1590
  438. 3080 gosub1360
  439. 3090 nn=fs(sk,2):gosub1110:al=nl:ah=nh
  440. 3100 nn=fs(sk,0):gosub1110
  441. 3110 gosub1480:gosub1330
  442. 3120 if(fs(sk,4)and2)=2 then3140
  443. 3130 gosub1520:goto3150
  444. 3140 gosub1560
  445. 3150 y=2:gosub1470
  446. 3160 gosub1340
  447. 3170 if(fs(sk,4)and2)=2 then3190
  448. 3180 gosub1530:goto3200
  449. 3190 gosub1570
  450. 3200 y1=5:y2=2:gosub1600
  451. 3210 y1=240:y2=2:gosub1600:y1=176:y2=3:gosub1600
  452. 3220 yl=al:yh=ah:gosub1510
  453. 3230 sk=sk-1:goto2000
  454. 3240 rem handle print chr$()
  455. 3250 gosub1010:ifb<>40then5360
  456. 3260 gosub1010:ifb>64then3280
  457. 3270 ad=ad-1:gosub1080:y=(n and 255):gosub1620:goto3300
  458. 3280 b=b-65:nn=(b*2)+zv:gosub1110
  459. 3290 gosub1270
  460. 3300 yl=210:yh=255:gosub1500:gosub1010:ifb<>59then2150
  461. 3305 goto2000
  462. 3310 rem handle read
  463. 3320 ifp<>2 then3370
  464. 3330 ifli%(1,5)=1then3350
  465. 3340 f2=1:nn=la:gosub1110:li%(1,3)=nl:li%(1,4)=nh:li%(1,5)=1:la=la+li%(1,2)
  466. 3350 ifli%(0,5)=1then3370
  467. 3360 nn=la:gosub1110:li%(0,3)=nl:li%(0,4)=nh:li%(0,5)=1:la=la+li%(0,2)
  468. 3370 gosub1010:b=b-65:nn=(b*2)+zv:gosub1110
  469. 3380 yl=li%(1,3):yh=li%(1,4):gosub1500
  470. 3390 gosub1290
  471. 3400 z=142:gosub1390:goto2000
  472. 3410 rem handle restore
  473. 3420 ifp<>2then3450
  474. 3430 ifli%(0,5)=1then3450
  475. 3440 f2=1:nn=la:gosub1110:li%(0,3)=nl:li%(0,4)=nh:li%(0,5)=1:la=la+li%(0,2)
  476. 3450 yl=li%(0,3):yh=li%(0,4):gosub1500:goto2000
  477. 3460 rem handle data
  478. 3470 gosub1010:ad=ad-1:ifb=0then2000
  479. 3480 gosub1080:nn=n:gosub1110:gosub1180:ifb=44then3480
  480. 3490 goto2000
  481. 3500 rem handle clr
  482. 3510 nn=bs+64:gosub1110:yl=nl:yh=nh:gosub1500:goto2000
  483. 3520 rem handle get
  484. 3530 gosub1010:gosub1250
  485. 3540 b=b-65:nn=(b*2)+zv:gosub1110:vh=nh:vl=nl
  486. 3550 yl=228:yh=255:gosub1500:gosub1290
  487. 3560 y=0:gosub1620
  488. 3570 gosub1300:goto2000
  489. 3580 rem
  490. 3590 rem handle let
  491. 3600 rem
  492. 3610 gosub1200:ifgthen5360
  493. 3620 vl=nl:vh=nh
  494. 3630 gosub1010:ifb<>178then5360
  495. 3640 gosub1030
  496. 3650 rem handle functions here
  497. 3660 ifb=194then4350: rem peek
  498. 3670 gosub1200:gosub1010:op=0
  499. 3680 ms(0,0)=nl:ms(0,1)=nh:ms(0,2)=g:ms(0,3)=nn
  500. 3690 if((b=0)or(b=58))thense=b:goto3760
  501. 3700 op=b:ro=b:ifop=175thenop=172
  502. 3710 ifop=176thenop=173
  503. 3720 ifro=172thenop=174
  504. 3730 ifro=173thenop=175
  505. 3740 gosub1200:gosub1010
  506. 3750 ms(1,0)=nl:ms(1,1)=nh:ms(1,2)=g:ms(1,3)=nn:se=b
  507. 3760 ifop<>0then3840
  508. 3770 h=0:gosub1370:ifms(0,2)then3810
  509. 3780 rem <var> = <var>
  510. 3790 gosub1270:gosub1350:gosub1280:gosub1360:goto3820
  511. 3800 rem <var> = <const>
  512. 3810 gosub1310:gosub1350:gosub1320:gosub1360
  513. 3820 ifse=58then3610
  514. 3830 goto2000
  515. 3840 if((op<170)or(op>173))then4070
  516. 3850 rem handle addition & subtraction
  517. 3860 ifms(0,2)+ms(1,2)<>2 then3920
  518. 3870 rem <var> = <const> <+-> <const>
  519. 3880 rem  gosub 500
  520. 3890 ifop=170then nn=ms(0,3)+ms(1,3):gosub1110:goto3810
  521. 3900 ifop=171then nn=ms(0,3)-ms(1,3):gosub1110:goto3810
  522. 3910 goto5360
  523. 3920 ifop=170thenz=24:gosub1140
  524. 3930 ifop=171thenz=56:gosub1140
  525. 3940 h=0:gosub1370:n1=nl:n2=nh:ifms(0,2)thengosub1310:goto3960
  526. 3950 gosub1270
  527. 3960 z=oc%(op-170,ms(1,2)):tt=z
  528. 3970 h=1:gosub1370:n3=nl:n4=nh:ifms(1,2)thengosub1400:goto3990
  529. 3980 gosub1380
  530. 3990 gosub1350
  531. 4000 nl=n1:nh=n2:ifms(0,2)thengosub1320:goto4020
  532. 4010 gosub1280
  533. 4020 z=tt:nl=n3:nh=n4:ifms(1,2)thengosub1410:goto4040
  534. 4030 gosub1390
  535. 4040 gosub1360
  536. 4050 ifse=58then3610
  537. 4060 goto2000
  538. 4070 ifop=175then4130
  539. 4080 ifop<>174then5360
  540. 4090 ifp<>2then4160
  541. 4100 ifli%(3,5)=1then4160
  542. 4110 f2=1:nn=la:gosub1110:li%(3,3)=nl:li%(3,4)=nh:li%(3,5)=1:la=la+li%(3,2)
  543. 4120 goto4160
  544. 4130 ifp<>2then4160
  545. 4140 ifli%(2,5)=1then4160
  546. 4150 f2=1:nn=la:gosub1110:li%(2,3)=nl:li%(2,4)=nh:li%(2,5)=1:la=la+li%(2,2)
  547. 4160 h=0:gosub1370:ifms(0,2)then4180
  548. 4170 gosub1270:y=5:gosub1470:gosub1280:y=6:gosub1470:goto4190
  549. 4180 gosub1310:y=5:gosub1470:gosub1320:y=6:gosub1470
  550. 4190 h=1:gosub1370:ifms(1,2)then4210
  551. 4200 gosub1270:y=3:gosub1470:gosub1280:y=4:gosub1470:goto4220
  552. 4210 gosub1310:y=3:gosub1470:gosub1320:y=4:gosub1470
  553. 4220 ifop=174then4250
  554. 4230 z=32:gosub1140:z=li%(2,3):gosub1140:z=li%(2,4):gosub1140
  555. 4240 y=5:gosub1420:gosub1350:y=6:gosub1420:gosub1360:goto4270
  556. 4250 z=32:gosub1140:z=li%(3,3):gosub1140:z=li%(3,4):gosub1140
  557. 4260 y=163:gosub1420:gosub1350:y=164:gosub1420:gosub1360
  558. 4270 ifse=58then3610
  559. 4280 goto2000
  560. 4290 rem handle sys
  561. 4300 gosub1200:ifgthen4320
  562. 4310 gosub1270:y=20:gosub1470:gosub1280:y=21:gosub1470:goto4330
  563. 4320 gosub1310:y=20:gosub1470:gosub1320:y=21:gosub1470
  564. 4330 z=32:gosub1140:z=48:gosub1140:z=225:gosub1140:goto2000
  565. 4340 rem handle peek
  566. 4350 gosub1010:gosub1010:ifb<>40then5360
  567. 4360 gosub1200:ifgthen4410
  568. 4370 gosub1270:y=20:gosub1470:gosub1280:y=21:gosub1470:y=0:gosub1430:y=20:gosub1440
  569. 4380 gosub1350:nl=0:gosub1310:gosub1360:gosub1010:ifb<>41then5360
  570. 4390 gosub1010:ifb=58then3610
  571. 4400 goto2000
  572. 4410 ifnh=0then4430
  573. 4420 gosub1270:goto4380
  574. 4430 y=nl:gosub1420:goto4380
  575. 4440 rem this is file save routine
  576. 4450 a$=fl$:dv=8
  577. 4455 open15,dv,15:print#15,"s0:"+a$:close15
  578. 4460 nn=dw+2:gosub1110:l=len(a$):ad=0:vl=0:vh=0:i=0
  579. 4470 a$=a$:poke251,peek(71):poke252,peek(72):ad=peek(251)+peek(252)*256
  580. 4480 vl=peek(ad+1):vh=peek(ad+2)
  581. 4490 poke780,8:poke781,8:poke782,1
  582. 4500 sys65466 :rem setlfs
  583. 4510 poke780,l:poke781,vl:poke782,vh
  584. 4520 sys65469 :rem setnam
  585. 4525 th=nh:tl=nl:nn=bs:gosub1110
  586. 4530 poke251,nl:poke252,nh :rem start
  587. 4540 poke780,251:poke781,tl:poke782,th
  588. 4550 sys65496 :rem save
  589. 4560 end
  590. 4570 rem print compile info
  591. 4580 rem print" "fl$" info.":print"press p for printer (device 4),"
  592. 4582 rem print"any other key for screen."
  593. 4584 rem poke198,0:wait198,1:geta$:ifa$="p"then open 4,4,7:cmd 4
  594. 4590 print"start........ "bs
  595. 4600 print"string pool.. "zp
  596. 4610 print"runtime lib.. "sp
  597. 4620 print"code start... "la
  598. 4630 print"code end .... "db-1
  599. 4640 print"code size.... "(db-1)-la"bytes"
  600. 4660 print"data area.... "db
  601. 4670 print"prog end..... "dw+2
  602. 4680 printtab(14);"-------------------"
  603. 4690 print"total size... "(dw+2)-bs"bytes"
  604. 4710 print:print:print"    zip-basic, copyright (c) 2000 by"
  605. 4720 printtab(9);"j & f  publishing inc."
  606. 4730 printtab(10);"all rights reserved"
  607. 4735 rem if a$="p" then print#4:close4
  608. 4740 return
  609. 4750 rem handle runtime library
  610. 4760 print"[147]building runtime library..."
  611. 4770 fori=bstobs+47:pokei,0:next:fori=bs+48tobs+62:pokei,234:next
  612. 4780 pokebs+63,96:pokebs,32:nn=bs+48:gosub1110:pokebs+1,nl:pokebs+2,nh
  613. 4790 read d$:fori=1tolen(d$):pokebs+9+i,asc(mid$(d$,i,1)):next
  614. 4800 fori=bs+64tobs+74:readd:pokei,d:next
  615. 4805 h%=zv/256:pokebs+69,zv-h%*256:pokebs+70,h%:rem variable's start address
  616. 4810 pokebs+51,32:nn=bs+64:gosub1110:pokebs+52,nl:pokebs+53,nh
  617. 4820 poke bs+3,76:nn=la:gosub1110:pokebs+4,nl:pokebs+5,nh
  618. 4830 iff2<>1thenreturn
  619. 4840 fori=0tolx
  620. 4850 ifli%(i,5)<>1 then4900
  621. 4860 rem install library
  622. 4870 sys828,li%(i,0),li%(i,1)
  623. 4880 nt=li%(i,3)+(li%(i,4)*256):nc=li%(i,2)-1
  624. 4890 ff=0:forj=0tonc:readd:ifsgn(d)<>-1then 4896
  625. 4892 if ff=1then ff=0:d=nh:goto4896
  626. 4894 nn=abs(d)+bs:gosub1110:ff=1:d=nl
  627. 4896 pokent+j,d:next
  628. 4900 next
  629. 4910 ifli%(0,5)<>1then4940
  630. 4920 nn=db:gosub1110:pokebs+6,nl:pokebs+7,nh:nn=dw:gosub1110:pokebs+8,nl
  631. 4930 pokebs+9,nh:pokebs+48,32:pokebs+49,li%(0,3):pokebs+50,li%(0,4)
  632. 4940 return
  633. 4950 rem lib array data
  634. 4960 data 176,19,11,0,0,0 :rem restore
  635. 4970 data 206,19,43,0,0,0 :rem read
  636. 4980 data 20,20,59,0,0,0 :rem divide
  637. 4990 data 110,20,48,0,0,0 :rem multiply
  638. 5000 data "zip-basic (c) 2000 j&f publishing"
  639. 5010 data 162,88,169,0,157,167,2,202
  640. 5020 data 16,250,96
  641. 5030 rem this is library restore
  642. 5040 data 173,-6,-1,133,65,173,-7,-1
  643. 5050 data 133,66,96
  644. 5060 rem *** this is library read ***
  645. 5070 data 165,65,205,-8,-1,208,12,165
  646. 5080 data 66,205,-9,-1,208,5,162,13
  647. 5090 data 108,0,3,160,0,177,65,72
  648. 5100 data 200,177,65,170,24,165,65,105
  649. 5110 data 2,133,65,165,66,105,0,133
  650. 5120 data 66,104,96
  651. 5130 rem *** this is library divide ***
  652. 5140 data 165,3,5,4,208,5,162,20
  653. 5150 data 108,0,3,169,0,133,163,133
  654. 5160 data 164,162,16,6,5,38,6,38
  655. 5170 data 163,38,164,56,165,163,229,3
  656. 5180 data 168,165,164,229,4,144,6,230
  657. 5190 data 5,133,164,132,163,202,208,227
  658. 5200 data 165,163,141,217,2,165,164,141
  659. 5210 data 218,2,96
  660. 5220 rem *** library multiply ***
  661. 5230 data 169,0,133,165,133,166,162,16
  662. 5240 data 70,4,102,3,144,11,24,165
  663. 5250 data 165,101,5,133,165,165,166,101
  664. 5260 data 6,106,133,166,102,165,102,164
  665. 5270 data 102,163,202,208,227,165,165
  666. 5280 data 141,217,2,165,166,141,218,2
  667. 5290 data 96
  668. 5360 er$="syntax error":goto5400
  669. 5370 er$="bad command":goto5400
  670. 5380 er$="undef'd statement":goto5400
  671. 5390 er$="next without for":goto5400
  672. 5400 print "[error][146][154] " er$" in line"ln:end
  673. 5410 rem fixup line numbers
  674. 5420 n=r2-r1:ifn=0thenreturn
  675. 5430 fori=0toxx-1:ll(i,1)=ll(i,1)+n:next:return
  676. 5440 poke828,32:poke829,253:poke830,174:poke831,32:poke832,158:poke833,183
  677. 5450 poke834,134:poke835,20:poke836,32:poke837,253:poke838,174:poke839,32
  678. 5460 poke840,158:poke841,183:poke842,134:poke843,21:poke844,32:poke845,19
  679. 5470 poke846,166:poke847,176:poke848,3:poke849,76:poke850,227:poke851,168
  680. 5480 poke852,165:poke853,95:poke854,164:poke855,96:poke856,56:poke857,233
  681. 5490 poke 858,1:poke859,76:poke860,36:poke861,168
  682. 5500 oc%(0,0)=109:oc%(0,1)=105:oc%(1,0)=237:oc%(1,1)=233
  683. 5510 oc%(2,0)=45:oc%(2,1)=41:oc%(3,0)=13:oc%(3,1)=9
  684. 5520 hx$="0123456789abcdef":return
  685. 9998 :
  686. 9999 rem * scratch & save *
  687. 10000 fl$="z.kb+":dv=8
  688. 10001 open15,dv,15:print#15,"s0:"+fl$:close15:save fl$,dv:end
  689. 10002 :
  690. 19998 rem * list to printer *
  691. 19999 rem (set to device 4 & emulate)
  692. 20000 p=peek(646):poke646,peek(53281):print"[147]print#1:close1":poke646,p
  693. 20001 poke631,19:poke632,13:poke198,2:open1,4,7:cmd1:list-&999:end
  694.