home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 92 / 092.d81 / klondike (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  8KB  |  247 lines
  1. 1 rem copyright 1991 by maurice jones
  2. 4 dimi,x,y,t2,fr,a$,bk$,bl$,ca,ch$,do,f,fc,fs,fv,j,jj,j%,k,k1,m,re,s$,s1,s2,s3
  3. 5 dimt,tc,te,ts,tv,v,va,z7,z9,s4,su,va$,vb$:ns=13:nc=52
  4. 6 deffns(x)=int(x/13):deffnv(x)=x-13*int(x/13)
  5. 8 jj=-1:dims(nc),x(12),y(12):fori=0tonc-1:s(i)=i:next:printchr$(142)
  6. 9 poke53272,31:poke198,0
  7. 10 goto500
  8. 19 rem choice
  9. 20 gosub62
  10. 21 fori=1tolen(ch$):ifa$=mid$(ch$,i,1)thenreturn
  11. 22 next: goto20
  12. 25 rem charge
  13. 26 a$="251331421502421502"
  14. 27 t=87:pokef+6,96:pokef+24,15
  15. 28 fori=1to18step3
  16. 29 pokef+1,val(mid$(a$,i,2)):pokef+4,33
  17. 30 forj=1tot*val(mid$(a$,i+2,1)):next
  18. 31 pokef+4,0:next:return
  19. 34 rem pick up
  20. 35 iffr=1then52
  21. 36 x=x(fr):y=24:gosub66:fori=1to17:print"    [145][157][157][157][157]";:next
  22. 38 iffr=2orc(fr+10)=0then42
  23. 40 x=x(fr):y=y(fr):gosub66:print"[145]";bk$
  24. 42 return
  25. 44 rem turn down card
  26. 45 do=10+fr:ifc(do)=0orfr=2orfr=1then52
  27. 47 ifc(do)<>1 then49
  28. 48 x=x(fr):y=y(fr):gosub66:print"[145]    ";
  29. 49 b(fr,1)=b(do,c(do)):c(fr)=1:c(do)=c(do)-1:i=fr:gosub200
  30. 52 return
  31. 58 x=10:y=24:gosub66:print"[151] please press a key [145][145][145]"
  32. 62 geta$:ifa$=""then70:return
  33. 66 poke211,x:poke214,y:sys58732:return
  34. 69 rem multitask
  35. 70 ifjj=nc-2thenjj=-1
  36. 71 jj=jj+1:j%=jj+int(rnd(0)*(nc-jj)):temp=s(jj):s(jj)=s(j%):s(j%)=temp:goto62
  37. 79 rem play to tab
  38. 80 x=x(t2):y=24:gosub66:fori=1to17:print"    [145][157][157][157][157]";:next
  39. 81 k=1: if c(t2)>7then90
  40. 82 k1=c(t2):i=t2:c(t2)=1:gosub200
  41. 84 ifk=k1then98
  42. 86 k=k+1:i=(t2):c(t2)=k:print"";:gosub202
  43. 88 goto84
  44. 90 gosub35
  45. 91 k1=c(t2):i=t2:c(t2)=1:gosub200:k=k1-6
  46. 92 ifk=k1thenreturn
  47. 94 k=k+1:c(t2)=k:print"";:gosub202
  48. 96 goto92
  49. 98 return
  50. 110 rem start up
  51. 111 dimva$(13),c(18),b(18,24),vb$(13),d(24):f=54272:fori=ftof+78:pokei,0:next
  52. 112 cr$="[216][203][202][201][200][199][198][197][196]&[195][194][217]":cs$="[204][215][214][213][212][211][210][209][208]'[207][206][205]"
  53. 115 s$(0)="[162]":s$(1)="[173]":s$(2)="[192]":s$(3)="[193]":co$(0)="[144]":co$(1)="":co$(2)=""
  54. 116 co$(3)="[144]":s1$(0)="[161]":s1$(1)="[218]":s1$(2)="[223]":s1$(3)="[176]"
  55. 119 fori=0to12:va$(i)=mid$(cr$,i+1,1):vb$(i)=mid$(cs$,i+1,1):next
  56. 120 ch$="12345678 fqschnb"
  57. 121 x=5:fori=2to8:x(i)=x:y(i)=8:x=x+5:next:x=16:fori=9to12:x(i)=x:y(i)=0:x=x+6
  58. 122 next:x(0)=0:y(0)=12:x(1)=0:y(1)=19
  59. 124 bk$="!##$[157][157][157][157]@[170][171]%[157][157][157][157]@[170][171]%[157][157][157][157]@[170][171]%[157][157][157][157]\++*[157][157][157][157][145][145][145][145][145]"
  60. 125 bl$="    [157][157][157][157]    [157][157][157][157]    [157][157][157][157]    [157][157][157][157]    [157][157][157][157][145][145][145][145][145]"
  61. 129 return
  62. 130 rem shuffle
  63. 131 ifjj=nc-2thenreturn
  64. 132 jj=jj+1:j%=jj+int(rnd(0)*(nc-jj)):temp=s(jj):s(jj)=s(j%):s(j%)=temp
  65. 133 ifjj<>nc-2then131
  66. 134 return
  67. 179 rem reprint from pile
  68. 180 k=1: if c(fr)>7then190
  69. 182 k1=c(fr):i=fr:c(fr)=1:gosub200
  70. 184 ifk=k1then198
  71. 186 k=k+1:i=(fr):c(fr)=k:print"";:gosub202
  72. 188 goto184
  73. 190 gosub35
  74. 191 k1=c(fr):i=fr:c(fr)=1:gosub200:k=k1-6
  75. 192 ifk=k1thenreturn
  76. 194 k=k+1:c(fr)=k:print"";:gosub202
  77. 196 goto192
  78. 198 return
  79. 199 rem print card or erase
  80. 200 x=x(i):y=y(i):gosub66
  81. 202 ca=b(i,c(i)):su=fns(ca):va=fnv(ca)
  82. 204 pokef+24,6:pokef+5,128:pokef+4,129:fort=1to50:next:pokef+4,128:pokef+5,0
  83. 206 pokef+24,0:pokef+24,15:pokef+4,129:pokef+4,128
  84. 208 ifc(i)<>0then220
  85. 214 rem erase card
  86. 216 printbl$;:return
  87. 220 printco$(su);va$(va);"[179][179][177][157][157][157][157]";s$(su);"[166][167][174][157][157][157][157][163][170][171][174][157][157][157][157][163][168][169]";s1$(su);
  88. 222 print"[157][157][157][157][180][178][178]";vb$(va);"[145][145][145][145][145][157][157][157][157]";:return
  89. 249 rem print back
  90. 250 x=x(i):y=y(i):gosub66
  91. 251 ifz8=1then258
  92. 252 pokef+24,6:pokef+5,128:pokef+4,129:fort=1to50:next:pokef+4,128:pokef+5,0
  93. 254 pokef+24,0:pokef+24,15:pokef+4,129:pokef+4,128:ifz9=1then return
  94. 258 printbk$:return
  95. 500 bg=1:poke53280,bg:poke53281,bg:print"[147]"
  96. 501 fori=0to4:print"[144]                                    ":next
  97. 502 print"[145][145][145][145][176][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][174]"
  98. 503 print"[221] k l o n d i k e   1 9 9 2 [255]"
  99. 504 print"[173][196][196][196][196][196][196][196][196][196][196][196][196][196][196][196][196][196][196][196][196][196][196][196][196][196][196][196][189]"
  100. 505 print"[151]       a maurice jones solitaire":gosub111:gosub131:gosub26
  101. 506 print"[147]":fori=1to18:c(i)=0:next:re=1
  102. 507 print"[144]klondike 1992":print:print" h-help         f      f      f      f"
  103. 508 print" deal 1[157]2    3    4    5    6    7    8"
  104. 510 print" 1"
  105. 514 k=0:fori=2to8:b(i,1)=s(k):k=k+1:c(i)=1:   next:fori=2to8:gosub200
  106. 516 form=i+1to8:y=7:x=x(m):gosub66:gosub252:next:z9=1:next
  107. 517 fori=3to8:forj=1toi-2:c(i+10)=j:b(i+10,j)=s(k):k=k+1:next:next
  108. 518 fori=1to24:d(i)=s(k):k=k+1:next:c(0)=24
  109. 520 i=0:z9=0:gosub250:x=0:y=10:gosub66
  110. 522 x=0:y=10:gosub66:print"[156]from[157][157][157][157]";:gosub20
  111. 529 onigoto660,700,700,700,700,700,700,700,600,522,900,1100,1200,1300,870,1400
  112. 537 rem to pile
  113. 538 x=0:y=10:gosub66:print"[156] to [157][157][157][157]";:gosub20
  114. 545 onigoto522,710,710,710,710,710,710,710,600,780,900,1100,1200,1300,870
  115. 599 rem turn card
  116. 600 ifc(0)=0andc(1)=0then522
  117. 601 ifc(0)=0then640
  118. 602 c(1)=c(1)+1:b(1,c(1))=d(c(0)):c(0)=c(0)-1:i=1:ifc(0)=0then 610
  119. 604 i=1:gosub200:goto522
  120. 610 i=0:gosub200:goto604
  121. 640 re=re+1:x=5:y=4:gosub66:print"[156]";re
  122. 650 x=c(1):fori=1tox:d(x)=b(1,i):x=x-1:next:c(0)=c(1):c(1)=0:i=1:gosub200
  123. 652 z8=1:i=0:gosub250:z8=0:goto522
  124. 660 ifc(i)=0then522
  125. 662 iffnv(b(i,c(i)))<>0then700
  126. 664 fc=b(1,c(1)):c(1)=c(1)-1:gosub200:i=12-fns(fc):c(i)=1:b(i,1)=fc:gosub200
  127. 668 goto522
  128. 699 rem from pile
  129. 700 ifc(i)=0then522
  130. 702 fr=i:iffnv(b(i,c(i)))<>0then708
  131. 704 fc=b(i,c(i)):gosub35:i=12-fns(fc):c(i)=1:c(fr)=c(fr)-1:b(i,1)=fc:gosub200
  132. 706 gosub45:goto522
  133. 708 fr=i:fc=b(i,1):fs=fns(fc):fv=fnv(fc):goto538
  134. 709 rem play to tab
  135. 710 t2=i:tc=b(i,c(i)):ts=fns(tc):tv=fnv(tc):iffr<>1then740
  136. 712 fc=b(fr,c(fr)):fv=fnv(fc):fs=fns(fc):ifc(t2)<>0then722
  137. 716 iffv<>12then522
  138. 718 c(1)=c(1)-1:i=1:gosub200:c(t2)=1:b(t2,1)=fc:i=t2:gosub200:goto522
  139. 722 ifco$(fs)=co$(ts)orfv+1<>tvthen522
  140. 724 c(1)=c(1)-1:i=1:gosub200:c(t2)=c(t2)+1:b(t2,c(t2))=fc:gosub80:goto522
  141. 739 rem tab to tab
  142. 740 ifc(t2)<>0then754
  143. 744 iffv<>12then522
  144. 746 ifc(t2)>7then756
  145. 748 gosub35:fori=1toc(fr):c(t2)=c(t2)+1:b(t2,c(t2))=b(fr,i):next:c(fr)=0
  146. 750 gosub80:gosub45:goto522
  147. 751 ifc(t2)>7thengosub35:gosub90:gosub45:goto522
  148. 752 gosub80:gosub45:goto522
  149. 754 ifco$(fs)=co$(ts)orfv+1<>tvthen522
  150. 756 gosub35:goto748
  151. 779 rem play to f
  152. 780 fc=b(fr,c(fr)):fv=fnv(fc):fs=fns(fc):ifc(12-fs)=0then522
  153. 781 iffnv(b(12-fs,c(12-fs)))+1<>fvthen522
  154. 782 iffr=1then840
  155. 790 gosub35:i=12-fs:c(i)=c(i)+1:b(i,c(i))=fc:gosub200:c(fr)=c(fr)-1
  156. 800 ifc(fr)>0then830
  157. 810 gosub45
  158. 820 ifc(fr)=0then850
  159. 830 gosub180:goto850
  160. 840 c(1)=c(1)-1:i=1:gosub200:i=12-fs:c(i)=c(i)+1:b(i,c(i))=fc:gosub200
  161. 850 k=0:fori=9to12:k=k+c(i):next:ifk<>52then522
  162. 860 gosub58:goto900
  163. 870 sys886:fori=3to8:x=x(i):y=y(i):gosub66
  164. 874 ifc(i+10)=0then880
  165. 876 print"[145][145]";c(i+10)
  166. 880 next:gosub58:sys907:goto522
  167. 899 rem quit
  168. 900 sys886:print"[147][159]":poke53280,0:poke53281,0 :ifz7=1then903
  169. 902 x=10:y=5:s1=0:gosub66:fori=9to12:s1=s1+5*c(i):next:s1=s1-50
  170. 903 s2=s2+1:s3=s3+s1
  171. 904 s4=int(s3/s2+.5):z7=0
  172. 905 print"[147]": poke53280,0:poke53281,0:ifs1<>210then910
  173. 906 printtab(6) "[158][213][192][192][192][192][192][192][192][192][192][192][192][192][192][192][201]"
  174. 907 print tab(6)"[221] perfect game [221]"
  175. 908 print tab(6)"[202][192][192][192][192][192][192][192][192][192][192][192][192][192][192][203]"
  176. 910 printtab(08)"[156]klondike scoreboard     ":print
  177. 912 printtab(08)"[159]  game score    "s1"       ":print
  178. 914 printtab(08)"  session score   "s3"    ":print
  179. 916 printtab(08)"  average score   "s4"    "
  180. 1002 x=18:y=16:gosub66:print"[158][213][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][201]"
  181. 1006 x=18:y=17:gosub66:print"[158][221] 1.new game        [221]"
  182. 1008 x=18:y=18:gosub66:print"[158][221] 2.inspect tableau [221]"
  183. 1010 x=18:y=19:gosub66:print"[158][221] 3.to loadstar     [221]"
  184. 1012 x=18:y