home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 73 / 073.d81 / bits (.txt) < prev    next >
Encoding:
Commodore BASIC  |  1990-01-01  |  7.9 KB  |  260 lines
  1. 1 rem save"puss.v6.1",8
  2. 2 gosub20:deffns(x)=int(x/12):deffnv(x)=x-12*int(x/12)
  3. 3 dimx,y,z3,jj,ii,fr,j,f,rd,nc,j%,t,t2,tc,te,tt,wf,wt
  4. 5 printchr$(142);chr$(8):gosub111:goto400
  5. 8 rem==========fanfare=========
  6. 9 :
  7. 10 t=87:n$="251331421502421502"
  8. 11 pokef+6,96:pokef+24,15
  9. 12 fori=1to18step3
  10. 13 pokef+1,val(mid$(n$,i,2)):pokef+4,33
  11. 14 forj=1tot*val(mid$(n$,i+2,1)):next
  12. 15 pokef+4,0:next:x=3:y=12:w$="[176][192][192][192][192][192][192][192][174][157][157][157][157][157][157][157][157][157][221]you win[221][157][157][157][157][157][157][157][157][157][173][192][192][192][192][192][192][192][189]"
  13. 16 gosub66:return
  14. 17 rem ======creates screen save
  15. 18 :
  16. 20 for i=828to972:reada:pokei,a:next:return
  17. 22 data169,000,133,251,133,253,141
  18. 23 data055,003,141,057,003,141,059
  19. 24 data003,162,000,160,000,177,251
  20. 25 data145,253,200,192,000,208,247
  21. 26 data230,252,230,254,232,224,004
  22. 27 data208,238,173,056,003,133,252
  23. 28 data173,058,003,133,254,238,059
  24. 29 data003,174,059,003,224,002,208
  25. 30 data214,096,169,004,133,252,169
  26. 31 data192,133,254,169,216,141,056
  27. 32 data003,169,196,141,058,003,076
  28. 33 data060,003,169,192,133,252,169
  29. 34 data004,133,254,169,196,141,056
  30. 35 data003,169,216,141,058,003,076
  31. 36 data060,003,169,004,133,252,169
  32. 37 data200,133,254,169,216,141,056
  33. 38 data003,169,204,141,058,003,076
  34. 39 data060,003,169,200,133,252,169
  35. 40 data004,133,254,169,204,141,056
  36. 41 data003,169,216,141,058,003,076
  37. 42 data060,003,000,000,000
  38. 43 :
  39. 51 :
  40. 52 rem==========again?==============
  41. 53 :
  42. 54 x= 8:y=16:w$="[144] again? [157][157][157][157][157][157][157][157] (y/n)  ":gosub66:goto62
  43. 55 :
  44. 56 rem==========any key-get a$=========
  45. 57 x=13:y=23:w$="[158][208]ress any key[145]":gosub66:goto62
  46. 58 x=13:y=23:w$="press any key[145]":gosub66
  47. 59 :
  48. 60 rem============get a$===========
  49. 61 :
  50. 62 geta$:ifa$=""then 90:return
  51. 64 rem=======print at=============
  52. 65 :
  53. 66 poke211,x:poke214,y:sys58732:printw$:return
  54. 68 :
  55. 69 ======dkwoody's card sound========
  56. 70 :
  57. 71 pokef+24,6:pokef+5,128:pokef+4,129:forii=1to50:next:pokef+4,128:pokef+5,0
  58. 72 pokef+24,0:pokef+24,15:pokef+4,129:pokef+4,128:return
  59. 90 ifjj=>nc-2then62
  60. 91 jj=jj+1:j%=jj+int(rnd(0)*(nc-jj)):temp=s(jj):s(jj)=s(j%):s(j%)=temp:goto62
  61. 106 :
  62. 107 rem===dim,define,once only stuff===
  63. 109 :
  64. 111 nc=48:dims(nc),va$(13),c(9),b(9,48):z9=0:f=54272
  65. 112 fori=0to3:reads$(i):readco$(i):next
  66. 113 fori=0to11:readva$(i):next
  67. 114 fori=1to9:readx(i),y(i):next:return
  68. 115 data"[216]","[144]","[218]","","[211]","","[193]","[144]",    2,3,4,5,6,7,8,9,10,j,q,k
  69. 116 data3,4,12,1,12,16,33,1,33,16,19,4,26,4,19,13,26,13
  70. 117 ch$="123456789hq"
  71. 119 c$="[176][192][192][192][192][174][157][157][157][157][157][157][221]    [221][157][157][157][157][157][157][221] [176][174] [221][157][157][157][157][157][157][221] [221][221] [221]"
  72. 120 c$=c$+     "[157][157][157][157][157][157][221] [173][189] [221][157][157][157][157][157][157][221]    [221][157][157][157][157][157][157][173][192][192][192][192][189]"+"[145][145][145][145][145][157][157][157][157][157]"
  73. 121 b$=c$+"[166][166][166][166][157][157][157][157][166][166][166][166][157][157][157][157][166][166][166][166][157][157][157][157][166][166][166][166][157][157][157][157][166][166][166][166]"
  74. 122 bl$="      [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]"
  75. 123 bl$=bl$+"      [157][157][157][157][157][157]      "
  76. 125 rem========shuffle & deal======
  77. 126 :
  78. 127 forj=0tonc-1:s(j)=j:next
  79. 128 forj=0tonc-2:j%=j+int(rnd(0)*(nc-j)):temp=s(j):s(j)=s(j%):s(j%)=temp:next
  80. 132 :
  81. 133 rem=======deal=============
  82. 134 :
  83. 135 for i=0to47:b(1,i+1)=s(i):next
  84. 136 c(1)=48:fori=2to9:c(i)=0:next:return
  85. 137 :
  86. 138 rem =====print card-deck is 1=====
  87. 139 :
  88. 140 j=c(i):x=x(i):y=y(i):                        if c(i)=0thenw$=bl$:goto66
  89. 141 ifi=1andwf=0and   c(i)<>0thenw$=b$:goto66
  90. 142 iffnv(b(i,j))<>8then146
  91. 143 w$=c$+co$(fns(b(i,j)))+va$(fnv(b(i,j)))+"[157][157]"+s$(fns(b(i,j)))+""
  92. 144 w$=w$+ s$(fns(b(i,j)))+"[157][157]"+va$(fnv(b(i,j)))
  93. 145 goto148
  94. 146 w$=c$+co$(fns(b(i,j)))+va$(fnv(b(i,j)))+"[157]"+ s$(fns(b(i,j)))+""
  95. 147 w$=w$+ s$(fns(b(i,j)))+"[157]"+va$(fnv(b(i,j)))
  96. 148 gosub71:goto66
  97. 157 :
  98. 158 rem=======print board=======
  99. 159 :
  100. 160 poke53280,1:poke53281,1:print"[144][147]"chr$(142)tab(14)"2"tab(34)"4"
  101. 162 print"1              6      7
  102. 164 [153]"               8      9
  103. 166 print"35
  104. 168 x[178]x(1):y[178]y(1):w$[178]b$:[141]66:x[178]x(6):y[178]y(6):w$[178]c$[170]"acmd(NULL)(NULL)cmda":[141]66
  105. 169 x[178]x(7):y[178]y(7):w$[178]c$[170]"acmd(NULL)(NULL)cmda":[141]66
  106. 170 x[178]x(8):y[178]y(8):w$[178]c$[170]"stopacmdatnatncmda":[141]66
  107. 171 x[178]x(9):y[178]y(9):w$[178]c$[170]"stopacmd(NULL)(NULL)cmda":[141]66
  108. 172 x[178]3:y[178]19:w$[178]"h-help":[141]66:x[178]3:y[178]21:w$[178]"q-quit":[141]66
  109. 173 [142]
  110. 192 [139]c(i)[178]0[167]210:[137]500
  111. 194 [137]510
  112. 200 [141]140:[137]510
  113. 205 [129]i[178]1[164]11:[139]a$[178][202](ch$,i,1)[167]208
  114. 206 [130]
  115. 207 [145]z3[137]500,510
  116. 208 [145]z3[137]503,514
  117. 209 [143]=======illegal aside=======
  118. 210 x[178]3:y[178]13:w$[178]"illegal":[141]66:[129]i[178]1[164]1000:[130]:[137]500
  119. 219 :
  120. 220 [143]=====second screen=====
  121. 222 [153]"loadcont            (NULL)(NULL)(NULL)(NULL) right$(NULL) len(NULL)(NULL)(NULL)val(NULL)"
  122. 223 [153]"def           by (NULL)aurice mid$onesopen"
  123. 225 [153]:[153]"   (NULL)(NULL)(NULL)(NULL) right$(NULL) len(NULL)(NULL)(NULL)val(NULL) is a traditional game"
  124. 226 [153]"of solitaire.  (NULL)inning chances are
  125. 227 print"often quoted as one in three.
  126. 229 [153]:[153]"   (NULL)he object of the game is to play
  127. 230 print"all of the cards to the center piles"
  128. 231 print"(6-9) in ascending order by color only.
  129. 234 [153]:[153]"   lenards are drawn from the deck (1)
  130. 235 print"one at a time and each card must be"
  131. 236 print"played to one of the waste piles (2-5).
  132. 240 [153]:[153]"   (NULL)nly the top card of each waste pile
  133. 242 print"is available for play to the center.
  134. 244 [153]:[153]"   (NULL)ne redeal is allowed.
  135. 250 return
  136. 267 :
  137. 268 rem======play card=======
  138. 269 :
  139. 270 c(t2)=c(t2)+1:b(t2,c(t2))=b(fr,c(fr)):c(fr)=c(fr)-1:i=fr:gosub140
  140. 272 i=t2:gosub140:goto970
  141. 287 :
  142. 288 rem======exceptions======
  143. 289 :
  144. 290 ifi>9then504
  145. 291 ifi=1andrd=1then604
  146. 292 ifi<10andc(i)=0then210:goto500
  147. 293 wf=0:ifi=1thenwf=1
  148. 294 goto504
  149. 397 :
  150. 398 rem========start of program=======
  151. 399 :
  152. 400 poke53280,0:poke53281,0:print"[147][159]"
  153. 410 gosub60000:gosub117:gosub222:gosub127:gosub57
  154. 498 tt=0:jj=0:rd=0:gosub160
  155. 500 x=0:y=13:w$="   from ? [157][157]":gosub66:gosub62:z3=1:goto205
  156. 503 goto290
  157. 504 fr=i:onigoto200,192,192,192,192,210,210,210,210,1038,950
  158. 510 x=0:y=13:w$="    to  ? [157][157]":gosub66:gosub62:z3=2:goto205
  159. 514 t2=i:onigoto210,700,700,700,700,800,800,800,800,1038,950
  160. 597 :
  161. 598 rem====redeal======
  162. 599 :
  163. 600 i=1:gosub140:tt=tt+1:iftt>=2then500
  164. 601 rd=1
  165. 602 x=3:y=15:w$="redeal":gosub66:goto500
  166. 604 fori=2to5:ifc(i)=0then612
  167. 608 forj=1toc(i):c(1)=c(1)+1:b(1,c(1))=b(i,j):next
  168. 612 next
  169. 616 fori=2to5:c(i)=0:x=x(i):y=y(i):w$=bl$:gosub66:gosub71
  170. 617 forj=1to500:next:next:rd=0
  171. 618 x=x(1):y=y(1):w$=b$:gosub66:x=3:y=15:w$="         ":gosub66:gosub71:goto500
  172. 697 :
  173. 698 rem======play to corners=========
  174. 699 :
  175. 700 iffr>1then210
  176. 702 wf=0:i=1:gosub140
  177. 704 c(t2)=c(t2)+1
  178. 706 b(t2,c(t2))=b(1,c(1)):c(1)=c(1)-1:i=t2:gosub140:goto970
  179. 797 :
  180. 798 rem======play to center==========
  181. 799 :
  182. 800 fc=b(fr,c(fr)):tc=b(t2,c(t2)):ct=c(t2)
  183. 801 iffr<>1then804
  184. 802 wf=0:i=1:gosub140
  185. 804 ont2-5goto810,810,814,814
  186. 810 iffns(b(fr,c(fr)))= 1orfns(b(fr,c(fr)))= 2then820
  187. 812 goto210:goto500
  188. 814 iffns(b(fr,c(fr)))= 0orfns(b(fr,c(fr)))= 3then850
  189. 816 goto210:goto500
  190. 820 ifc(t2)<>0then 830
  191. 824 iffnv(b(fr,c(fr)))<>0then210:goto500
  192. 828 goto270
  193. 830 iffnv(b(fr,c(fr)))-1<>fnv(b(t2,c(t2))) then210:goto500
  194. 834 goto270
  195. 850 ifc(t2)<>0then 860
  196. 854 iffnv(b(fr,c(fr)))<>0then210:goto500
  197. 858 goto270
  198. 860 iffnv(b(fr,c(fr)))-1<>fnv(b(t2,c(t2)))then210:goto500
  199. 864 goto270
  200. 947 :
  201. 948 rem===quit======
  202. 949 :
  203. 950 sys886:x=11:y=12:w$="[176][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][174][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]"
  204. 951 w$=w$+"[221] [151]you sure? (y/n) [221][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][173][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][189]"
  205. 952 gosub66:gosub62
  206. 953 if a$="y"then960
  207. 954 ifa$<>"n"thengosub62:goto953
  208. 956 sys907:onz3goto500,510
  209. 960 sys907:fi$=str$(c(2)+c(3)+c(4)+c(5)+c(1)):x=3:y=11:w$="  cards left"+fi$
  210. 961 w$=" cards [157][157][157][157][157][157][157] left  [157][157][157][157][157][157][157]       [157][157][157][157][157][157]"+fi$:gosub66:goto980
  211. 968 rem==check for win- redeal====
  212. 969 :
  213. 970 wt=c(9)+c(8)+c(7)+c(6):ifwt<>48then974
  214. 973 gosub10:goto980
  215. 974 ifc(1)=0andrd=0 then600
  216. 975 ifc(1)=0andrd=1andfr=1then604
  217. 976 goto500
  218. 980 x=1:y=15:w$="play again (y/n)?":gosub66
  219. 981 gosub62:ifa$="n"then2000
  220. 982 ifa$<>"y"then981
  221. 984 gosub135:goto498
  222. 1038 sys886:poke53280,0:poke53281,0:print"[147]";
  223. 1046 print"[129]             [208][213][211][211] [201][206] [195][207][210][206][197][210]"
  224. 1050 print"[159]    [198]ollow the prompts at the left of
  225. 1052 [153]"the screen using the numbers below the
  226. 1054 print"piles.  [215]hen you have exhausted the
  227. 1056 [153]"deck once,def (NULL)valstr$valatn(NULL) openwait will be displayed.
  228. 1058 print"[212]he next time you choose 1 at the 'from'";
  229. 1060 print"prompt, the piles will be collected and"
  230. 1062 print"placed in pile 1.
  231. 1064 [153]"    right$f 'illegal' is displayed briefly,
  232. 1066 print"your choice is wrong for the situation"
  233. 1068 print"at hand.  [206]o problem, since you will be
  234. 1070 [153]"prompted again.
  235. 1072 print"    [193]fter the second time through, if
  236. 1074 [153]"no play is available, use the 'quit'
  237. 1076 print"option to end the game.
  238. 1078 [153]"    (NULL)he help and quit options are
  239. 1080 print"available at any prompt."
  240. 1082 gosub57:sys907:printchr$(142):poke53281,1:poke53280,1:poke646,0:onz3goto500,510
  241. 2000 open15,8,15,"r0:hello connect=hello connect":input#15,er:close15
  242. 2010 if er<>63 then print"[147]":end
  243. 2020 a$="hello connect":q$=chr$(34)
  244. 2030 poke646,peek(53281):print"[147]load"q$a$q$",8"
  245. 2040 print"run":poke631,13:poke632,13:poke198,2:end
  246. 10000 open15,8,15,"s0:bits":close15:save"bits",8:end
  247. 60000 b9$="                                      "
  248. 60010 poke214,14:print:print"  [155][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][184][184][184][152]"
  249. 60020 fori=0to7:printb9$:next:print"  [151][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][152]"
  250. 60030 b9$(0)="[208][213][211][211] [201][206] [195][207][210][206][197][210]"
  251. 60040 b9$(1)="by [205]aurice [202]ones
  252. 60050 b9$(2)[178]"(len) 1990 by (NULL)oftdisk, right$nc."
  253. 60060 b9$(3)[178]"(NULL)ublished on (NULL)(NULL)atnstr$(NULL)(NULL)atn(NULL) #73"
  254. 60070 b9$(4)[178]"(NULL)ubscriptions 1-800-831-2694"
  255. 60080 b9$(5)[178]"atnll (NULL)ights (NULL)eserved"
  256. 60090 [151]214,16:[153]:[129]i[178]0[164]5:[153][163]20[171]([195](b9$(i))[173]2))""b9$(i):[130]
  257. 60092 [151]214,7:[153]:[153]"for      (NULL) (NULL) (NULL) (NULL)   right$ (NULL)   len (NULL) (NULL) (NULL) val (NULL)"
  258. 60094 [153]"open        atn lenlassic lenard (NULL)olitaire"
  259. 60099 [142]
  260.