0 'FOURSC.BA - By Stevens, G
1 'Club 100 Library - 415/939-1246 BBS,    937-5039 NEWSLETTER, 932-8856 VOICE
2 CLEAR1000:DEFSTRS:DEFINTA-R,T:DIMA(52),HP(52),HS(52),SA(13),D(52),T(5,13),N(5),F(4),PT(5),PF(4):DATA" A"," 2"," 3"," 4"," 5"," 6"," 7"," 8"," 9","10"," J"," Q"," K":FORI1=1TO13:READSA(I1):NEXT:SM="##,###":RV$=CHR$(27)+"p":NV$=CHR$(27)+"q":CLS
3 PRINTTAB(14);"Four Seasons":PRINT:PRINT:PRINT"Initializing - hang in there ...":PRINT:GOSUB81:PT(1)=23:PT(2)=97:PT(3)=103:PT(4)=109:PT(5)=183:PF(1)=17:PF(2)=29:PF(3)=177:PF(4)=189:CL=0:CW=0:GL=0:GW=0:SC=""
4 IFSC=""THENGOSUB9:GOTO4
5 SR="Y"
6 IFSR<>"N"THENGOSUB17:GOTO6
7 IFSC="N"THENMENU
8 OPEN"FOURSC"FOROUTPUTAS1:PRINT#1,GW;GL;IG:CLOSE:MENU
9 PRINT"Keep cumulative scores? ";:SC=INPUT$(1):IFSC="n"THENSC="N"
10 IFSC="y"THENSC="Y"
11 IFSC="N"THENPRINT"No";:RETURN
12 IFSC<>"Y"THENSC="":BEEP:PRINT@240,"*** PLEASE ENTER <Y> OR <N> ***":RETURN
13 PRINT"Yes";:ONERRORGOTO15:OPEN"FOURSC"FORINPUTAS1:INPUT#1,GW,GL,IG:CLOSE
14 ONERRORGOTO0:RETURN
15 IFERR=52THENRESUME14
16 ONERRORGOTO0
17 CLS:IFSR="Y"THENGOSUB64ELSEGOSUB69
18 GOSUB71:CLS:GOSUB72
19 IFNH<52THENGOSUB34:GOTO19
20 CLS:IFND=0THENPRINT"YOU WON!":CW=CW+1:GW=GW+1ELSEPRINT"YOU LOST!":CL=CL+1:GL=GL+1
21 PRINT:BL=CL:BW=CW:SG="Current:":GOSUB33:BL=GL:BW=GW:IFSC="Y"THENSG="Cum:":GOSUB33
22 SR=""
23 IFSR=""THENGOSUB28:GOTO23
24 IFSR="Y"THENPRINT"Yes";
25 IFSR="N"THENPRINT"No";
26 IFSR="R"THENPRINT"Replay";
27 RETURN
28 PRINT@280,"Play again (yes/no/replay)? ";:SR=INPUT$(1):IFSR="y"THENSR="Y":RETURN
29 IFSR="n"THENSR="N":RETURN
30 IFSR="r"THENSR="R":RETURN
31 IFSR="Y"ORSR="N"ORSR="R"THENRETURN
32 SR="":BEEP:PRINT@240,"** Please type <Y>, <N>, or <R> **":RETURN
33 PRINTSG;:PRINTTAB(9);"Played:";TAB(17);:PRINTUSINGSM;BL+BW;:PRINTTAB(26);"Won:";TAB(31);:PRINTUSINGSM;BW:PRINTTAB(9);"Lost:";TAB(17);:PRINTUSINGSM;BL;:PRINTTAB(26);"% Won:";TAB(33);:PRINTUSING"###.##";BW/(BW+BL)*100;:PRINT"%";:RETURN
34 NH=NH+1:IC=HP(NH):ND=ND+1:D(ND)=IC:GOSUB74:PRINT@303,SG;:PRINT@280,52-NH;"Cards left ";:IS=1
35 IFIS=1THENGOSUB37:GOTO35
36 RETURN
37 IS=0:GOSUB76:PRINT@240,STRING$(33," ");:IFSG="H"THENPRINT@206,"Hit";:RETURN
38 IFSG="Q"THENNH=52:PRINT@206,"Quit";:RETURN
39 IFSG="M"THENPRINT@206,"Move";
40 GOSUB83:PRINT@6,SF;:GOSUB105:PRINT@44,ST;:GOSUB44:IFIS=1THENRETURN
41 GOSUB46:IFIS=1THENRETURN
42 IFLEFT$(ST,1)="T"THENGOSUB49ELSEGOSUB55
43 IS=1:RETURN
44 IFSF="D"ANDND>0THENFC=D(ND):RETURN
45 IT=ASC(RIGHT$(SF,1))-48:FC=T(IT,N(IT)):RETURN
46 IT=ASC(RIGHT$(ST,1))-48:IFLEFT$(ST,1)="F"THENTC=F(IT):RETURN
47 TC=T(IT,N(IT)):RETURN
48 IS=1:BEEP:PRINT@240,"ILLEGAL MOVE";:RETURN
49 TM=((TC-1)MOD13)+1:FM=((FC-1)MOD13)+1:IFTM=FMORTM=IBTHENGOSUB48:RETURN
50 IFTM=1THENTM=13ELSETM=TM-1
51 IFTM<0THENTM=FM
52 IFFM<>TMTHENGOSUB48:RETURN
53 IT=ASC(RIGHT$(ST,1))-48:N(IT)=N(IT)+1:T(IT,N(IT))=FC:IC=FC:GOSUB74:PRINT@PT(IT),SG;:IFSF="D"THENGOSUB62ELSEGOSUB63
54 RETURN
55 TM=((TC-1)MOD13)+1:FM=((FC-1)MOD13)+1:IFTM=0THENTM=IBELSETM=TM+1
56 IFTM=14THENTM=1
57 IFFM<>TMTHENGOSUB48:RETURN
58 I1=(FC-1)/13+1:IFTC=0THENI2=I1ELSEI2=(TC-1)/13+1
59 IFI1<>I2THENGOSUB48:RETURN
60 IT=ASC(RIGHT$(ST,1))-48:F(IT)=FC:IC=FC:GOSUB74:PRINT@PF(IT),SG;:IFSF="D"THENGOSUB62ELSEGOSUB63
61 RETURN
62 ND=ND-1:IC=D(ND):GOSUB74:PRINT@303,SG;:RETURN
63 IT=ASC(RIGHT$(SF,1))-48:N(IT)=N(IT)-1:IC=T(IT,N(IT)):GOSUB74:PRINT@PT(IT),SG;:RETURN
64 PRINT"Shuffling - be patient ...":FORI1=1TO52:A(I1)=0:NEXT:I1=0
65 IFI1<52THENGOSUB67:GOTO65
66 RETURN
67 I2=RND(1)*52+1:IFA(I2)=1THENRETURN
68 I1=I1+1:HP(I1)=I2:HS(I1)=I2:A(I2)=1:RETURN
69 FORI1=1TO52:HP(I1)=HS(I1):NEXT:IFND=0THENGW=GW-1:CW=CW-1ELSEGL=GL-1:CL=CL-1
70 RETURN
71 T(1,1)=HP(1):T(3,1)=HP(2):T(5,1)=HP(3):T(2,1)=HP(4):T(4,1)=HP(5):F(1)=HP(6):FORI1=1TO5:N(I1)=1:NEXT:F(2)=0:F(3)=0:F(4)=0:ND=0:NH=6:IB=((F(1)-1)MOD13)+1:RETURN
72 IC=F(1):GOSUB74:PRINT@PF(1),SG;:GOSUB132:IC=T(1,N(1)):GOSUB74:PRINT@PT(1),SG;:IC=F(2):GOSUB74:PRINT@PF(2),SG;:IC=T(2,N(2)):GOSUB74:PRINT@PT(2),SG;:IC=T(3,N(3)):GOSUB74:PRINT@PT(3),SG;:IC=T(4,N(4)):GOSUB74:PRINT@PT(4),SG;:IC=F(3)
73 GOSUB74:PRINT@PF(3),SG;:IC=T(5,N(5)):GOSUB74:PRINT@PT(5),SG;:IC=F(4):GOSUB74:PRINT@PF(4),SG;:RETURN
74 IFIC=0THENSG=STRING$(4," "):RETURN
75 I1=((IC-1)MOD13)+1:SG=SA(I1)+" ":I1=(IC-1)/13+1:SG=SG+CHR$(155+I1):RETURN
76 PRINT@200,STRING$(11," "):PRINT@0,STRING$(8," "):PRINT@40,STRING$(6," "):PRINT@200,"PLAY? ";:SG=INPUT$(1):IFSG="h"THENSG="H"
77 IFSG="q"THENSG="Q"
78 IFSG="m"THENSG="M"
79 IFSG="H"ORSG="Q"ORSG="M"THENRETURN
80 BEEP:PRINT@240,"** Please type <M>, <H> or <Q> **":GOTO76
81 I1=VAL(LEFT$(DATE$,2)):GOSUB82:I1=VAL(MID$(DATE$,4,2)):GOSUB82:I1=VAL(MID$(DATE$,7,2)):GOSUB82:I1=VAL(MID$(TIME$,1,2)):GOSUB82:I1=VAL(MID$(TIME$,4,2)):GOSUB82:I1=VAL(MID$(TIME$,7,2)):GOSUB82:RETURN
82 FORI2=1TOI1:I3=RND(1):NEXT:RETURN
83 CF=0:PF=0:SF="":GOSUB96:PRINT@0,"From:";
84 IFSF<>CHR$(13)THENGOSUB87:GOTO84
85 PF=CF:IFPF=0THENSF="D":RETURN
86 SF="T"+RIGHT$(STR$(CF),1):CF=CF+4:RETURN
87 SF=INKEY$:IFSF=""THEN87
88 IFSF=CHR$(13)THENRETURN
89 IFASC(SF)<28ORASC(SF)>31THENBEEP:GOTO87
90 IFSF=CHR$(28)THENMV=-2
91 IFSF=CHR$(29)THENMV=2
92 IFSF=CHR$(30)THENMV=-1
93 IFSF=CHR$(31)THENMV=1
94 PF=CF:CF=(CF+MV)MOD6:IFCF<0THENCF=6+CF
95 GOSUB96:RETURN
96 IFPF=0THENGOSUB101
97 IFPF<>0THENGOSUB102
98 IFCF=0THENGOSUB103
99 IFCF<>0THENGOSUB104
100 RETURN
101 IC=D(ND):GOSUB74:PRINT@303,SG;:RETURN
102 IC=T(PF,N(PF)):GOSUB74:PRINT@PT(PF),SG;:RETURN
103 IC=D(ND):GOSUB74:PRINT@303,RV$;SG;NV$;:RETURN
104 IC=T(CF,N(CF)):GOSUB74:PRINT@PT(CF),RV$;SG$;NV$;:RETURN
105 CT=1:PT=1:ST="":GOSUB123:PRINT@40,"TO:";
106 IFST<>CHR$(13)THENGOSUB114:GOTO106
107 PT=CT:IFPT<5THENGOSUB112
108 IFPT>4THENGOSUB113
109 IFPF=0THENGOSUB101
110 IFPF<>0THENGOSUB102
111 RETURN
112 GOSUB128:ST="F"+RIGHT$(STR$(PT),1):RETURN
113 GOSUB129:ST="T"+RIGHT$(STR$(PT-4),1):RETURN
114 ST=INKEY$:IFST=""THEN114
115 IFST=CHR$(13)THENRETURN
116 IFASC(ST)<28ORASC(ST)>31THENBEEP:GOTO114
117 IFST=CHR$(28)THENMV=1
118 IFST=CHR$(29)THENMV=-1
119 IFST=CHR$(30)THENMV=4
120 IFST=CHR$(31)THENMV=-4
121 PT=CT:CT=(CT+MV)MOD9:IFCT<1THENCT=9-ABS(CT)
122 GOSUB123:RETURN
123 IFPT<5THENGOSUB128
124 IFPT>4ANDCF<>PTTHENGOSUB129
125 IFCT<5THENGOSUB130
126 IFCT>4THENGOSUB131
127 RETURN
128 IC=F(PT):GOSUB74:PRINT@PF(PT),SG;:RETURN
129 IC=T(PT-4,N(PT-4)):GOSUB74:PRINT@PT(PT-4),SG;:RETURN
130 IC=F(CT):GOSUB74:PRINT@PF(CT),RV$;SG;NV$;:RETURN
131 IC=T(CT-4,N(CT-4)):GOSUB74:PRINT@PT(CT-4),RV$;SG;NV$;:RETURN
132 PRINT@315,LEFT$(SG,2);:IFVAL(LEFT$(SG,2))=10THENLS=203ELSELS=206
133 LINE(LS,63)-(LS+24,52),1,B:LINE(LS+2,63)-(LS+22,54),1,B:FORZ=LS+1TOLS+23STEP2:PSET(Z,53):NEXTZ:FORZ=53TO63STEP2:PSET(LS+1,Z):PSET(LS+23,Z):NEXTZ:RETURN