5REM "PATIENCE"
10*TV0,1
20MODE 6:E=0:F=0:H=1:P=0:SA=0:SB=0:SC
=0:SD=0:T=4:TA=-3:CB=53
30VDU 23,225,8,28,62,127,127,62,8,8:V
DU 23,226,8,28,62,127,127,62,28,8:VDU 23
,227,8,28,8,42,127,42,8,8:VDU 23,228,54,
127,127,127,62,62,28,8:VDU 23,229,0,127,
102,90,92,102,127,0:VDU 23,230,0,254,102
,58,90,102,254,0
40DIM B$(20,8),C$(54):MODE 7
50PRINT TAB(12,5)CHR$129;CHR$141;"PAT
IENCE":PRINT TAB(12)CHR$129;CHR$141;"PAT
IENCE":PROCINS
60 CLS:PRINT TAB(5,5)"PLEASE WAIT WHI
LE I SHUFFLE":PRINT TAB(16,10)"AND":PRIN
T TAB(11,15)"DEAL THE CARDS"
70DATA "A","2","3","4","5","6","7","8
","9","X","J","Q","K"
80FOR Q=1 TO 13:READ A$
90C$(Q)=A$+CHR$225:C$(Q+13)=A$+CHR$22
6:C$(Q+26)=A$+CHR$227:C$(Q+39)=A$+CHR$22
8:NEXT Q:FOR Q=1 TO 104:A=RND(52):B=RND(
52):C$(53)=C$(A):C$(A)=C$(B):C$(B)=C$(53
):NEXT Q:FOR Q=1 TO 7:G=0:E=E+1:FOR R=1
TO E
100CB=CB-1:G=G+1:B$(G,Q)=C$(CB)+"H":C$
(CB)=""
110NEXT R:NEXT Q:CLS:MODE 5:VDU 23;820
2;0;0;0;
120VDU 19,0,2,0,0,0,19,2,0,0,0,0,19,3,
7,0,0,0
130COLOUR 2:PRINT TAB(6,1)"PATIENCE":P
RINT TAB(1,3)"1 2 3 4 5 6 7":COLOU
R 2:COLOUR 135:BC=0:FOR BD=0 TO 18 STEP
3:BC=BC+1:FOR BE=1 TO BC:PRINT TAB(BD,4+
BE)CHR$229;CHR$230:NEXT BE:NEXT BD:COLOU
R 128:COLOUR 3
140 PRINT TAB(1,29)"SUIT":PRINT TAB(12
,28)"PACK":PRINT TAB(15,30)"LEFT":COLOUR
131:COLOUR2:PRINT TAB(6,28)CHR$225:COLOU
R 1:PRINT TAB(7,28)CHR$226:COLOUR 2:PRIN
T TAB(8,28)CHR$227:COLOUR1:PRINT TAB(9,2
8)CHR$228;
150MOVE 32,16:DRAW 32,144:DRAW 656,144
:DRAW 656,16:DRAW 32,16:MOVE 736,16:DRAW
736,144:DRAW 1248,144:DRAW 1248,16:DRAW
736,16
160PROCTURNCARD
170FOR R=1 TO 7:FOR Q=1 TO 8:COLOUR 13
5:TB=R*2:IF MID$(B$(Q,R),2,1)=CHR$225 OR
MID$(B$(Q,R),2,1)=CHR$227 THEN COLOUR 2
180IF MID$(B$(Q,R),2,1)=CHR$226 OR MID
$(B$(Q,R),2,1)=CHR$228 THEN COLOUR 1
190D$=RIGHT$(B$(Q,R),1):E$=B$(Q+1,R):I
F D$="H" AND E$="" THEN B$(Q,R)=LEFT$(B$
(Q,R),2):PRINT TAB(R+TA+TB,Q+T)B$(Q,R)
200NEXT Q:NEXT R
210 I$=GET$:IF I$="1" OR I$="2" OR I$=
"3" OR I$="4" OR I$="5" OR I$="6" OR I$=
"7" OR I$="P" OR I$=" " OR I$="E" THEN G
OTO 220 ELSE GOTO 210
220IF I$=" " THEN PROCTURNCARD
230IF I$="P" THEN I$="PACK"
240IF I$=" " THEN GOTO 210
250IF I$="E" THEN GOTO 1180
255 COLOUR 128:COLOUR 2:PRINT TAB(2,24
)I$;" TO ":PRINT TAB(2,26)"
"
260J$=GET$:IF J$="1" OR J$="2" OR J$="
3" OR J$="4" OR J$="5" OR J$="6" OR J$="
7" OR J$="S" THEN GOTO 270 ELSE GOTO 260
270IF J$="S" THEN J$="SUIT"
280PRINT TAB(2,24)I$;" TO ";J$:E=VAL(I
$):F=VAL(J$):IF E<>0 AND F<>0 THEN PROCM
OVE(E,F)
290IF E<>0 AND F=0 THEN OY=0:PROCSUIT(
E)
300IF E=0 AND F<>0 THEN PROCPD(F)
310IF E=0 AND F=0 THEN PROCACES
320IF SA=13 AND SB=13 AND SC=13 AND SD
=13 THEN GOTO 1180
330GOTO 170
340DEFPROCTURNCARD
350 COLOUR 128:COLOUR 2:PRINT TAB(2,24
)"TURN CARD ":PRINT TAB(2,26)"
"
360FOR PA=1 TO 3
370PB=0:PA$=C$(1)
380REPEAT
390PB=PB+1:C$(PB)=C$(PB+1):UNTIL C$(PB
)=""
400IF PA$<>"" THEN C$(PB)=PA$
410NEXT PA
420COLOUR 128:COLOUR 3:IF PB>1 THEN PR
INT TAB(12,30);PB;" ":COLOUR 131
425IF RIGHT$(PA$,1)=CHR$225 OR RIGHT$(
PA$,1)=CHR$227 THEN COLOUR 2 ELSE COLOUR
1
430PRINT TAB(17,28)PA$
440ENDPROC
450DEFPROCMOVE(E,F):Y=0:U=0:V=0:ZB=0
460REPEAT
470U=U+1:DA$=RIGHT$(B$(U,E),1):UNTIL D
A$<>"H"
480AA=VAL(B$(U,E)):IF B$(U+1,E)<>"" TH
EN ZB=1
490REPEAT
500V=V+1:UNTIL B$(V+1,F)=""
510 AB=VAL(B$(V,F)):S$=RIGHT$(B$(U,E),
1):SA$=RIGHT$(B$(V,F),1):SB$=LEFT$(B$(U,
E),1):SC$=LEFT$(B$(V,F),1):IF SB$="A" TH
EN AA=1
520IF SB$="X" THEN AA=10
530IF SB$="J" THEN AA=11
540IF SB$="Q" THEN AA=12
550IF SB$="K" THEN AA=13
560IF SC$="A" THEN AB=1
570IF SC$="X" THEN AB=10
580IF SC$="J" THEN AB=11
590IF SC$="Q" THEN AB=12
600IF SC$="K" THEN AB=13
610IF SC$="" THEN AB=14
620IF SC$="" THEN V=V-1
630IF S$=CHR$225 AND SA$=CHR$226 THEN
Y=1
640IF S$=CHR$225 AND SA$=CHR$228 THEN
Y=1
650IF S$=CHR$226 AND SA$=CHR$225 THEN
Y=1
660IF S$=CHR$226 AND SA$=CHR$227 THEN
Y=1
670IF S$=CHR$227 AND SA$=CHR$226 THEN
Y=1
680IF S$=CHR$227 AND SA$=CHR$228 THEN
Y=1
690IF S$=CHR$228 AND SA$=CHR$225 THEN
Y=1
700IF S$=CHR$228 AND SA$=CHR$227 THEN
Y=1
710IF SA$="" THEN Y=1
720FA=F*2:EA=E*2:IF Y=0 THEN ZB=0
730IF AB<>AA+1 THEN ZB=0
740COLOUR 131:IF RIGHT$(B$(U,E),1)=CHR
$226 OR RIGHT$(B$(U,E),1)=CHR$228 THEN C
OLOUR 1 ELSE COLOUR 2
750IF AB=AA+1 AND Y=1 AND E<>8 THEN PR
INT TAB(F+FA+TA,V+T+1)B$(U,E):COLOUR 128
:PRINT TAB(E+EA+TA,U+T)" "
755IF AB=AA+1 AND Y=1 AND E=8 THEN PRI
NT TAB(F+FA+TA,V+T+1)B$(U,E):COLOUR 128
760IF AB=AA+1 AND Y=1 THEN B$(V+1,F)=B
$(U,E):B$(U,E)=""
770COLOUR 128:COLOUR 2:IF AB<>AA+1 OR
Y=0 THEN PRINT TAB(2,26)"OH! NO YOU DON'
T"
780IF ZB=1 THEN PROCMOVEA(E,F,U,V)
790ENDPROC
800DEFPROCMOVEA(E,F,U,V):ZA=0:REPEAT
810ZA=ZA+1:FOR WA=1 TO 200:NEXT WA:COL
OUR 131:IF RIGHT$(B$(U+ZA,E),1)=CHR$225
OR RIGHT$(B$(U+ZA,E),1)=CHR$227 THEN COL
OUR 2 ELSE COLOUR 1
820PRINT TAB(F+TA+FA,V+1+T+ZA)B$(U+ZA,
E):COLOUR 128:PRINT TAB(E+TA+EA,U+T+ZA)"
":B$(V+1+ZA,F)=B$(U+ZA,E):B$(U+ZA,E)="
"
830UNTIL B$(U+ZA+1,E)=""
840ENDPROC
850DEFPROCSUIT(E):YA=0:REPEAT
860YA=YA+1:UNTIL B$(YA+1,E)=""
870MA=E*2:SU=VAL(B$(YA,E)):IF LEFT$(B$
(YA,E),1)="A" THEN SU=1
880IF LEFT$(B$(YA,E),1)="X" THEN SU=10
890IF LEFT$(B$(YA,E),1)="J" THEN SU=11
900IF LEFT$(B$(YA,E),1)="Q" THEN SU=12
910IF LEFT$(B$(YA,E),1)="K" THEN SU=13
920 COLOUR 131:IF RIGHT$(B$(YA,E),1)=C
HR$225 OR RIGHT$(B$(YA,E),1)=CHR$227 THE
N COLOUR 2 ELSE COLOUR 1
930IF RIGHT$(B$(YA,E),1)=CHR$225 AND S
U=SA+1 THEN OY=1:GG=6:SA=SU
940IF RIGHT$(B$(YA,E),1)=CHR$226 AND S
U=SB+1 THEN OY=1:GG=7:SB=SU
950IF RIGHT$(B$(YA,E),1)=CHR$227 AND S
U=SC+1 THEN OY=1:GG=8:SC=SU
960IF RIGHT$(B$(YA,E),1)=CHR$228 AND S
U=SD+1 THEN OY=1:GG=9:SD=SU
970IF OY=1 AND E=8 THEN PRINT TAB(GG,3
0)LEFT$(B$(YA,E),1):COLOUR 128:B$(YA,E)=
"":ENDPROC
975IF OY=1 AND E<>8 THEN PRINT TAB(GG,
30)LEFT$(B$(YA,E),1):COLOUR 128:PRINT TA
B(E+TA+MA,YA+T)" ":B$(YA,E)="":ENDPROC
980COLOUR 128:COLOUR 2:PRINT TAB(2,26)
"OH! NO YOU DON'T":ENDPROC
990DEFPROCPD(F):E=8:RT=0:B$(1,E)=PA$
1000PROCMOVE(E,F)
1010REPEAT
1020RT=RT+1:UNTIL C$(RT+1)=""
1030 IF Y=1 AND AB=AA+1 THEN C$(RT)="":
PA$=C$(RT-1)
1040COLOUR 131:IF RIGHT$(PA$,1)=CHR$225
OR RIGHT$(PA$,1)=CHR$227 THEN COLOUR 2
ELSE COLOUR 1
1050PRINT TAB(17,28)PA$:COLOUR 128:COLO
UR 3:IF Y=1 AND AB=AA+1 THEN PRINT TAB(1
2,30);RT-1;" "
1060COLOUR 2:IF RT=1 AND Y=1 AND AB=AA+
1 THEN PRINT TAB(12,30)" ":PRINT TAB(1
6,28)"OUT"
1070ENDPROC
1080DEFPROCACES:E=8:OZ=0:OY=0:B$(1,E)=P
A$
1090PROCSUIT(E)
1100REPEAT
1110OZ=OZ+1:UNTIL C$(OZ+1)=""
1120 IF OY=1 THEN C$(OZ)="":PA$=C$(OZ-1
)
1130COLOUR 131:IF RIGHT$(PA$,1)=CHR$225
OR RIGHT$(PA$,1)=CHR$227 THEN COLOUR 2
1140IF RIGHT$(PA$,1)=CHR$226 OR RIGHT$(
PA$,1)=CHR$228 THEN COLOUR 1
1150PRINT TAB(17,28)PA$:COLOUR 128:COLO
UR 3:IF OY=1 THEN PRINT TAB(12,30);OZ-1;
" "
1160COLOUR 2:IF OZ=1 AND OY=1 THEN PRIN
T TAB(12,30)" ":PRINT TAB(16,28)"OUT"
1170ENDPROC
1180COLOUR 128:IF I$="E" THEN PROCEND
1190COLOUR 2:IF I$="E" THEN PRINT TAB(2
,24)" HARD LUCK!" ELSE PRINT TAB(2,24)"
WELL DONE!"
1200PRINT TAB(1,25)"WOULD YOU LIKE TO
TRY AGAIN? 'Y'/'N'":F$=GET$:IF F$="Y"
THEN CLEAR:GOTO 20
1210CLS:END
1220DEFPROCEND
1230FOR R=1 TO 7:FOR Q=1 TO 8:XT=R*2:IF
MID$(B$(Q,R),2,1)=CHR$225 OR MID$(B$(Q,
R),2,1)=CHR$227 THEN COLOUR 2 ELSE COLOU
R 1
1240IF RIGHT$(B$(Q,R),1)="H" THEN PRINT
TAB(R+TA+XT,Q+T)LEFT$(B$(Q,R),2)
1250NEXT Q:NEXT R
1260ENDPROC
1270DEFPROCINS
1280CLS:PRINT TAB(2,1)CHR$129"PATIENCE"
;CHR$135;" by....T.C.ATTHOW":PRINT "
````````":PRINT CHR$130;"Move cards from
column to column":PRINT CHR$130;"using
the number at the top of"
1285PRINT CHR$130;"each column, e.g.";C
HR$135;"'3'";CHR$130;"to";CHR$135;"'4'":
PRINT
1290PRINT CHR$130;"Build up the columns
using cards":PRINT CHR$130;"of alternat
e colour.":PRINT :PRINT CHR$130;"To move
cards from the pack to a"
1300PRINT CHR$130;"column use";CHR$135;
"'P'";CHR$130;"and column number":PRINT
:PRINT CHR$130;"To turn cards in the pac
k press":PRINT CHR$130;"the";CHR$135;"'S
PACE BAR'":PRINT :PRINT CHR$130;"You may
move a card to suit from"
1310PRINT CHR$130;"either the pack or a
column by":PRINT CHR$130;"using"CHR$135
;"'P'";CHR$130;"or column number to";CHR
$135;"'S'":PRINT :PRINT CHR$130;"If the
game cannot be completed":PRINT CHR$130;
"Press"CHR$135;"'E'"CHR$130;"to exit"
1320PRINT :PRINT " PRESS ANY KEY TO
CONTINUE":CONT$=GET$:CLS:ENDPROC