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); " "; 6880 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(GAMERECORDS+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