home *** CD-ROM | disk | FTP | other *** search
/ Ahoy 1985 October / Ahoy_Magazine_85-10_1985_Double_L.d64 / solitaire (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  10KB  |  390 lines
  1. 1 rem         solitaire 64
  2. 2 rem        by eric w sink
  3. 3 poke55,255:poke56,63:clr:poke53269,.:poke53271,.:poke53277,.
  4. 4 x=rnd(-ti)
  5. 5 s4=64:o4=14:t6=26:h9=39:z1=1:z2=2:z3=3:z4=4:o3=13
  6. 6 poke53280,0:poke53281,4:print"[147][158]";chr$(142)""
  7. 7 ifpeek(2)=15thenprintchr$(14)""
  8. 8 gosub103
  9. 9 gosub54:gosub101:gosub72:gosub190:gosub216
  10. 10 clr:dim p(7,20),h(13),c(13),d(13),s(13),np(7),dk%(52)
  11. 11 s4=64:o4=14:t6=26:h9=39:z1=1:z2=2:z3=3:z4=4:o3=13
  12. 12 m$="hang on, still setting up...":p$="":print"[147]":gosub108
  13. 13 x=rnd(-ti)
  14. 14 dp=0:nh=0:nc=0:nd=0:ns=0:dn=0
  15. 15 print:print:print"shuffling..."
  16. 16 fori=1to52
  17. 17 cd=int(rnd(1)*52)+z1:ifdk%(cd)then17
  18. 18 dk%(cd)=i:next
  19. 19 print"dealing out cards..."
  20. 20 fori=1to28
  21. 21 f1=.:cd=dk%(53-i):dk%(53-i)=.
  22. 22 ifi=7ori=13ori=18ori=22ori=25ori=27ori=28thencd=cd+s4:f1=1
  23. 23 pi=pi+1:p(pi,np(pi)+1)=cd:np(pi)=np(pi)+1:iff1=1thenpi=0
  24. 24 next
  25. 25 dn=24:dp=24:poke53280,0:poke53281,1
  26. 26 print"[147]   * * *   s o l i t a i r e   * * *   ";:poke16423,160
  27. 27 gosub368
  28. 28 print"[147]   * * *   s o l i t a i r e   * * *   ";:poke16423,160
  29. 29 iflv=1thengosub382
  30. 30 poke55335,11:print:print"";
  31. 31 forq=1to7:pn=q:gosub111:next
  32. 32 gosub155
  33. 33 gosub187:gosub226
  34. 34 gosub243:rem first move
  35. 35 gosub269:rem second move
  36. 36 ifbu=1thenbu=.:goto34
  37. 37 ifdnthen34
  38. 38 fori=1to7:ifp(i,1)ands4=s4ornp(i)=0thennext:goto40
  39. 39 goto34
  40. 40 fori=1to7:np(i)=.:next:nh=o3:nc=o3:nd=o3:ns=o3
  41. 41 h(nh)=o3:c(nc)=o3:d(nd)=o3:s(ns)=o3
  42. 42 gosub155:gosub137:forhi=1to7:pn=hi:gosub111:next
  43. 43 iflv=1then374
  44. 44 print""tab(15);"you won!!!"
  45. 45 print""tab(14);"play again??"
  46. 46 print:print
  47. 47 printtab(9)"press up to play again"
  48. 48 print
  49. 49 printtab(11)"press down to quit[144]"
  50. 50 x=peek(56320):u=xand1:v=xand2:ifu=1andv=2then50
  51. 51 ifu=.thenrun10
  52. 52 print"[147][144]";:poke53269,.:end
  53. 53 rem
  54. 54 rem
  55. 55 poke2,15
  56. 56 data173,000,221,041,252,009,002
  57. 57 data141,000,221,169,002,141,024
  58. 58 data208,169,064,141,136,002,169
  59. 59 data147,032,210,255,169,127,141
  60. 60 data013,220,169,051,133,001,160
  61. 61 data000,169,000,133,251,133,253
  62. 62 data169,208,133,252,169,072,133
  63. 63 data254,177,251,145,253,200,192
  64. 64 data000,208,247,230,252,230,254
  65. 65 data165,252,201,224,208,237,169
  66. 66 data055,133,001,169,129,141,013
  67. 67 data220,096,000
  68. 68 print"e"
  69. 69 c1=.:fori=49152to49231:readb:c1=c1+b:pokei,b:poke1024,b:poke16384,b:next
  70. 70 ifc1<>11494thenprint"error in data lines 10010-10065":stop
  71. 71 return
  72. 72 rem
  73. 73 data064,007,012,024,024,024,024,024,024
  74. 74 data065,255,000,240,144,240,144,144,000
  75. 75 data066,255,000,240,016,240,128,240,000
  76. 76 data067,255,000,240,016,240,016,240,000
  77. 77 data068,255,000,144,144,240,016,016,000
  78. 78 data069,255,000,240,128,240,016,240,000
  79. 79 data070,255,000,240,128,240,144,240,000
  80. 80 data071,255,000,240,016,016,016,016,000
  81. 81 data072,255,000,240,144,240,144,240,000
  82. 82 data073,255,000,240,144,240,016,240,000
  83. 83 data074,255,000,152,164,164,164,152,000
  84. 84 data075,255,000,112,032,032,160,224,000
  85. 85 data076,255,000,240,144,144,240,024,000
  86. 86 data077,255,000,144,160,192,160,144,000
  87. 87 data078,255,000,054,127,127,062,028,008
  88. 88 data079,255,000,012,012,051,051,012,030
  89. 89 data080,255,000,008,028,062,028,008,000
  90. 90 data081,255,000,024,060,126,126,024,060
  91. 91 data082,224,048,024,024,024,024,024,024
  92. 92 data085,024,024,024,024,024,024,012,007
  93. 93 data086,024,024,024,024,024,024,048,224
  94. 94 data087,024,024,024,024,024,024,024,024
  95. 95 data088,000,000,000,000,000,000,000,255
  96. 96 data-1
  97. 97 print"[147]e"
  98. 98 reada:ifa=-1thenreturn
  99. 99 poke16384,a
  100. 100 fori=0to7:readb:poke18432+a*8+i,b:next:goto98
  101. 101 rem
  102. 102 sys49152:return
  103. 103 rem
  104. 104 m$="               solitaire":p$="":gosub108
  105. 105 m$="             by eric w sink":p$="":gosub108
  106. 106 m$="        please wait...setting up":p$="":gosub108
  107. 107 return
  108. 108 rem
  109. 109 fori=1tolen(m$):printp$right$(m$,i);:next
  110. 110 return
  111. 111 rem
  112. 112 rem
  113. 113 rem
  114. 114 rem
  115. 115 hp=3+(pn-1)*5:uc=.
  116. 116 vp=5:zq=.
  117. 117 print"";:fori=1tovp:print"";:next:printtab(hp);
  118. 118 ifnp(pn)then120
  119. 119 print"    ":fori=1to13:printtab(hp);"    ":next:goto135
  120. 120 fori=1tonp(pn):cd=p(pn,i):ifi=sxthenzq=1
  121. 121 ifcd<s4thenuc=uc+z1:goto130
  122. 122 cd=cd-s4:su=z4:ifcd<o4thensu=z1
  123. 123 ifcd>=o4andcd<=t6thensu=z2
  124. 124 ifcd>t6andcd<=h9thensu=z3
  125. 125 ch=cd-((su-1)*13)
  126. 126 su$=chr$(205+su):co$="[144]":ifsu=1orsu=3thenco$=""
  127. 127 ifzc=1andzq=1thenco$=""
  128. 128 cd$=co$+chr$(192)+chr$(192+ch)+su$+chr$(210)
  129. 129 printcd$
  130. 130 printtab(hp);
  131. 131 next
  132. 132 print"[221]  [221]":printtab(hp)"[213][164][164][214]"
  133. 133 zc=.:zq=.
  134. 134 fori=1to12-np(pn)+uc:printtab(hp);"    ":next
  135. 135 print"";:poke214,3:print:printtab(hp+1)uc
  136. 136 return
  137. 137 rem aces
  138. 138 print"";
  139. 139 ifnh=.then141
  140. 140 su=z1:cd=h(nh):hp=9:gosub151
  141. 141 print"";
  142. 142 ifnc=.then144
  143. 143 su=z2:cd=c(nc):hp=15:gosub151
  144. 144 print"";
  145. 145 ifnd=.then147
  146. 146 su=z3:cd=d(nd):hp=21:gosub151
  147. 147 print"";
  148. 148 ifns=.then150
  149. 149 su=z4:cd=s(ns):hp=27:gosub151
  150. 150 return
  151. 151 rem ace
  152. 152 su$=chr$(205+su):co$="[144]":ifsu=1orsu=3thenco$=""
  153. 153 cd$=co$+chr$(192)+chr$(192+cd)+su$+chr$(210)
  154. 154 printtab(hp)cd$:printtab(hp)"[221]  [221]":printtab(hp)"[213][164][164][214]":return
  155. 155 rem deck
  156. 156 ifdpthengosub176:goto158
  157. 157 gosub180
  158. 158 print""tab(9);
  159. 159 ifdp<>dnthen161
  160. 160 print"    ":printtab(9)"    ":printtab(9)"    ":printtab(9)"    ":goto171
  161. 161 cd=dk%(dp+z1):su=4:ifcd<=o3thensu=z1
  162. 162 ifcd>=o4andcd<=t6thensu=z2
  163. 163 ifcd>t6andcd<=h9thensu=z3
  164. 164 ch=cd-((su-1)*o3)
  165. 165 su$=chr$(205+su):co$="[144]":ifsu=1orsu=3thenco$=""
  166. 166 ifzc=1thenzc=.:co$=""
  167. 167 cd$=co$+chr$(192)+chr$(192+ch)+su$+chr$(210)
  168. 168 printcd$
  169. 169 printtab(9);
  170. 170 print"[221]  [221]":printtab(9)"[213][164][164][214]"
  171. 171 print""tab(3);"    "
  172. 172 print""tab(3);dp
  173. 173 print""tab(9);"    "
  174. 174 print""tab(9);dn-dp
  175. 175 return
  176. 176 rem
  177. 177 print"[156]"tab(3);"[192][163][163][210]":printtab(3);
  178. 178 print"[221]  [221]":printtab(3)"[213][164][164][214]"
  179. 179 return
  180. 180 rem
  181. 181 iflv=1then184
  182. 182 print""tab(3);"turn":printtab(3);
  183. 183 print"deck":printtab(3)"over":goto186
  184. 184 print""tab(3);"e   ":printtab(3);
  185. 185 print" n  ":printtab(3)"  d "
  186. 186 return
  187. 187 rem
  188. 188 print""tab(32)"concede"
  189. 189 print"";:return
  190. 190 rem
  191. 191 data234,173,000,220,141,144,003
  192. 192 data074,176,010,173,001,208,201
  193. 193 data052,144,003,206,001,208,173
  194. 194 data144,003,074,074,176,010,173
  195. 195 data001,208,201,228,176,003,238
  196. 196 data001,208,173,144,003,074,074
  197. 197 data074,176,034,173,016,208,074
  198. 198 data176,013,173,000,208,201,025
  199. 199 data144,021,206,000,208,024,144
  200. 200 data015,206,000,208,173,000,208
  201. 201 data201,255,208,005,169,000,141
  202. 202 data016,208,173,144,003,074,074
  203. 203 data074,074,176,029,173,016,208
  204. 204 data074,176,013,238,000,208,208
  205. 205 data018,169,001,141,016,208,024
  206. 206 data144,010,173,000,208,201,063
  207. 207 data176,003,238,000,208,173,144
  208. 208 data003,074,074,074,074,074,176
  209. 209 data001,096,160,243,162,161,232
  210. 210 data208,253,200,208,248,076,000
  211. 211 data193,000,000
  212. 212 c2=.:fori=49408to49550:readb:c2=c2+b:pokei,b:poke1024,b:poke16384,b:next
  213. 213 ifc2<>16685thenprint"error in data lines 11400-11500":stop
  214. 214 poke49519,79:poke49439,243
  215. 215 return
  216. 216 rem
  217. 217 data252,000,000,224,000,000,240,000
  218. 218 data000,152,000,000,140,000,000,012
  219. 219 data000,000,000,000,000,000,000,000
  220. 220 data000,000,000,000,000,000,000,000
  221. 221 data000,000,000,000,000,000,000,000
  222. 222 data000,000,000,000,000,000,000,000
  223. 223 data000,000,000,000,000,000,000,000
  224. 224 data000,000,000,000,000,000,000,000
  225. 225 fori=22528to22591:readb:pokei,b:next:return
  226. 226 rem
  227. 227 poke53269,.:poke53264,.:poke53248,170:poke53249,150:poke53287,6
  228. 228 poke17400,96:poke53269,1:return
  229. 229 rem read joystick-sprite position
  230. 230 sys49408:ys=peek(53249):xs=peek(53248)+256*(peek(53264)and1)
  231. 231 xs=xs-24:ys=ys-51
  232. 233 cx=int(xs/8):cy=int(ys/8)
  233. 234 return
  234. 235 rem
  235. 236 jc=.
  236. 237 ifcy>=22andcx>33thenjc=1
  237. 238 ifcx>=3andcx<=7andcy>=19andcy<=22thenjc=2
  238. 239 ifcx>=8andcx<=12andcy>=19andcy<=22thenjc=3
  239. 240 ifcx>=3andcx<=36andcy<=18andcy>=5thenjc=4
  240. 241 ifcy<=4thenjc=5
  241. 242 return
  242. 243 rem 1st move
  243. 244 am=.
  244. 245 gosub229:gosub235
  245. 246 onjcgoto248,249,254,256
  246. 247 gosub306:goto243
  247. 248 goto45
  248. 249 ifdp=.theniflv=.thendp=dn-3:goto252
  249. 250 ifdp=.then374
  250. 251 dp=dp-cg
  251. 252 ifdp<.thendp=.
  252. 253 gosub155:goto243
  253. 254 ifdp=dnthen247
  254. 255 zc=1:gosub155:am=1:return
  255. 256 rem
  256. 257 pn=7:ifcx<33thenpn=6
  257. 258 ifcx<28thenpn=5
  258. 259 ifcx<23thenpn=4
  259. 260 ifcx<18thenpn=3
  260. 261 ifcx<o3thenpn=z2
  261. 262 ifcx<8thenpn=1
  262. 263 p1=pn:ifnp(pn)=.thengosub306:goto243
  263. 264 dc=.:fori=1tonp(pn):ifp(pn,i)>52thendc=dc+z1
  264. 265 next:d1=np(pn)-dc+1
  265. 266 ca=cy-5:ca=ca+d1:ifca>np(pn)thenca=np(pn)
  266. 267 sx=ca
  267. 268 zc=1:gosub111:return
  268. 269 rem 2nd move
  269. 270 gosub229:gosub235
  270. 271 onjcgoto273,274,275,277,308
  271. 272 gosub306:goto269
  272. 273 goto248
  273. 274 goto272
  274. 275 ifam=1thenzc=.:am=.:bu=1:gosub155:return
  275. 276 goto272
  276. 277 rem drop cards to a pile
  277. 278 p2=7:ifcx<33thenp2=6
  278. 279 ifcx<28thenp2=5
  279. 280 ifcx<23thenp2=4
  280. 281 ifcx<18thenp2=3
  281. 282 ifcx<o3thenp2=z2
  282. 283 ifcx<8thenp2=1
  283. 284 w2=p(p2,np(p2))
  284. 285 w2=w2-s4:s2=z4:ifw2<o4thens2=z1
  285. 286 ifw2>=o4andw2<=t6thens2=z2
  286. 287 ifw2>t6andw2<=h9thens2=z3
  287. 288 ifw2>o3thenw2=w2-o3:goto288
  288. 289 ifam=1then342
  289. 290 w1=p(p1,sx)
  290. 291 w1=w1-s4:gosub386
  291. 292 ifnp(p2)=.andw1=o3then300
  292. 293 ifp1=p2thenbu=1:pn=p1:gosub111:return
  293. 294 ifw2<>w1+1thengosub306:goto269
  294. 295 o1=1:ifs1=2ors1=4theno1=2
  295. 296 o2=1:ifs2=2ors2=4theno2=2
  296. 297 ifo1=1ando2=2then300
  297. 298 ifo1=2ando2=1then300
  298. 299 gosub306:goto269
  299. 300 fori=sxtonp(p1):np(p2)=np(p2)+1:p(p2,np(p2))=p(p1,i):nexti
  300. 301 np(p2)=np(p2)+cq
  301. 302 np(p1)=sx-1:p(p1,np(p1))=p(p1,np(p1))ors4
  302. 303 pn=p1:gosub111
  303. 304 pn=p2:gosub111
  304. 305 return
  305. 306 fora=1to20:poke54296,15:fort=1to3:next:poke54296,0:fort=1to3:next:next
  306. 307 return
  307. 308 rem
  308. 309 ifam=1then314
  309. 310 ifsx<>np(p1)thengosub306:goto269
  310. 311 w1=p(p1,sx)
  311. 312 w1=w1-s4:gosub386
  312. 313 ons1goto326,330,334,338
  313. 314 rem
  314. 315 w1=dk%(dp+1)
  315. 316 gosub386
  316. 317 ons1goto318,320,322,324
  317. 318 w2=h(nh):ifw2+1<>w1thengosub306:goto269
  318. 319 nh=nh+z1:h(nh)=w1:gosub365:gosub137:gosub155:return
  319. 320 w2=c(nc):ifw2+1<>w1thengosub306:goto269
  320. 321 nc=nc+z1:c(nc)=w1:gosub365:gosub137:gosub155:return
  321. 322 w2=d(nd):ifw2+1<>w1thengosub306:goto269
  322. 323 nd=nd+z1:d(nd)=w1:gosub365:gosub137:gosub155:return
  323. 324 w2=s(ns):ifw2+1<>w1thengosub306:goto269
  324. 325 ns=ns+z1:s(ns)=w1:gosub365:gosub137:gosub155:return
  325. 326 w2=h(nh):ifw2+1<>w1thengosub306:goto269
  326. 327 nh=nh+1:h(nh)=w1
  327. 328 np(p1)=np(p1)-z1:p(p1,np(p1))=p(p1,np(p1))ors4:gosub111:gosub137
  328. 329 return
  329. 330 w2=c(nc):ifw2+1<>w1thengosub306:goto269
  330. 331 nc=nc+1:c(nc)=w1
  331. 332 np(p1)=np(p1)-z1:p(p1,np(p1))=p(p1,np(p1))ors4:gosub111:gosub137
  332. 333 return
  333. 334 w2=d(nd):ifw2+1<>w1thengosub306:goto269
  334. 335 nd=nd+1:d(nd)=w1
  335. 336 np(p1)=np(p1)-z1:p(p1,np(p1))=p(p1,np(p1))ors4:gosub111:gosub137
  336. 337 return
  337. 338 w2=s(ns):ifw2+1<>w1thengosub306:goto269
  338. 339 ns=ns+1:s(ns)=w1
  339. 340 np(p1)=np(p1)-z1:p(p1,np(p1))=p(p1,np(p1))ors4:gosub111:gosub137
  340. 341 return
  341. 342 rem
  342. 343 p2=7:ifcx<33thenp2=6
  343. 344 ifcx<28thenp2=5
  344. 345 ifcx<23thenp2=4
  345. 346 ifcx<18thenp2=3
  346. 347 ifcx<o3thenp2=z2
  347. 348 ifcx<8thenp2=1
  348. 349 w2=p(p2,np(p2))
  349. 350 w2=w2-s4:s2=z4:ifw2<o4thens2=z1
  350. 351 ifw2>=o4andw2<=t6thens2=z2
  351. 352 ifw2>t6andw2<=h9thens2=z3
  352. 353 ifw2>o3thenw2=w2-o3:goto353
  353. 354 w1=dk%(dp+1)
  354. 355 gosub386
  355. 356 ifw1=o3andnp(p2)=.then363
  356. 357 ifw2<>w1+1thengosub306:goto269
  357. 358 o1=1:ifs1=2ors1=4theno1=2
  358. 359 o2=1:ifs2=2ors2=4theno2=2
  359. 360 ifo1=1ando2=2then363
  360. 361 ifo1=2ando2=1then363
  361. 362 gosub306:goto269
  362. 363 np(p2)=np(p2)+z1:p(p2,np(p2))=dk%(dp+1)ors4:gosub365
  363. 364 gosub155:pn=p2:gosub111:return
  364. 365 rem
  365. 366 fora=dp+1todn:dk%(a)=dk%(a+1):next:dn=dn-1:return
  366. 367 end
  367. 368 rem las vegas or regular
  368. 369 print"":print"las vegas style or regular??"
  369. 370 print"push up for 'vegas' and down for regular"
  370. 371 x=peek(56320):u=xand1:v=xand2:ifu=1andv=2then371
  371. 372 ifu=.thenlv=1:cg=1:return
  372. 373 lv=.:cg=3:return
  373. 374 print"[147]had you bought the deck for $50,"
  374. 375 print"at $5 for every card you put at the top,"
  375. 376 print"you would receive  $"(nh+nc+nd+ns)*5"back."
  376. 377 print"this leaves you with a net ";
  377. 378 if((nh+nc+nd+ns)*5)-50>=0thenprint"profit":goto380
  378. 379 print"loss"
  379. 380 print"of   $"abs(((nh+nc+nd+ns)*5)-50)
  380. 381 goto45
  381. 382 x$="las vegas":print:print:print:print""
  382. 383 fori=1to9:print""mid$(x$,i,1)tab(38)mid$(x$,i,1)
  383. 384 next
  384. 385 return
  385. 386 s1=z4:ifw1<o4thens1=z1
  386. 387 ifw1>=o4andw1<=t6thens1=z2
  387. 388 ifw1>t6andw1<=h9thens1=z3
  388. 389 ifw1>o3thenw1=w1-o3:goto389
  389. 390 return
  390.