5 CLS:MC=16384
7 DIM S(4),N(13),D(52),P(8),PT(8),C(8,52),C$(3,4)
8 DIM PS(8),CT(8)
9 DIMKS(4)
10 DATA 32,128,128,128
20 DATA 1,50,51,52,53,54,55,56,57,20,10,17,11
25 FORX=1TO7:PT(X)=X:NEXTX
30 FORX=1TO4:READS(X):NEXTX
35 CLS:GOSUB7000:GOSUB5000
40 FORX=1TO13:READN(X):NEXTX
50 BL$=CHR$(128)+CHR$(128)+CHR$(128)+CHR$(128)
60 L=194:KK=0:FORK=1TO7:GOSUB1000:GOSUB450:NEXTK
65 PRINT@448,"   <1> <2> <3> <4> <5> <6> <7>"
70 FORK=1TO7:C=C(K,0):TT=PT(K):GOSUB500:NEXTK
75 K=8:FORKK=1TO24:GOSUB1000:GOSUB450:NEXTKK
80 L=66:GOSUB3100
85 PRINT@0,  "  <SP> <8>          <ENTER>";
90 MP=23
95 GOTO200
100 IFR$=" "ORFL=1THEN120
105 L=194:FORK=1TO7:IF K=LC OR K=DC THENC=C(K,0):TT=PT(K):GOSUB500:GOTO107
106 L=L+4
107 NEXTK
110 L=290
112 FORK=1TO7
114 IFCT(K)>0THENIFK=LC OR K=DC THENC=C(K,CT(K)):TT=CT(K):GOSUB500:GOTO117
115 IFCT(K)=0THENPRINT@L+64,"    ";:PRINT@L+96,"    ";:PRINT@L+128,"    ";
116 L=L+4
117 NEXTK
120 L=38:C=C(8,0):TT=PT(8):GOSUB500
190 RETURN
200 GOSUB100:PRINT@480,"                               ";
210 R$=INKEY$:R=RND(10):IFR$=""THEN210
220 FL=0:R=VAL(R$)
230 IFR>0ANDR<9THENGOSUB300
240 IFR$=" "THENGOSUB600
250 IFR$="Q"THENGOSUB400
260 GOTO200
300 LC=R:IFPT(LC)<1THEN340
305 PRINT@480,"MOVE FROM";LC;CHR$(8);".  MOVE TO (1-7,CR)?";
310 R$=INKEY$:IFR$=""THEN310
315 R=VAL(R$)
320 IFR>0ANDR<8THEN350
325 IFR$="W"ORR$="^"ORR$=CHR$(13)THENGOSUB700
340 RETURN
350 DC=R
352 C=C(DC,0):IFCT(DC)>0THENC=C(DC,CT(DC))
354 GOSUB4000:DK=N:DS=S
356 C=C(LC,0):GOSUB4000:LK=N:LS=S
357 FL=0:GOSUB800
358 IFFL=1THENSOUND1,1:RETURN
360 IFCT(LC)<1ORLC=8THENGOSUB380:GOTO340
365 IFPT(DC)=0THENCT(DC)=-1:PT(DC)=1
370 FORX=0TOCT(LC)
372 CT(DC)=CT(DC)+1:C(DC,CT(DC))=C(LC,X)
373 C(LC,X)=0
378 NEXTX:CT(LC)=0:PT(LC)=PT(LC)-1:GOSUB385
379 GOTO340
380 IFPT(DC)=0THENCT(DC)=-1:PT(DC)=1
382 CT(DC)=CT(DC)+1:C(DC,CT(DC))=C(LC,0):PT(LC)=PT(LC)-1
383 IFLC=8THENC(8,0)=C(8,PT(LC)):IFPT(LC)=0THENC(8,0)=0
384 IFLC=8THENFORX=PT(LC)+1TOMP:C(8,X)=C(8,X+1):NEXTX:GOTO340
385 IFPT(LC)>0THENK=LC:KK=0:GOSUB1000:GOSUB450
387 IFPT(LC)=0THENK=LC:KK=0:Z=0:GOSUB450
390 RETURN
400 PRINT@480,"        QUIT GAME (Y/N)?       ";
410 R$=INKEY$:IFR$=""THEN410
420 IFR$="Y"THEN900
430 IFR$="N"THENRETURN
440 GOTO410
450 C(K,KK)=Z:C=C(K,KK):GOSUB4000:PS(K)=S:RETURN
460 C(K,KK)=Z:C=C(K,KK):GOSUB4000:CS(K)=S:RETURN
500 GOSUB4000:GOSUB2000
510 GOSUB3000
515 GOSUB2050
520 RETURN
600 T=T+1:IFT>24THENSOUND1,1:T=24:GOTO630
605 L=66:GOSUB3100
610 PT(8)=PT(8)+1
620 C(8,0)=C(8,PT(8))
630 RETURN
700 DC=0
705 K=LC
710 C=C(LC,CT(LC)):GOSUB4000
720 IFN=KS(S)+1THENGOSUB750:GOTO740
730 SOUND1,1
740 RETURN
750 KS(S)=N:IFLC=8THENPT(8)=PT(8)-1:GOSUB383:GOTO760
752 C(K,CT(K))=0
753 IFCT(K)>0THENCT(K)=CT(K)-1:GOTO760
754 IFPT(K)>1THENGOSUB1000:C(K,0)=Z:PT(K)=PT(K)-1:C(K,1)=0:GOTO760
755 C(K,0)=0:PT(K)=0
760 TT=N:L=42+(S*4):GOSUB500
770 TK=TK+1:IFTK>51THENGOSUB100:GOSUB8000:SOUND100,5:GOTO900
780 RETURN
800 IFPT(DC)=0ANDLK=13THEN850
805 IFPT(DC)=0ANDLK<>13THENFL=1
810 IF(LS=1ORLS=2)AND(DS=1ORDS=2)THENFL=1
820 IF(LS=3ORLS=4)AND(DS=3ORDS=4)THENFL=1
830 IFLK<>DK-1THENFL=1
840 IFLC=DCTHENFL=1
850 RETURN
900 PRINT@480,"      PLAY ANOTHER (Y/N)?      ";
910 R$=INKEY$:IFR$=""THEN910
920 IFR$="Y"THENRUN
930 IFR$="N"THENEND
940 GOTO910
1000 REM PICK A CARD
1005 Z=RND(52)
1010 IFD(Z)=0THEN1005
1020 D(Z)=0
1030 RETURN
2000 REM PRINT SUITS
2005 L1=L:IFL>232THEN2010
2006 PRINT@L1,"    ";:PRINT@L1,"";
2007 IFTT>2THENPRINT"====";
2008 IFTT=2THENPRINT"----";
2010 FORX=1TO4
2015 L1=L1+32
2025 IFC=0THENPRINT@L1,"    ";:GOTO2040
2026 PRINT@L1,BL$;
2030 POKEL1+MC,32
2040 NEXTX
2045 RETURN
2046 REM
2050 IFC=0THEN2070
2060 FORX=1TO3:PRINT@L+(32*X)+1,C$(X,S);:NEXTX
2070 L1=0:L=L+4
2080 RETURN
3000 REM PRINT NUMBERS
3010 IFC=0THEN3045
3020 L1=L+32
3030 POKEMC+L1,N(N)
3040 POKEMC+L1+99,N(N)
3045 L1=0
3050 RETURN
3100 IFT<22THENPRINT@L-32,"====";:GOTO 3108
3101 IFT=22THENPRINT@L-32,"----";:GOTO 3108
3102 IFT=23THENPRINT@L-32,"    ";:GOTO 3108
3103 PRINT@L-32,"    ";:PRINT@L,"    ";
3104 PRINT@L+32,"    ";
3105 PRINT@L+64,"    ";
3106 PRINT@L+96,"    ";:GOTO3140
3108 PRINT@L,BL$;
3110 PRINT@L+32,BL$;
3120 PRINT@L+64,BL$;
3130 PRINT@L+96,BL$;
3140 RETURN
4000 REM COMPUTE NUMBER AND SUIT
4005 S=INT((C-1)/13)+1
4010 N=C-(S*13-13)
4040 RETURN
5000 C$(1,1)=CHR$(177)+CHR$(177)+CHR$(176)
5001 C$(2,1)=CHR$(191)+CHR$(191)+CHR$(186)
5002 C$(3,1)=CHR$(180)+CHR$(190)+CHR$(176)
5010 C$(1,2)=CHR$(176)+CHR$(178)+CHR$(176)
5011 C$(2,2)=CHR$(183)+CHR$(191)+CHR$(178)
5012 C$(3,2)=CHR$(180)+CHR$(190)+CHR$(176)
5020 C$(1,3)=CHR$(176)+CHR$(162)+CHR$(176)
5021 C$(2,3)=CHR$(167)+CHR$(175)+CHR$(162)
5022 C$(3,3)=CHR$(172)+CHR$(174)+CHR$(168)
5030 C$(1,4)=CHR$(161)+CHR$(163)+CHR$(176)
5031 C$(2,4)=CHR$(167)+CHR$(175)+CHR$(162)
5032 C$(3,4)=CHR$(172)+CHR$(174)+CHR$(168)
5043 RETURN
7000 PRINT@192,"         ***SOLITAIRE***";
7001 PRINT@256,"          BY JIM GERRIE";
7002 PRINT@320,"           SHUFFLING...";
7010 FORDE=1TO52:D(DE)=DE:NEXTDE
7040 RETURN
8000 FORX=194TO416STEP32
8020 PRINT@X,"                               ";
8030 NEXTX
8040 PRINT@320,"             YOU WIN!          ";
8050 RETURN
