
100 REM MODIFIED FROM A DOWNLOAD FROM XA1
101 REM SLIGHT FORMAT ERRORS FIXED AND PROGRAM SHRUNK 
110 REM %%%%%%%%%%%%%%%%%%%%%%%%
120 REM PREPARE COMPUTER
130 REM %%%%%%%%%%%%%%%%%%%%%%%%
140 CLEAR 1000
150 REM %%%%%%%%%%%%%%%%%%%%%%%%
160 REM DEFINE ARRAYS USED
170 REM %%%%%%%%%%%%%%%%%%%%%%%%
180 DIM P$(24),D$(13,4),H$(4),H(4),A(52),B(52),D(13,4),T$(7,20),RD(24),SD(24)
280 DIM U(7),L(7),S(7,20),T(7,20)
320 REM %%%%%%%%%%%%%%%%%%%%%%%%
330 REM DEFINE THE DECK
340 FOR R=1 TO 13
350 READ A$
360 FOR S = 1 TO 4
370 D$(R,S) = A$
380 NEXT S
390 NEXT R
400 DATA " A"," 2"," 3"," 4"," 5"," 6"," 7"," 8"," 9","10"," J"," Q"," K"
410 FOR S = 1 TO 4
420 READ A$
430 FOR R = 1 TO 13
440 D$(R,S) = D$(R,S) +A$
450 NEXT R
460 NEXT S
470 DATA "D ","C ","H ","S "
480 REM %%%%%%%%%%%%%%%%%%%%%%%%
490 REM SHUFFLE THE DECK
500 CARD = 1
510 Q7 = 0
520 FOR E = 1 TO 13
530 FOR F = 1 TO 4
540 H$(F) = "    "
550 H(F) = 0
560 D(E,F) = 0
570 NEXT F
580 NEXT E
590 E =RND(13):F=RND(4)
610 IF D(E,F) = 1 THEN 590
620 A(CARD) = E
630 B(CARD) = F
640 D(E,F) = 1
650 CARD = CARD +1
660 IF CARD <= 52 THEN 590
670 REM %%%%%%%%%%%%%%%%%%%%%%%%
680 REM PREPARE TABLEAU
690 FOR Y = 1 TO 16
700 FOR X = 1 TO 7
710 T$(X,Y) = "    "
720 NEXT X
730 NEXT Y
740 REM %%%%%%%%%%%%%%%%%%%%%%%%
750 REM DEAL OUT TABLEAU
760 CARD = 1
770 FOR Y = 1 TO 7
780 FOR X = Y TO 7
790 S(X,Y) = A(CARD)
800 T(X,Y) = B(CARD)
810 T$(X,Y) = CHR$(175) +CHR$(175) +CHR$(175) +CHR$(175)
820 IF X = Y THEN T$(X,Y) = D$(S(X,Y),T(X,Y))
830 CARD = CARD +1
840 NEXT X
850 NEXT Y
860 CLS
870 FOR X = 1 TO 7
880 U(X) = X
890 L(X) = X
900 NEXT X
910 GOSUB 2450
920 REM %%%%%%%%%%%%%%%%%%%%%%%%
930 REM TABLEAU TO ACES-UP?
940 FOR I = 7 TO 1 STEP -1
950 IF U(I) = 0 THEN 980
960 IF T(I,U(I)) = 0 THEN 980
970 IF S(I,U(I)) = H(T(I,U(I))) +1 THEN 1000
980 NEXT I
990 GOTO 1150
1000 H$(T(I,U(I))) = T$(I,U(I))
1010 H(T(I,U(I))) = S(I,U(I))
1020 GOSUB 2520
1030 T$(I,U(I)) = "    "
1040 S(I,U(I)) = 0
1050 T(I,U(I)) = 0
1060 IF U(I) -1 = 0 THEN 1090
1070 T$(I,U(I) -1) = D$(S(I,U(I) -1),T(I,U(I) -1))
1080 IF U(I) = L(I) THEN L(I) = L(I) -1
1090 U(I) = U(I) -1
1100 IF U(I) = 0 THEN L(I) = 0
1110 GOSUB 2450
1120 GOTO 940
1130 REM %%%%%%%%%%%%%%%%%%%%%%%
1140 REM KING TO TABLEAU EMPTY SPACE?
1150 Q2 = 0
1160 FOR I = 1 TO 7
1170 IF L(I) = 0 THEN GOSUB 1210
1180 NEXT I
1190 IF Q2 = 1 THEN 940
1200 GOTO 1490
1210 FOR J = 7 TO 1 STEP -1
1220 IF L(J) = 0 THEN 1240
1230 IF S(J,L(J)) = 13 THEN 1260
1240 NEXT J
1250 GOTO 1490
1260 IF L(J) = 1 THEN 1240
1270 Q2 = 1
1280 GOSUB 1300
1290 GOTO 940
1300 K = U(J) -L(J) +1
1310 FOR M = 1 TO K
1320 T$(I,U(I) +M) = T$(J,L(J) +M -1)
1330 S(I,U(I) +M) = S(J,L(J) +M -1)
1340 T(I,U(I) +M) = T(J,L(J) +M -1)
1350 T$(J,L(J) +M -1) = "    "
1360 S(J,L(J) +M -1) = 0
1370 T(J,L(J) +M -1) = 0
1380 NEXT M
1390 L(J) = L(J) -1
1400 U(J) = L(J)
1410 U(I) = U(I) +K
1420 IF L(I) = 0 THEN L(I) = 1
1430 IF L(J) = 0 THEN 1450
1440 T$(J,L(J)) = D$(S(J,L(J)),T(J,L(J)))
1450 GOSUB 2450
1460 RETURN
1470 REM %%%%%%%%%%%%%%%%%%%%%%%
1480 REM MOVE WITHIN TABLEAU?
1490 Q3 = 0
1500 FOR J = 7 TO 1 STEP -1
1510 FOR I = 1 TO 7
1520 IF L(J) = 0 THEN 1550
1530 IF U(I) = 0 THEN 1550
1540 IF S(I,U(I)) = S(J,L(J)) +1 THEN 1580
1550 NEXT I
1560 NEXT J
1570 GOTO 1630
1580 IF INT(T(I,U(I)) / 2) *2 - T(I,U(I)) <> INT(T(J,L(J)) / 2) *2 -T(J,L(J)) THEN 1600
1590 GOTO 1550
1600 Q3 = 1
1610 GOSUB 1300
1620 GOTO 940
1630 IF Q7 = 1 THEN 1680
1640 CARD = 28
1650 DISCARD = 0
1660 REM %%%%%%%%%%%%%%%%%%%%%%%
1670 REM TURN UP DISCARD IF NEEDED
1680 IF DISCARD = 0 THEN 1700
1690 IF Q4 = 1 OR Q5 = 1 OR Q6 = 1 THEN 1800
1700 CARD = CARD +1
1710 IF CARD > 52 THEN 1800
1720 Q7 = 1
1730 DISCARD = DISCARD +1
1740 RD(DISCARD) = A(CARD)
1750 SD(DISCARD) = B(CARD)
1760 P$(DISCARD) = D$(RD(DISCARD),SD(DISCARD))
1770 GOSUB 2590
1780 REM %%%%%%%%%%%%%%%%%%%%%%
1790 REM DISCARD TO ACES-UP
1800 Q4 = 0
1810 IF RD(DISCARD) = H(SD(DISCARD)) +1 THEN 1830
1820 GOTO 1970
1830 Q4 = 1
1840 H$(SD(DISCARD)) = P$(DISCARD)
1850 H(SD(DISCARD)) = RD(DISCARD)
1860 GOSUB 2520
1870 RD(DISCARD) = 0
1880 SD(DISCARD) = 0
1890 P$(DISCARD) = "    "
1900 DISCARD = DISCARD -1
1910 IF DISCARD = 0 THEN 1930
1920 P$(DISCARD) = D$(RD(DISCARD),SD(DISCARD))
1930 GOSUB 2590
1940 GOTO 940
1950 REM %%%%%%%%%%%%%%%%%%%%%%%
1960 REM KING FROM DISCARD TO EMPTY TABLEAU SPACE
1970 Q5 = 0
1980 FOR I = 1 TO 7
1990 IF U(I) = 0 THEN 2010
2000 GOTO 2020
2010 IF RD(DISCARD) = 13 THEN 2040
2020 NEXT I
2030 GOTO 2140
2040 Q5 = 1
2050 S(I,1) = RD(DISCARD)
2060 T(I,1) = SD(DISCARD)
2070 T$(I,1) = D$(S(I,1),T(I,1))
2080 U(I) = 1
2090 L(I) = 1
2100 GOSUB 2450
2110 GOTO 1870
2120 REM %%%%%%%%%%%%%%%%%%%%%%%
2130 REM MOVE DISCARD TO TABLEAU
2140 Q6 = 0
2150 FOR I = 1 TO 7
2160 IF U(I) = 0 THEN 2200
2170 IF S(I,U(I)) = RD(DISCARD) +1 THEN 2190
2180 GOTO 2200
2190 IF INT(SD(DISCARD) / 2) *2 -SD(DISCARD) <> INT(T(I,U(I)) / 2) *2 -T(I,U(I)) THEN 2230
2200 NEXT I
2210 IF CARD = 53 THEN 2350
2220 GOTO 1680
2230 Q6 = 1
2240 S(I,U(I) +1) = RD(DISCARD)
2250 T(I,U(I) +1) = SD(DISCARD)
2260 T$(I,U(I) +1) = D$(S(I,U(I) +1),T(I,U(I) +1))
2270 U(I) = U(I) +1
2280 GOSUB 2450
2290 GOTO 1870
2300 GOSUB 2450
2310 GOSUB 2520
2320 GOSUB 2590
2330 REM %%%%%%%%%%%%%%%%%%%%%%%
2340 REM GAME OVER - DISPLAY SCORES
2350 SCORE = 5 *(H(1) +H(2) +H(3) +H(4))
2360 TSCORE = TSCORE +SCORE
2370 GAMES = GAMES +1
2380 AVGSCORE = TSCORE / GAMES
2390 PRINT @ 416,"**  GAME"GAMES"OVER  **";
2400 PRINT @ 448,"SCORE=";SCORE;" AVG=";INT(AV)
2420 GOTO 500
2430 REM %%%%%%%%%%%%%%%%%%%%%%%
2440 REM PRINT TABLEAU SUBROUTINE
2450 FOR J = 1 TO 15
2460 Z = 32 *J -32
2470 PRINT @ Z,T$(1,J);T$(2,J);T$(3,J);T$(4,J );T$(5,J);T$(6,J);T$(7,J);
2480 NEXT J
2490 RETURN
2500 REM %%%%%%%%%%%%%%%%%%%%%%%
2510 REM PRINT ACES UP PILES
2520 PRINT @ 480,H$(1);
2530 PRINT @ 488,H$(2);
2540 PRINT @ 496,H$(3);
2550 PRINT @ 504,H$(4);
2560 RETURN
2570 REM %%%%%%%%%%%%%%%%%%%%%%%
2580 REM PRINT DISCARD PILE SUBROUTINE
2590 PILE = DISCARD
2600 AT = 476
2610 PRINT @ AT,"    ";
2620 IF PILE < 1 OR AT < 28 THEN 2680
2630 PRINT @ AT,P$(PILE);
2640 PILE = PILE -1
2650 AT = AT -32
2660 IF AT > 27 THEN PRINT @ AT,"    ";
2670 GOTO 2620
2680 RETURN
