Solitaire

This file is part of and SINCUS Exchange Tape 103 - Potpourri. Download the collection to get this file.
Date: 198x
Type: Program
Platform(s): TS 2068

This program implements the card game Klondike Solitaire, dealing seven tableau columns with cards represented as two-character strings encoding rank and suit. The deck is stored as a concatenated string in C$ (lines 170–180) and shuffled using a Fisher-Yates-style extraction algorithm at line 190, reducing the working string by one card per iteration. Card graphics are rendered using user-defined graphics (UDGs) defined via POKE USR in the subroutine at line 9000, encoding suit symbols (hearts, diamonds, clubs, spades) and box-drawing characters for the foundation display area. The game supports a standard three-card waste pile deal with unlimited redeals, tracks wins and losses across multiple games in variables W1 and L1, and uses a 3D array A$(7,20,2) to store the tableau state.

Program Analysis

Program Structure

The program is divided into several functional regions:

  1. Lines 40–48: Variable initialization and array setup on new game.
  2. Lines 50–190: Shuffle routine — builds the full 52-card string C$, displays a “shuffling” message, and populates the P$(52,2) array via extraction shuffle.
  3. Lines 220–300: Tableau rendering — deals cards into seven columns, printing face-down cards as inverse spaces and the last card of each column face-up.
  4. Lines 330–960: Main game loop — reads keystrokes, validates moves, and updates state for column-to-column and column-to-foundation moves.
  5. Lines 970–1020: GO SUB 970 card-parsing subroutine — decodes rank (NU) and suit color parity (SU, S2) from a two-character card string.
  6. Lines 1040–1080: Cursor-positioning subroutine — converts logical column/row coordinates to screen PRINT AT positions.
  7. Lines 1110–1250: End-of-game handler — checks foundation completion, displays win/loss, updates W1/L1, prompts replay.
  8. Lines 1270–1399: Waste pile deal and management (D$ string, pointer P).
  9. Lines 1400–1610: Introduction/instructions screen and UDG initialization call.
  10. Lines 1720–1810: Auto-move routine — scans tableau for cards that can go directly to foundations.
  11. Lines 9000–9100: UDG definition subroutine using POKE USR and READ/DATA.

Deck Representation and Shuffle

The entire 52-card deck is encoded as a single concatenated string C$ built across lines 170–180. Each card occupies exactly two characters: the rank character followed by a suit UDG character (\a through \d, mapping to UDGs A–D). The shuffle at line 190 is a selection-without-replacement algorithm: on each iteration, a random position A in the remaining string is chosen, that two-character card is extracted into P$(I), and the string is rebuilt as the left portion plus the right portion, reducing C by 1. This is functionally equivalent to a Fisher-Yates shuffle operating on a string rather than an array.

Card State Storage

The tableau is stored in the three-dimensional string array A$(7,20,2) — 7 columns, up to 20 rows, with each cell holding a 2-character card code or spaces for empty. The integer arrays T(7) and B(7) track the top (highest face-up) and bottom (lowest occupied) row index for each column respectively. The waste pile is stored as a concatenated string D$ with pointer P indicating the currently visible card.

UDG Definitions (Suit Symbols and Box Drawing)

The subroutine at line 9000 defines UDGs A–K using POKE USR "X"+I inside FOR loops reading from DATA statements. UDGs A–D represent the four suit symbols (spades, hearts, clubs, diamonds in some order). UDGs E–H form the corners and sides of the foundation display box drawn at lines 290–300. UDG I is used as a horizontal rule (line 9080 sets all rows to 0, then row 4 to 255, producing a mid-cell horizontal bar). UDGs J and K provide vertical bar variants. The BIN keyword is used throughout the data for readability of the bitmap patterns.

Move Validation

Card validation is handled by the GO SUB 970 subroutine (line 980 onward), which restores the DATA pointer to line 160 and re-reads suits and ranks to decode SU (suit color parity, 0 or 1), S2 (suit index 1–4), and NU (rank 1–13). For column-to-column moves, the destination card’s rank and color are checked at lines 620–650: the moved card must be one rank lower (NU-1 <> N1) and opposite color (1-SU <> S1). Foundation moves at line 830 check that F(S2) equals NU-1, enforcing ascending same-suit build order.

Key BASIC Idioms

  • INKEY$ polling loops (lines 380, 490, 1220) provide responsive keyboard input without INPUT.
  • POKE 23658,8 at line 1580 sets the system’s caps-lock flag, ensuring uppercase input without the user holding CAPS SHIFT.
  • FOR I=1 TO 200: NEXT I (lines 950, 960) is used as a simple delay after displaying error messages.
  • String slicing on C$ at line 190 (C$(1 TO 2*(A-1)) and C$(2*A+1 TO LEN C$)) performs in-place card extraction from the deck string.
  • The V$( TO 30) slice at line 700 uses a pre-dimensioned blank string to overprint cards during animation.

Auto-Complete Routine

Lines 1720–1810 implement an auto-move pass that scans all tableau columns for cards that can be placed on foundations without player input. This routine is called when the waste pile is exhausted (lines 330–350 and 1280–1300 funnel to line 1720 when D$="" and no buried face-down cards remain). The loop uses GO TO 1720 for re-entry after each successful move, continuing until no further auto-moves are possible, then falls through to the end-game check at line 1110.

Bugs and Anomalies

  • Line 1810 uses NEXT I but the loop variable at line 1740 is Q. This mismatch (NEXT I instead of NEXT Q) will cause an error if the loop body does not always exit via GO TO before reaching NEXT I. In practice the NEXT Q at line 1750 and the GO TO 1720 at line 1760 mean this line is rarely reached normally, but it remains a latent bug.
  • Line 260 contains an IF that sets up a NEXT J: NEXT I in the same statement, then falls to line 270 for the face-down path. The face-up branch at line 260 unconditionally executes NEXT J: NEXT I and then jumps to 280, bypassing line 270 entirely for that card — this is intentional flow control using inline NEXT statements rather than a structured block.
  • The F$(12,2) array at line 80 stores sequences being moved between columns, but the loop at line 780 only clears indices 1–12, matching the declared first dimension.
  • Line 920 uses PEEK 23689 and PEEK 23688 (the system variable S_POSN storing the current print position row and column) to reprint the revealed card after removing the top card of a column. This is a clever but fragile technique dependent on the current cursor position being predictable.

Variable Summary

VariablePurpose
A$(7,20,2)Tableau card storage (column, row, 2-char card code)
T(7)Top (highest face-up row) index per column
B(7)Bottom (lowest occupied row) index per column
D$Waste pile as concatenated card string
PPointer to current waste pile card
F(4)Current top rank on each foundation pile
Q(4)Count of cards on each foundation (win check)
NU, SU, S2Decoded rank, color parity, suit index of current card
W1, L1Session win and loss counters
PIFlag: 1 if source is waste pile

Content

Related Products

Related Articles

Related Content

Image Gallery

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

Note: Type-in program listings on this website use ZMAKEBAS notation for graphics characters.

Tags

Archived Media Downloadable TS 2068 Card Game Game

People

No people associated with this content.

Scroll to Top