Solitaire

Source Code

   40 GO TO 1400
   41 LET G=0: LET NU=1: LET X$="": LET S2=1: DIM V$(32)
   42 LET W1=0: LET L1=0
   45 LET Q$=""
   46 LET X=1: LET T=0
   47 LET H$=""
   48 DIM Q(4)
   50 RESTORE 160: CLS : PRINT TAB 8; INVERSE 1;"                        "
   60 PRINT TAB 8; INVERSE 1;" I'M SHUFFLING THE PACK "
   70 PRINT TAB 8; INVERSE 1;"                        "
   80 LET L=0: DIM t(7): DIM b(7): DIM f$(12,2): DIM p$(52,2): DIM s$(4): DIM n$(13): DIM a$(7,20,2): FOR n=1 TO 7: LET t(n)=n: LET b(n)=n: NEXT n: LET l=1
   90 DIM f(4): DIM p(4): RANDOMIZE : LET p=0
  100 DIM e$(26)
  110 LET d$=""
  150 FOR I=1 TO 4: READ S$(I): NEXT I: FOR I=1 TO 13: READ N$(I): NEXT I
  160 DATA "\b","\d","\a","\c","A","2","3","4","5","6","7","8","9","T","J","Q","K"
  170 LET C$="A\cA\bA\aA\d2\c2\b2\a2\d3\c3\b3\a3\d4\c4\b4\a4\d5\c5\b5\a5\d6\c6\b6\a6\d7\c7\b7\a7\d8\c8\b8\a8\d"
  180 LET C$=C$+"9\c9\b9\a9\dT\cT\bT\aT\dJ\cJ\bJ\aJ\dQ\cQ\bQ\aQ\dK\cK\bK\aK\d": LET C=52
  190 FOR I=1 TO 52: LET A=INT (RND*C)+1: LET P$(I)=C$(2*A-1 TO 2*A): LET L$=C$(1 TO 2*(A-1)): LET R$=C$(2*A+1 TO LEN C$): LET C$=L$+R$: LET C=C-1: NEXT I
  220 CLS : FOR I=1 TO 7: FOR J=1 TO I: PRINT AT J,(I-1)*3;
  260 IF J=B(I) THEN PRINT P$(L): LET A$(I,J)=P$(L): LET L=L+1: NEXT J: NEXT I: GO TO 280
  270 LET A$(I,J)=P$(L): PRINT INVERSE 1;"  ": LET L=L+1: NEXT J: NEXT I
  280 FOR I=29 TO 52: LET D$=D$+P$(I): NEXT I
  290 PRINT AT 0,20;"\e\i\i\i\i\i\i\i\i\i\i\f": FOR F=1 TO 13: PRINT AT F,20;"\j          \k": NEXT F
  300 PRINT TAB 20;"\g\i\i\i\i\i\i\i\i\i\i\h"
  310 INVERSE 1: FOR I=0 TO 18 STEP 3: PRINT AT 0,I;" ";STR$ (1+I/3): NEXT I: INVERSE 0
  330 IF D$<>"" THEN GO TO 360
  340 FOR I=1 TO 7: IF B(I)>1 THEN LET I=8: NEXT I: GO TO 360
  350 NEXT I: GO TO 1720
  360 LET PI=0: LET X=0: LET Y=0: LET T=0: LET TT=0: PRINT AT 19,0;TAB 24;AT 19,0;"FROM ";
  380 LET Z$=INKEY$: IF Z$="" THEN GO TO 380
  390 IF Z$="D" THEN GO TO 1270
  400 IF Z$="E" THEN GO TO 1110
  410 IF Z$="P" THEN LET PI=1: GO TO 480
  430 IF Z$>"7" OR Z$<"1" THEN GO TO 460
  440 LET T=VAL Z$: LET X=T: LET Y=B(X)
  450 IF Y=0 THEN GO TO 330
  460 IF T=0 THEN GO TO 380
  480 PRINT Z$;" TO ";
  490 LET B$=INKEY$: IF B$="" THEN GO TO 490
  491 IF B$="F" THEN GO TO 500
  492 IF B$<"1" OR B$>"9" THEN GO TO 490
  500 IF B$="F" AND X=0 THEN GO TO 360
  505 IF B$="F" THEN LET TT=8: GO TO 520
  510 LET TT=VAL B$
  520 IF TT=0 THEN GO TO 490
  530 IF TT=T THEN GO TO 490
  540 PRINT B$;
  550 IF TT=8 THEN LET Y=T(X)
  560 IF PI=1 THEN LET X$=H$: GO TO 580
  570 LET X$=A$(X,Y)
  580 GO SUB 970
  590 IF TT=8 THEN GO TO 830
  600 IF T(TT)=0 AND NU<>13 THEN GO TO 330
  610 IF T(TT)=0 THEN LET B(TT)=1: GO TO 670
  620 LET S1=SU: LET N1=NU
  630 LET X$=A$(TT,T(TT))
  640 GO SUB 970
  650 IF NU-1<>N1 OR 1-SU<>S1 THEN GO TO 950
  670 GO SUB 1040: LET F=1
  680 IF PI=1 THEN LET F=2: LET F$(1)=H$: GO SUB 1380: LET P=P-1: GO TO 740
  690 FOR I=B(X) TO T(X): LET F$(F)=A$(X,I): LET A$(X,I)="   ": LET F=F+1
  700 PRINT "  "; OVER 1;V$( TO 30);: NEXT I: LET XX=X: LET YY=Y
  710 LET B(X)=B(X)-1: LET T(X)=B(X)
  720 IF B(X)>0 THEN LET G=1
  730 IF T(TT)=0 THEN LET X=TT: LET Y=0: GO SUB 1040: GO TO 750
  740 LET X=TT: LET Y=T(TT): GO SUB 1040
  750 PRINT OVER 1;V$;: FOR I=1 TO F-1: PRINT F$(I); OVER 1;V$( TO 30);: LET A$(X,T(X)+1)=F$(I)
  760 IF F$(I)<>" " THEN LET T(X)=T(X)+1
  770 NEXT I
  780 FOR I=1 TO 12: LET F$(I)=" ": NEXT I: LET F=1
  790 IF G=1 THEN LET G=0: LET X=XX: LET Y=YY-1: GO SUB 1040: PRINT A$(X,Y)
  800 IF PI=1 THEN GO TO 1310
  810 GO TO 330
  830 IF F(S2)<>NU-1 THEN GO TO 330
  840 LET Q(S2)=Q(S2)+1: LET F(S2)=NU
  850 PRINT AT F(S2),S2*3+18;
  860 IF Y=1 THEN GO TO 880
  870 IF A$(X,Y-1)<>"  " THEN LET G=1
  880 PRINT X$
  890 IF PI=1 THEN GO SUB 1380: LET P=P-1: GO TO 1310
  900 GO SUB 1040: PRINT "  ";: LET A$(X,Y)="  ": IF Y>1 THEN LET T(X)=T(X)-1
  910 IF T(X)=B(X)-1 THEN LET B(X)=B(X)-1
  920 IF G=1 THEN LET G=0: PRINT AT (24-PEEK 23689)-1,33-PEEK 23688-2;A$(X,Y-1)
  930 GO TO 330
  950 IF 1-SU<>S1 THEN PRINT AT 19,0;TAB 24;AT 19,0;"WRONG COLOR ";: FOR I=1 TO 200: NEXT I: GO TO 330
  960 PRINT AT 19,0;TAB 24;AT 19,0;"WRONG VALUES";: FOR I=1 TO 200: NEXT I: GO TO 330
  980 RESTORE 160: FOR I=1 TO 4: READ W$: IF X$(LEN X$)=W$ THEN LET SU=I-INT (I/2)*2: LET S2=I
  990 NEXT I
 1000 FOR I=1 TO 13: READ W$: IF X$(1)=W$ THEN LET NU=I: LET I=14
 1010 NEXT I
 1020 RETURN 
 1040 LET X1=X: LET Y1=Y: PRINT AT 0,0;
 1050 LET X1=X1*3-3: IF X1=0 THEN GO TO 1070
 1060 GO TO 1080
 1070 IF Y1=0 THEN RETURN 
 1080 PRINT AT Y1,X1;: RETURN 
 1110 FOR I=1 TO 4: IF Q(I)<>13 THEN GO TO 1160
 1120 NEXT I: PRINT AT 6,0; FLASH 1;"YOU'VE WON!!"
 1121 LET W1=W1+1
 1130 FOR I=1 TO 1000: NEXT I
 1140 GO TO 1190
 1160 PRINT AT 6,0; FLASH 1;"SORRY,YOU'VE LOST"
 1161 LET L1=L1+1
 1170 FOR I=1 TO 300: NEXT I
 1190 CLS : PRINT "__________": PRINT INVERSE 1;" SCORES   ": PRINT : PRINT "WINS:";W1: PRINT : PRINT "LOSSES:";L1
 1210 PRINT : PRINT "PLAY AGAIN?(Y/N)"
 1220 LET Z$=INKEY$: IF Z$="" THEN GO TO 1220
 1230 IF Z$="Y" THEN GO TO 41
 1240 IF Z$<>"N" THEN GO TO 1220
 1250 PRINT "GOODBYE!!!": STOP 
 1270 LET P=P+3
 1280 IF D$<>"" THEN GO TO 1310
 1290 FOR I=1 TO 7: IF B(I)>1 THEN LET I=8: NEXT I: GO TO 330
 1300 NEXT I: GO TO 1720
 1310 IF P=0 THEN LET H$="  ": GO TO 1360
 1320 IF LEN D$/2=P-1 THEN LET P=LEN D$/2: GO TO 1350
 1330 IF LEN D$/2=P-2 THEN LET P=LEN D$/2: GO TO 1350
 1340 IF P>LEN D$/2 THEN LET P=0: GO TO 1270
 1350 LET H$=D$(2*P-1 TO (2*P-1)+1)
 1360 PRINT AT 21,0;H$: GO TO 330
 1380 LET L$=D$( TO (P-1)*2): LET R$=D$(2*P+1 TO LEN D$): LET D$=L$+R$: RETURN 
 1399 STOP 
 1400 BORDER 0: PAPER 0: INK 7: CLS 
 1401 GO SUB 9000
 1410 PRINT "_______________________________"
 1420 PRINT INVERSE 1;"                               "
 1430 PRINT "   FROM 1-7 CARDS ARE DEALT TO  SEVEN COLUMNS,THE LAST CARD ONLY"  
 1440 PRINT "OF EACH COLUMN BEING FACE UPWAR-DS."
 1450 PRINT "  EXPOSED CARDS ARE MOVED IN"
 1460 PRINT "ASCENDING SUIT SEQUENCE TO ACES AS THESE APPEAR,AND IN DESCENDI-NG";
 1470 PRINT " SEQUENCE OF ALTERNATE COLORS TO THE BOTTOM CARDS OF COLUMNS."
 1480 PRINT " COMPLETE SEQUENCES OF CARDS MAYBE MOVED BETWEEN COLUMNS."
 1490 PRINT "EMPTY COLUMNS MAY BE FILLED ONLYBY SEQUENCES HEADED BY KINGS."
 1500 PRINT "   THE REST OF THE PACK IS DEALT3 CARDS AT A TIME TO A WASTE"
 1510 PRINT "PILE,THE TOP CARD OF WHICH IS   ALWAYS AVAILABLE.ANY NUMBER OF  REDEALS ARE ALLOWED."
 1520 PRINT "PRESS 'ENTER' TO CONTINUE."
 1530 INPUT LINE I$: CLS 
 1540 PRINT "  CARDS ARE MOVED BY SIMPLY     TYPING THE ORIGINAL COLUMN NUMB-ER,OR P FOR WASTE PILE,FOLLOWED BY THE DESTINATION COLUMN."
 1550 PRINT "NUMBER OR 'F' FOR FOUNDATION."
 1560 PRINT : PRINT " D DEALS A FRESH GROUP OF THREE CARDS,E ENDS THE GAME."
 1570 PRINT : PRINT "PLEASE  PRESS 'ENTER'."
 1580 INPUT LINE A$: POKE 23658,8
 1590 DIM F(4)
 1600 FOR F=1 TO 4: LET F(F)=13: NEXT F
 1610 GO TO 41
 1720 FOR Q=1 TO 7: IF T(Q)<>0 THEN LET Q=8: NEXT Q: GO TO 1740
 1730 NEXT Q: GO TO 1110
 1740 FOR Q=1 TO 7: LET X=Q: LET Y=T(Q): LET X$=A$(X,Y): GO SUB 970
 1750 IF F(S2)<>NU-1 THEN NEXT Q: GO TO 1720
 1760 LET Q(S2)=Q(S2)+1: LET F(S2)=NU: PRINT AT 0,20;
 1770 PRINT AT F(S2),S2*3;
 1780 PRINT X$
 1790 GO SUB 1040: PRINT "  ";: LET A$(X,Y)="  ": IF Y>0 THEN LET P(X)=T(X)-1
 1800 IF T(X)=B(X) THEN LET B(X)=B(X)-1
 1810 NEXT I: RETURN 
 8999 STOP 
 9000 RESTORE 9020: FOR I=0 TO 7
 9010 READ A,B,C,D: POKE USR "A"+I,A: POKE USR "B"+I,B: POKE USR "C"+I,C: POKE USR "D"+I,D: NEXT I
 9020 DATA 0,BIN 1000100,16,16,16,BIN 11101110,BIN 111000,BIN 111000
 9030 DATA BIN 00111000,254,BIN 1111100,BIN 1010100
 9040 DATA BIN 01111100,254,BIN 11111110,BIN 11111110,BIN 11111110,BIN 1111100,BIN 10010010,BIN 01010100,BIN 01111100,BIN 111000,16,16
 9050 DATA BIN 00111000,16,16,16,16,0,BIN 111000,16
 9060 FOR F=0 TO 7: READ A,B,C,D: POKE USR "E"+F,A: POKE USR "F"+F,B: POKE USR "G"+F,C: POKE USR "H"+F,D: NEXT F
 9070 DATA 0,0,16,8,0,0,16,8,0,0,16,8,0,0,8,16,7,224,7,224,8,16,0,0,16,8,0,0,16,8,0,0
 9080 FOR F=0 TO 7: POKE USR "I"+F,0: NEXT F: POKE USR "I"+4,255
 9090 FOR F=0 TO 7: POKE USR "J"+F,16: POKE USR "K"+F,8: NEXT F
 9100 RETURN