home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Compute! Gazette 1994 August
/
1994-08b.d64
/
wanaka
(
.txt
)
< prev
Wrap
Commodore BASIC
|
2022-09-20
|
5KB
|
152 lines
10 rem copyright 1994 - compute publications intl ltd - all rights reserved
20 data 0,0,0,0,0,0,0,0,0,0,24,0,0,24,0,0,24,0,0,60,0,0,255,0,1,153,128
30 data 3,24,192,63,255,252
40 data 0,0,0,0,24,0,0,60,0,0,126,0,0,219,0,0,24,0,0,24,0,0,24,0,48,0,12
50 data 96,0,6,255,0,255
60 data 32,0,0,16,0,0,12,0,0,14,0,0,7,32,0,1,32,0,0,144,0,0,240,0,0,248,96
70 data 0,254,240,0,255,240,0,255,224,1,239,192,3,252,192,3,254,0,0,126,0
80 data 0,62,0,0,60,0,0,120,0,0,112,0,0,32,0
90 data 0,0,64,0,0,238,0,1,254,0,1,254,0,3,252,0,7,248,0,31,240,0,127,224
100 data 0,255,240,1,255,144,7,255,0,31,252,0,63,248,0,127,248,0,255,240,0
110 data 255,224,0,255,192,0,7,128,0,0,0,0,24,0,0,16,0,0
120 data 1,522,1,1,1,2,0,0,0,0
130 data 3,527,2,1,2,2,3,1,3,2
140 data 1,537,4,1,4,2,0,0,0,0
150 data 2,2575,2,3,3,3,0,0,0,0
160 data 1,3594,1,4,1,5,0,0,0,0
170 data 0,3599,2,4,0,0,0,0,0,0
180 data 0,3604,3,4,0,0,0,0,0,0
190 data 1,3609,4,4,4,5,0,0,0,0
200 data 0,4623,2,5,0,0,0,0,0,0
210 data 0,4628,3,5,0,0,0,0,0,0
220 data 0,-1,-1,-1,-1,0,-1,1,2,2,3,-1,-1,1,2,2,3,-1,-1,0,4,4,0,-1
230 data -1,5,6,7,8,-1,-1,5,9,10,8,-1,0,-1,-1,-1,-1,0
300 rem ---===*** setup ***===---
310 for x=0 to 1
320 for y=0 to 32:read z:poke 832+x*64+y,z:next y
330 for y=11 to 20:for z=0 to 2:poke 832+x*64+y*3+z,peek(892+x*64-y*3+z)
340 next z:next y:next x
350 for x=0 to 1:for y=0 to 62:read z:poke 16256+x*64+y,z:next:next
360 st$="[207][183][183][183][208][157][157][157][157][157]"
370 sm$="[165] [167][157][157][157][157][157]"
380 sb$="[204][175][175][175][186][157][157][157][157][157]"
390 lt$="[207][183][183][183][183][183][183][183][183][208][157][157][157][157][157][157][157][157][157][157]"
400 lm$="[165] [167][157][157][157][157][157][157][157][157][157][157]"
410 lb$="[204][175][175][175][175][175][175][175][175][186][157][157][157][157][157][157][157][157][157][157]"
420 dim p$(3),pd(10,4,1),bd(5,6)
430 p$(0)="[150]"+st$+sm$+sm$+sb$
440 p$(1)="[158]"+st$+sm$+sm$+sm$+sm$+sm$+sm$+sb$
450 p$(2)="[154]"+lt$+lm$+lm$+lb$
460 p$(3)="[156]"+lt$+lm$+lm$+lm$+lm$+lm$+lm$+lb$
470 for x=1 to 10:for y=0 to 4:for z=0 to 1:read pd(x,y,z):next z:next y:next x
480 for y=0 to 6:for x=0 to 5:read bd(x,y):next x:next y:m=0
490 poke 53280,0:poke 53281,0:print"[147]"tab(7)"[152] "
500 printtab(7)" wanaka "
510 for x=1 to 20:printtab(7)" "spc(20)" ":next x
520 printtab(7)" "
530 printtab(7)" "
540 printtab(7)"[164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][146][159]"m
550 for p=1 to 10:gosub 3000:next p
560 poke 53269,7:poke 53271,0:poke 53276,0:poke 53277,0:poke 53287,6
570 poke 53288,0:poke 53289,0:poke 53250,179:poke 53251,106:poke 53252,163
580 poke 53253,227:poke 2041,254:poke 2042,255
590 poke 2040,13:poke 53248,111:poke 53249,72:sx=1:sy=1
600 rem ---===*** main loop ***===---
610 j=31-peek(56320) and 31:if j=0 then 610
620 if j and 16 then 700
630 if j and 1 then sy=(sy-1)-(sy=1)
640 if j and 2 then sy=(sy+1)+(sy=5)
650 if j and 4 then sx=(sx-1)-(sx=1)
660 if j and 8 then sx=(sx+1)+(sx=4)
670 poke 53248,71+40*sx:poke 53249,40+32*sy
680 for x=1 to 60:next x
690 goto 610
700 rem ---===*** selected ***===---
710 if bd(sx,sy)=0 then 600
720 poke 53287,1:poke2040,14
730 j=31-peek(56320) and 31:if j=16 then 730
740 if(j and 16)=0 then poke 53287,6:poke 2040,13:goto 600
750 if j and 1 then 1000
760 if j and 2 then 1500
770 if j and 4 then 2000
780 if j and 8 then 2500
790 goto 730
1000 rem ---===*** move up ***===---
1010 p=bd(sx,sy):f=0:poke 53269,6
1020 for x=1 to 4:if pd(p,x,0)=0 then 1040
1030 c=bd(pd(p,x,0),pd(p,x,1)-1):if c<>0 and c<>p then f=1
1040 next x:if f then poke 53269,7:goto 700
1050 gosub 3500:pd(p,0,1)=pd(p,0,1)-1024:gosub 3000:gosub 4000
1060 for x=1 to 4:bd(pd(p,x,0),pd(p,x,1))=0:next x
1070 for x=1 to 4:if pd(p,x,1) then pd(p,x,1)=pd(p,x,1)-1
1080 next x
1090 for x=1 to 4:bd(pd(p,x,0),pd(p,x,1))=p:next x
1100 if f then 4500
1110 sy=sy-1:poke 53287,6:poke 2040,13
1120 poke 53248,71+40*sx:poke 53249,40+32*sy:poke 53269,7:goto 600
1500 rem ---===*** move down ***===---
1510 p=bd(sx,sy):f=0:poke 53269,6
1520 for x=1 to 4:if pd(p,x,0)=0 then 1540
1530 c=bd(pd(p,x,0),pd(p,x,1)+1):if c<>0 and c<>p then f=1
1540 next x:if f then poke 53269,7:goto 700
1550 gosub 3500:pd(p,0,1)=pd(p,0,1)+1024:gosub 3000:gosub 4000
1560 for x=1 to 4:bd(pd(p,x,0),pd(p,x,1))=0:next x
1570 for x=1 to 4:if pd(p,x,1) then pd(p,x,1)=pd(p,x,1)+1
1580 next x
1590 for x=1 to 4:bd(pd(p,x,0),pd(p,x,1))=p:next x
1600 if f then 4500
1610 sy=sy+1:poke 53287,6:poke 2040,13
1620 poke 53248,71+40*sx:poke 53249,40+32*sy:poke 53269,7:goto 600
2000 rem ---===*** move left ***===---
2010 p=bd(sx,sy):f=0:poke 53269,6
2020 for x=1 to 4:if pd(p,x,0)=0 then 2040
2030 c=bd(pd(p,x,0)-1,pd(p,x,1)):if c<>0 and c<>p then f=1
2040 next x:if f then poke 53269,7:goto 700
2050 gosub 3500:pd(p,0,1)=pd(p,0,1)-5:gosub 3000:gosub 4000
2060 for x=1 to 4:bd(pd(p,x,0),pd(p,x,1))=0:next x
2070 for x=1 to 4:if pd(p,x,0) then pd(p,x,0)=pd(p,x,0)-1
2080 next x
2090 for x=1 to 4:bd(pd(p,x,0),pd(p,x,1))=p:next x
2100 if f then 4500
2110 sx=sx-1:poke 53287,6:poke 2040,13
2120 poke 53248,71+40*sx:poke 53249,40+32*sy:poke 53269,7:goto 600
2500 rem ---===*** move right ***===---
2510 p=bd(sx,sy):f=0:poke 53269,6
2520 for x=1 to 4:if pd(p,x,0)=0 then 2540
2530 c=bd(pd(p,x,0)+1,pd(p,x,1)):if c<>0 and c<>p then f=1
2540 next x:if f then poke 53269,7:goto 700
2550 gosub 3500:pd(p,0,1)=pd(p,0,1)+5:gosub 3000:gosub 4000
2560 for x=1 to 4:bd(pd(p,x,0),pd(p,x,1))=0:next x
2570 for x=1 to 4:if pd(p,x,0) then pd(p,x,0)=pd(p,x,0)+1
2580 next x
2590 for x=1 to 4:bd(pd(p,x,0),pd(p,x,1))=p:next x
2600 if f then 4500
2610 sx=sx+1:poke 53287,6:poke 2040,13
2620 poke 53248,71+40*sx:poke 53249,40+32*sy:poke 53269,7:goto 600
3000 rem ---===*** draw ***===---
3010 poke 53250,59+8*(pd(2,0,1) and 255):poke 53251,90+8*int(pd(2,0,1)/256)
3020 poke 781,pd(p,0,1)/256:poke 782,pd(p,0,1) and 255:poke 783,0:sys 65520
3030 print p$(pd(p,0,0)):poke 53269,6:return
3500 rem ---===*** erase ***===---
3510 z=pd(p,0,0)
3520 if z=0 then z$=" [157][157][157][157][157]":r=4
3530 if z=1 then z$=" [157][157][157][157][157]":r=8
3540 if z=2 then z$=" [157][157][157][157][157][157][157][157][157][157]":r=4
3550 if z=3 then z$=" [157][157][157][157][157][157][157][157][157][157]":r=8
3560 poke 781,pd(p,0,1)/256:poke 782,pd(p,0,1) and 255:poke 783,0:sys 65520
3570 for x=1 to r:print z$;:next x
3580 if p=2 then poke 53269,4
3590 return
4000 rem ---===*** check ***===---
4010 f=0:if pd(2,0,1)=3599 then f=1
4020 m=m+1:print"[159]"m
4030 return
4500 rem ---===*** finished ***===---
4510 print "";tab(12);"[152]congradulations!"
4520 print tab(8)"you completed the puzle"
4530 print"[159] in "tab(34)"press"
4540 print " "m;tab(35)"any"
4550 print" moves"tab(35)"key"
4560 poke 198,0:wait 198,1:poke 198,0
4570 print"[147]";:poke 53269,0:end