home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 60 / 060.d81 / digithunt.bas (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  15KB  |  429 lines
  1. 10 rem@ s1024
  2. 20 rem@ 02
  3. 30 rem@ r=cs
  4. 40 clr:dim a(9,9),x(9),y(9),pt(9),rx(81),ry(81),rn(9),cn(9),bn(9),rc(9),cc(9)
  5. 50 dim bc(9),rp(9),cp(9),bp(9),nr(9),nc(9),nb(9),lv(9),uv(9),kv(9),vv(9),c(7)
  6. 60 dim rf(7),m1$(3),m2$(3),bt$(9,2)
  7. 70 data255,0,56,69,130,69,56,0,224,144,144,144,224,128,64,63
  8. 80 data255,16,144,16,16,16,144,16,16,16,16,16,32,64,128,0
  9. 90 fori=832to894:pokei,0:next
  10. 100 fori=832to877step3:readj:pokei,j:next
  11. 110 fori=833to878step3:readj:pokei,j:next
  12. 120 poke53287,0:poke53248,50:poke53249,194:poke53264,1:poke2040,13:poke53269,1
  13. 130 deffnx(y)=int(log(y)/log(2))+1
  14. 140 sl$="":cl$="                                       "
  15. 150 bs$="[157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]":cs=55386:ts=1114:
  16. 160 cl$="[155]"+sl$+cl$+bs$+cl$+bs$
  17. 170 cl$=cl$+"[144]                                      [155][145][145][145]"
  18. 180 c(1)=11:c(2)=12:c(3)=15:c(4)=1:c(5)=15:c(6)=12
  19. 190 poke53280,0:poke53281,0:db$="[157][157][157][157][157][157][157][157]"
  20. 200 bo$="[159][213][192][192][192][192][192][192][201]"+db$+"[221]      [221]"+db$+"[202][192][192][192][192][192][192][203]"+db$+"[144]        [145][157] [157][145] [157]"
  21. 210 bo$=bo$+"[157][157][157][157][157][157][157][159]":open15,8,15,"i0:"
  22. 220 open2,8,2,"best times,p,r"
  23. 230 input#15,a$,a$:ifa$<>"ok"thenclose2:goto250
  24. 240 fori=1to9:input#2,bt$(i,1),bt$(i,0),bt$(i,2):next:close2:goto270
  25. 250 fori=1to9:bt$(i,1)="006000":bt$(i,0)="---------":bt$(i,2)="5"
  26. 260 next:gosub3940:run
  27. 270 close15:poke53272,21:print"[147][158]           d i g i t h u n t           "
  28. 280 gosub3690:print"[155]"spc(3)"  level  time      name    errors[151][184]"
  29. 290 printspc(4)"[184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][155]"
  30. 300 jj$="   ":fori=1to9:a$=bt$(i,1):ifi=skthenpoke199,1
  31. 310 printspc(6)i"[157].  ";:ifval(mid$(a$,3,2))<10thenprint" ";
  32. 320 printval(mid$(a$,3,2))"[157]:"mid$(a$,5,2)jj$bt$(i,0)jj$;
  33. 330 ifval(bt$(i,2))<10thenprint" ";
  34. 340 printbt$(i,2)" ":next:ifskthen4050
  35. 350 poke214,13:print:print"[158]             setting up..."
  36. 360 gosub1830
  37. 370 gosub1550:forj=1to3:fori=1to3:x(i+j*3-3)=r(j)*3-3:next:next
  38. 380 gosub1550:forj=1to3:fori=1to3:y(i+j*3-3)=r(j)*3-3:next:next
  39. 390 fori=0to6step3:gosub1550:forj=1to3:x(i+j)=x(i+j)+r(j):next:gosub1550
  40. 400 forj=1to3:y(i+j)=y(i+j)+r(j):next:next
  41. 410 poke214,13:print:print"             setting up..."
  42. 420 forx=1to9:fory=1to9:readq:a(x(x),y(y))=-z(q):next:next
  43. 430 data1,5,9,8,4,6,7,2,3,8,6,3,1,2,7,5,4,9,7,2,4,3,9,5,8,6,1
  44. 440 data2,1,8,5,3,9,6,7,4,4,9,5,7,6,2,3,1,8,6,3,7,4,1,8,2,9,5
  45. 450 data5,8,2,9,7,4,1,3,6,3,4,6,2,8,1,9,5,7,9,7,1,6,5,3,4,8,2
  46. 460 poke198,0:i=1
  47. 470 poke214,13:print:print"[159]skill level (1-9) or clr to clear times"
  48. 480 geta$:ifti<10then510
  49. 490 poke55869,c(i):poke55871,c(i)
  50. 500 poke55877,c(i):poke55878,c(i):poke55879,c(i):i=i+1:ti$="000000":ifi>6theni=1
  51. 510 sk=val(a$):if(sk>9orsk<1)anda$<>"[147]"anda$<>""then480
  52. 520 ifa$="[147]"ora$=""then3990
  53. 530 ti$="160000":goto280
  54. 540 poke53272,21:poke53280,11:poke53281,11:poke53269,0
  55. 550 x$="[144][221][155][166][158][221][155][166][158][221][155][166][144][221][155][166][158][221][155][166][158][221][155][166][144][221][155][166][158][221][155][166][158][221][155][166][144][221]"
  56. 560 y$="           [144][171][158][192][219][192][219][192][144][219][158][192][219][192][219][192][144][219][158][192][219][192][219][192][144][179]"
  57. 570 z$="           [144][171][192][219][192][219][192][219][192][219][192][219][192][219][192][219][192][219][192][179]"
  58. 580 print"[147][155]           d i g i t h u n t         [144][146][175]"
  59. 590 print"[144][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175]"
  60. 600 print"            a b c d e f g h i"
  61. 610 print"[144]           [176][192][178][192][178][192][178][192][178][192][178][192][178][192][178][192][178][192][174]"
  62. 620 print"          r";x$:printy$
  63. 630 print"          s";x$:printy$
  64. 640 print"          t";x$:printz$
  65. 650 print"          u";x$:printy$
  66. 660 print"          v";x$:printy$
  67. 670 print"          w";x$:printz$
  68. 680 print"          x";x$:printy$
  69. 690 print"          y";x$:printy$
  70. 700 print"          z";x$:print"           [144][173][192][177][192][177][192][177][192][177][192][177][192][177][192][177][192][177][192][189]"
  71. 710 printcl$;"[155]             one moment..."
  72. 720 print"   i'm thinking of a good puzzle..."
  73. 730 poke1983,160:poke2023,160:poke56255,0:poke56295,0
  74. 740 poke214,12:print:print"[144]best time":print""bo$;:a$=bt$(sk,1)
  75. 750 print"[159]"val(mid$(a$,3,2))"[157]:"mid$(a$,5,2)
  76. 760 poke214,12:print:printtab(32)"[144]errors"
  77. 770 printtab(31)bo$
  78. 780 print"[144]";:ifbt$(sk,0)="---------"thenprint"[151]";
  79. 790 printbt$(sk,0):print"[144]limit"
  80. 800 print""val(mid$(tb$,3,2))"[157]:"mid$(tb$,5,2)
  81. 810 gosub1950:rem ifsk=10thenfori=1to9:forii=1to9:a(i,ii)=abs(a(i,ii)):next:next
  82. 820 printcl$;"[155]             i've got it!"
  83. 830 gosub1750:x1=5:y1=5
  84. 840 gosub1290
  85. 850 :
  86. 860 rem   main loop
  87. 870 :
  88. 880 ifnu<1thengosub3880:printcl$"        you win with only"sc"errors";:goto1480
  89. 890 ifval(ti$)>10000thenprint""bo$""spc(31)bo$:ti$="000000"
  90. 900 print"[144][146]timeaccuracy"
  91. 910 pokecs+2*x1+80*y1,1
  92. 920 gosub3860
  93. 930 gosub3580:ifa(x1,y1)>0thenifa$>"0"anda$<="9"thentr%=tr%+1
  94. 940 rem ifa$="?"ora$="/"thensc=sc+1:xm=1:gosub3640:tr%=tr%+1
  95. 950 ifti$>tb$thengosub3970
  96. 960 a=asc(a$):x2=x1:y2=y1:rempoke1983,160:poke2023,160:poke56255,0:poke56295,0
  97. 970 ifa>=65anda<=73thenx2=a-64:goto1320
  98. 980 ifa>=82anda<=90theny2=a-81:goto1320
  99. 990 ifa=133thengosub2280:goto840
  100. 1000 ifa=134thengosub2650:goto840
  101. 1010 ifa=135thengosub2550:goto840
  102. 1020 ifa=136then2860
  103. 1030 ifa=47anda(x1,y1)>0thenff%=1:gosub1680:sc=sc+2:gosub3860:goto880
  104. 1040 ifa=63thengosub1790:sc=sc+2:ff%=1:gosub3860:goto880
  105. 1050 ifa=17theny2=y1+1:goto1320
  106. 1060 ifa=29thenx2=x1+1:goto1320
  107. 1070 ifa=145theny2=y1-1:goto1320
  108. 1080 ifa=157thenx2=x1-1:goto1320
  109. 1090 ifa=81then1370
  110. 1100 ifa<49ora>57then880
  111. 1110 a=a-48:ifa(x1,y1)<0then880
  112. 1120 ifa(x1,y1)=athengosub1680:goto880
  113. 1130 x2=x1:y2=y1:sc=sc+1:gosub3860
  114. 1140 if(rn(y1)andpt(a))=0then1170
  115. 1150 j=1:fori=1to9:ifa(i,y1)=-athenx2=i
  116. 1160 next:i=y1:gosub2820:goto1240
  117. 1170 if(cn(x1)andpt(a))=0then1200
  118. 1180 j=2:fori=1to9:ifa(x1,i)=-atheny2=i
  119. 1190 next:i=x1:gosub2820:goto1240
  120. 1200 b=kv(x1)+uv(y1):if(bn(b)andpt(a))=0then1230
  121. 1210 fori=vv(b)+1tovv(b)+3:forj=uv(b)+1touv(b)+3:ifa(i,j)=-athenx2=i:y2=j
  122. 1220 nextj,i:j=3:i=b:gosub2820:goto1240
  123. 1230 m1$(1)=">>> i have a different digit there":x2=0:goto1250
  124. 1240 m1$(1)=">>> "+b$+c$+" already has a"+str$(a)
  125. 1250 printcl$;m1$(1):ifx2>0thenpokecs+2*x2+80*y2,0
  126. 1260 gosub 3580
  127. 1270 ifx2>0thenpokecs+2*x2+80*y2,15
  128. 1280 gosub1290:goto960
  129. 1290 printcl$;"  q:quit  ?:reveal rnd  /:reveal this"
  130. 1300 print"  f1:print  f3:load  f5:save  f7:hint";:return
  131. 1310 rem   move cursor, check bounds
  132. 1320 pokecs+2*x1+80*y1,15:x1=x2:y1=y2:ifx1<1thenx1=9
  133. 1330 ifx1>9thenx1=1
  134. 1340 ify1<1theny1=9
  135. 1350 ify1>9theny1=1
  136. 1360 goto880
  137. 1370 printcl$;"quit?  f1:yes  f3:show grid  f7:no"
  138. 1380 geta$:ifa$=""then1380
  139. 1390 ifa$="y"thena$="[133]"
  140. 1400 ifa$="n"thena$="[136]"
  141. 1410 ifa$=chr$(136)then840
  142. 1420 ifa$=chr$(133)then1470
  143. 1430 ifa$<>chr$(134)then1380
  144. 1440 fory=1to9:forx=1to9:pokets+2*x+80*y,48+a(x,y)
  145. 1450 ifa(x,y)<0thenpokets+2*x+80*y,48-a(x,y)
  146. 1460 nextx,y
  147. 1470 printcl$;"[145]";
  148. 1480 ifsc=1then print"[157] "
  149. 1490 print
  150. 1500 pokecs+2*x1+80*y1,15:printspc(13)"play again?  (y/n)"
  151. 1510 geta$:ifa$<>"y"anda$<>"n"then1510
  152. 1520 ifa$="n"then3640
  153. 1530 run
  154. 1540 rem   compute permutation of 3
  155. 1550 r(1)=1:r(2)=2:r(3)=3
  156. 1560 r=int(rnd(ti)*2)+2:s=r(1):r(1)=r(r):r(r)=s
  157. 1570 r=int(rnd(ti)*2)*2+1:s=r(2):r(2)=r(r):r(r)=s
  158. 1580 r=int(rnd(ti)*2)+1:s=r(3):r(3)=r(r):r(r)=s
  159. 1590 return
  160. 1600 rem   remove square at (x,y)
  161. 1610 n=-a(x,y):a(x,y)=n:nu=nu+1:pt=pt(n):b=kv(x)+uv(y):bs=lv(x)+vv(y)
  162. 1620 rn(y)=rn(y)-pt:cn(x)=cn(x)-pt:bn(b)=bn(b)-pt
  163. 1630 rc(