home *** CD-ROM | disk | FTP | other *** search
/ Compute! Gazette 1986 May / 1986-05.d64 / klondike (.txt) < prev    next >
Commodore BASIC  |  2022-09-20  |  5KB  |  163 lines
  1. 10 print"[147]":poke53280,5:poke53281,5:ifpeek(14850)<>24thengosub2000
  2. 20 dn$="":ov$=""
  3. 30 bk$="[211][209][210][212][157][157][157][157][213][187][188][214]":bl$="    [157][157][157][157]    ":poke53272,31
  4. 40 b2$="                             "
  5. 50 dim cd$(52):c$(0)="":c$(1)="[144]":c$(2)="":c$(3)="[144]":cd$(0)=bl$
  6. 60 forx=0to3:fory=1to13
  7. 70 cd$(x*13+y)=c$(x)+"[211]"+chr$(95+y)+chr$(109+x)+"[212][157][157][157][157][213]"+chr$(173+x)+chr$(159+y)+"[214]"
  8. 80 nexty,x
  9. 90 dimdk(52),st(24),ly(7,20),uc(7),tp(7):forx=1to52:dk(x)=x:next
  10. 100 deffnr(z)=int(52*rnd(z))+1
  11. 110 deffnsu(x)=int(x/13.1)+1:deffnvl(x)=x-13*(fnsu(x)-1)
  12. 120 deffnsc(x)=(x/2=int(x/2)):gosub1190
  13. 125 iftt<=0thentt=500
  14. 130 bt=int((tt+51)/52)
  15. 140 gosub710:gosub720
  16. 150 print"[147] #1  #2  #3  #4  #5  #6  #7[144]pile"
  17. 160 printov$"[144]f2-end game":printov$"[144]f8-quit"
  18. 170 print"[144]deck  [144]stack   total":print"bet"
  19. 180 print"from       to";
  20. 190 print""ov$"hearts[157][157][157][157][157][157][144]spades[157][157][157][157][157][157]diamonds[157][157][157][157][157][157][157][157][144]";
  21. 200 print"clubs":nb=-1:gosub940:nb=0
  22. 210 forx=1to7:print""left$(dn$,x)left$(ov$,x*4-4);:fory=xto7:ify=xthen230
  23. 220 printbk$"[145]";:goto240
  24. 230 printcd$(ly(x,x))"[145]";
  25. 240 nexty:nextx
  26. 250 print""ov$"";:forx=1to4:printbk$"[157][157][157][157]";:next:print
  27. 260 gosub740
  28. 270 gosub760:ifquthen1240
  29. 280 print"[145][145][145][145][145]":forx=1to5:printb2$:next:tt=tt-52*bg:gosub940
  30. 290 rem *** main loop
  31. 300 gw=0:gm=-1:m1=1
  32. 310 ed=0:gosub960:ifedthenprint"[147]":goto125
  33. 320 ifquthen1240
  34. 330 ifgwthen1160
  35. 340 gm=0:gosub350:goto310
  36. 350 ifm1>-1then380
  37. 360 ifdp=0thenreturn
  38. 370 sp=sp+1:st(sp)=dk(dp):dp=dp-1:print""dn$"[145][145]";:gosub740:gm=-1:return
  39. 380 ifm1=0thenc1=st(sp):c3=c1:goto400
  40. 390 c1=ly(m1,uc(m1)+1):c3=ly(m1,tp(m1))
  41. 400 ifm2>-1then600
  42. 410 ifc3=0thenreturn
  43. 420 s3=fnsu(c3):v3=fnvl(c3):ifv3-1<>pl(s3)thenreturn
  44. 430 ifnotamthen510
  45. 440 bm=0:forx=1to4:iffnsc(x)=fnsc(s3)then460
  46. 450 ifv3>pl(x)+2thenbm=-1
  47. 460 next:if(m1>0)or(v3<3)then500
  48. 470 forx=1to7:c4=ly(x,uc(x)+1):v4=fnvl(c4):ifv4<>v3-1then490
  49. 480 iffnsc(s3)<>fnsc(fnsu(c4))thenbm=-1
  50. 490 next
  51. 500 ifbmthenreturn
  52. 510 ifm1=0then570
  53. 520 c=m1:gosub1150:iftp(m1)=1thenprintbl$:tp(m1)=0:goto580
  54. 530 iftp(m1)=1thenprintbl$:tp(m1)=0:goto560
  55. 540 tp(m1)=tp(m1)-1:printbl$"[157][157][157][157][145][145]"cd$(ly(m1,tp(m1)));
  56. 550 iftp(m1)=uc(m1)thenuc(m1)=uc(m1)-1
  57. 560 goto580
  58. 570 gosub1170
  59. 580 print""ov$left$(dn$,s3*4-3)cd$(c3):pl(s3)=v3:tt=tt+5*bg:mu=-1
  60. 590 gosub940:tq=0:forq=1to4:tq=tq+pl(q):next:gw=(tq=52):gm=-1:return
  61. 600 c2=ly(m2,tp(m2)):s1=fnsc(fnsu(c1)):s2=fnsc(fnsu(c2))
  62. 610 v1=fnvl(c1):v2=fnvl(c2):if(v1=13)and(v2=0)then630
  63. 620 if(s1=s2)or(v1+1<>v2)thenreturn
  64. 630 ifm1>0then650
  65. 640 gosub1170:ly(m2,tp(m2)+1)=c1:nc=1:goto690
  66. 650 nc=tp(m1)-uc(m1):c=m1:print""left$(dn$,uc(c)+1)left$(ov$,c*4-4);
  67. 660 forx=1tonc:printbl$"[157][157][157][157]";:ly(m2,tp(m2)+x)=ly(m1,uc(m1)+x):next
  68. 670 tp(m1)=uc(m1):uc(m1)=uc(m1)-1-(uc(m1)=0)
  69. 680 iftp(m1)>0thengosub1150:printcd$(ly(m1,tp(m1)));
  70. 690 c=m2:gosub1150:print"";:forx=1tonc:printcd$(ly(m2,tp(m2)+x))"[157][157][157][157]";:next
  71. 700 tp(m2)=tp(m2)+nc:gm=-1:return
  72. 710 forx=1to52:a=fnr(0):s=dk(a):dk(a)=dk(x):dk(x)=s:next:dp=52:return
  73. 720 forx=1to7:fory=xto7:ly(y,x)=dk(dp):dp=dp-1:nexty:tp(x)=x:uc(x)=x-1:nextx
  74. 730 st(1)=dk(dp):dp=dp-1:sp=1:forx=1to4:pl(x)=0:next:return
  75. 740 print""dn$"[145]"bk$"[145]"cd$(st(sp))
  76. 750 print""dp"[157] ";tab(6)sp"[157] ";:return
  77. 760 print" please enter your bet"
  78. 770 print" maximum bet =[144]"bt
  79. 780 print" press [144]f1 to bet it all"
  80. 790 print" press [144]f7 to re-shuffle"
  81. 800 print" ->        [157][157][157][157][157][157][157][144][185][157]";:n=0:bg=0:b$=""
  82. 810 geta$:ifa$=""then810
  83. 820 if(a$=chr$(133))and(n=0)thenbg=bt:return
  84. 830 if(a$=chr$(136))and(n=0)then910
  85. 840 if(a$=chr$(140))and(n=0)thenqu=-1:return
  86. 850 ifa$<>chr$(13)then880
  87. 860 bg=val(b$):ifnot((bg=0)or(bg>bt))thenreturn
  88. 870 print:print"[145]            ":goto760
  89. 880 if(a$<":")and(a$>"/")and(n<11)thenb$=b$+a$:n=n+1:printa$"[185][157]";:goto810
  90. 890 if(a$=chr$(20))and(n>0)thenn=n-1:print" [157][157][185][157]";:b$=mid$(b$,1,n)
  91. 900 goto810
  92. 910 print"working":gosub710:gosub720
  93. 920 print"";:forx=1to7:printcd$(ly(x,x));:next
  94. 930 print:print""cd$(st(sp)):goto760
  95. 940 print"[144]"dn$tab(19)tt"[157] ":ifnbthenreturn
  96. 950 printtab(19)bg:return
  97. 960 ifnotgmthen1010
  98. 970 am=-1:m2=-1:ifm1>0thenmu=0:forz=1to7:m1=z:gosub350:next
  99. 980 m1=0:gosub350
  100. 990 ifmuthenm1=1:goto970
  101. 1000 am=0:ifgwthenreturn
  102. 1010 print"[144]"dn$"          [157][157][157][157][157][157][157][157][157][157][157][157][157][157]";
  103. 1020 geta$:ifa$=""then1020
  104. 1030 if(a$>"0")and(a$<"8")thenm1=val(a$):printa$"";:goto1090
  105. 1040 ifa$=chr$(137)thened=-1:return
  106. 1050 ifa$="d"thenm1=-1:print"deck";:return
  107. 1060 ifa$="s"thenm1=0:print"stack";:goto1090
  108. 1070 ifa$=chr$(140)thenqu=-1:return
  109. 1080 goto1020
  110. 1090 geta$:ifa$=""then1090
  111. 1100 if(a$>"0")and(a$<"8")thenm2=val(a$):printa$;:return
  112. 1110 if(a$="p")or(a$="f")thenm2=-1:print"pile";:return
  113. 1120 goto1010
  114. 1150 print""left$(dn$,tp(c))left$(ov$,c*4-4);:return
  115. 1160 tt=tt+740*bg:print"[147]you won!":goto130
  116. 1170 sp=sp-1:ifsp=0anddp>0thensp=1:st(sp)=dk(dp):dp=dp-1
  117. 1180 gosub740:return
  118. 1190 input"[147][144]enter your name ";n$
  119. 1200 f$="@0:"+n$+".money,s,":open2,8,2,f$+"r"
  120. 1210 input#2,tt:close2
  121. 1220 open2,8,2,f$+"w"
  122. 1230 print#2,0:close2:return
  123. 1240 open2,8,2,f$+"w":print#2,tt:close2
  124. 1250 print"[147][144]goodbye..."
  125. 1260 end
  126. 2000 forx=828to885:reada:pokex,a:next:sys828
  127. 2010 forx=0to16:b=14848+x*8:c=15104+x*8:fory=2to7:reada
  128. 2020 pokeb+y,a:ifx>12thena=a/2
  129. 2030 pokec+y-1+(x>12),a:nexty
  130. 2040 pokeb,255:pokec+7,255:pokeb+1,0:pokec-6*(x>12),0:nextx
  131. 2050 forx=14984to15031:reada:pokex,a:next
  132. 2060 forx=15320to15335:reada:pokex,a:next
  133. 2070 return
  134. 2080 data169,0,141,14,220,169,51,133,1,169,0,133,251,133,253,169
  135. 2090 data208,133,252,169,56,133,254,160,0,177,251,145
  136. 2100 data253,230,251,230,253,208,246,165,252,201,215,240,7,230,252,230
  137. 2110 data254,76,85,3,169,55,133,1,169,129,141,14,220,96
  138. 2120 data 24,60,102,126,102,0
  139. 2130 data 60,102,12,48,126,0
  140. 2140 data 60,102,12,102,60,0
  141. 2150 data 102,102,126,6,6,0
  142. 2160 data 126,96,124,6,124,0
  143. 2170 data 60,96,124,102,60,0
  144. 2180 data 126,6,12,24,24,0
  145. 2190 data 60,102,60,102,60,0
  146. 2200 data 60,102,62,6,60,0
  147. 2210 data 126,24,24,24,24,0
  148. 2220 data 30,12,12,108,56,0
  149. 2230 data 60,102,102,60,14,0
  150. 2240 data 102,108,120,108,102,0
  151. 2250 data 108,254,254,124,56,16
  152. 2260 data 16,56,124,254,56,124
  153. 2270 data 24,60,126,126,60,24
  154. 2280 data 56,56,254,254,56,124
  155. 2290 data 255,51,102,204,153,51,102,204
  156. 2300 data 255,204,102,51,153,204,102,51
  157. 2310 data 0,3,3,3,3,3,3,3
  158. 2320 data 0,192,192,192,192,192,192,192
  159. 2330 data 3,3,3,3,3,3,3,0
  160. 2340 data 192,192,192,192,192,192,192,0
  161. 2350 data 204,102,51,153,204,102,51,255
  162. 2360 data 51,102,204,153,51,102,204,255
  163.