home *** CD-ROM | disk | FTP | other *** search
/ Compute! Gazette 1994 August / 1994-08b.d64 / wanaka (.txt) < prev   
Encoding:
Commodore BASIC  |  1994-01-01  |  5.3 KB  |  152 lines
  1. 10 rem copyright 1994 - compute publications intl ltd - all rights reserved
  2. 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
  3. 30 data 3,24,192,63,255,252
  4. 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
  5. 50 data 96,0,6,255,0,255
  6. 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
  7. 70 data 0,254,240,0,255,240,0,255,224,1,239,192,3,252,192,3,254,0,0,126,0
  8. 80 data 0,62,0,0,60,0,0,120,0,0,112,0,0,32,0
  9. 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
  10. 100 data 0,255,240,1,255,144,7,255,0,31,252,0,63,248,0,127,248,0,255,240,0
  11. 110 data 255,224,0,255,192,0,7,128,0,0,0,0,24,0,0,16,0,0
  12. 120 data 1,522,1,1,1,2,0,0,0,0
  13. 130 data 3,527,2,1,2,2,3,1,3,2
  14. 140 data 1,537,4,1,4,2,0,0,0,0
  15. 150 data 2,2575,2,3,3,3,0,0,0,0
  16. 160 data 1,3594,1,4,1,5,0,0,0,0
  17. 170 data 0,3599,2,4,0,0,0,0,0,0
  18. 180 data 0,3604,3,4,0,0,0,0,0,0
  19. 190 data 1,3609,4,4,4,5,0,0,0,0
  20. 200 data 0,4623,2,5,0,0,0,0,0,0
  21. 210 data 0,4628,3,5,0,0,0,0,0,0
  22. 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
  23. 230 data -1,5,6,7,8,-1,-1,5,9,10,8,-1,0,-1,-1,-1,-1,0
  24. 300 rem ---===*** setup ***===---
  25. 310 for x=0 to 1
  26. 320 for y=0 to 32:read z:poke 832+x*64+y,z:next y
  27. 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)
  28. 340 next z:next y:next x
  29. 350 for x=0 to 1:for y=0 to 62:read z:poke 16256+x*64+y,z:next:next
  30. 360 st$="[207][183][183][183][208][157][157][157][157][157]"
  31. 370 sm$="[165]   [167][157][157][157][157][157]"
  32. 380 sb$="[204][175][175][175][186][157][157][157][157][157]"
  33. 390 lt$="[207][183][183][183][183][183][183][183][183][208][157][157][157][157][157][157][157][157][157][157]"
  34. 400 lm$="[165]        [167][157][157][157][157][157][157][157][157][157][157]"
  35. 410 lb$="[204][175][175][175][175][175][175][175][175][186][157][157][157][157][157][157][157][157][157][157]"
  36. 420 dim p$(3),pd(10,4,1),bd(5,6)
  37. 430 p$(0)="[150]"+st$+sm$+sm$+sb$
  38. 440 p$(1)="[158]"+st$+sm$+sm$+sm$+sm$+sm$+sm$+sb$
  39. 450 p$(2)="[154]"+lt$+lm$+lm$+lb$
  40. 460 p$(3)="[156]"+lt$+lm$+lm$+lm$+lm$+lm$+lm$+lb$
  41. 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
  42. 480 for y=0 to 6:for x=0 to 5:read bd(x,y):next x:next y:m=0
  43. 490 poke 53280,0:poke 53281,0:print"[147]"tab(7)"[152]                          "
  44. 500 printtab(7)"          wanaka          "
  45. 510 for x=1 to 20:printtab(7)"   "spc(20)"   ":next x
  46. 520 printtab(7)"                          "
  47. 530 printtab(7)"                          "
  48. 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
  49. 550 for p=1 to 10:gosub 3000:next p
  50. 560 poke 53269,7:poke 53271,0:poke 53276,0:poke 53277,0:poke 53287,6
  51. 570 poke 53288,0:poke 53289,0:poke 53250,179:poke 53251,106:poke 53252,163
  52. 580 poke 53253,227:poke 2041,254:poke 2042,255
  53. 590 poke 2040,13:poke 53248,111:poke 53249,72:sx=1:sy=1
  54. 600 rem ---===*** main loop ***===---
  55. 610 j=31-peek(56320) and 31:if j=0 then 610
  56. 620 if j and 16 then 700
  57. 630 if j and 1 then sy=(sy-1)-(sy=1)
  58. 640 if j and 2 then sy=(sy+1)+(sy=5)
  59. 650 if j and 4 then sx=(sx-1)-(sx=1)
  60. 660 if j and 8 then sx=(sx+1)+(sx=4)
  61. 670 poke 53248,71+40*sx:poke 53249,40+32*sy
  62. 680 for x=1 to 60:next x
  63. 690 goto 610
  64. 700 rem ---===*** selected ***===---
  65. 710 if bd(sx,sy)=0 then 600
  66. 720 poke 53287,1:poke2040,14
  67. 730 j=31-peek(56320) and 31:if j=16 then 730
  68. 740 if(j and 16)=0 then poke 53287,6:poke 2040,13:goto 600
  69. 750 if j and 1 then 1000
  70. 760 if j and 2 then 1500
  71. 770 if j and 4 then 2000
  72. 780 if j and 8 then 2500
  73. 790 goto 730
  74. 1000 rem ---===*** move up ***===---
  75. 1010 p=bd(sx,sy):f=0:poke 53269,6
  76. 1020 for x=1 to 4:if pd(p,x,0)=0 then 1040
  77. 1030 c=bd(pd(p,x,0),pd(p,x,1)-1):if c<>0 and c<>p then f=1
  78. 1040 next x:if f then poke 53269,7:goto 700
  79. 1050 gosub 3500:pd(p,0,1)=pd(p,0,1)-1024:gosub 3000:gosub 4000
  80. 1060 for x=1 to 4:bd(pd(p,x,0),pd(p,x,1))=0:next x
  81. 1070 for x=1 to 4:if pd(p,x,1) then pd(p,x,1)=pd(p,x,1)-1
  82. 1080 next x
  83. 1090 for x=1 to 4:bd(pd(p,x,0),pd(p,x,1))=p:next x
  84. 1100 if f then 4500
  85. 1110 sy=sy-1:poke 53287,6:poke 2040,13
  86. 1120 poke 53248,71+40*sx:poke 53249,40+32*sy:poke 53269,7:goto 600
  87. 1500 rem ---===*** move down ***===---
  88. 1510 p=bd(sx,sy):f=0:poke 53269,6
  89. 1520 for x=1 to 4:if pd(p,x,0)=0 then 1540
  90. 1530 c=bd(pd(p,x,0),pd(p,x,1)+1):if c<>0 and c<>p then f=1
  91. 1540 next x:if f then poke 53269,7:goto 700
  92. 1550 gosub 3500:pd(p,0,1)=pd(p,0,1)+1024:gosub 3000:gosub 4000
  93. 1560 for x=1 to 4:bd(pd(p,x,0),pd(p,x,1))=0:next x
  94. 1570 for x=1 to 4:if pd(p,x,1) then pd(p,x,1)=pd(p,x,1)+1
  95. 1580 next x
  96. 1590 for x=1 to 4:bd(pd(p,x,0),pd(p,x,1))=p:next x
  97. 1600 if f then 4500
  98. 1610 sy=sy+1:poke 53287,6:poke 2040,13
  99. 1620 poke 53248,71+40*sx:poke 53249,40+32*sy:poke 53269,7:goto 600
  100. 2000 rem ---===*** move left ***===---
  101. 2010 p=bd(sx,sy):f=0:poke 53269,6
  102. 2020 for x=1 to 4:if pd(p,x,0)=0 then 2040
  103. 2030 c=bd(pd(p,x,0)-1,pd(p,x,1)):if c<>0 and c<>p then f=1
  104. 2040 next x:if f then poke 53269,7:goto 700
  105. 2050 gosub 3500:pd(p,0,1)=pd(p,0,1)-5:gosub 3000:gosub 4000
  106. 2060 for x=1 to 4:bd(pd(p,x,0),pd(p,x,1))=0:next x
  107. 2070 for x=1 to 4:if pd(p,x,0) then pd(p,x,0)=pd(p,x,0)-1
  108. 2080 next x
  109. 2090 for x=1 to 4:bd(pd(p,x,0),pd(p,x,1))=p:next x
  110. 2100 if f then 4500
  111. 2110 sx=sx-1:poke 53287,6:poke 2040,13
  112. 2120 poke 53248,71+40*sx:poke 53249,40+32*sy:poke 53269,7:goto 600
  113. 2500 rem ---===*** move right ***===---
  114. 2510 p=bd(sx,sy):f=0:poke 53269,6
  115. 2520 for x=1 to 4:if pd(p,x,0)=0 then 2540
  116. 2530 c=bd(pd(p,x,0)+1,pd(p,x,1)):if c<>0 and c<>p then f=1
  117. 2540 next x:if f then poke 53269,7:goto 700
  118. 2550 gosub 3500:pd(p,0,1)=pd(p,0,1)+5:gosub 3000:gosub 4000
  119. 2560 for x=1 to 4:bd(pd(p,x,0),pd(p,x,1))=0:next x
  120. 2570 for x=1 to 4:if pd(p,x,0) then pd(p,x,0)=pd(p,x,0)+1
  121. 2580 next x
  122. 2590 for x=1 to 4:bd(pd(p,x,0),pd(p,x,1))=p:next x
  123. 2600 if f then 4500
  124. 2610 sx=sx+1:poke 53287,6:poke 2040,13
  125. 2620 poke 53248,71+40*sx:poke 53249,40+32*sy:poke 53269,7:goto 600
  126. 3000 rem ---===*** draw ***===---
  127. 3010 poke 53250,59+8*(pd(2,0,1) and 255):poke 53251,90+8*int(pd(2,0,1)/256)
  128. 3020 poke 781,pd(p,0,1)/256:poke 782,pd(p,0,1) and 255:poke 783,0:sys 65520
  129. 3030 print p$(pd(p,0,0)):poke 53269,6:return
  130. 3500 rem ---===*** erase ***===---
  131. 3510 z=pd(p,0,0)
  132. 3520 if z=0 then z$="     [157][157][157][157][157]":r=4
  133. 3530 if z=1 then z$="     [157][157][157][157][157]":r=8
  134. 3540 if z=2 then z$="          [157][157][157][157][157][157][157][157][157][157]":r=4
  135. 3550 if z=3 then z$="          [157][157][157][157][157][157][157][157][157][157]":r=8
  136. 3560 poke 781,pd(p,0,1)/256:poke 782,pd(p,0,1) and 255:poke 783,0:sys 65520
  137. 3570 for x=1 to r:print z$;:next x
  138. 3580 if p=2 then poke 53269,4
  139. 3590 return
  140. 4000 rem ---===*** check ***===---
  141. 4010 f=0:if pd(2,0,1)=3599 then f=1
  142. 4020 m=m+1:print"[159]"m
  143. 4030 return
  144. 4500 rem ---===*** finished ***===---
  145. 4510 print "";tab(12);"[152]congradulations!"
  146. 4520 print tab(8)"you completed the puzle"
  147. 4530 print"[159]  in "tab(34)"press"
  148. 4540 print " "m;tab(35)"any"
  149. 4550 print" moves"tab(35)"key"
  150. 4560 poke 198,0:wait 198,1:poke 198,0
  151. 4570 print"[147]";:poke 53269,0:end
  152.