1 REM
2 REM  SOLITAIRE  (for TRS-80 Model 3)
3 REM  Originally appeared in Softside
4 REM  Magazine (May 82, Vol 5, No. 8)
5 REM  Author: Larry Williams
6 REM
7 REM  Translated for the TANDY 200
8 REM  by: Max L Seim (71116,1347)
9 REM  -- version: Jan 26, 1986 ---
10 CLS:CLEAR1000:DEFINTA-Z:GOTO1110
20 PRINT@X*5+Y*40,G$(6);
25 PRINT@X*5+Y*40,G$(SU);
30 PRINT@X*5+Y*40,MID$(VA$,VA,1);MID$(S$,SU,1);
50 RETURN
70 SU=INT(NU/100)
80 VA=NU-100*SU
90 RETURN
100 FORM=1TO3
103 IFD(IN)=0THENGOTO3002
105 IFHF<>0THENGOSUB1480:RETURN
120 OD(IN(7))=D(IN):IN=IN+1:X=7:Y=12:NU=OD(IN(7)):GOSUB70:GOSUB20
125 IN(7)=IN(7)+1
130 IFCU=7ANDM=3THENGOSUB150
131 IFD(IN)=0THENGOTO3000
135 NEXTM
140 RETURN
150 IFOC<>7THENPRINT@600+OC*5,"    ";
151 IFIN(7)=0THEN156
152 JJ=OD(IN(7)-1):JT=INT(JJ/100)
154 IFIN(7)<>0AND((JT=1)OR(JT=2))THENPRINT@635,CHR$(237);
155 IFIN(7)<>0AND((JT=3)OR(JT=4))THENPRINT@635,CHR$(239);
156 IFIN(7)=0 AND CU=7THENPRINT@635,CHR$(255);
157 IFIN(7)=0 AND CU<>7THENPRINT@635," ";
158 IFIN(7)<>0 AND CU=7THENPRINT@635,CHR$(255);
160 IFCU<>7THENPRINT@600+CU*5,STRING$(4,255);
170 RETURN
200 CU=CU+1:IFCU>7THENCU=7
210 GOSUB150
220 OC=CU
230 RETURN
240 CU=CU-1:IFCU<0THENCU=0
250 GOSUB150
260 OC=CU
270 RETURN
280 IFHF<>0THENGOSUB1480:RETURN
290 ST=CU
300 IFIN(CU)=0THENGOSUB1510:RETURN
310 IFCU=7THENNU=OD(IN(7)-1):GOTO330
320 NU=C(CU,0)
330 HF=1
340 X=CU:J=0:IFCU=7THENJ=12:PRINT@X*5+480,G$(6);:GOTO380
350 IFP(CU,0)<>0THENPRINT@X*5,G$(6);:GOTO380
360 FORY=0TO3:PRINT@Y*40+X*5,STRING$(4,32);
370 NEXTY
380 IFCU=7THENGOSUB150:RETURN
385 IFIN(CU)=1THENRETURN
390 J=IN(CU)+2:IFJ>15THENJ=15
395 FORI=4TOJ:PRINT@I*40+X*5,STRING$(4,32);:NEXTI
400 RETURN
410 IFHF=0THENGOSUB1520:RETURN
420 IFCU=7THENGOSUB590:RETURN
430 IFST=CUTHENGOSUB750:RETURN
440 IFIN(CU)=0THENGOSUB630:RETURN
450 NU=C(CU,IN(CU)-1)
460 GOSUB70:TS=SU:TV=VA
470 IFST=7THENNU=OD(IN(7)-1):GOTO490
480 NU=C(ST,0)
490 GOSUB70:IF((TS=1)OR(TS=2))AND((SU=1)OR(SU=2))THENGOSUB1540:RETURN
500 IF((TS=3)OR(TS=4))AND((SU=3)OR(SU=4))THENGOSUB1530:RETURN
510 IFTV<>VA+1THENGOSUB1550:RETURN
515 IFVA=1THENGOSUB1500:RETURN
520 IFST=7THENGOSUB700:RETURN
530 FORI=0TOIN(ST)-1:NU=C(ST,I):C(CU,IN(CU))=NU:GOSUB70:X=CU:Y=IN(CU)
535 GOSUB20:IN(CU)=IN(CU)+1:C(ST,I)=0:NEXTI
540 IN(ST)=0:HF=0
550 IFP(ST,0)=0THENRETURN
560 NU=P(ST,0):GOSUB70:X=ST:Y=0:GOSUB20:C(ST,IN(ST))=NU:IN(ST)=1
570 FORI=0TO4:P(ST,I)=P(ST,I+1):NEXTI:P(ST,5)=0
580 RETURN
590 IFST<>7THENGOSUB1560:RETURN
600 NU=OD(IN(7)-1):GOSUB70:X=CU:Y=12:GOSUB20:GOSUB150
610 HF=0
620 RETURN
630 IFST=7THENNU=OD(IN(7)-1):GOTO650
640 NU=C(ST,0)
650 GOSUB70
660 IFVA<>13THENGOSUB1570:RETURN
670 IFST=7THENGOSUB700:RETURN
680 GOSUB530
690 RETURN
700 X=CU:Y=IN(CU):C(CU,IN(CU))=NU:GOSUB20:IN(CU)=IN(CU)+1
710 IN(7)=IN(7)-1:OD(IN(7))=0:HF=0
720 IFIN(7)=0THENPRINT@515,G$(7);:RETURN
730 NU=OD(IN(7)-1):GOSUB70:X=7:Y=12:GOSUB20
740 RETURN
750 FORI=0TOIN(CU)-1:NU=C(CU,I):GOSUB70:X=CU:Y=I:GOSUB20:NEXTI
760 HF=0
770 RETURN
780 NU=OD(IN(7)-1):GOSUB70:FL=1
785 IF(F(SU)<>VA-1) AND (F(SU)=0)THENGOSUB1580:RETURN
790 IFF(SU)<>VA-1THENTV=F(SU):GOSUB1550:RETURN
800 GOSUB980
810 OD(IN(CU))=0
820 IFIN(CU)=0THENGOSUB720:RETURN
830 GOSUB730
835 GOSUB150
840 RETURN
850 REM
860 X=CU:IFP(CU,0)<>0THENPRINT@X*5,G$(6);:GOTO880
870 FORY=0TO3:PRINT@Y*40+X*5,STRING$(4,32);:NEXTY
880 C(CU,0)=P(CU,0):IFP(CU,0)=0THENRETURN
890 NU=C(CU,0):X=CU:Y=0:GOSUB70:GOSUB20
900 IN(CU)=1
910 FORI=0TO4:P(CU,I)=P(CU,I+1):NEXTI:P(CU,5)=0
920 RETURN
930 IFHF<>0THENGOSUB1480:RETURN
935 FL=0
940 IFIN(CU)=0THENGOSUB1510:RETURN
950 IFCU=7THENGOSUB780:RETURN
960 NU=C(CU,IN(CU)-1):GOSUB70
965 IF(F(SU)<>VA-1) AND (F(SU)=0)THENGOSUB1580:RETURN
970 IF F(SU)<>VA-1THENTV=F(SU):GOSUB1550:RETURN
980 X=7
990 Y=SU*3-3
1030 PRINT@X*5+Y*40,MID$(VA$,VA,1);MID$(S$,SU,1);:F(SU)=VA
1040 IN(CU)=IN(CU)-1:IFFL<>0THENRETURN
1050 C(CU,IN(CU))=0
1060 IFIN(CU)=0THENGOSUB850:RETURN
1070 X=CU:Y=IN(CU)-1:NU=C(CU,IN(CU)-1):GOSUB70:GOSUB20
1085 PRINT@CU*5+(IN(CU)+3)*40,STRING$(4,32);
1100 RETURN
1110 DIMC(6,11),P(6,5),D(52),OD(23),F(4),IN(7),TX$(13),G$(10)
1112 PRINT@295,"SOLITAIRE"
1114 GOSUB2000
1120 FORI=1TO13:READTX$(I):NEXTI
1150 FORI=0TO6:FORJ=0TO5:C(I,J)=0:P(I,J)=0:NEXTJ:FORJ=6TO11:C(I,J)=0:NEXTJ,I
1160 FORI=0TO23:OD(I)=0:NEXTI
1170 FORI=0TO3:F(I)=0:NEXTI
1200 D(52)=0
1210 IN=0:FORI=1TO4:FORJ=1TO13:D(IN)=100*I+J:IN=IN+1:NEXTJ,I
1220 SEC=VAL(RIGHT$(TIME$,2))+VAL(MID$(TIME$,4,2))
1222 FORI=1TOSEC
1224 DUMMY=RND(1)
1226 NEXTI
1230 FORI=51TO0STEP-1:X=INT(RND(1)*I+1):T=D(X):D(X)=D(I):D(I)=T:NEXTI
1240 IN=0:FORI=1TO6:FORJ=0TOI-1:P(I,J)=D(IN):IN=IN+1:NEXTJ,I:CC=24
1250 FORI=0TO6:C(I,0)=D(IN):IN=IN+1:NEXTI
1260 CLS
1290 FORI=0TO6:NU=C(I,0):GOSUB70:X=I:Y=0:GOSUB20:NEXTI
1300 FORI=0TO6:IN(I)=1:NEXTI:IN(7)=0
1310 GOSUB100
1320 CU=0:OC=0:X=CU:GOSUB150
1330 REM control section
1332 A$=INKEY$:IFA$=""THEN1332
1335 IFA$>=CHR$(96)ANDA$<=CHR$(127)THENA$=CHR$(ASC(A$)-32)
1340 IFA$=CHR$(28)THENGOSUB200:GOTO1330
1350 IFA$=CHR$(29)THENGOSUB240:GOTO1330
1360 IFA$="N"THENGOSUB100:GOTO1330
1365 IFA$=CHR$(30)THENGOSUB280:GOTO1330
1370 IFA$="P"THENGOSUB280:GOTO1330
1375 IFA$=CHR$(31)THENGOSUB410:GOTO1330
1376 IFA$="="THENGOSUB100:GOTO1330
1380 IFA$="D"THENGOSUB410:GOTO1330
1390 IFA$<>"F"THEN1400ELSEGOSUB930
1395 IFF(1)<13ORF(2)<13ORF(3)<13ORF(4)<13THEN1330ELSEPRINT@600,CHR$(30);"YOU WIN  Care to play again? ";
1396 A$=INKEY$:IFA$=""THEN1396
1397 IFA$="y" OR A$="Y"THENRUNELSE:CLS:END
1400 IFA$="E"THEN1420
1410 GOTO1330
1420 PRINT@600,"Do you want to END?";
1430 A$=INKEY$:IFA$=""THEN1430
1435 IFA$="Y" OR A$="y"THEN1440ELSE1436
1436 PRINT@600,"                    ";:GOSUB150:GOTO1330
1440 PRINT@600,STRING$(30,32);:PRINT@600,"Care to play again ?";:GOTO1396
1480 A$="Drop cards in hand first.":GOSUB2100:RETURN
1490 A$="No more cards in deck.":GOSUB2100:RETURN
1500 A$="Why don't you play the ACE?":GOSUB2100:RETURN
1510 A$="No cards to pick up.":GOSUB2100:RETURN
1520 A$="No cards to drop.":GOSUB2100:RETURN
1530 A$="Can't play BLACK on BLACK.":GOSUB2100:RETURN
1540 A$="Can't play RED on RED.":GOSUB2100:RETURN
1550 A$="Can't play a"+TX$(VA)+" on a"+TX$(TV)+".":GOSUB2100:RETURN
1560 A$="You can't drop them here.":GOSUB2100:RETURN
1570 A$="Only a KING on empty space.":GOSUB2100:RETURN
1580 A$="Foundation starts with ACE.":GOSUB2100:RETURN
1590 DATA"n Ace"," Two"," Three"," Four"," Five"," Six"
1591 DATA" Seven"," Eight"," Nine"," Ten"," Jack"," Queen"," King"
2000 G$=CHR$(27)+CHR$(66)+CHR$(27)+CHR$(68)+CHR$(27)+CHR$(68)
2001 G$=G$+CHR$(27)+CHR$(68)+CHR$(27)+CHR$(68)
2010 G$(1)=CHR$(235)+CHR$(231)+CHR$(231)+CHR$(236)+G$
2011 G$(1)=G$(1)+CHR$(233)+CHR$(252)+CHR$(254)+CHR$(234)+G$
2012 G$(1)=G$(1)+CHR$(233)+CHR$(253)+CHR$(251)+CHR$(234)+G$
2013 G$(1)=G$(1)+CHR$(237)+CHR$(232)+CHR$(232)+CHR$(238)
2020 G$(2)=CHR$(235)+CHR$(231)+CHR$(231)+CHR$(236)+G$
2022 G$(2)=G$(2)+CHR$(233)+CHR$(254)+CHR$(252)+CHR$(234)+G$
2024 G$(2)=G$(2)+CHR$(233)+CHR$(253)+CHR$(251)+CHR$(234)+G$
2026 G$(2)=G$(2)+CHR$(237)+CHR$(232)+CHR$(232)+CHR$(238)
2030 G$(3)=CHR$(239)+CHR$(239)+CHR$(239)+CHR$(239)+G$
2032 G$(3)=G$(3)+CHR$(239)+CHR$(225)+CHR$(226)+CHR$(239)+G$
2034 G$(3)=G$(3)+CHR$(239)+CHR$(251)+CHR$(253)+CHR$(239)+G$
2036 G$(3)=G$(3)+CHR$(239)+CHR$(239)+CHR$(239)+CHR$(239)
2040 G$(4)=CHR$(239)+CHR$(239)+CHR$(239)+CHR$(239)+G$
2042 G$(4)=G$(4)+CHR$(239)+CHR$(251)+CHR$(253)+CHR$(239)+G$
2044 G$(4)=G$(4)+CHR$(239)+CHR$(227)+CHR$(228)+CHR$(239)+G$
2046 G$(4)=G$(4)+CHR$(239)+CHR$(239)+CHR$(239)+CHR$(239)
2050 G$(6)=CHR$(239)+CHR$(239)+CHR$(239)+CHR$(239)+G$
2052 G$(6)=G$(6)+CHR$(239)+CHR$(239)+CHR$(239)+CHR$(239)+G$
2054 G$(6)=G$(6)+CHR$(239)+CHR$(239)+CHR$(239)+CHR$(239)+G$
2056 G$(6)=G$(6)+CHR$(239)+CHR$(239)+CHR$(239)+CHR$(239)
2070 VA$="A23456789TJQK"
2071 S$=CHR$(157)+CHR$(158)+CHR$(156)+CHR$(159)
2075 G$(7)=STRING$(4,32)+G$+STRING$(4,32)+G$+STRING$(4,32)+G$+STRING$(4,32)
2080 RETURN
2100 PRINT@600,STRING$(34,32);:PRINT@600,A$;
2110 A$=INKEY$:IFA$=""THEN2110
2111 PRINT@600,STRING$(34,32);
2115 GOSUB150:RETURN
3000 PRINT@600,"   <LAST CARD>";:FOROO=1TO100:NEXTOO
3001 BEEP:PRINT@600,STRING$(30,32);:GOSUB150:GOTO140
3002 PRINT@600,"  <<DECK FLIP>>";:FOROO=1TO100:NEXTOO:IFHF=0 AND IN=28THEN3010
3003 BEEP:PRINT@600,STRING$(30,32);:GOSUB150:IN(7)=0
3004 FORX=28TO51:D(X)=OD(X-28):OD(X-28)=0:NEXTX:IN=28:A$="n":GOTO1335
3010 PRINT@600,STRING$(30,32);:GOTO1330