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