home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 18 / 018.d81 / solitaire (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  6KB  |  236 lines
  1. 995 poke53280,0:poke53281,13
  2. 999 print"[147]"
  3. 1000 rem ******************************
  4. 1010 rem
  5. 1020 rem        s o l i t a i r e
  6. 1030 rem
  7. 1040 rem
  8. 1050 rem
  9. 1060 rem ******************************
  10. 1070 print"[144]shuffling cards for a game of solitaire!"
  11. 1090 print: print: print: print"   i'll be ready in a few seconds..."
  12. 1100 forx=1 to val(right$(ti$,2))
  13. 1110 r=rnd(1):next x
  14. 1120 dim f(7,18),s(4),d(52),s$(4):rb=1
  15. 1130 s$(1)="[211]":s$(2)="[218]":s$(3)="[193]":s$(4)="[216]"
  16. 1140 rem suit#1 = hearts
  17. 1150 rem suit#2 = diamonds
  18. 1160 rem suit#3 = spades
  19. 1170 rem suit#4 = clubs
  20. 1180 :
  21. 1190 forx=0 to 7: fory=0to18:f(x,y)=0:next y,x
  22. 1200 forx=0to4:s(x)=0:nextx
  23. 1210 forx=0to52:d(x)=0:nextx
  24. 1220 rem *** shuffle cards in deck
  25. 1230 forx=1to52
  26. 1240 r=int(rnd(1)*52+1): ifd(r)>0then1240
  27. 1250 d(r)=x:nextx
  28. 1260 rem *** deal cards into piles
  29. 1270 r=52:forx=1to7:fory=1tox
  30. 1280 f(x,y)=d(r)+100
  31. 1290 d(r)=0:r=r-1:nexty
  32. 1300 f(x,x)=f(x,x)-100:nextx
  33. 1310 rem *** display everything
  34. 1320 c=3:c2=3:gosub2730
  35. 1330 rem ***command input
  36. 1340 print"";
  37. 1360 l=3:gosub3080
  38. 1370 if s(1)+s(2)+s(3)+s(4)<>130then1390
  39. 1380 l=3:gosub3080
  40. 1385 l=1:gosub3060:print"[144]congratulations, y o u  w i n  !":goto1510
  41. 1390 print"[144]d=deck, row#1-7, c=card, q=quit";:poke198,0:wait198,1:getp$
  42. 1392 p=val(p$)
  43. 1400 if(p>7)or(p<0)then2360
  44. 1410 ifp>0then1840
  45. 1420 ifp$="c"thengosub2900:goto1340:rem next card
  46. 1430 ifp$<>"q"goto1550
  47. 1440 rem *** quitter!
  48. 1450 forx=1to7:fory=1to18
  49. 1460 iff(x,y)>100thenf(x,y)=f(x,y)-100
  50. 1470 nexty,x
  51. 1480 gosub2830
  52. 1490 l=3:gosub3080
  53. 1500 l=1:gosub3060:print"[144]sorry, better luck next time !!!"
  54. 1510 print"want to play again (y/n) ?"
  55. 1520 getp$:ifp$= "y"then goto  5000
  56. 1530 ifp$<>"n"then1520
  57. 1540 goto63000
  58. 1550 ifp$<>"d"goto2360
  59. 1560 rem *** from deck to ...
  60. 1570 if d(1)=0then2370
  61. 1580 v=d(c):s1=int((d(c)-1)/13)+1
  62. 1590 ifv>13thenv=v-13:goto1590
  63. 1600 l=1:gosub3060
  64. 1610 print"from deck to (a=aces, row#1-7)        ";:poke198,0:wait198,1:getr$
  65. 1620 ifr$<>"a"then1700
  66. 1630 rem *** deck to aces
  67. 1640 if s1<>(d(c)+12)/13then1670
  68. 1650 if s(s1)>0then2370
  69. 1660 goto1680
  70. 1670 ifd(c)<>s(s1)+1then2370
  71. 1680 s(s1)=d(c):x=s1:gosub2420:gosub3130:goto1340
  72. 1690 rem ***deck to row
  73. 1700 r=val(r$)
  74. 1710 y=1:if(r<1)or(r>7)then2360
  75. 1720 ify>18then2370
  76. 1730 if f(r,y)<>0theny=y+1:goto1720
  77. 1740 ify>1then1770
  78. 1750 ifv=13then1820
  79. 1760 goto2370
  80. 1770 v1=f(r,y-1)
  81. 1780 ifv1>13thenv1=v1-13:goto1780
  82. 1790 ifv<>v1-1then2370
  83. 1800 s2=int((f(r,y-1)-1)/26):s1=int((s1-1)/2)
  84. 1810 ifs1=s2then2370
  85. 1820 f(r,y)=d(c):gosub3180:gosub3130:gosub2830:goto1340
  86. 1830 rem ** from row to...
  87. 1840 y=0:iff(p,1)=0then2370
  88. 1850 rem *** single card in row?
  89. 1860 y=y+1: ify>18then2370
  90. 1870 y2=f(p,y): if y2>100then1860
  91. 1880 if f(p,y+1)<>0then1920
  92. 1890 if y2>13theny2=y2-13:goto1890
  93. 1900 goto2030
  94. 1910 rem *** from what card in row?
  95. 1920 l=1:gosub3060
  96. 1930 print"from row";p;"card (a,2-10,j,q,k)  "
  97. 1934 gety$:ify$=""then1934
  98. 1935 y1=val(y$)
  99. 1936 ify1=1theny1=10
  100. 1940 ify$="a"theny1=1
  101. 1950 ify$="j"theny1=11
  102. 1960 ify$="q"theny1=12
  103. 1970 ify$="k"theny1=13
  104. 1980 if(y1=0)or(y1>13)then2360
  105. 1990 ify>18then2370
  106. 2000 y2=f(p,y):ify2>100theny=y+1:goto1990
  107. 2010 if y2>13theny2=y2-13:goto2010
  108. 2020 if y1<>y2 then y=y+1:goto1990
  109. 2030 r=f(p,y):l=1:gosub3060
  110. 2040 print"from ";:gosub2520
  111. 2050 print"[144] row";p;"to (a=aces,row#1-7)";:poke198,0:wait198,1:geta$
  112. 2060 rem *** from row/card to ...
  113. 2070 s1=int((f(p,y)-1)/13)+1
  114. 2080 ifa$<>"a"then2180
  115. 2090 rem *** from row/card to aces
  116. 2100 if f(p,y+1)>0then2370
  117. 2110 ifs1<>(f(p,y)+12)/13then2140
  118. 2120 ifs(s1)>0then2370
  119. 2130 goto2150
  120. 2140 if f(p,y)<>s(s1)+1then2370
  121. 2150 s(s1)=f(p,y):f(p,y)=0:if f(p,y-1)>100thenf(p,y-1)=f(p,y-1)-100
  122. 2160 gosub3180:gosub2830:x=s1:gosub2420:goto1340
  123. 2170 rem *** from row/card to row
  124. 2180 q=val(a$)
  125. 2190 z=1:if(q<1)or(q>7)then2360
  126. 2200 ifz>18then2250
  127. 2210 iff(q,z)<>0thenz=z+1:goto2200
  128. 2220 ifz>1then2250
  129. 2230 ify2=13then2300
  130. 2240 goto2370
  131. 2250 v1=f(q,z-1)
  132. 2260 ifv1>13thenv1=v1-13:goto2260
  133. 2270 ify2<>v1-1then2370
  134. 2280 s2=int((f(q,z-1)-1)/26):s1=int((s1-1)/2)
  135. 2290 ifs1=s2then2370
  136. 2300 if f(p,y-1)>100thenf(p,y-1)=f(p,y-1)-100
  137. 2310 f(q,z)=f(p,y):f(p,y)=0
  138. 2320 y=y+1:z=z+1
  139. 2330 iff(p,y)<>0then2310
  140. 2340 gosub3180:gosub2830:ifrb=0thengosub3034
  141. 2345 goto1340
  142. 2350 rem *** errors!
  143. 2360 print:print"[145]          invalid response!          ":goto2380
  144. 2370 print:print"[145]         illegal play!               "
  145. 2380 t=ti
  146. 2390 if(ti-t)<50goto2390
  147. 2400 goto1340
  148. 2410 rem *** display aces
  149. 2420 print"";
  150. 2430 forx1=1tox:print"";:nextx1
  151. 2440 if(s(x)=0)and(x>2)thenprint"--";s$(x):return
  152. 2450 ifs(x)=0thenprint"[149]  ";s$(x);"[146][144]":return
  153. 2460 r=s(x):gosub2520:print:return
  154. 2470 rem *** display cards in piles
  155. 2480 r=f(x,y)
  156. 2490 if r=0thenprint"   ";:return
  157. 2500 ifr>100thenprint"[144][207][183][208]";:return
  158. 2510 rem *** print card
  159. 2520 r1=r
  160. 2525 print"";
  161. 2530 ifr1>13thenr1=r1-13:goto2530
  162. 2540 ifr<27thenprint"[149]";:goto2550
  163. 2545 print"[144]";
  164. 2550 on r1 goto 2570,2580,2590,2600,2610,2620
  165. 2560 on r1-6goto2630,2640,2650,2660,2670,2680,2690
  166. 2570 print" a";:goto2700
  167. 2580 print" 2";:goto2700
  168. 2590 print" 3";:goto2700
  169. 2600 print" 4";:goto2700
  170. 2610 print" 5";:goto2700
  171. 2620 print" 6";:goto2700
  172. 2630 print" 7";:goto2700
  173. 2640 print" 8";:goto2700
  174. 2650 print" 9";:goto2700
  175. 2660 print"10";:goto2700
  176. 2670 print" j";:goto2700
  177. 2680 print" q";:goto2700
  178. 2690 print" k";
  179. 2700 r9=int((r-1)/13)+1
  180. 2710 prints$(r9);"[146]";:return
  181. 2720 rem *** display aces & rows
  182. 2730 print"[147]rows  -1-  -2-  -3-  -4-  -5-  -6-  -7-"
  183. 2740 printchr$(17);chr$(17);chr$(192);chr$(192);chr$(192);chr$(192);chr$(238)
  184. 2750 print"aces";
  185. 2760 forxx=1to8:printchr$(221);chr$(17);chr$(157);:nextxx
  186. 2770 printchr$(221)
  187. 2780 printchr$(192);chr$(192);chr$(192);chr$(192);chr$(253)
  188. 2790 forx=1to4:gosub2420:nextx
  189. 2800 gosub2830
  190. 2810 goto2960
  191. 2820 rem *** update row display
  192. 2830 print"";
  193. 2840 fory=1to18
  194. 2850 y9=y-11:ify<12theny9=1
  195. 2860 printtab(4+((y9-1)*5));
  196. 2870 forx=y9to7:printspc(2);:gosub2480
  197. 2880 nextx:print:nexty:return
  198. 2890 rem *** next 3rd card in deck
  199. 2900 ifd(1)=0then2960
  200. 2910 x=0:fory=1to24:ifd(y)<>0thenx=x+1:nexty:ifflthenc=c2
  201. 2920 ifc=xthenc=3:goto2945
  202. 2930 c=c+3
  203. 2940 ifc>xthenc=c-1:goto2940
  204. 2945 c2=c:fl=0
  205. 2955 rem *** update deck display
  206. 2960 print"deck"
  207. 2980 print"                           ":rem 27 spaces
  208. 2990 print"[145]";
  209. 3000 ifd(1)=0thenprint"   ";:goto3020:rem  3 spaces in print
  210. 3010 r=d(c):gosub2520
  211. 3020 x=0:fory=1to24:ifd(y)<>0thenx=x+1:nexty
  212. 3030 printtab(10);"[144](";x;"cards left )"
  213. 3032 ifx<>0then3040
  214. 3034 rb=0:cr$="no":forzr=1to7:forzc=1to18
  215. 3036 iff(zr,zc)>100thencr$="yes"
  216. 3038 nextzc:nextzr:ifcr$="no"then1380
  217. 3040 return
  218. 3050 rem *** back up lines then clear
  219. 3060 forl1=1tol:print"[145]";:nextl1
  220. 3070 rem *** blank lines!
  221. 3080 forl1=1tol
  222. 3090 print"                                       ":rem 39 spaces
  223. 3100 nextl1
  224. 3110 forl1=1tol:print"[145]";:nextl1:return
  225. 3120 rem *** remove card from deck & disp
  226. 3130 forx=cto24:d(x)=d(x+1):nextx
  227. 3140 ifd(1)=0then3170
  228. 3145 ifflthenc2=c2-1
  229. 3150 c=c-1:ifnotflthenc2=c
  230. 3155 fl=-1
  231. 3160 ifc<1thenc=c2:gosub2900:return
  232. 3170 gosub2960:return
  233. 3180 print:print"please wait while i fix the cards !":return
  234. 5000 run
  235. 63000 load"payload connect",8
  236.