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