2000 REM *****************
2010 REM ** SOLITAIRE **
2020 REM *****************
2025 REM COPYRIGHT JAN 1983, BOB FOWLER
2030
2040 MAP1 TAKEN(52),B,1
2050
2060 MAP1 DECK1'CARD(52)
2070 MAP2 DECK1'KIND,B,1
2080 MAP2 DECK1'SUIT,B,1
2090 MAP2 DECK1'COLOR,B,1
2100 MAP2 DECK1'CODE$,S,3
2110
2120 MAP1 DECK2'CARD(52)
2130 MAP2 DECK2'KIND,B,1
2140 MAP2 DECK2'SUIT,B,1
2150 MAP2 DECK2'COLOR,B,1
2160 MAP2 DECK2'CODE$,S,3
2170
2180 MAP1 STACK'CARD(10,19)
2190 MAP2 STACK'KIND,B,1
2200 MAP2 STACK'SUIT,B,1
2210 MAP2 STACK'COLOR,B,1
2220 MAP2 STACK'CODE$,S,3
2230 MAP1 IN'STACK(10),B,1
2240 MAP1 CARDS'DOWN(10),B,1
2250 MAP1 EMPTY'STACKS,B,1
2260
2270 MAP1 SUIT'STACK(4),B,1
2280
2290 MAP1 SUIT'CODE$(4),S,1
2300 MAP1 SUIT'CODES$,S,4,"HDCS" ! FIRST 2 SUITS WILL BE LOW CRT INTENSITY
2310 MAP1 KIND'CODE$(13),S,2
2320 MAP1 KIND'CODES$,S,26," A 2 3 4 5 6 7 8 910 J Q K"
2330
2340 REM ...... OTHER STRING DEFINITIONS
2350 MAP1 CARD'WIDTH,F,6,4
2360 MAP1 STACK'BASE'COLUMN,F,6,1
2370 MAP1 BLANK$,S,3," **"
2380 MAP1 COMD$,S,15
2390
2400 REM ...... MAPS RELATING TO HOW CARDS ARE DEALT
2410 MAP1 LC'USED$,S,1
2420 MAP1 FCARD1,B,1
2430 MAP1 LCARD2,B,1
2440 MAP1 LAST'LCARD2,B,1
2450 MAP1 LAST'LAST'LCARD2,B,1
2460
2470 REM ...... WIN/LOSS FILE OUTPUT MAPS
2480 MAP1 WINDATA
2490 MAP2 WIN$ ,S,1
2500 MAP2 NDECK ,B,1
2510 MAP2 NDOWN ,B,1
2520 MAP2 NUP ,B,1
2530 MAP2 NACES ,B,1
2540 MAP2 NSTACK2,B,1
2550 MAP1 FBLOX ,F,6,20 ! SIZE OF WIN/LOSS FILE IN BLOCKS
2560 MAP1 RECORDS,F,6
2570 MAP1 IMAGE1$,S,36," #### #### #### #### ####"
2580 MAP1 FNAME$,S,15,"SOLIT.DAT"
2590 MAP1 TITLE1$,S,55," ---- ---- ---- ---- ---- ---- ----"
2600 MAP1 TITLE2$,S,55," #### WIN DECK DOWN -UP- SUIT ACES"
2610
2620
2630
2640 !---------------------------!
2650 ! ONE-TIME INITIALIZATION !
2660 !---------------------------!
2670
2680 INITIALIZE:
2690 FOR I=1 TO 04 : SUIT'CODE$(I)=SUIT'CODES$[I,I] : NEXT I
2700 FOR I=1 TO 13 : KIND'CODE$(I)=KIND'CODES$[2*I-1;2] : NEXT I
2710 STACK'BASE=STACK'BASE'COLUMN - CARD'WIDTH
2720 ACE'BASE=STACK'BASE + 10*CARD'WIDTH
2730 NOTE'BASE=ACE'BASE+CARD'WIDTH
2740 SEVEN=7 ! CONTROLS # OF CARD COLUMNS IN GAME
2750 PRINT TAB(-1,0);
2760
2770
2780
2790 !------------------------------------!
2800 ! BEGINNING OF MAIN EXECUTION LOOP !
2810 !------------------------------------!
2820
2830 MAIN'LOOP:
2840 GOSUB OPEN'FILE
2850 CLOSE #1
2860 GAME=NEXT'GAME
2870 EMPTY'STACKS=0
2880 KINGS'WAITING=0
2890 FCARD1=1
2900 LCARD2=0
2910 FOR I=1 TO 4 : SUIT'STACK(I)=0 : NEXT I
2920 LC'USED$="N"
2930 LAST'LAST'LCARD2=54
2940 LAST'LCARD2=53
2950 START'TIME=TIME
2960
2970 REM ...... DISPLAY BEGINNING NOTES
2980 PRINT TAB(-1,0);
2990 PRINT TAB(-1,12);
3000 PRINT TAB(15,NOTE'BASE); TAB(-1,9);
3010 PRINT "--- WELCOME TO AM-100 SOLITAIRE ! ---";
3020 PRINT TAB(16,NOTE'BASE); TAB(-1,9);
3030 PRINT "SO FAR,"; RECORDS; "GAMES HAVE BEEN PLAYED !";
3040 REM ...... ENTER COMMAND
3050 PRINT TAB(17,NOTE'BASE); TAB(-1,9);
3060 PRINT "ENTER SPEED (SEC/MOVE) : 0.1";
3070 FOR I=1 TO 3 : PRINT CHR(8); : NEXT I
3080 COMD$="0.1"
3090 INPUT "" COMD$
3100 PRINT TAB(17,NOTE'BASE+25); TAB(-1,9);
3110 REM ...... CHECK FOR VARIOUS COMMANDS
3120 IF(INSTR(1,"END" ,COMD$)=1) THEN PRINT "END" ; : GOTO END
3130 IF(INSTR(1,"WINS",COMD$)=1) THEN PRINT "WINS"; : GOTO OUTPUT'WINS
3140 IF(INSTR(1,"GAME",COMD$)=1) THEN PRINT "GAME"; : GOTO SELECT'GAME
3150 IF(INSTR(1,"HOG" ,COMD$)=1) THEN PRINT "HOG" ; : GOSUB HOG : GOTO END
3160 RATE=VAL(COMD$)
3170 PRINT COMD$;
3180 GOTO BEGIN'GAME
3190
3200
3210
3220 !------------------------------!
3230 ! REPLAY GAME BY GAME NUMBER !
3240 !------------------------------!
3250
3260 SELECT'GAME:
3270 GOSUB OPEN'FILE
3280 CLOSE #1
3290 GAME=NEXT'GAME
3300 PRINT GAME;
3310 PRINT TAB(17,NOTE'BASE+30);
3320 INPUT "" GAME ! DEFAULTS TO NEXT GAME IN SEQUENCE
3330 PRINT TAB(17,NOTE'BASE+29); TAB(-1,9); GAME;
3340 DRAW=RND( SIN(GAME)-1 ) ! SEED FOR RANDOM # SEQUENCE IS SIN(I)-1
3350 RATE=0.1
3360 GOTO BEGIN'GAME
3370
3380
3390
3400 !-------------------------------------------!
3410 ! OUTPUT WIN/LOSS DATA FROM WIN/LOSS FILE !
3420 !-------------------------------------------!
3430
3440 OUTPUT'WINS:
3450 PRINT TAB(18,NOTE'BASE);
3460 INPUT LINE "ENTER DEVICE NAME : ", COMD$
3470 REM ...... CHECK FOR DEFAULT OUTPUT TO CRT
3480 IF(COMD$ <> "") THEN GOTO OPEN'PRINTER
3490 P=0
3500 PRINT #P, TAB(-1,0);
3510 GOTO CHECK'RECORDS
3520 OPEN'PRINTER:
3530 P=99
3540 OPEN #99, "TRM:"+COMD$, OUTPUT
3560 CHECK'RECORDS:
3570 GOSUB OPEN'FILE
3580 IF(RECORDS=0) THEN ? #P, " ["; FNAME$; " EMPTY]" : GOTO END'PRINT
3590 WINS=0
3600 LOSSES=0
3610 REM ...... OUTPUT LOOP
3620 FOR REC1=1 TO RECORDS
3630 REM ...... CHECK FOR NEW PAGE
3640 IF( (REC1-1)/50 <> INT( (REC1-1)/50 ) ) THEN GOTO CHECK'SUB'PAGE
3645 PRINT #P, CHR(12);
3650 PRINT #P, TITLE1$
3660 PRINT #P, TITLE2$
3670 PRINT #P, TITLE1$
3680 CHECK'SUB'PAGE:
3690 IF( (REC1-1)/10 = INT( (REC1-1)/10 ) ) THEN PRINT #P
3700 READ #1, WINDATA
3710 PRINT #P, USING " #####", REC1;
3720 IF(WIN$="W") THEN PRINT #P, " WIN"; ELSE PRINT #P, " LOSE";
3730 IF(WIN$="W") THEN WINS=WINS+1 ELSE LOSSES=LOSSES+1
3740 PRINT #P, USING IMAGE1$, NDECK, NDOWN, NUP, NSTACK2, NACES
3750 NEXT REC1
3760
3770 REM ...... FINAL COMMENTS
3780 PRINT #P
3790 PRINT #P, TAB(21); STR$(WINS); " WINS , "; STR$(LOSSES); " LOSSES"
3800 IF(P=99) THEN CLOSE #P
3810 END'PRINT:
3820 CLOSE #1
3830
3840 END'DATA:
3850 PRINT
3860 COMD$="Y"
3870 PRINT
3880 PRINT " GO ON TO NEXT GAME ? ('Y' OR 'N' OR DEFAULT 'Y') : ";
3890 INPUT "" COMD$
3900 IF(COMD$="Y") THEN GOTO MAIN'LOOP ELSE GOTO END
3910
3920
3930
3940 !--------------!
3950 ! BEGIN GAME !
3960 !--------------!
3970
3980 BEGIN'GAME:
3990
4000 REM ...... SHUFFLE CARD DECK
4010 PRINT TAB(18,NOTE'BASE); "NOW SHUFFLING CARD DECK .... ";
4020 REM ...... CLEAR DECK
4030 FOR I=1 TO 52 : TAKEN(I)=0 : NEXT I
4040 REM ...... FOLLOWING ALGORITHM REQUIRES AVERAGE OF 235.98 RANDOM #'S
4050 FOR I=1 TO 52
4060 DRAW:
4070 DRAW=INT(51.9999*RND(1))+1
4080 IF(TAKEN(DRAW)=1) THEN GOTO DRAW
4090 TAKEN(DRAW)=1
4100 DECK1'KIND(I)=INT( (DRAW-1)/4 )+1
4110 DECK1'SUIT(I)=DRAW-4*(DECK1'KIND(I)-1)
4120 DECK1'COLOR(I)=11+INT(DECK1'SUIT(I)/3)
4130 DECK1'CODE$(I)=KIND'CODE$(DECK1'KIND(I)) + SUIT'CODE$(DECK1'SUIT(I))
4140 NEXT I
4150 PRINT "DONE !";
4160 GOSUB WAIT
4170 GOSUB WAIT
4180 PRINT TAB(18,NOTE'BASE); TAB(-1,9);
4190
4200 REM ...... SET UP STACKS AND DISPLAY
4210 FOR ROW=1 TO SEVEN
4220 FOR COLUMN=ROW TO SEVEN
4230 STACK'CARD(COLUMN,ROW)=DECK1'CARD(FCARD1)
4240 FCARD1=FCARD1+1
4250
4260 REM ...... FACE-UP CARD CHECK
4270 IF(ROW <> COLUMN) THEN GOTO FACE'DOWN
4280 PRINT TAB(ROW,COLUMN*CARD'WIDTH+STACK'BASE);
4290 PRINT TAB(-1,STACK'COLOR(COLUMN,ROW));
4300 PRINT STACK'CODE$(COLUMN,ROW);
4310 GOTO NEXT'COLUMN
4320
4330 FACE'DOWN:
4340 IF(COLUMN=ROW+1) THEN PRINT TAB(-1,12);
4350 PRINT SPACE(CARD'WIDTH-3); BLANK$;
4360 NEXT'COLUMN:
4370 NEXT COLUMN
4380 NEXT ROW
4390
4400 FOR COLUMN=1 TO SEVEN
4410 IN'STACK(COLUMN)=COLUMN
4420 CARDS'DOWN(COLUMN)=COLUMN-1
4430 NEXT COLUMN
4440
4450 PRINT TAB(-1,12);
4460 PRINT TAB(20,1); "# OF CARDS IN LEFT DECK (FACE DOWN) : "; 53-FCARD1;
4470 PRINT TAB(21,1); "# OF CARDS IN RIGHT DECK (FACE UP) : "; LCARD2;
4480 LAST'TIME=TIME
4490
4500 CARD'MOVE'CHECK:
4510 MOVES=0
4520 FOR COLUMN=1 TO SEVEN
4530 R=IN'STACK(COLUMN)
4540 IF(R=0) THEN GOTO NO'CARD'MOVE
4550 S=STACK'SUIT(COLUMN,R)
4560 IF(STACK'KIND(COLUMN,R) <> SUIT'STACK(S)+1) THEN GOTO NO'CARD'MOVE
4570 REM ...... A MOVE FOUND IN THIS STACK
4580 GOSUB WAIT
4590 MOVES=MOVES+1
4600 REM ...... PICK CARD OFF OF STACK 1
4610 PRINT TAB(R,COLUMN*CARD'WIDTH+STACK'BASE); " ";
4620 REM ...... MOVE CARD TO ACE STACKS
4630 SUIT'STACK(S)=SUIT'STACK(S)+1
4640 PRINT TAB(STACK'KIND(COLUMN,R),ACE'BASE+CARD'WIDTH*S);
4650 PRINT TAB(-1,STACK'COLOR(COLUMN,R));
4660 PRINT STACK'CODE$(COLUMN,R);
4670 REM ...... CHECK NEXT EXPOSED CARD IN STACK 1
4680 IN'STACK(COLUMN)=R-1
4690 IF(R=1) THEN EMPTY'STACKS=EMPTY'STACKS+1 : GOTO NO'CARD'MOVE
4700 REM ...... CHECK FOR LAST FACE-UP CARD GONE
4710 IF(CARDS'DOWN(COLUMN) < R-1) THEN GOTO NO'CARD'MOVE
4720 REM ...... NEW CARD TURNED OVER IN STACK
4730 CARDS'DOWN(COLUMN)=CARDS'DOWN(COLUMN)-1
4740 PRINT TAB(R-1,COLUMN*CARD'WIDTH+STACK'BASE);
4750 PRINT TAB(-1,STACK'COLOR(COLUMN,R-1));
4760 PRINT STACK'CODE$(COLUMN,R-1);
4770
4780 NO'CARD'MOVE:
4790 NEXT COLUMN
4800 IF(MOVES > 0) THEN GOTO CARD'MOVE'CHECK
4810
4820
4830
4840 REM ...... KING MOVE CHECK
4850 MOVES=0
4860 REM ...... CHECK FOR NO EMPTY STACKS AVAILABLE TO MOVE KINGS TO
4870 IF(EMPTY'STACKS=0) THEN GOTO STACK'MOVE'CHECK
4880
4890 FOR COLUMN=1 TO SEVEN
4900 CD=CARDS'DOWN(COLUMN)
4910 REM ...... CHECK FOR ANY CARDS FACE-DOWN IN THIS STACK
4920 IF(CD=0) THEN GOTO NO'KINGS'MOVED
4930 REM ...... CHECK FOR KING PRESENT
4940 IF(STACK'KIND(COLUMN,CD+1) <> 13) THEN GOTO NO'KINGS'MOVED
4950
4960 REM ...... AN EMPTY STACK & A KING-AT-TOP STACK BOTH FOUND
4970 MOVES=MOVES+1
4980 FOR I=1 TO SEVEN
4990 IF(IN'STACK(I)=0) THEN EMPTY=I
5000 NEXT I
5010
5020 REM ...... MOVE KING & OTHER CARDS TO EMPTY STACK
5030 GOSUB WAIT
5040 CARDS=IN'STACK(COLUMN)-CD
5050 FOR I=1 TO CARDS
5060 REM ....... REMOVE KING FROM OLD SPOT
5070 PRINT TAB(CD+I,STACK'BASE+CARD'WIDTH*COLUMN); " ";
5080 REM ....... MOVE KING (& ANY OTHERS) TO EMPTY STACK
5090 STACK'CARD(EMPTY,I)=STACK'CARD(COLUMN,CD+I)
5100 PRINT TAB(I,STACK'BASE+CARD'WIDTH*EMPTY);
5110 PRINT TAB(-1,STACK'COLOR(EMPTY,I));
5120 PRINT STACK'CODE$(EMPTY,I);
5130 NEXT I
5140 IN'STACK(EMPTY)=CARDS
5150 IN'STACK(COLUMN)=CD
5160 CARDS'DOWN(COLUMN)=CD-1
5170
5180 REM ...... NEW CARD TURNED OVER IN STACK
5190 PRINT TAB(CD,STACK'BASE+CARD'WIDTH*COLUMN);
5200 PRINT TAB(-1,STACK'COLOR(COLUMN,CD));
5210 PRINT STACK'CODE$(COLUMN,CD);
5220
5230 REM ...... 1 LESS EMPTY STACK
5240 EMPTY'STACKS=EMPTY'STACKS-1
5250 COLUMN=SEVEN
5260
5270 NO'KINGS'MOVED:
5280 NEXT COLUMN
5290 IF(MOVES > 0) THEN GOTO CARD'MOVE'CHECK
5300
5310
5320
5330 STACK'MOVE'CHECK:
5340 MOVES=0
5350
5360 FOR COLUMN=1 TO SEVEN
5370 REM ...... CHECK FOR EMPTY STACK
5380 S=IN'STACK(COLUMN)
5390 IF(S=0) THEN GOTO NO'STACKS'MOVED
5400
5410 REM ...... CHECK FOR MOVING TO EACH OTHER STACK
5420 REM ***** NOTE : IF >1 MOVE POSSIBLE, CHOOSES THE LEFTMOST MOVE *****
5430 DEST=0
5440 CD=CARDS'DOWN(COLUMN)
5450 K=STACK'KIND(COLUMN,CD+1)
5460 C=STACK'COLOR(COLUMN,CD+1)
5470 FOR I=SEVEN TO 1 STEP -1
5480 IF(IN'STACK(I)=0) THEN GOTO TRY'NEXT'STACK
5490 IF(STACK'KIND(I,IN'STACK(I)) <> K+1) THEN GOTO TRY'NEXT'STACK
5500 IF(STACK'COLOR(I,IN'STACK(I)) = C) THEN GOTO TRY'NEXT'STACK
5510 DEST=I
5520 TRY'NEXT'STACK:
5530 NEXT I
5540 IF(DEST=0) THEN GOTO NO'STACKS'MOVED
5550
5560 REM ..... 2 STACKS FOUND WHICH CAN BE JOINED TOGETHER
5570 GOSUB WAIT
5580 MOVES=MOVES+1
5590 CARDS=IN'STACK(COLUMN)-CD
5600 FOR I=1 TO CARDS
5610 PRINT TAB(CD+I,STACK'BASE+CARD'WIDTH*COLUMN); " ";
5620 IS=IN'STACK(DEST)
5630 STACK'CARD(DEST,IS+I)=STACK'CARD(COLUMN,CD+I)
5640 PRINT TAB(IS+I,STACK'BASE+CARD'WIDTH*DEST);
5650 PRINT TAB(-1,STACK'COLOR(DEST,IS+I));
5660 PRINT STACK'CODE$(DEST,IS+I);
5670 NEXT I
5680 IN'STACK(DEST)=IS+CARDS
5690 IN'STACK(COLUMN)=CD
5700
5710 REM ...... CHECK FOR NO FACE-DOWN CARDS UNDER MOVED STACK
5720 IF(CD=0) THEN EMPTY'STACKS=EMPTY'STACKS+1 : GOTO NO'STACKS'MOVED
5730
5740 REM ...... NEW CARD TURNED OVER IN STACK
5750 CARDS'DOWN(COLUMN)=CD-1
5760 PRINT TAB(CD,STACK'BASE+CARD'WIDTH*COLUMN);
5770 PRINT TAB(-1,STACK'COLOR(COLUMN,CD));
5780 PRINT STACK'CODE$(COLUMN,CD);
5790
5800 NO'STACKS'MOVED:
5810 NEXT COLUMN
5820 IF(MOVES > 0) THEN GOTO CARD'MOVE'CHECK
5830
5840
5850
5860 NEXT'CARD'FROM'DECK:
5870
5880 REM ...... CHECK FOR WHETHER TO TAKE NEXT CARD FROM DECK 2 NOW
5890 IF(LC'USED$="Y" AND LCARD2 <> 0) THEN GOTO NEXT'CARD
5900 GOSUB WAIT
5910
5920 REM ...... CHECK FOR FACE-DOWN DECK USED UP
5930 IF(FCARD1 < 53) THEN GOTO NEXT'TRIPLET
5940 REM ...... CHECK FOR NO CARDS USED DURING LAST DEAL
5950 IF(LCARD2=LAST'LAST'LCARD2) THEN GOTO LOSER
5960
5970 REM ...... CHECK FOR NO CARDS LEFT IN DECK
5980 IF(LCARD2 <> 0) THEN GOTO DECK2'TO'DECK1
5990 CARDS=0
6000 FOR COLUMN=1 TO SEVEN
6010 CARDS=CARDS+IN'STACK(COLUMN)
6020 NEXT COLUMN
6030 IF(CARDS=0) THEN GOTO WINNER ELSE GOTO LOSER
6040
6050 DECK2'TO'DECK1:
6060 FOR I=1 TO LCARD2
6070 DECK1'CARD(I+52-LCARD2)=DECK2'CARD(I)
6080 NEXT I
6090 LAST'LAST'LCARD2=LAST'LCARD2
6100 LAST'LCARD2=LCARD2
6110 FCARD1=53-LCARD2
6120 LCARD2=0
6130
6140 REM ...... UPDATE SCREEN
6150 PRINT TAB(-1,12);
6160 PRINT TAB(20,38); 53-FCARD1;
6170 PRINT TAB(21,38); 0;
6180 PRINT TAB(22,1); TAB(-1,10);
6190 GOSUB WAIT
6200
6210 NEXT'TRIPLET:
6220 REM ...... TAKE THE LESSER OF 3 CARDS OR THE NUMBER LEFT IN DECK
6230 CARDS=3 MIN 53-FCARD1
6240 FOR I=1 TO CARDS
6250 DECK2'CARD(LCARD2+I)=DECK1'CARD(FCARD1-1 + (CARDS+1-I) )
6260 ROW=22
6270 COLUMN=(LCARD2+I-1)*CARD'WIDTH+1
6280 WRAP: IF(COLUMN > 77) THEN ROW=ROW+1 : COLUMN=COLUMN-80 : GOTO WRAP
6290 PRINT TAB(ROW,COLUMN);
6300 PRINT TAB(-1,DECK2'COLOR(LCARD2+I));
6310 PRINT DECK2'CODE$(LCARD2+I);
6320 NEXT I
6330 FCARD1=FCARD1+CARDS
6340 LCARD2=LCARD2+CARDS
6350 PRINT TAB(-1,12);
6360 PRINT TAB(20,38); 53-FCARD1;
6370 PRINT TAB(21,38); LCARD2;
6380
6390 NEXT'CARD:
6400
6410 LC'USED$="Y"
6420 S=DECK2'SUIT(LCARD2)
6430 K=DECK2'KIND(LCARD2)
6440 ROW=22
6450 COLUMN=(LCARD2-1)*CARD'WIDTH+1
6460 WRP2: IF(COLUMN > 77) THEN ROW=ROW+1 : COLUMN=COLUMN-80 : GOTO WRP2
6470
6480 CHECK'SUITS:
6490 IF(SUIT'STACK(S)+1 <> K) THEN GOTO CHECK'STACKS
6500 REM ...... CARD FROM DECK PUT INTO SUIT STACKS
6510 GOSUB WAIT
6520 REM ...... PICK CARD OFF OF DECK 2
6530 PRINT TAB(ROW,COLUMN); " ";
6540 REM ...... PUT ONTO SUIT STACKS
6550 SUIT'STACK(S)=SUIT'STACK(S)+1
6560 PRINT TAB(K,ACE'BASE+CARD'WIDTH*S);
6570 PRINT TAB(-1,DECK2'COLOR(LCARD2));
6580 PRINT DECK2'CODE$(LCARD2);
6590 REM ...... DECREASE DECK 2 COUNTER
6600 LCARD2=LCARD2-1
6610 PRINT TAB(-1,12);
6620 PRINT TAB(21,38); LCARD2;
6630 GOTO CARD'MOVE'CHECK
6640
6650
6660
6670 CHECK'STACKS:
6680 DEST=0
6690 CHECK'NEXT'STACK:
6700 DEST=DEST+1
6710 IF(DEST=SEVEN+1) THEN GOTO CARD'NOT'USED
6720
6730 REM ...... CHECK FOR EMPTY STACK & A KING FROM DECK
6740 IS=IN'STACK(DEST)
6750 IF(IS=0 AND K=13) THEN EMPTY'STACKS=EMPTY'STACKS-1 :GOTO DECK2'TO'STACK
6760
6770 REM ...... CHECK FOR DECK CARD GOING TO STACK
6780 IF(IS=0) THEN GOTO CHECK'NEXT'STACK
6790 REM ****** NOTE : IF >1 POSSIBLE, LEFTMOST IS CHOSEN *****
6800 IF(STACK'KIND(DEST,IS)-1 <> K) THEN GOTO CHECK'NEXT'STACK
6810 IF(STACK'COLOR(DEST,IS)=DECK2'COLOR(LCARD2)) THEN GOTO CHECK'NEXT'STACK
6820 GOTO DECK2'TO'STACK
6830
6840 DECK2'TO'STACK:
6850 GOSUB WAIT
6860 REM ...... PICK CARD OFF OF DECK 2
6870 PRINT TAB(ROW,COLUMN); " ";
6
880 REM ...... PUT CARD ONTO STACKS
6890 IN'STACK(DEST)=IS+1
6900 STACK'CARD(DEST,IS+1)=DECK2'CARD(LCARD2)
6910 PRINT TAB(IS+1,STACK'BASE+CARD'WIDTH*DEST);
6920 PRINT TAB(-1,DECK2'COLOR(LCARD2));
6930 PRINT DECK2'CODE$(LCARD2);
6940
6950 REM ...... TAKE CARD OFF DECK
6960 LCARD2=LCARD2-1
6970 PRINT TAB(-1,12); TAB(21,38); LCARD2;
6980 GOTO STACK'MOVE'CHECK
6990
7000
7010
7020 CARD'NOT'USED:
7030 LC'USED$="N"
7040 GOTO NEXT'CARD'FROM'DECK
7050
7060
7070
7080 WINNER:
7090 PRINT TAB(-1,12);
7100 PRINT TAB(15,NOTE'BASE);
7110 PRINT TAB(-1,9);
7120 PRINT "CONGRATULATIONS, YOU WON !";
7130 GOSUB HOG
7140 WIN$="W"
7150
7160 GOTO TEST'END
7170
7180
7190
7200 LOSER:
7210 PRINT TAB(-1,12);
7220 PRINT TAB(15,NOTE'BASE);
7230 PRINT TAB(-1,9);
7240 PRINT "SORRY CHARLIE, YOU LOST !";
7250 WIN$="L"
7260
7270 GOTO TEST'END
7280
7290
7300
7310 TEST'END:
7320 NDECK=LCARD2
7330 NUP=0
7340 NDOWN=0
7350 FOR COLUMN=1 TO SEVEN
7360 NDOWN=NDOWN+CARDS'DOWN(COLUMN)
7370 NUP=NUP+IN'STACK(COLUMN)-CARDS'DOWN(COLUMN)
7380 NEXT COLUMN
7390 NACES=0
7400 NSTACK2=0
7410 FOR I=1 TO 4
7420 IF(SUIT'STACK(I) > 0) THEN NACES=NACES+1
7430 NSTACK2=NSTACK2+SUIT'STACK(I)
7440 NEXT I
7450
7460
7470 REM ...... WRITE WIN/LOSS DATA
7480 GOSUB OPEN'FILE
7490 PRINT TAB(16,NOTE'BASE); TAB(-1,9);
7500 IF(GAME > LASTREC) THEN ? "[SOLIT.DAT FILE IS FULL]" : GOTO END'OUTPUT
7510 IF(GAME<RECORDS+1)THEN ? "[GAME #";GAME;"PLAYED BEFORE]":GOTO END'OUTPUT
7520 IF(GAME>RECORDS+1)THEN ? "[GAME #";GAME;"OUT OF ORDER]":GOTO END'OUTPUT
7530 REC1=GAME
7540 WRITE #1, WINDATA
7550 REC1=0
7560 WRITE #1, GAME
7570 PRINT "THIS WAS GAME #"; GAME;
7580 END'OUTPUT:
7590 CLOSE #1
7600
7610 END'QUERY:
7620 PRINT TAB(17,NOTE'BASE);
7630 PRINT TAB(-1,9);
7640 PRINT "ANOTHER GAME ? ('Y' OR 'N') : ";
7650 INPUT "" COMD$
7660 IF(COMD$ <> "N") THEN GOTO MAIN'LOOP
7670
7680 GOTO END
7690
7700
7710
7720 WAIT:
7730 REM ...... WAITS UNTIL "RATE" SECONDS HAVE PASSED SINCE LAST WAIT CALL
7740 IF( (TIME-LAST'TIME)/60 < RATE) THEN GOTO WAIT
7750 LAST'TIME=TIME
7760 PRINT TAB(1,74); TAB(-1,12);
7770 PRINT USING "####.#", (TIME-START'TIME)/60
7780 RETURN
7790
7800
7810
7820 OPEN'FILE:
7830 RECORDS=0
7840 LOOKUP FNAME$, THERE
7850 IF(THERE=0) THEN ALLOCATE FNAME$, FBLOX
7860 OPEN #1, FNAME$, RANDOM, 6, REC1
7870 LASTREC=INT(512/6)*FBLOX-1
7880 REC1=0
7890 IF(THERE=0) THEN WRITE #1, RECORDS ELSE READ #1, RECORDS
7900 NEXT'GAME=RECORDS+1
7910 IF(NEXT'GAME>LASTREC) THEN RANDOMIZE ELSE DRAW=RND( SIN(NEXT'GAME)-1 )
7920 RETURN
7930
7940
7950
7960 HOG:
7970 PRINT TAB(-1,1);
7980
7990 PRINT " .... .... "
8000 PRINT " / \ / \ "
8010 PRINT " / \................/ \ "
8020 PRINT "/ / / \ \ \"
8030 PRINT "| | / \ | |"
8040 PRINT "| / \/ \/ \ |"
8050 PRINT "\/ / [o] [o] \ \/"
8060 PRINT " / ...... \ "
8070 PRINT " | / \ | "
8080 PRINT " | | O O | | "
8090 PRINT " \ \....../ / "
8100 PRINT " \ / "
8110 PRINT " \ \....../ / "
8120 PRINT " \ / "
8130 PRINT " \ / "
8140 PRINT " ------------------ "
8150 PRINT
8160 PRINT " IT'S THE AMOS HOG ! "
8170
8180 REM ...... OINK !
8190 NWAIT=600
8200 OINKS=6
8210 FOR OINK=1 TO OINKS
8220 PRINT TAB(13,16); "OINK";
8230 PRINT TAB(23,1);
8240 PRINT CHR(7);
8250 FOR I=1 TO NWAIT : NEXT I
8260 PRINT TAB(13,16); "....";
8270 PRINT TAB(23,1);
8280 FOR I=1 TO NWAIT : NEXT I
8290 NEXT OINK
8300
8310 RETURN
8320
8330
8340
8350 END:
8360 PRINT TAB(23,1);
8370 END
