home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 75 / 075.d81 / bytes (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  8KB  |  250 lines
  1. 0 poke52,56:poke51,0:poke56,56:poke55,0:clr
  2. 1 dima$,a,ii,jj,te,i,j,x,y,va,t2,tc,t,su,t,j%,f,fc,fr,fs,j9,ba,ca,i3,nc,ns,su$
  3. 2 deffns(x)=int(x/13):deffnv(x)=x-13*int(x/13):ns=13:nc=52:ii=827
  4. 3 jj=-1:dimg$(ns),s(nc),x(11),y(11)     :fori=0tonc-1:s(i)=i:next
  5. 4 g$(1)="setup":g$(2)="title":g$(3)="anykey":g$(4)="getkey":g$(5)="printat"
  6. 5 g$(6)="card":g$(7)="help":g$(8)="board":g$(9)="deal":g$(10)="win"
  7. 6 g$(11)="shuffle":g$(12)="choice":g$(13)="quit" :goto403
  8. 7 :
  9. 8 rem name that subroutine
  10. 9 :
  11. 10 fori3=1tons:ifsu$=g$(i3)then12
  12. 11 next:print"error";su$:end
  13. 12 oni3goto111,348,58,62,66,200,304,360,134,26,140,20,48
  14. 17 :
  15. 18 rem choice
  16. 19 :
  17. 20 sub$="getkey":gosub10
  18. 21 fori=1to10:ifa$=mid$(ch$,i,1)thenreturn
  19. 22 next:goto20
  20. 23 :
  21. 24 rem fanfare
  22. 25 :
  23. 26 t=87:a$="251331421502421502"
  24. 27 pokef+6,96:pokef+24,15
  25. 28 fori=1to18step3
  26. 29 pokef+1,val(mid$(a$,i,2)):pokef+4,33
  27. 30 forj=1tot*val(mid$(a$,i+2,1)):next
  28. 31 pokef+4,0:next:x=4:y=15:sub$="printat":gosub10
  29. 32 print"[156][176][192][192][192][192][192][192][192][174][157][157][157][157][157][157][157][157][157][221]you win[255][157][157][157][157][157][157][157][157][157][173][196][196][196][196][196][196][196][189]"
  30. 33 fori=1to1200:next
  31. 37 :
  32. 38 rem again
  33. 39 :
  34. 40 x=4:y=19:sub$="printat":gosub10
  35. 42 print"[129][176][192][192][192][192][192][192][192][192][174][157][157][157][157][157][157][157][157][157][157][221] again  [255][157][157][157][157][157][157][157][157][157][157][221] (y/n)? [255]";
  36. 44 print"[157][157][157][157][157][157][157][157][157][157][173][196][196][196][196][196][196][196][196][189]":return
  37. 45 :
  38. 46 rem quit
  39. 47 :
  40. 48 t=0:forj=1to7:t=t+c(j):next:x=2:y=14:sub$="printat":gosub10
  41. 49 print"[156][213][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][221] cards left [255][157][157][157][157][157][157][157][157][157][157][157][157][157][157][221]";
  42. 50 print"            [255][157][157][157][157][157][157][157][157][157][157][157][157][157][157][173][196][196][196][196][196][196][196][196][196][196][196][196][189][145][157][157][157][157][157][157][157][157][157]";t:goto33
  43. 55 :
  44. 56 rem any key-get a$
  45. 57 :
  46. 58 x=10:y=24:sub$="printat":gosub10:print" please press a key [145][145][145]"
  47. 59 :
  48. 60 rem get a$
  49. 61 :
  50. 62 geta$:ifa$=""then70:return
  51. 63 :
  52. 64 rem print at
  53. 65 :
  54. 66 poke211,x:poke214,y:sys58732:return
  55. 67 :
  56. 68 rem multitask-not subroutine
  57. 69 :
  58. 70 ifjj=nc-2then62
  59. 71 ifii=930then74
  60. 72 ii=ii+1:reada:pokeii,a:goto62
  61. 74 jj=jj+1:j%=jj+int(rnd(0)*(nc-jj)):temp=s(jj):s(jj)=s(j%):s(j%)=temp:goto62
  62. 108 :
  63. 109 rem dim,define,once only stuff
  64. 110 :
  65. 111 nc=52:dimva$(13),c(11),b(11,46):f=54272
  66. 112 fori=ftof+24:pokef,0:next
  67. 115 fori=0to3:reads$(i):readco$(i):next
  68. 119 fori=0to12:readva$(i):next
  69. 120 ch$="1234567fhq"
  70. 121 fori=1to11:readx(i),y(i):next:return
  71. 123 data"[216]","[144]","[218]","","[211]","","[193]","[144]",a,2,3,4,5,6,7,8,9,10,j,q,k
  72. 125 data2,10,9,10,18,8,25,8,32,8,25,0,25,16,18,0,32,0,18,16,32,16
  73. 131 :
  74. 132 rem deal
  75. 133 :
  76. 134 for i=0to45:b(1,i+1)=s(i):next:i=45:forj=3to8:i=i+1:b(j,1)=s(i):c(j)=1:next
  77. 136 c(1)=46:c(2)=0:c(9)=0:c(10)=0:c(11)=0:ba=fnv(b(8,1)):return
  78. 137 :
  79. 138 rem shuffle
  80. 139 :
  81. 140 ifjj=nc-2thenreturn
  82. 142 ifii=930then146
  83. 144 ii=ii+1:reada:pokeii,a:goto142
  84. 146 jj=jj+1:j%=jj+int(rnd(0)*(nc-jj)):temp=s(jj):s(jj)=s(j%):s(j%)=temp
  85. 148 ifjj<>nc-2then146
  86. 150 return
  87. 197 :
  88. 198 rem card
  89. 199 :
  90. 200 ca=b(i,c(i)):su=fns(ca):va=fnv(ca):x=x(i):y=y(i):sub$="printat":gosub10
  91. 204 pokef+24,15:pokef+5,128:pokef+4,129:fort=1to50:next:pokef+4,128:pokef+5,0
  92. 206 pokef+24,0:pokef+24,15:pokef+4,129:pokef+4,128
  93. 208 ifc(i)<>0then220
  94. 216 print"      [157][157][157][157][157][157]      [157][157][157][157][157][157]      [157][157][157][157][157][157]      ";
  95. 218 print"[157][157][157][157][157][157]      [157][157][157][157][157][157]      [157][157][157][157][157][157]      ";:return
  96. 220 print"[176][192][192][192][192][174][157][157][157][157][157][157][221]    [255][157][157][157][157][157][157][221] [166][167] [255][157][157][157][157][157][157][221] [170][171] [255]";
  97. 222 print"[157][157][157][157][157][157][221] [168][169] [255][157][157][157][157][157][157][221]    [255][157][157][157][157][157][157][173][196][196][196][196][189]
  98. 224 sub$[178]"printat":[141]10
  99. 225 [139]va[179][177]9[167]227
  100. 226 [153]"";co$(su);va$(va);"cmdcmd";s$(su);"";s$(su);"cmdcmd";va$(va):[142]
  101. 227 [153]"";co$(su);va$(va);"cmd";s$(su);"";s$(su);"cmd";va$(va):[142]
  102. 301 :
  103. 302 [143] help
  104. 303 :
  105. 304 [151]53280,1:[151]53281,1:[153]"load       andposnewnewnew four seasons newnewnewposand "
  106. 306 [153]" the foundations [f] are built upward by";
  107. 308 [153]"suit with king 'wrapping' to ace.  each
  108. 310 print"pile  in  the  tableau  [3-7]  is built
  109. 312 [153]"downward, regardless of suit, with aces
  110. 314 print"'wrapping' to kings.
  111. 316 [153]:[153]" the foundation cards will be the other
  112. 318 print"three  cards  of the same  value as the
  113. 320 [153]"one  dealt.  one card at a time can be
  114. 322 print"moved from the top of any pile [2-7] to
  115. 324 [153]"any pile except the waste [2].
  116. 326 print:print" turn cards up from the stock [1] one
  117. 328 [153]"at a time.  the card will be placed on
  118. 330 print"the waste pile. fill empty spaces [3-7]
  119. 332 [153]"from any pile. follow the prompts below
  120. 334 print"the deck.  cards  will be played to the
  121. 336 [153]"proper foundation  when you select 'f'."
  122. 338 [153]"in  order  to  win,  all cards must be
  123. 339 print"played to the foundations. no redeal is
  124. 340 [153]"allowed.":[139]j9[178]1[167]342
  125. 341 [153]"          a moment, pleaseonon";:j9[178]1:sub$[178]"shuffle":[141]10
  126. 342 [153]"onon": sub$[178]"anykey":[141]10:[142]
  127. 345 :
  128. 346 [143] title
  129. 347 :
  130. 348 [151]53280,0:[151]53281,0:[153]"loadprint"[199](142)""
  131. 349 [153]"tantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantan"
  132. 350 [153]"deftantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantan"
  133. 351 [153]"print        f o u r    s e a s o n s
  134. 352 print"[150]        a classic solitaire game
  135. 353 [153]"print            by maurice jones
  136. 354 print"[150][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192]
  137. 355 [153]"printtantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantantan"
  138. 356 [141]60000:[142]
  139. 357 :
  140. 358 [143] board
  141. 359 :
  142. 360 [151]53280,1:[151]53281,1:[153]"load    ortantantantantantantantantan^
  143. 361 print"    [221]  four   [255]
  144. 362 [153]"    (NULL) seasons (NULL)
  145. 363 print"    [173][196][196][196][196][196][196][196][196][196][189]
  146. 364 [153]"stop      h-help
  147. 365 print"      q-quit         f      6      f
  148. 366 [153]"                     3      4      5
  149. 368 print"     1      2"
  150. 371 print"                     f      7      f";
  151. 372 fori=3to8:sub$="card":gosub10:next:x=x(1):y=y(1):sub$="printat":gosub10
  152. 373 print"[176][192][192][192][192][174][157][157][157][157][157][157][221][166][164][164][167][255][157][157][157][157][157][157][221][170][172][172][171][255][157][157][157][157][157][157][221][170][172][172][171][255]";
  153. 374 print"[157][157][157][157][157][157][221][170][172][172][171][255][157][157][157][157][157][157][221][168][165][165][169][255][157][157][157][157][157][157][173][196][196][196][196][189][145][145][145][145][145][157][157][157][157][157]";:return
  154. 375 :
  155. 376 rem ss data
  156. 377 :
  157. 379 data169,000,133,251,133,253,141
  158. 380 data055,003,141,057,003,141,059
  159. 381 data003,162,000,160,000,177,251
  160. 382 data145,253,200,192,000,208,247
  161. 383 data230,252,230,254,232,224,004
  162. 384 data208,238,173,056,003,133,252
  163. 385 data173,058,003,133,254,238,059
  164. 386 data003,174,059,003,224,002,208
  165. 387 data214,096,169,004,133,252,169
  166. 388 data192,133,254,169,216,141,056
  167. 389 data003,169,196,141,058,003,076
  168. 390 data060,003,169,192,133,252,169
  169. 391 data004,133,254,169,196,141,056
  170. 392 data003,169,216,141,058,003,076
  171. 393 data060,003,000,000,000
  172. 400 :
  173. 401 rem start
  174. 402 :
  175. 403 sub$="title":gosub10:sub$="setup":gosub10
  176. 408 sub$="help":gosub10:j9=1
  177. 412 jj=-1:sub$="deal":gosub1