10 REM ----------------------------------------------------------------------
20 REM
30 REM           The Game of Klondyke Solitar
40 REM           By:  Jeff Littlefield
50 REM           For: the IBM PC and the Color Graphics Card
60 REM
70 REM           FOR PUBLIC USE    MAY NOT BE SOLD
80 REM           ALL  RIGHTS  RESERVED
90 REM
100 REM ---------------------------------------------------------------------
110 DEFINT  A-Z
120 DIM DECK$(52), STACK$(7,21),CARD$(52),TOP$(4),STACKPTR(7),VISIPTR(7)
130 KEY OFF: KEY(1) ON: ON KEY(1) GOSUB 900
140 RANDOMIZE(VAL(MID$(TIME$,7,2))+(VAL(MID$(TIME$,4,2))*60))
150 CLS:SCREEN 0,0,0,0:PRINT"Pardon me while I shuffle the deck."
160 GOSUB 770            'SET UP THE HELP SCREEN
170 LOCATE 1,1:PRINT"Pardon me while I shuffle the deck."
180 GOSUB 250            'SHUFFLE THE DECK
190 CLS
200 GOSUB 530            'PRINT OUT THE PLAYING TABLE
210 GOTO 920
220 IF FLAG=1 THEN GOSUB 2310 ELSE GOSUB 2000
230 FLAG=0:GOSUB 2240           'ASK IF THEY WANT TO PLAY AGAIN
240 CLS:SCREEN 0,0,0,0:IF FLAG=1 THEN 170 ELSE KEY ON:END
250 RESTORE
260 FOR I=1 TO 52:READ CARD$(I):NEXT I
270 FOR I= 52 TO 1 STEP -1
280     X=INT(RND(1)*I)+1       'PICK NUMBER FROM 1 TO I
290     DECK$(I)=CARD$(X)       'PICK THAT CARD OUT OF THE PILE
300     CARD$(X)=CARD$(I)       'MOVE LAST CARD TO WHERE PREVIOUS ONE WAS
310 NEXT I
320 X=1                         'DECK COUNTER
330 FOR I=1 TO 7                'NUMBER OF STACKS
340   FOR J=1 TO I              'NUMBER OF CARDS IN THAT STACK
350     STACK$(I,J)=DECK$(X)    'ASSIGN CARDS TO STACK
360     X=X+1
370   NEXT J
380   STACKPTR(I)=I             'SET STACKPTR(I) TO LAST CARD IN EACH STACK
390   VISIPTR(I)=I              'SAME WITH VISIPTR(I)
400 NEXT I
410 DECKPTR=31:ENDDECK=52:DECK$(28)="   ":NC=24
420 DATA" A"," 2"," 3"," 4"," 5"," 6"," 7"," 8"," 9","10"," J"," Q"
421 DATA" K"
430 DATA" A"," 2"," 3"," 4"," 5"," 6"," 7"," 8"," 9","10"," J"," Q"
431 DATA" K"
440 DATA" A"," 2"," 3"," 4"," 5"," 6"," 7"," 8"," 9","10"," J"," Q"
441 DATA" K"
450 DATA" A"," 2"," 3"," 4"," 5"," 6"," 7"," 8"," 9","10"," J"," Q"
451 DATA" K"
460 FOR I=1 TO 7
470   STACK$(I,0)="   "
480 NEXT I
490 FOR I=1 TO 4
500   TOP$(I)="   "
510 NEXT I
520 RETURN
530 COLOR 3 :LOCATE 1,4:PRINT"TOP:"
540 LOCATE 3,1:PRINT"STACKS:"
550 FOR I=7 TO 1 STEP -1
560   LOCATE  3,(45-(5*I))
570   PRINT I;
580 NEXT I
590 COLOR 7
600 FOR I=1 TO 7
610  FOR J=I TO 7
620     LOCATE (I+3),(45-(J*5))
630     IF VISIPTR(J)=I THEN C$=STACK$(J,I):GOSUB 10000:PRINT STACK$(J,I);:COLOR 7,0 ELSE FOR X=1 TO 3:PRINT CHR$(254);:NEXT X
640  NEXT J
650 NEXT I
660 COLOR 3
670 LOCATE 10 ,53:PRINT"PILE:";
680 COLOR 7
690 LOCATE 10,59:C$=DECK$(DECKPTR):GOSUB 10000:PRINT DECK$(DECKPTR);:COLOR 3,0:LOCATE 10,65:PRINT"Count: ";:COLOR 7:PRINT NC;:COLOR 3
700 LOCATE 11,64:PRINT"Card #: ";:COLOR 7:PRINT DECKPTR-28;"  ";
710 COLOR 3:LOCATE 12,50:PRINT"COMMAND: __";
720 COLOR 2
730 LOCATE 24,24:PRINT"Press F1 for a list of Commands";
740 COLOR 7
750 LOCATE 12,59
760 RETURN
770 SCREEN 0,0,1,0
780 CLS
790 LOCATE 10,10:PRINT"C    Claim Victory"
800 LOCATE 11,10:PRINT"N    New Card on Pile"
810 LOCATE 12,10:PRINT"P#   Card on Pile to Specified Stack"
820 LOCATE 13,10:PRINT"PT   Card on Pile to Top"
830 LOCATE 14,10:PRINT"##   Visible Cards on Stack to New Specified Stack"
840 LOCATE 15,10:PRINT"#T   Bottom Card on Specified Stack to Top"
850 LOCATE 16,10:PRINT"Q    Quit"
860 LOCATE 17,10:PRINT"F1   For This Screen"
870 COLOR 2:LOCATE 22,28:PRINT"Press Any Key To Continue":COLOR 7
880 SCREEN 0,0,0,0
890 RETURN
900 SCREEN 0,0,0,1
910 A$=INKEY$:IF A$="" THEN 910 ELSE 880
920 FLAG=0:GOSUB 1590:IF FLAG=1 THEN 220
930 LOCATE 12,59:PRINT"__";:LOCATE 12,59
940 K$=INKEY$:IF K$="" THEN 940 ELSE PRINT K$;
950 IF K$="N" OR K$="n" THEN 1010
960 IF K$="P" OR K$="p" THEN 1090
970 IF K$>="1"AND K$<="7" THEN 1650
980 IF K$="Q" OR K$="q" THEN FLAG=0:GOTO 220
990 IF K$="C" OR K$="c" THEN  2330
1000 BEEP:GOTO 930
1010 IF DECKPTR+3>ENDDECK THEN DECKPTR=28
1020 X=ENDDECK-28
1030 IF X <=3 THEN DECKPTR=ENDDECK ELSE DECKPTR=DECKPTR+3
1040 LOCATE 10,59
1050 C$=DECK$(DECKPTR):GOSUB 10000:PRINT DECK$(DECKPTR):COLOR 7,0
1060 LOCATE 11,72:PRINT DECKPTR-28;"  ";
1070 GOTO 930
1080 K$=INKEY$:IF K$="" THEN 1080 ELSE PRINT K$;:RETURN
1090 GOSUB 1080
1100 IF(K$="t" OR K$="T") OR (K$>="1" AND K$<="7") THEN 1110 ELSE BEEP:GOTO 930
1110 W$=DECK$(DECKPTR)
1120 SUIT$=MID$(W$,3,1):SIZE$=MID$(W$,2,1)
1130 IF K$="T" OR K$="t" THEN GOSUB 1310:GOTO 1210
1140 K=VAL(K$)
1150 W1$=STACK$(K,STACKPTR(K))
1160 SUITST$=MID$(W1$,3,1):SIZEST$=MID$(W1$,2,1)
1170 FLAG=0:GOSUB 1380:IF FLAG=0 THEN BEEP :GOTO 920
1180 STACKPTR(K)=STACKPTR(K)+1
1190 STACK$(K,STACKPTR(K))=W$
1200 LOCATE STACKPTR(K)+3,(45-(K*5)):C$=W$:GOSUB 10000:PRINT W$:COLOR 7,0
1210 DECKPTR=DECKPTR-1:GOSUB 1250
1220 LOCATE 10,59:IF DECKPTR>28 THEN C$=DECK$(DECKPTR):GOSUB 10000:PRINT DECK$(DECKPTR):COLOR 7,0 ELSE PRINT"   "
1230 LOCATE 11,72:PRINT DECKPTR-28;"  ";
1240 GOTO 920
1250 IF DECKPTR+1=ENDDECK THEN 1290
1260 FOR I= DECKPTR+2 TO ENDDECK
1270 DECK$(I-1)=DECK$(I)
1280 NEXT I
1290 ENDDECK=ENDDECK-1:NC=NC-1:LOCATE 10,72:PRINT NC;
1300 RETURN
1310 IF SUIT$="" THEN N=1:GOTO 1350
1320 IF SUIT$="" THEN N=2:GOTO 1350
1330 IF SUIT$="" THEN N=3:GOTO 1350
1340 N=4
1350 SIZEST$=MID$(TOP$(N),2,1)
1360 FLAG=0:GOSUB 1500:IF FLAG=0 THEN BEEP:GOTO 920
1370 TOP$(N)=W$:LOCATE 1,10+(10*(N-1)):C$=W$:GOSUB 10000:PRINT W$:COLOR 7,0:RETURN
1380 IF(SUIT$=""OR SUIT$="")AND(SUITST$=""OR SUITST$="") THEN RETURN
1390 IF(SUIT$=""OR SUIT$="")AND(SUITST$=""OR SUITST$="") THEN RETURN
1400 IF SIZE$>"9" THEN 1440
1410 IF SIZE$="0" AND SIZEST$="J" THEN 1490
1420 IF SIZE$="9" AND SIZEST$="0" THEN 1490
1430 IF (ASC(SIZEST$)-ASC(SIZE$))=1 THEN 1490
1440 IF SIZE$="A" AND SIZEST$="2" THEN 1490
1450 IF SIZE$="J" AND SIZEST$="Q" THEN 1490
1460 IF SIZE$="Q" AND SIZEST$="K" THEN 1490
1470 IF SIZE$="K" AND SIZEST$=" " THEN 1490
1480 RETURN
1490 FLAG=1:RETURN
1500 IF SIZE$="A" AND SIZEST$=" " THEN 1580
1510 IF SIZE$="2" AND SIZEST$="A" THEN 1580
1520 IF SIZE$="0" AND SIZEST$="9" THEN 1580
1530 IF (ASC(SIZE$)-ASC(SIZEST$))=1 THEN 1580
1540 IF SIZE$="J" AND SIZEST$="0" THEN 1580
1550 IF SIZE$="Q" AND SIZEST$="J" THEN 1580
1560 IF SIZE$="K" AND SIZEST$="Q" THEN 1580
1570 RETURN
1580 FLAG=1:RETURN
1590 REM  CHECK TO SEE IF THE GAME IS OVER
1600 FOR I=1 TO 4
1610 IF MID$(TOP$(I),2,1)<>"K" THEN RETURN
1620 NEXT I
1630 REM GAME OVER AND PLAYER WON
1640 FLAG=1:RETURN
1650 REM STACK TO STACK MOVE OR STACK TO TOP
1660 STKNUM1=VAL(K$)
1670 GOSUB 1080
1680 IF (K$>="1" AND K$<="7") OR (K$="T" OR K$="t") THEN 1700
1690 BEEP:GOTO 930
1700 IF K$="t" OR K$="T" THEN W$=STACK$(STKNUM1,STACKPTR(STKNUM1)):GOTO 1720
1710 W$=STACK$(STKNUM1,VISIPTR(STKNUM1))
1720 SUIT$=MID$(W$,3,1)
1730 SIZE$=MID$(W$,2,1)
1740 IF K$="T" OR K$="t" THEN GOSUB 1310:GOTO 1950
1750 STKNUM2=VAL(K$)
1760 W$=STACK$(STKNUM2,STACKPTR(STKNUM2))
1770 SUITST$=MID$(W$,3,1)
1780 SIZEST$=MID$(W$,2,1)
1790 FLAG=0:GOSUB 1380
1800 IF FLAG=0 THEN BEEP:GOTO 930
1810 IF VISIPTR(STKNUM1)=0 THEN VISIPTR(STKNUM1)=1
1820 FOR I=VISIPTR(STKNUM1) TO STACKPTR(STKNUM1)
1830 STACKPTR(STKNUM2)=STACKPTR(STKNUM2)+1
1840 LOCATE I+3,45-(STKNUM1*5):PRINT"   ";
1850 STACK$(STKNUM2,STACKPTR(STKNUM2))=STACK$(STKNUM1,I)
1860 LOCATE STACKPTR(STKNUM2)+3,45-(STKNUM2*5)
1870 C$ =  STACK$(STKNUM2,STACKPTR(STKNUM2)):GOSUB 10000
1875 PRINT STACK$(STKNUM2,STACKPTR(STKNUM2));:COLOR 7,0
1880 NEXT I
1890 IF VISIPTR(STKNUM1)>0 THEN VISIPTR(STKNUM1)=VISIPTR(STKNUM1)-1
1900 STACKPTR(STKNUM1)=VISIPTR(STKNUM1)
1910 IF STACKPTR(STKNUM1)<1 THEN 920
1920 LOCATE STACKPTR(STKNUM1)+3,45-(STKNUM1*5)
1930 C$ =  STACK$(STKNUM1,STACKPTR(STKNUM1)):GOSUB 10000
1935 PRINT STACK$(STKNUM1,STACKPTR(STKNUM1));:COLOR 7,0
1940 GOTO 920
1950 LOCATE STACKPTR(STKNUM1)+3,45-(STKNUM1*5)
1960 PRINT"   ";
1970 IF STACKPTR(STKNUM1)=VISIPTR(STKNUM1) THEN 1890
1980 STACKPTR(STKNUM1)=STACKPTR(STKNUM1)-1
1990 GOTO 920
2000 REM PRINT OUT THE TABLE
2010 COLOR 2
2020 LOCATE 24,24:PRINT"Would you like to see the cards? ";
2030 A$=INKEY$:IF A$="" THEN 2030
2040 IF A$<>"y" AND A$<>"Y" AND A$<>"N" AND A$<>"n" THEN BEEP:GOTO 2030
2050 IF A$="N" OR A$="n" THEN 2220
2060 LOCATE 24,24:PRINT "                                    ";
2070 FOR I=7 TO 1 STEP -1
2080 X=1
2090 WHILE VISIPTR(I)>X
2100 LOCATE X+3,45-(I*5)
2110 PRINT STACK$(I,X);:X=X+1
2120 WEND
2130 NEXT I
2140 LOCATE 18,50:PRINT"Pile: "
2150 X=0:RR=18
2160 FOR I=29 TO ENDDECK
2170 IF X+56>76 THEN RR=RR+1:X=0
2180 LOCATE RR,X+56
2190 IF DECK$(I)="   "THEN 2220 ELSE PRINT DECK$(I);:X=X+4
2200 NEXT I
2210 COLOR 7
2220 RETURN
2230 COLOR 2
2240 LOCATE 24,24
2250 PRINT"Do you want to play again?                     ";
2260 A$=INKEY$:IF A$="" THEN 2260
2270 COLOR 7
2280 IF A$="y" OR A$="Y" THEN FLAG =1:RETURN
2290 IF A$="N" OR A$="n" THEN RETURN
2300 BEEP:GOTO 2260
2310 CLS:LOCATE 10,15:PRINT"YOU  WON   C O N G R A T U L A T I O N S ! ! !"
2320 RETURN
2330 'CHECK TO SEE IF CLAIMED VICTORY
2340 FLAG=0
2350 IF NC>0 THEN 2400
2360 FOR I=1 TO 7
2370 IF VISIPTR(I)>1 THEN 2400
2380 NEXT I
2390 FLAG=1:GOTO 220
2400 BEEP:LOCATE 14,50:PRINT"You Have Not Won Yet!!!"
2410 Z=VAL(MID$(TIME$,7,2))
2415 IF VAL(MID$(TIME$,7,2))-2 <> Z THEN 2415 ELSE LOCATE 14,50:PRINT SPC(25);
2420 GOTO 930
10000 C$=MID$(C$,3,1)
10010 IF C$="" OR C$="" THEN COLOR 4,7 ELSE COLOR 0,7
10020 RETURN
URN