home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 203 / 203.d81 / z.kb+ (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  17KB  |  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. 19