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