home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 87 / 087.d81 / supreme (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  15KB  |  451 lines
  1. 5 poke56576,4:poke53272,2:poke648,192:poke53265,27
  2. 10 poke53280,0:poke53281,0:print"[147][146][156]"tab(10)"solitaires supreme"
  3. 20 printtab(10)"[163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163]":poke53269,0:poke50168,45:poke53287,14
  4. 30 dimcd(13,25),ac(4,2),dk(52),rk$(13),ln(13),a(4),bk(4),pl(52),un(52)
  5. 40 deffnrk(x)=(13*int((x-1)/13)-x)*(x>0)
  6. 50 deffnsu(x)=int((x-1)/13)+1
  7. 60 deffncd(x)=cd(x,ln(x))
  8. 70 forx=1to52:dk(x)=x:next
  9. 80 forx=0to4:readcl$(x),su$(x),dn$(x):next
  10. 90 data"[144]","","[144]","[144]","[193]","[152]","","[211]","[150]","","[218]","[150]","[144]","[216]","[152]"
  11. 100 forx=0to13:readrk$(x):next
  12. 110 data"","[209]","[215]","[197]","[210]","[212]","[217]","[213]","[201]","[196]","[198]","[199]","[200]","[202]"
  13. 120 bk$="[207][208][157][157][204][186][145]"
  14. 130 printtab(13)"[159]1[154] bisley":printtab(13)"[159]2[154] klondike"
  15. 140 printtab(13)"[159]3[154] golf":printtab(13)"[159]4[154] gaps"
  16. 150 printtab(13)"[159]i[154] instructions"
  17. 160 printtab(13)"[159]q[154] quit"
  18. 180 geta$:if(a$<"1"ora$>"4")anda$<>"i"anda$<>"q"then180
  19. 190 ifa$<>"q"then240
  20. 200 poke214,18:print:printtab(20)"[156]are you sure? (y[156]/n[156])"
  21. 210 geta$:ifa$<>"y"anda$<>"n"then210
  22. 220 ifa$="n"thenpoke214,18:print:printtab(20)"                          ":goto180
  23. 230 print"[147]":poke648,4:poke53272,21:poke56576,(peek(56576)and252)or3:print"[147]"
  24. 231 open15,8,15,"r0:hello connect=hello connect":input#15,er:close15
  25. 232 ifer<>63thenend
  26. 233 print"[147][144]load"chr$(34)"hello connect"chr$(34)",8"
  27. 234 print"run"
  28. 235 poke631,13:poke632,13:poke198,2:end
  29. 240 onval(a$)gosub320,1150,2600,3140
  30. 250 ifa$<>"i"thenrun
  31. 260 poke214,16:print:printtab(15)"[156]for which game? ([159]1[156]-[159]4[156])"
  32. 270 geta$:if(a$<"1"ora$>"4")anda$<>"q"then270
  33. 280 ifa$="q"thenrun
  34. 290 onval(a$)gosub1010,2450,3000,3910
  35. 300 run
  36. 310 rem bisley
  37. 320 gosub4240:gm=1:print""tab(14)"[144]b i s l e y"
  38. 330 deffnsy(y)=108+8*y
  39. 340 deffnxx(x)=-(x>9)
  40. 350 deffnsx(x)=16+24*x-256*fnxx(x)
  41. 360 hz=1:ac=0:t=0:gosub4030
  42. 370 forx=1to4:a(x)=1:kg(x)=14:ln(x)=3:next:forx=5to13:ln(x)=4:next
  43. 380 print"[144][209][193][209][211][209][218][144][209][216]":print"        "
  44. 381 print"[145][145]"tab(28)"        ":printtab(28)"        "
  45. 390 cd=0:forx=1to13:fory=1to3:cd=cd+1
  46. 400 if(fnrk(dk(cd))=1)thencd=cd+1:goto400
  47. 410 cd(x,y)=dk(cd):next:next:y=4
  48. 420 forx=5to13:cd=cd+1
  49. 430 if(fnrk(dk(cd))=1)thencd=cd+1:goto430
  50. 440 cd(x,y)=dk(cd):next
  51. 450 fory=1to4:forx=1to13:print"";
  52. 460 m=cd(x,y):gosub4060
  53. 470 next:print:next
  54. 480 print"[144]from?":ifhz=0thenhz=1
  55. 490 ifln(hz)=0thenhz=hz+1:goto490
  56. 500 poke53269,0:poke53264,fnxx(hz):poke53248,fnsx(hz):poke53249,fnsy(ln(hz))
  57. 510 poke53269,1:gosub4160
  58. 520 ifa$=chr$(13)then630
  59. 530 ifa$<>"[157]"anda$<>"[145]"then550
  60. 540 hz=hz-1-13*(hz=1):ifln(hz)=0then540
  61. 550 ifa$<>""anda$<>""then570
  62. 560 hz=hz+1+13*(hz=13):ifln(hz)=0then560
  63. 570 ifa$="q"then590
  64. 580 goto500
  65. 590 print"[144]quit?  (y/n)"
  66. 600 geta$:ifa$<>"y"anda$<>"n"then600
  67. 610 ifa$="n"thenprint"[144]                    ":goto480
  68. 620 poke214,17:print:goto970
  69. 630 fm=hz:print"[157][157]";:forx=1tofm:print"";:next:forx=1toln(fm)
  70. 640 print"";:next:m=cd(fm,ln(fm)):gosub4090
  71. 650 print"[144] to?  "
  72. 660 poke53269,0:poke53264,fnxx(hz):poke53248,fnsx(hz):poke53249,fnsy(ln(hz))
  73. 670 poke53269,1:gosub4160
  74. 680 ifa$=chr$(13)then760
  75. 690 ifa$="[157]"thenhz=hz-1-14*(hz=0):ifln(hz)=0andhz>0then690
  76. 700 ifa$=""thenhz=hz+1+14*(hz=13):ifln(hz)=0andhz>0then700
  77. 710 if(a$="[145]"ora$="")thenhz=1+(hz>0)
  78. 720 ifhz<>0then750
  79. 721 if(fnrk(fncd(fm))=13)then729
  80. 722 ifa(fnsu(fncd(fm)))+1=fnrk(fncd(fm))then730
  81. 723 ifkg(fnsu(fncd(fm)))-1=fnrk(fncd(fm))then729
  82. 724 goto730
  83. 729 poke53269,0:poke53248,24*(fnsu(fncd(fm))-1):poke53249,92:poke53264,1:goto670
  84. 730 poke53269,0:poke53248,16+24*fnsu(fncd(fm)):poke53249,92:poke53264,0:goto670
  85. 740 poke53269,1:goto670
  86. 750 goto660
  87. 760 tu=hz
  88. 770 iftu>0then860
  89. 780 if(fnrk(fncd(fm))=13)then820
  90. 781 ifa(fnsu(fncd(fm)))+1<>fnrk(fncd(fm))then820
  91. 790 print"[157][157]";:forx=1tofnsu(fncd(fm)):print"";:next
  92. 800 m=cd(fm,ln(fm)):gosub4060
  93. 810 ac=ac+1:a(fnsu(fncd(fm)))=a(fnsu(fncd(fm)))+1:goto910
  94. 820 ifkg(fnsu(fncd(fm)))-1<>fnrk(fncd(fm))thengosub980:goto480
  95. 830 print"[157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]";:forx=1tofnsu(fncd(fm)):print"";:next
  96. 840 m=fncd(fm):gosub4060
  97. 850 ac=ac+1:kg(fnsu(fncd(fm)))=kg(fnsu(fncd(fm)))-1:goto910
  98. 860 iffnsu(fncd(fm))<>fnsu(fncd(tu))thengosub980:goto480
  99. 870 ifabs(fnrk(fncd(fm))-fnrk(fncd(tu)))<>1thengosub980:goto480
  100. 880 print"[157][157]";:forx=1totu:print"";:next:forx=1toln(tu)+1
  101. 890 print"";:next
  102. 900 m=fncd(fm):gosub4060
  103. 910 print"[157][157]";:forx=1tofm:print"";:next:forx=1toln(fm)
  104. 920 print"";:next
  105. 930 ln(tu)=ln(tu)+1:cd(tu,ln(tu))=fncd(fm):ln(fm)=ln(fm)-1
  106. 940 m=fncd(fm):gosub4060:print"[157][157][144]  "
  107. 950 t=t+1:print"[157][157][157][157][144]"t:ln(0)=1:ifac<48then480
  108. 960 poke214,17:print:print"[144] congratulations!  you won in"t"moves"
  109. 970 print"[145][145]":gosub4130:run
  110. 980 print"[157][157]";:forx=1tofm:print"";:next:forx=1toln(fm)
  111. 990 print"";:next:gosub4060:return
  112. 1000 rem bisley instructions
  113. 1010 print"[147][156]bisley instructions"
  114. 1020 print"[163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163]"
  115. 1030 print"[154]   the object is to build all of the"
  116. 1040 print" cards in the layout to the aces and"
  117. 1050 print" kings in suit."
  118. 1060 print"   only the bottom card of each row"
  119. 1070 print" may be moved.  it may be placed on the"
  120. 1080 print" ace pile, the king pile, or onto the"
  121. 1090 print" bottom of another column, building"
  122. 1100 print" either up or down in suit.  any time"
  123. 1110 print" a king is available, it may be placed"
  124. 1120 print" in a row above the layout."
  125. 1130 gosub4120:return
  126. 1140 rem klondike
  127. 1150 gosub4240:gm=2:print""tab(12)"[144]k l o n d i k e"
  128. 1160 deffnsy(y)=92+8*y
  129. 1170 deffnxx(x)=-(x>6)
  130. 1180 deffnsx(x)=56+32*x-256*fnxx(x)
  131. 1190 hz=1:ac=0:cs=24:bt(8)=1:gosub4030
  132. 1200 forx=1to4:a(x)=0:next:forx=1to7:tp(x)=x:bt(x)=x:next
  133. 1210 cd=0:forx=1to7:fory=1tox:cd=cd+1:cd(x,y)=dk(cd):next:next
  134. 1220 forx=1to24:cd=cd+1:cd(0,x)=dk(cd):next
  135. 1230 print"";
  136. 1240 fory=1to7:print"";:forx=1to7:ify<tp(x)thenprintbk$;:goto1260
  137. 1250 m=cd(x,y):gosub4060
  138. 1260 print"";:next:print:next
  139. 1270 print""bk$"";:m=cd(0,1):gosub4060
  140. 1280 pl=1:tp(0)=1:bt(0)=1
  141. 1290 print"[144]from?":ifhz=8thenhz=1
  142. 1291 ifhz<1thenhz=0
  143. 1300 if(cs=0or(cs=1andcd(0,bt(0))<>0))andhz=-1thenhz=0
  144. 1310 ifhz<1then1460
  145. 1320 ifbt(hz)=0thenhz=hz+1+9*(hz>6):goto1300
  146. 1330 ifhz<1then1460
  147. 1340 poke53269,0:poke53264,fnxx(hz):poke53248,fnsx(hz):poke53249,fnsy(bt(hz))
  148. 1350 poke53269,1:gosub4160
  149. 1360 ifa$=chr$(13)then1670
  150. 1370 ifa$<>"[145]"anda$<>""then1400
  151. 1380 ifcd(0,bt(0))<>0and(hz<>0orcs=1)thenhz=0:goto1460
  152. 1390 if(cs>1or(cs=1andcd(0,bt(0))=0))thenhz=-1:goto1460
  153. 1400 ifa$<>"[157]"then1480
  154. 1410 hz=hz-1:ifhz<>0andhz<>-1then1470
  155. 1420 ifhz=0andcd(0,bt(0))=0thenhz=-1
  156. 1430 ifhz=-1and(cs=0or(cs=1andcd(0,bt(0))<>0))thenhz=8:goto1410
  157. 1440 ifhz<1then1460
  158. 1450 ifbt(hz)=0then1410
  159. 1460 poke53269,0:poke53264,0:poke53248,80+24*hz:poke53249,212:goto1350
  160. 1470 hz=hz-9*(hz=-2):ifbt(hz)=0then1410
  161. 1480 ifa$<>""then1550
  162. 1490 ifhz=7thenhz=-2
  163. 1500 hz=hz+1:ifhz>0then1540
  164. 1510 ifhz=-1and(cs=0or(cs=1andcd(0,bt(0))<>0))thenhz=0
  165. 1520 ifhz=0andcd(0,bt(0))=0thenhz=1:goto1300
  166. 1530 goto1460
  167. 1540 ifbt(hz)=0then1490
  168. 1550 ifa$="q"then1570
  169. 1560 goto1340
  170. 1570 print"[144]quit?  (y/n)"
  171. 1580 geta$:ifa$<>"y"anda$<>"n"then1580
  172. 1590 print"[144]            ":ifa$="n"then1290
  173. 1600 print"";
  174. 1610 fory=1to7:print"";:forx=1to7
  175. 1620 m=cd(x,y):ify<tp(x)then1640
  176. 1630 gosub4050:goto1650
  177. 1640 gosub4080
  178. 1650 print"";:next:print:next
  179. 1660 poke214,21:print:goto2430
  180. 1670 ifhz<>-1then1740
  181. 1680 pl=pl+1:ifpl>23thencs=1:print"[144]  [157][157]  "
  182. 1690 ifcd(0,pl)=0andcs>0andpl<24then1680
  183. 1700 bt(0)=pl:tp(0)=pl
  184. 1710 poke214,18:print:print"";:m=cd(0,pl):gosub4060
  185. 1720 ifcs=1thenprint"[145][144]  [157][157]  "
  186. 1730 goto1290
  187. 1740 fm=hz:iffm<>0then1760
  188. 1750 poke214,18:print:print"";: