home *** CD-ROM | disk | FTP | other *** search
/ 8bitfiles.net/archives / archives.tar / archives / commodore-users-of-norman / CUON_13_(11-1984).d64 / solitaire (.txt) < prev    next >
Commodore BASIC  |  2019-04-13  |  5KB  |  219 lines
  1. 0 PRINTCHR$(142)
  2. 1 REM *****************************
  3. 2 REM
  4. 3 REM         S O L I T A I R E
  5. 4 REM
  6. 5 REM  BY: ROBERT BAKER, ATCO, NJ
  7. 6 REM
  8. 7 REM *****************************
  9. 8 REM FROM POWER/PLAY, FALL 1983,    P. 107-111
  10. 9 PRINT"[147]SHUFFLING CARDS FOR A GAME OF SOLITAIRE!"
  11. 10 PRINT:PRINT:PRINT:PRINT"    I'LL BE READY IN A FEW SECONDS"
  12. 11 FORX=1TOVAL(RIGHT$(TI$,2))
  13. 12 R=RND(1):NEXTX
  14. 13 DIMF(7,18),S(4),D(52),S$(4)
  15. 14 S$(1)="[211]":S$(2)="[218]":S$(3)="[193]":S$(4)="[216]"
  16. 15 REM SUIT#1=HEARTS
  17. 16 REM SUIT#2=DIAMONDS
  18. 17 REM SUIT#3=SPADES
  19. 18 REM SUIT#4=CLUBS
  20. 19 QM$="  ?"+CHR$(157)+CHR$(157)+CHR$(157)
  21. 20 FORX=0TO7:FORY=0TO18:F(X,Y)=0:NEXTY,X
  22. 21 FORX=0TO4:S(X)=0:NEXTX
  23. 22 FORX=0TO52:D(X)=0:NEXTX
  24. 23 REM *** SHUFFLE CARDS IN DECK
  25. 24 FORX=1TO52
  26. 25 R=INT(RND(1)*52+1):IFD(R)>0THEN25
  27. 26 D(R)=X:NEXTX
  28. 27 REM *** DEAL CARDS INTO PILES
  29. 28 R=52:FORX=1TO7:FORY=1TOX
  30. 29 F(X,Y)=D(R)+100
  31. 30 D(R)=0:R=R-1:NEXTY
  32. 31 F(X,X)=F(X,X)-100:NEXTX
  33. 32 REM *** DISPLAY EVERYTHING
  34. 33 C=3:GOSUB173
  35. 34 REM *** COMMAND INPUT
  36. 35 PRINT"";
  37. 36 L=3:GOSUB207
  38. 37 IFS(1)+S(2)+S(3)+S(4)<>130THEN39
  39. 38 PRINT"CONGRATULATIONS,  Y O U   W I N   !":GOTO51
  40. 39 PRINT"D=DECK,ROW#1-7,C=CARD,Q=QUIT; PLAY=";QM$;:INPUTP$:P=VAL(P$)
  41. 40 IF(P>7)OR(P<0)THEN136
  42. 41 IFP>0THEN84
  43. 42 IFP$="C"THENGOSUB190:GOTO35:REM NEXT CARD
  44. 43 IFP$<>"Q"THEN55
  45. 44 REM *** QUITTER!
  46. 45 FORX=1TO7:FORY=1TO18
  47. 46 IFF(X,Y)>100THENF(X,Y)=F(X,Y)-100
  48. 47 NEXTY,X
  49. 48 GOSUB183
  50. 49 L=3:GOSUB207
  51. 50 PRINT"SORRY, BETTER LUCK NEXT TIME !!!"
  52. 51 PRINT"WANT TO PLAY AGAIN (Y/N) ? "
  53. 52 GETP$:IFP$="Y"THENRUN
  54. 53 IFP$<>"N"THEN52
  55. 54 END
  56. 55 IFP$<>"D"THEN136
  57. 56 REM *** FROM DECK TO ...
  58. 57 IFD(1)=0THEN137
  59. 58 V=D(C):S1=INT((D(C)-1)/13)+1
  60. 59 IFV>13THENV=V-13:GOTO59
  61. 60 L=1:GOSUB205
  62. 61 PRINT"FROM DECK TO (A=ACES, ROW#1-7)";QM$;:INPUTR$
  63. 62 IFR$<>"A"THEN70
  64. 63 REM *** DECK TO ACES
  65. 64 IFS1<>(D(C)+12)/13THEN67
  66. 65 IFS(S1)>0THEN137
  67. 66 GOTO68
  68. 67 IFD(C)<>S(S1)+1THEN137
  69. 68 S(S1)=D(C):X=S1:GOSUB142:GOSUB212:GOTO35
  70. 69 REM *** DECK TO ROW
  71. 70 R=VAL(R$)
  72. 71 Y=1:IF(R<1)OR(R>7)THEN136
  73. 72 IFY>18THEN137
  74. 73 IFF(R,Y)<>0THENY=Y+1:GOTO72
  75. 74 IFY>1THEN77
  76. 75 IFV=13THEN82
  77. 76 GOTO137
  78. 77 V1=F(R,Y-1)
  79. 78 IFV1>13THENV1=V1-13:GOTO78
  80. 79 IFV<>V1-1THEN137
  81. 80 S2=INT((F(R,Y-1)-1)/26):S1=INT((S1-1)/2)
  82. 81 IFS1=S2THEN137
  83. 82 F(R,Y)=D(C):GOSUB217:GOSUB212:GOSUB183:GOTO35
  84. 83 REM *** FROM ROW TO ...
  85. 84 Y=0:IFF(P,1)=0THEN137
  86. 85 REM *** SINGLE CARD IN ROW?
  87. 86 Y=Y+1:IFY>18THEN137
  88. 87 Y2=F(P,Y):IFY2>100THEN86
  89. 88 IFF(P,Y+1)<>0THEN92
  90. 89 IFY2>13THENY2=Y2-13:GOTO89
  91. 90 GOTO103
  92. 91 REM *** FROM WHAT CARD IN ROW?
  93. 92 L=1:GOSUB205
  94. 93 PRINT"FROM ROW";P;"CARD (A,2-10,J,Q,K)";QM$;:INPUTY$:Y1=VAL(Y$)
  95. 94 IFY$="A"THENY1=1
  96. 95 IFY$="J"THENY1=11
  97. 96 IFY$="Q"THENY1=12
  98. 97 IFY$="K"THENY1=13
  99. 98 IF(Y1=0)OR(Y1>13)THEN136
  100. 99 IFY>18THEN137
  101. 100 Y2=F(P,Y):IFY2>100THENY=Y+1:GOTO99
  102. 101 IFY2>13THENY2=Y2-13:GOTO101
  103. 102 IFY1<>Y2THENY=Y+1:GOTO99
  104. 103 R=F(P,Y):L=1:GOSUB205
  105. 104 PRINT"FROM ";:GOSUB152
  106. 105 PRINT" ROW";P;"TO (A=ACES,ROW#1-7)";QM$;:INPUTA$
  107. 106 REM ***FROM ROW/CARD TO ...
  108. 107 S1=INT((F(P,Y)-1)/13)+1
  109. 108 IFA$<>"A"THEN118
  110. 109 REM *** FROM ROW/CARD TO ACES
  111. 110 IFF(P,Y+1)>0THEN137
  112. 111 IFS1<>(F(P,Y)+12)/13THEN114
  113. 112 IFS(S1)>0THEN137
  114. 113 GOTO115
  115. 114 IFF(P,Y)<>S(S1)+1THEN137
  116. 115 S(S1)=F(P,Y):F(P,Y)=0:IFF(P,Y-1)>100THENF(P,Y-1)=F(P,Y-1)-100
  117. 116 GOSUB217:GOSUB183:X=S1:GOSUB142:GOTO35
  118. 117 REM *** FROM ROW/CARD TO ROW
  119. 118 Q=VAL(A$)
  120. 119 Z=1:IF(Q<1)OR(Q>7)THEN136
  121. 120 IFZ>18THEN137
  122. 121 IFF(Q,Z)<>0THENZ=Z+1:GOTO120
  123. 122 IFZ>1THEN125
  124. 123 IFY2=13THEN130
  125. 124 GOTO137
  126. 125 V1=F(Q,Z-1)
  127. 126 IFV1>13THENV1=V1-13:GOTO126
  128. 127 IFY2<>V1-1THEN137
  129. 128 S2=INT((F(Q,Z-1)-1)/26):S1=INT((S1-1)/2)
  130. 129 IFS1=S2THEN137
  131. 130 IFF(P,Y-1)>100THENF(P,Y-1)=F(P,Y-1)-100
  132. 131 F(Q,Z)=F(P,Y):F(P,Y)=0
  133. 132 Y=Y+1:Z=Z+1
  134. 133 IFF(P,Y)<>0THEN131
  135. 134 GOSUB217:GOSUB183:GOTO35
  136. 135 REM *** ERRORS!
  137. 136 PRINT"INVALID RESPONSE!":GOTO138
  138. 137 PRINT"ILLEGAL PLAY!"
  139. 138 T=TI
  140. 139 IF(TI-T)<50THEN139
  141. 140 GOTO35
  142. 141 REM *** DISPLAY ACES
  143. 142 PRINT"";
  144. 143 FORX1=1TOX:PRINT"";:NEXTX1
  145. 144 IF(S(X)=0)AND(X>2)THENPRINT"--";S$(X):RETURN
  146. 145 IFS(X)=0THENPRINT"  ";S$(X);"[146]":RETURN
  147. 146 R=S(X):GOSUB152:PRINT:RETURN
  148. 147 REM *** DISPLAY CARDS IN PILES
  149. 148 R=F(X,Y)
  150. 149 IFR=0THENPRINT"   ";:RETURN
  151. 150 IFR>100THENPRINT"XXX";:RETURN
  152. 151 REM *** PRINT CARD
  153. 152 R1=R
  154. 153 IFR1>13THENR1=R1-13:GOTO153
  155. 154 IFR<27THENPRINT"";
  156. 155 ONR1GOTO157,158,159,160,161,162
  157. 156 ONR1-6GOTO163,164,165,166,167,168,169
  158. 157 PRINT" A";:GOTO170
  159. 158 PRINT" 2";:GOTO170
  160. 159 PRINT" 3";:GOTO170
  161. 160 PRINT" 4";:GOTO170
  162. 161 PRINT" 5";:GOTO170
  163. 162 PRINT" 6";:GOTO170
  164. 163 PRINT" 7";:GOTO170
  165. 164 PRINT" 8";:GOTO170
  166. 165 PRINT" 9";:GOTO170
  167. 166 PRINT"10";:GOTO170
  168. 167 PRINT" J";:GOTO170
  169. 168 PRINT" Q";:GOTO170
  170. 169 PRINT" K";
  171. 170 R9=INT((R-1)/13)+1
  172. 171 PRINTS$(R9);"[146]";:RETURN
  173. 172 REM *** DISPLAY ACES AND ROWS
  174. 173 PRINT"[147]ROWS  -1-  -2-  -3-  -4-  -5-  -6-  -7-"
  175. 174 PRINTCHR$(17);CHR$(17);CHR$(192);CHR$(192);CHR$(192);CHR$(192);CHR$(238)
  176. 175 PRINT"ACES";
  177. 176 FORXX=1TO8:PRINTCHR$(221);CHR$(17);CHR$(157);:NEXTXX
  178. 177 PRINTCHR$(221)
  179. 178 PRINTCHR$(192);CHR$(192);CHR$(192);CHR$(192);CHR$(253)
  180. 179 FORX=1TO4:GOSUB142:NEXTX
  181. 180 GOSUB183
  182. 181 GOTO196
  183. 182 REM *** UPDATE ROW DISPLAY
  184. 183 PRINT"";
  185. 184 FORY=1TO18
  186. 185 Y9=Y-11:IFY<12THENY9=1
  187. 186 PRINTTAB(4+((Y9-1)*5));
  188. 187 FORX=Y9TO7:PRINTSPC(2);:GOSUB148
  189. 188 NEXTX:PRINT:NEXTY:RETURN
  190. 189 REM *** NEXT 3RD CARD IN DECK
  191. 190 IFD(1)=0THEN196
  192. 191 C=C+3
  193. 192 IFC>24THENC=3
  194. 193 IFD(C)+D(C-1)+D(C-2)=0THENC=3
  195. 194 IFD(C)=0THENC=C-1:GOTO194
  196. 195 REM *** UPDATE DECK DISPLAY
  197. 196 PRINT"DECK"
  198. 197 PRINT"                           ":REM 27 SPACES
  199. 198 PRINT"[145]";
  200. 199 IFD(1)=0THENPRINT"   ";:GOTO201
  201. 200 R=D(C):GOSUB152
  202. 201 X=0:FORY=1TO24:IFD(Y)<>0THENX=X+1:NEXTY
  203. 202 PRINTTAB(10);"(";X;"CARDS LEFT )"
  204. 203 RETURN
  205. 204 REM *** BACK UP LINES THEN CLEAR
  206. 205 FORL1=1TOL:PRINT"[145]";:NEXTL1
  207. 206 REM *** BLANK LINES!
  208. 207 FORL1=1TOL
  209. 208 PRINT"                                       ":REM 39 SPACES
  210. 209 NEXTL1
  211. 210 FORL1=1TOL:PRINT"[145]";:NEXTL1:RETURN
  212. 211 REM *** REMOVE CARD FROM DECK &    DISPLAY
  213. 212 FORX=CTO24:D(X)=D(X+1):NEXTX
  214. 213 IFD(1)=0THEN216
  215. 214 C=C-1:IFC<1THENC=3
  216. 215 IFD(C)=0THENC=C-1:GOTO215
  217. 216 GOSUB196:RETURN
  218. 217 PRINT"PLEASE WAIT WHILE I FIX THE CARDS !":RETURN
  219.