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