7 S                                        PILE:  3S   COUNT:  24
10 REM $LINESIZE:132
20 REM ----------------------------------------------------------------------
30 REM
40 REM           The Game of Klondyke Solitar
50 REM           By:  Jeff Littlefield
60 REM           For: the IBM PC and the Color Graphics Card
70 REM
80 REM           FOR PUBLIC USE    MAY NOT BE SOLD
90 REM           ALL  RIGHTS  RESERVED
100 REM
110 REM ---------------------------------------------------------------------
120 DEFINT  A-Z
130 FALSE=0:TRUE = NOT FALSE : ABORT = FALSE : WON = FALSE
140 DIM DECK$(52), STACK$(7,21),CARD$(52),TOP$(4),STACKPTR(7),VISIPTR(7),XYARR$(82)
145 NOT.READ=TRUE
150 KEY OFF: KEY(1) ON: ON KEY(1) GOSUB 950
160 RANDOMIZE(VAL(MID$(TIME$,7,2))+(VAL(MID$(TIME$,4,2))*60))
170 SCREEN 0,1,0,0:COLOR 7,1,1:CLS:PRINT"Pardon me while I shuffle the deck."
180 GOSUB 810 : GOTO 200 'SET UP THE HELP SCREEN
200 GOSUB 290            'SHUFFLE THE DECK
210 CLS
220 GOSUB 570            'PRINT OUT THE PLAYING TABLE
225 WON = FALSE
230 GOTO 970
240 IF FLAG=1 THEN GOSUB 2420 ELSE GOSUB 2070
250 IF ABORT THEN ABORT = FALSE : GOTO 230
260 FLAG=0:GOSUB 2320           'ASK IF THEY WANT TO PLAY AGAIN
270 IF ABORT THEN ABORT = FALSE : GOTO 230
280 CLS:IF FLAG=1 THEN 170 ELSE KEY ON:COLOR 7,0,0:CLS:END
290 RESTORE
300 FOR I=1 TO 52:READ CARD$(I):NEXT I
310 FOR I= 52 TO 1 STEP -1
320     X=INT(RND(1)*I)+1       'PICK NUMBER FROM 1 TO I
330     DECK$(I)=CARD$(X)       'PICK THAT CARD OUT OF THE PILE
340     CARD$(X)=CARD$(I)       'MOVE LAST CARD TO WHERE PREVIOUS ONE WAS
350 NEXT I
360 X=1                         'DECK COUNTER
370 FOR I=1 TO 7                'NUMBER OF STACKS
380   FOR J=1 TO I              'NUMBER OF CARDS IN THAT STACK
390     STACK$(I,J)=DECK$(X)    'ASSIGN CARDS TO STACK
400     X=X+1
410   NEXT J
420   STACKPTR(I)=I             'SET STACKPTR(I) TO LAST CARD IN EACH STACK
430   VISIPTR(I)=I              'SAME WITH VISIPTR(I)
440 NEXT I
450 DECKPTR=31:ENDDECK=52:DECK$(28)="   ":NC=24
460 DATA" AH"," 2H"," 3H"," 4H"," 5H"," 6H"," 7H"," 8H"," 9H","10H"," JH"," QH"," KH"
470 DATA" AD"," 2D"," 3D"," 4D"," 5D"," 6D"," 7D"," 8D"," 9D","10D"," JD"," QD"," KD"
480 DATA" AC"," 2C"," 3C"," 4C"," 5C"," 6C"," 7C"," 8C"," 9C","10C"," JC"," QC"," KC"
490 DATA" AS"," 2S"," 3S"," 4S"," 5S"," 6S"," 7S"," 8S"," 9S","10S"," JS"," QS"," KS"
500 FOR I=1 TO 7
510   STACK$(I,0)="   "
520 NEXT I
530 FOR I=1 TO 4
540   TOP$(I)="   "
550 NEXT I
560 RETURN
570 COLOR 3,1 :LOCATE 1,4:PRINT"TOP:":LOCATE 1,65:PRINT "Time: "
580 LOCATE 3,1:PRINT"STACKS:"
590 FOR I=7 TO 1 STEP -1
600   LOCATE  3,(45-(5*I))
610   PRINT I;
620 NEXT I
630 COLOR 7,1
640 FOR I=1 TO 7
650  FOR J=I TO 7
660     LOCATE (I+3),(45-(J*5))
670     IF VISIPTR(J)=I THEN C$=STACK$(J,I):GOSUB 2670:PRINT STACK$(J,I);:COLOR 7,1 ELSE FOR X=1 TO 3:PRINT CHR$(254);:NEXT X
680  NEXT J
690 NEXT I
700 COLOR 3,1
710 LOCATE 10 ,53:PRINT"PILE:";
720 COLOR 7,1
730 LOCATE 10,59:C$=DECK$(DECKPTR):GOSUB 2670:PRINT DECK$(DECKPTR);:COLOR 3,1:LOCATE 10,65:PRINT"Count: ";:COLOR 7:PRINT NC;:COLOR 3
740 LOCATE 11,64:PRINT"Card #: ";:COLOR 7:PRINT DECKPTR-28;"  ";
750 COLOR 3:LOCATE 12,50:PRINT"COMMAND: __  ";
760 COLOR 2
770 LOCATE 24,24:PRINT"Press F1 for a list of Commands";
780 COLOR 7
790 LOCATE 12,59
800 RETURN
810 SCREEN 0,1,1,0
820 CLS
830 LOCATE 10,10:PRINT"C    Claim Victory"
840 LOCATE 11,10:PRINT"N    New Card on Pile"
850 LOCATE 12,10:PRINT"P#   Card on Pile to Specified Stack"
860 LOCATE 13,10:PRINT"PT   Card on Pile to Top"
870 LOCATE 14,10:PRINT"##   Visible Cards on Stack to New Specified Stack"
880 LOCATE 15,10:PRINT"#T   Bottom Card on Specified Stack to Top"
890 LOCATE 16,10:PRINT"Q    Quit"
900 LOCATE 17,10:PRINT"F1   For This Screen"
910 COLOR 12:LOCATE 18,10:PRINT"Esc  Abort End and Return to Present Game
920 COLOR 2:LOCATE 22,28:PRINT"Press Any Key To Continue":COLOR 7
930 SCREEN 0,1,0,0
940 RETURN
950 SCREEN 0,1,0,1
960 A$=INKEY$:IF A$="" THEN 960 ELSE 930
970 FLAG=0:GOSUB 1640:IF FLAG=1 THEN 240
980 LOCATE 12,59:PRINT"__  ";:LOCATE 12,59
990 K$=INKEY$:IF K$="" THEN LOCATE 1,71:PRINT TIME$;:LOCATE 12,59:GOTO 990 ELSE PRINT K$;
1000 IF K$="N" OR K$="n" THEN 1060
1010 IF K$="P" OR K$="p" THEN 1140
1020 IF K$>="1"AND K$<="7" THEN 1700
1030 IF K$="Q" OR K$="q" THEN FLAG=0:GOTO 240
1040 IF K$="C" OR K$="c" THEN  2440
1050 SOUND 50,5:GOTO 980
1060 IF DECKPTR+3>ENDDECK THEN DECKPTR=28
1070 X=ENDDECK-28
1080 IF X <=3 THEN DECKPTR=ENDDECK ELSE DECKPTR=DECKPTR+3
1090 LOCATE 10,59
1100 C$=DECK$(DECKPTR):GOSUB 2670:PRINT DECK$(DECKPTR):COLOR 7,1
1110 LOCATE 11,72:PRINT DECKPTR-28;"  ";
1120 GOTO 980
1130 K$=INKEY$:IF K$="" THEN 1130 ELSE PRINT K$;:RETURN
1140 GOSUB 1130
1150 IF(K$="t" OR K$="T") OR (K$>="1" AND K$<="7") THEN 1160 ELSE SOUND 50,5:GOTO 980
1160 W$=DECK$(DECKPTR)
1170 SUIT$=MID$(W$,3,1):SIZE$=MID$(W$,2,1)
1180 IF K$="T" OR K$="t" THEN GOSUB 1360:GOTO 1260
1190 K=VAL(K$)
1200 W1$=STACK$(K,STACKPTR(K))
1210 SUITST$=MID$(W1$,3,1):SIZEST$=MID$(W1$,2,1)
1220 FLAG=0:GOSUB 1430:IF FLAG=0 THEN SOUND 50,5 :GOTO 970
1230 STACKPTR(K)=STACKPTR(K)+1
1240 STACK$(K,STACKPTR(K))=W$
1250 LOCATE STACKPTR(K)+3,(45-(K*5)):C$=W$:GOSUB 2670:PRINT W$:COLOR 7,1
1260 DECKPTR=DECKPTR-1:GOSUB 1300
1270 LOCATE 10,59:IF DECKPTR>28 THEN C$=DECK$(DECKPTR):GOSUB 2670:PRINT DECK$(DECKPTR):COLOR 7,1 ELSE PRINT"   "
1280 LOCATE 11,72:PRINT DECKPTR-28;"  ";
1290 GOTO 970
1300 IF DECKPTR+1=ENDDECK THEN 1340
1310 FOR I= DECKPTR+2 TO ENDDECK
1320 DECK$(I-1)=DECK$(I)
1330 NEXT I
1340 ENDDECK=ENDDECK-1:NC=NC-1:LOCATE 10,72:PRINT NC;
1350 RETURN
1360 IF SUIT$="C" THEN N=1:GOTO 1400
1370 IF SUIT$="D" THEN N=2:GOTO 1400
1380 IF SUIT$="H" THEN N=3:GOTO 1400
1390 N=4
1400 SIZEST$=MID$(TOP$(N),2,1)
1410 FLAG=0:GOSUB 1550:IF FLAG=0 THEN SOUND 50,5:GOTO 970
1420 TOP$(N)=W$:LOCATE 1,10+(10*(N-1)):C$=W$:GOSUB 2670:PRINT W$:COLOR 7,1:RETURN
1430 IF(SUIT$="H"OR SUIT$="D")AND(SUITST$="H"OR SUITST$="D") THEN RETURN
1440 IF(SUIT$="C"OR SUIT$="S")AND(SUITST$="C"OR SUITST$="S") THEN RETURN
1450 IF SIZE$>"9" THEN 1490
1460 IF SIZE$="0" AND SIZEST$="J" THEN 1540
1470 IF SIZE$="9" AND SIZEST$="0" THEN 1540
1480 IF (ASC(SIZEST$)-ASC(SIZE$))=1 THEN 1540
1490 IF SIZE$="A" AND SIZEST$="2" THEN 1540
1500 IF SIZE$="J" AND SIZEST$="Q" THEN 1540
1510 IF SIZE$="Q" AND SIZEST$="K" THEN 1540
1520 IF SIZE$="K" AND SIZEST$=" " THEN 1540
1530 RETURN
1540 FLAG=1:RETURN
1550 IF SIZE$="A" AND SIZEST$=" " THEN 1630
1560 IF SIZE$="2" AND SIZEST$="A" THEN 1630
1570 IF SIZE$="0" AND SIZEST$="9" THEN 1630
1580 IF (ASC(SIZE$)-ASC(SIZEST$))=1 THEN 1630
1590 IF SIZE$="J" AND SIZEST$="0" THEN 1630
1600 IF SIZE$="Q" AND SIZEST$="J" THEN 1630
1610 IF SIZE$="K" AND SIZEST$="Q" THEN 1630
1620 RETURN
1630 FLAG=1:RETURN
1640 REM  CHECK TO SEE IF THE GAME IS OVER
1650 FOR I=1 TO 4
1660 IF MID$(TOP$(I),2,1)<>"K" THEN RETURN
1670 NEXT I
1680 REM GAME OVER AND PLAYER WON
1690 FLAG=1:RETURN
1700 REM STACK TO STACK MOVE OR STACK TO TOP
1710 STKNUM1=VAL(K$)
1720 GOSUB 1130
1730 IF (K$>="1" AND K$<="7") OR (K$="T" OR K$="t") THEN 1750
1740 SOUND 50,5:GOTO 980
1750 IF K$="t" OR K$="T" THEN W$=STACK$(STKNUM1,STACKPTR(STKNUM1)):GOTO 1770
1760 W$=STACK$(STKNUM1,VISIPTR(STKNUM1))
1770 SUIT$=MID$(W$,3,1)
1780 SIZE$=MID$(W$,2,1)
1790 IF K$="T" OR K$="t" THEN GOSUB 1360:GOTO 2020
1800 STKNUM2=VAL(K$)
1810 W$=STACK$(STKNUM2,STACKPTR(STKNUM2))
1820 SUITST$=MID$(W$,3,1)
1830 SIZEST$=MID$(W$,2,1)
1840 FLAG=0:GOSUB 1430
1850 IF FLAG=0 THEN SOUND 50,5:GOTO 980
1860 IF VISIPTR(STKNUM1)=0 THEN VISIPTR(STKNUM1)=1
1870 FOR I=VISIPTR(STKNUM1) TO STACKPTR(STKNUM1)
1880 STACKPTR(STKNUM2)=STACKPTR(STKNUM2)+1
1890 LOCATE I+3,45-(STKNUM1*5):PRINT"   ";
1900 STACK$(STKNUM2,STACKPTR(STKNUM2))=STACK$(STKNUM1,I)
1910 LOCATE STACKPTR(STKNUM2)+3,45-(STKNUM2*5)
1920 C$ =  STACK$(STKNUM2,STACKPTR(STKNUM2)):GOSUB 2670
1930 PRINT STACK$(STKNUM2,STACKPTR(STKNUM2));:COLOR 7,1
1940 NEXT I
1950 IF VISIPTR(STKNUM1)>0 THEN VISIPTR(STKNUM1)=VISIPTR(STKNUM1)-1
1960 STACKPTR(STKNUM1)=VISIPTR(STKNUM1)
1970 IF STACKPTR(STKNUM1)<1 THEN 970
1980 LOCATE STACKPTR(STKNUM1)+3,45-(STKNUM1*5)
1990 C$ =  STACK$(STKNUM1,STACKPTR(STKNUM1)):GOSUB 2670
2000 PRINT STACK$(STKNUM1,STACKPTR(STKNUM1));:COLOR 7,1
2010 GOTO 970
2020 LOCATE STACKPTR(STKNUM1)+3,45-(STKNUM1*5)
2030 PRINT"   ";
2040 IF STACKPTR(STKNUM1)=VISIPTR(STKNUM1) THEN 1950
2050 STACKPTR(STKNUM1)=STACKPTR(STKNUM1)-1
2060 GOTO 970
2070 REM PRINT OUT THE TABLE
2080 COLOR 2 : SEEN = FALSE
2090 LOCATE 24,24:PRINT"Would you like to see the cards? "; :SOUND 1975,1:GOSUB 2550 : SOUND 1975,1
2100 A$=INKEY$:IF A$="" THEN 2100
2110 IF A$=CHR$(27) THEN ABORT=TRUE : LOCATE 24,24:PRINT SPACE$(40);:COLOR 7 : RETURN :ELSE ABORT=FALSE
2120 IF A$<>"y" AND A$<>"Y" AND A$<>"N" AND A$<>"n" THEN SOUND 50,5:GOTO 2100
2130 IF A$="N" OR A$="n" THEN 2300
2140 SEEN = TRUE : LOCATE 24,24:PRINT "                                    ";
2150 FOR I=7 TO 1 STEP -1
2160 X=1
2170 WHILE VISIPTR(I)>X
2180 LOCATE X+3,45-(I*5)
2190 PRINT STACK$(I,X);:X=X+1
2200 WEND
2210 NEXT I
2220 LOCATE 18,50:PRINT"Pile: "
2230 X=0:RR=18
2240 FOR I=29 TO ENDDECK
2250 IF X+56>76 THEN RR=RR+1:X=0
2260 LOCATE RR,X+56
2270 IF DECK$(I)="   "THEN 2300 ELSE PRINT DECK$(I);:X=X+4
2280 NEXT I
2290 COLOR 7
2300 RETURN
2310 COLOR 2
2320 IF SCR.WIDTH=40 THEN SCR.WIDTH =80:LOCATE 24,15:PRINT"Play Again?";:GOTO 2340 ELSE LOCATE 24,24
2330 LOCATE 24,24:PRINT"     Do you want to play again?                     ";
2340 A$=INKEY$:IF A$="" THEN 2340
2350 IF NOT WON THEN COLOR 7
2360 IF A$<>CHR$(27) THEN 2390 ELSE IF NOT SEEN AND NOT WON THEN ABORT=TRUE :LOCATE 24,28:PRINT SPACE$(30);:RETURN
2365 IF WON THEN SOUND 50,5: GOTO 2340
2370 SOUND 50,5:LOCATE 24,17:PRINT"Cheater... Shame Shame!  You've already seen the cards!";:DT!=2000:GOSUB 2570
2380 LOCATE 24,17 : PRINT SPACE$(60);:GOTO 2320
2390 IF A$="y" OR A$="Y" THEN GOSUB 2870:FLAG =1:RETURN
2400 IF A$="N" OR A$="n" THEN GOSUB 2870:RETURN
2410 SOUND 50,5:GOTO 2340
2420 GOSUB 2700
2430 RETURN
2440 'CHECK TO SEE IF CLAIMED VICTORY
2450 FLAG=0
2460 IF NC>0 THEN 2510
2470 FOR I=1 TO 7
2480 IF VISIPTR(I)>1 THEN 2510
2490 NEXT I
2500 FLAG=1:GOTO 240
2510 SOUND 50,5:LOCATE 14,50:PRINT"You Have Not Won Yet!!!"
2520 DT! = 2000 : GOSUB 2570
2530 LOCATE 14,50:PRINT SPC(25);
2540 GOTO 980
2550 'DELAY TIME ROUTINE FOR (DT!) MILLISECONDS
2560 DT!=250
2570 DV!=DT!*18.2/1000
2580 DEF SEG = &H40
2590 WHILE DV!>0
2600    A! = O
2610    FOR ID = O TO 3
2620    A! = A!*256 + PEEK(&H6F-ID)
2630    NEXT ID
2640    IF A! <> AOLD! THEN DV! = DV! - 1 : AOLD! = A!
2650 WEND
2660 DEF SEG : RETURN
2670 C$=MID$(C$,3,1)
2680 IF C$="H" OR C$="D" THEN COLOR 12,7 ELSE COLOR 0,7
2690 RETURN
2700 REM 'DISPLAY WON SCREEN'
2710 IF NOT.READ THEN FOR I = 1 TO 82 : READ XYARR$(I) : NEXT : NOT.READ=FALSE
2730 SCREEN 1,0 : COLOR 1,0
2740 FOR I = 82 TO 1 STEP -1
2750 FOR J = 1 TO 45
2760 X=RND(1)*320:Y=RND(1)*200:C=C+1:IF C=4 THEN C=1
2770 PSET (X,Y),C
2780 NEXT J
2790 LL = INT(RND(1)*I)+1
2800 XYPOS$=XYARR$(LL)
2810 XYARR$(LL)=XYARR$(I)
2820 Y = VAL(LEFT$(XYPOS$,1))+8
2830 X= VAL(RIGHT$(XYPOS$,2))
2840 LOCATE Y,X:PRINT "*";
2850 NEXT I
2860 SCR.WIDTH=40 : WON = TRUE : RETURN
2870 SCREEN 0,0,0,0:WIDTH 80:RETURN
2880  DATA "002","006","009","010","011","014","018","023","027","030"
2890  DATA "031","032","035","039","103","105","108","112","114"
2900  DATA "118","123","127","129","133","135","136","139","204","208"
2910  DATA "212","214","218","223","225","227","229","233","235","236"
2920  DATA "237","239","304","308","312","314","318","323","325","327"
2930  DATA "329","333","335","337","338","339","404","408","412","414"
2940  DATA "418","423","425","427","429","433","435","438","439","504"
2950  DATA "509","510","511","515","516","517","524","526","530","531"
2960  DATA "532","535","539"