This file is part of and CATS Library Tape 1. Download the collection to get this file.
This program implements a complete two-player Cribbage card game, pitting a human against a computer opponent. The game includes all standard Cribbage rules: six-card dealing, discarding to a crib, pegging play up to 31, and full hand-counting with fifteens, pairs, runs, flushes, and “one for his nob.” The computer AI evaluates discard choices by scoring the residual four-card hand and assigning bonuses for favorable card combinations, while pegging strategy uses heuristic scoring adjustments based on the running total and opponent’s likely responses. User-defined graphics characters (UDGs) are loaded from DATA statements at startup to render card suits, pegs, and board markers. The program stores subroutine addresses in named variables (e.g., PICK2, EVALHAND) to achieve readable symbolic GO SUB calls, a technique that improves clarity at the cost of a small runtime overhead.
Program Analysis
Program Structure
The program is organized into well-delineated subroutines, each introduced by a REM banner. Execution begins at line 7000 (initialization), which chains to the main game loop around line 7400. Named numeric variables serve as symbolic subroutine labels, set in the block from lines 7100–7210, allowing constructs like GO SUB EVALHAND or GO TO TOTAL instead of raw line numbers. This is a deliberate readability optimization common in longer Sinclair BASIC programs.
Key Subroutines
| Line range | Label variable | Purpose |
|---|---|---|
| 500–695 | PICK2 | Computer selects 2 cards to discard into the crib |
| 1000–1510 | EVALHAND | Scores fifteens, pairs, runs, and flushes in a hand |
| 2000–2390 | LAYCARD | Plays a card to the table during pegging, scoring pairs and runs |
| 2400–2460 | SORT | Bubble sort on array h(), length l |
| 2700–2963 | MANPLAY / TOTAL | Human plays a card; updates running total and score |
| 3200–3640 | ZXPLAY | Computer pegging AI with heuristic card selection |
| 3700–3810 | SELECT | Interactive card selection using SPACE and ENTER |
| 4000–4450 | TAKETURNS | Alternating play loop managing GO declarations and resets |
| 4500–4895 | SHOW / COUNT | Displays and counts each hand after pegging ends |
| 4900–4985 | CUT | Cuts the pack to reveal the starter card |
| 5000–5270 | MANHAND / ZXHAND / CRIBHAND | Display routines for each of the three hands |
| 5300–5470 | ERASE / FACEDOWN / FACEUP | Card rendering: blank, face-down, and face-up display |
| 5700–5820 | DRAWBOARD | Draws the crib board using UDG pegs and characters |
| 6000–6490 | UPDATE | Updates scores and moves pegs on the crib board |
| 7000–7390 | — | Initialization: dimensions, UDG loading, pack construction |
| 9000–9590 | — | Optional interactive tutorial with scoring demonstrations |
User-Defined Graphics
Lines 9600–9850 contain DATA blocks defining 13 UDG characters ("a" through "t", plus "s"). These are loaded via POKE USR k$+y,z in the loop at lines 7080–7095. The characters render card suits (clubs \h, hearts \d, diamonds \c, spades \s), peg positions (\f, \g, \i, \j, \k), and board dot markers (\a, \b, \e). The rank string r$ at line 7320 uses UDG \t to represent the 10 as a single character, enabling fixed-width card display.
Card Representation
The pack array p(52) stores cards as floating-point values: the integer part is the rank (1–13) and the fractional part encodes suit (.1 = suit 1, .2 = suit 2, .3 = suit 3, .4 = suit 4). Two DEF FN functions extract these: FN t(x) at line 40 maps ranks to pip values (face cards capped at 10), and FN s(x) at line 50 extracts the suit index via 10*(x-INT(x)). Separate parallel arrays (a()/a$() for human, c()/c$() for computer, e()/e$() for crib, h()/h$() as a working hand buffer) hold rank integers and suit-character strings respectively.
Hand Evaluation Algorithm
The EVALHAND subroutine (lines 1000–1510) computes all scoring categories. Fifteens are found by exhaustive enumeration of pairs (i(x)+i(y)=15), triples (the sum of remaining cards checked at lines 1170–1210), and four-card totals (line 1250). Pairs are counted by comparing all rank combinations. Flushes are detected by checking all suits against h$(1), with a special rule at line 1310 requiring all 5 cards for a crib flush. Run detection (lines 1400–1500) uses a sequential scan with counters for run length r and duplicate multiplicity d, handling double and triple runs by multiplying length by duplicates and subtracting double-counted pairs.
Computer Discard Strategy
The PICK2 subroutine iterates over all 15 pairs of cards from the computer’s six-card hand. For each pair discarded, it evaluates the remaining four cards with EVALHAND and adds a bonus score cr for favorable crib-seeding properties: suited consecutive cards, fives, and pairs summing to 15. When the computer is dealer (dlr=1), crib bonuses are added; when non-dealer, they are subtracted. The best pair is stored in t(1) and t(2).
Computer Pegging AI
The ZXPLAY subroutine (lines 3200–3640) evaluates each unplayed card by tentatively calling LAYCARD, then undoing the play with LET n=n-1. Heuristic adjustments are applied to the raw peg score: bonuses for totals above 15, penalties for totals of 21 or 5 (opponent-favorable targets), and opponent-hand lookahead at line 3320–3380 that rewards leaving a total where no remaining opponent card completes a 15 or a close pair. A small random perturbation (RND>.6) at line 3450 prevents perfectly predictable play.
Crib Board Display and Peg Movement
The board is drawn in the right margin (columns 25–31) using UDG characters for peg holes (\a, \b) and the winning peg (\e). Score advancement is handled in UPDATE (lines 6000–6490): the old peg position v(player) is erased with OVER 1 (XOR mode) and the new position drawn. The board is notionally 60 holes per side; the coordinate mapping at lines 6410–6450 translates a score 1–120 to a screen row and selects the correct column-offset and peg UDG variant depending on player and which half of the board is in use.
Muggins Rule
When the muggins option is selected at line 7405, the COUNT subroutine prompts the human player to enter their own score (lines 4780–4800). If the entered score is incorrect, the variable mug is set to 2, player is switched to zx, and the computer claims the correct points instead. After scoring, mug reverts to 1 and normal play resumes.
Notable Techniques and Idioms
- Symbolic subroutine variables (
LET EVALHAND=1000) allowGO SUB EVALHAND, making the code self-documenting at the cost of global numeric variables. - The
PAUSE 0followed by pollingINKEY$(e.g., lines4925,8105) is the standard efficient keypress-wait idiom. - The bubble sort at lines
2410–2460terminates early by testingz=0(no swap occurred), a classic optimization. - Card face-up rendering at lines
5410–5470automatically selectsINK 2(red) for heart and diamond suits by testingy$=s$(1) OR y$=s$(3). - Line
4985(LET e(5)=k: LET e$(5)=k$) is unreachable dead code, duplicating the assignment already made at lines4970–4975. - The instruction demo at line
9130callsGO SUB UPDATE+15, targeting line6015(a secondary entry point insideUPDATEthat skips the initials=0guard), a deliberate non-obvious entry technique. - Pack construction at lines
7355–7380uses the floating-point encoding scheme; the shuffle at lines7610–7630is a Fisher-Yates variant operating in-place onp().
Potential Bugs and Anomalies
- Line
645:IF c(i)=5 OR d(j)=5— the second condition testsd(j)(pip value of card j) rather thanc(j)(rank of card j) ord(i), which appears inconsistent with the surrounding logic testing card ranks for crib-seeding bonuses. - Line
4985is dead code following aRETURNat line4980, never executed. - Variable
sis used both as a global score accumulator and as a local working variable in multiple subroutines (e.g.,LAYCARD,ZXPLAY), requiring callers to save and restore context carefully; this creates subtle aliasing risks throughout the program. - Line
9530:GO SUB Message— the variable name uses a capital M, which on this platform is equivalent to the all-lowercase tokenized keyword and will resolve correctly, but the inconsistent capitalization in the REM comments versus actual variable names is notable.
Content
Image Gallery
Source Code
1 REM *********************** *Underlined characters* *are entered in * *GRAPHICS mode. * ***********************
40 DEF FN t(x)=(x>9)*10+(x<10)*x
50 DEF FN s(x)=10*(x-INT (x))
60 GO TO 7000
500 REM ================================== PICK 2 CARDS
510 PRINT AT 7,8; FLASH 1;"THINKING";AT 0,0:
565 FOR i=1 TO 5
570 FOR j=i+1 TO 6
575 LET y=1: LET tot=0: LET f5=0
580 FOR x=1 TO 6
585 IF x=i OR x=j THEN GO TO 610
590 LET h(y)=c(x): LET i(y)=d(x): LET h$(y)=c$(x): LET tot=tot+i(y)
595 IF i(y)=5 THEN LET f5=f5+1
600 LET y=y+1
610 NEXT x
620 GO SUB EVALHAND
630 LET s=s+p+f+fl+f5: LET cr=0
640 IF c(j)=c(i) OR c(j)=c(i)+1 THEN LET cr=2
645 IF c(i)=5 OR d(j)=5 THEN LET cr=cr+2
650 IF d(i)+d(j)=15 THEN LET cr=cr+2
652 IF debug THEN PRINT : FOR q=1 TO 4: PRINT h(q);" ";: NEXT q: PRINT ,s;" ";cr;" ";
655 IF dlr=1 THEN LET s=s+cr: GO TO 665
660 LET s=s-cr
665 IF s>max THEN LET max=s: LET t(1)=i: LET t(2)=j: IF debug THEN PRINT "x";
670 NEXT j: NEXT i
675 LET y=0
680 LET x=t(1): GO SUB ERASE
685 LET x=t(2): GO SUB ERASE
690 PRINT AT 7,8;" READY "
695 RETURN
1000 REM =================================== EVALUATE A HAND
1070 LET p=0: LET f=0: LET fl=4
1110 IF tot=15 THEN LET f=2
1120 FOR x=1 TO c-1
1130 FOR y=x+1 TO c
1140 IF h(x)=h(y) THEN LET p=p+2
1150 IF i(x)+i(y)=15 THEN LET f=f+2
1155 IF c<5 THEN GO TO 1220
1160 LET t=0
1170 FOR z=1 TO c
1180 IF z=x OR z=y THEN GO TO 1200
1190 LET t=i(z)+t
1200 NEXT z
1210 IF t=15 THEN LET f=f+2
1220 NEXT y: NEXT x
1240 FOR x=1 TO 4
1250 IF tot-i(x)=15 THEN LET f=f+2
1260 IF h$(x)<>h$(1) THEN LET fl=0
1270 NEXT x
1280 IF c=4 THEN GO TO 1400
1290 IF tot-i(5)=15 THEN LET f=f+2
1300 IF fl=4 AND h$(5)=h$(1) THEN LET fl=5
1310 IF fl=4 AND crib=1 THEN LET fl=0: REM flush in crib must be 5 cards
1400 LET x=1: LET s=0
1410 IF x>3 THEN RETURN
1420 LET r=1: LET d=1
1430 IF h(x+1)=h(x)+1 THEN LET r=r+1: GO TO 1490
1440 IF h(x+1)>h(x) THEN GO TO 1470
1450 LET d=d+1: IF d<>3 THEN GO TO 1490
1455 IF h(x-1)<>h(x) THEN LET d=4
1460 GO TO 1490
1470 IF r>rlen THEN LET s=s+d*r: IF r=2 THEN LET s=s-d
1480 LET x=x+1: GO TO 1410
1490 LET x=x+1: IF x<c THEN GO TO 1430
1500 IF r>rlen THEN LET s=s+d*r: IF r=2 THEN LET s=s-d
1510 RETURN
2000 REM =================================== LAY CARD ON TABLE
2005 LET p=0: LET s=0
2008 LET ct=FN t(c)
2010 IF tot+ct>31 THEN LET s=-1: RETURN
2015 LET n=n+1: LET t(n)=c
2020 LET t=tot+ct: IF t=15 OR t=31 THEN LET s=2
2022 IF n=1 THEN RETURN
2025 IF ABS (t(n-1)-c)>=n THEN RETURN
2026 REM *** any pairs?
2030 FOR x=n-1 TO 1 STEP -1
2040 IF t(n)<>t(x) THEN GO TO 2100
2050 LET p=p+2
2060 NEXT x
2100 IF p=6 THEN LET p=12
2110 IF p=4 THEN LET p=6
2115 LET s=s+p
2120 IF p>0 THEN RETURN
2130 REM *** no pairs,check runs
2200 IF n<3 THEN RETURN
2210 FOR l=3 TO n
2220 LET y=1
2230 FOR x=n-l+1 TO n
2240 LET h(y)=t(x): LET y=y+1
2250 NEXT x
2270 GO SUB SORT
2330 LET r=l
2340 FOR x=1 TO l-1
2350 IF h(x)+1<>h(x+1) THEN GO TO 2380
2360 NEXT x
2370 IF r>p THEN LET p=r
2380 NEXT l
2385 LET s=s+p
2390 RETURN
2400 REM =================================== SORT H(), length l
2410 LET z=0
2420 FOR x=1 TO l-1
2430 IF h(x)>h(x+1) THEN LET z=h(x): LET h(x)=h(x+1): LET h(x+1)=z
2440 NEXT x
2450 IF z<>0 THEN GO TO 2410
2460 RETURN
2700 REM =================================== MANPLAY human plays a card
2710 IF nh=4 THEN LET hgo=1: PRINT AT 6,9;" GO ": RETURN
2715 LET m$="Select a card using SPACE+ENTER": GO SUB MESSAGE
2720 LET c=4: LET x=1: GO SUB SELECT
2740 IF b(x)<>0 THEN GO TO 2765
2742 IF tot<22 THEN GO TO 2720
2745 PRINT AT 20,x*4-4;"GO?"
2747 LET m$="ENTER again if you can't play.": GO SUB MESSAGE
2750 LET hgo=x: GO SUB SELECT
2755 PRINT AT 20,hgo*4-4;" ";
2760 IF hgo<>x THEN GO TO 2740
2762 IF tot<safe THEN LET safe=tot
2763 RETURN
2765 LET k=x: BEEP .02,15
2770 LET c=a(k): GO SUB LAYCARD
2775 IF s<0 THEN BEEP .2,20: LET m$="Total must be less than 32": GO SUB MESSAGE: GO TO 2720
2780 LET nh=nh+1
2785 LET tot=t: LET b(k)=0
2790 LET x=k: LET y=16
2800 GO SUB ERASE
2820 LET x=nh: LET y=8
2830 LET x$=r$(c): LET y$=a$(k)
2840 GO SUB FACEUP
2850 LET player=man
2900 REM =================================== TOTAL AND SCORE
2910 PAPER 4
2920 PRINT AT 6,0;"TOTAL ";tot;" "
2930 IF s=0 THEN RETURN
2940 PRINT AT 6,9;"for ";s;" "
2955 GO SUB UPDATE
2960 RETURN
3200 REM =================================== ZX PLAYS A CARD
3220 IF nc=4 THEN LET cgo=1: RETURN
3225 LET m$="": GO SUB MESSAGE
3230 IF debug=1 THEN PRINT #1;AT 0,0;n$;AT 0,0;
3240 LET max=-9: LET x1=0
3250 FOR i=1 TO 4
3260 IF d(i)<0 THEN GO TO 3500: REM already played
3270 LET c=c(i)
3280 GO SUB LAYCARD: IF s<0 THEN GO TO 3500: REM illegal
3290 LET n=n-1: LET i(i)=s: REM unplay and save score
3300 REM special rules
3305 IF t+c=31 AND t<safe THEN LET s=s-1
3310 LET s=s+(t>15)-(t=21)+(t>=safe)-2*(t=5)
3315 IF n>0 THEN GO TO 3400
3320 FOR j=1 TO 4
3330 IF i=j OR d(j)<0 THEN GO TO 3360
3340 IF t<>5 AND t+d(j)=15 THEN LET s=s+2
3350 IF ABS (c-c(j))<2 THEN LET s=s+2
3360 NEXT j
3380 GO TO 3450
3400 IF ABS (t(n)-c)>2 THEN GO TO 3450
3410 FOR j=1 TO 4
3420 IF j=i OR d(j)<0 THEN GO TO 3440
3430 IF ABS (t(n)-c(j))<=2 THEN IF t+2*d(i)<32 THEN LET s=s+2
3440 NEXT j
3450 LET s=s+(RND>.6)
3460 IF s>=max THEN LET max=s: LET x1=i
3490 IF debug THEN PRINT #1;c;"=";i(i);",";s;" ";
3500 NEXT i
3550 IF x1=0 THEN LET cgo=1: PRINT AT 6,9;" GO ": RETURN
3560 LET c=c(x1): LET t=tot+FN t(c)
3570 LET n=n+1: LET t(n)=c
3580 LET tot=t: LET s=i(x1)
3590 LET nc=nc+1: LET d(x1)=-9
3600 LET x=nc: LET y=0
3610 LET x$=r$(c): LET y$=c$(x1)
3620 BEEP .02,12: GO SUB FACEUP
3630 LET player=zx
3640 GO TO TOTAL
3700 REM =================================== SELECT CARD
3710 PAPER 4
3720 PRINT AT 21,X*4-3; FLASH 1;"^";
3725 IF INKEY$<>"" THEN GO TO 3725
3730 IF CODE INKEY$=13 THEN GO TO 3800
3750 IF INKEY$<>" " THEN GO TO 3730
3760 PRINT AT 21,x*4-3;" ";
3770 LET x=x+1: IF x>c THEN LET x=1
3790 GO TO 3720
3800 PRINT AT 21,x*4-3;" ";
3810 RETURN
4000 REM =================================== TAKE TURNS
4050 LET nh=0: LET nc=0
4065 LET safe=31
4080 GO SUB 4400
4090 IF dlr<>zx THEN GO TO 4200
4100 REM human
4110 IF done=1 THEN RETURN
4120 GO SUB MANPLAY
4125 IF win>0 THEN RETURN
4130 IF tot=31 THEN GO SUB 4300: GO TO 4200
4140 IF cgo=0 THEN GO TO 4200
4150 IF hgo=0 THEN GO TO 4100
4160 LET s=1: GO SUB TOTAL: IF win>0 THEN RETURN
4170 GO SUB 4300
4200 REM computer
4205 IF done=1 THEN RETURN
4210 GO SUB ZXPLAY
4220 IF win>0 THEN RETURN
4230 IF tot=31 THEN GO SUB 4300: GO TO 4100
4240 IF hgo=0 THEN GO TO 4100
4250 IF cgo=0 THEN GO TO 4200
4260 LET s=1: GO SUB TOTAL: IF win>0 THEN RETURN
4270 GO SUB 4300
4290 GO TO 4100
4300 REM *** turn over ***
4310 LET y=0
4320 FOR x=1 TO nc
4325 GO SUB FACEDOWN
4330 NEXT x
4340 LET y=8
4350 FOR x=1 TO nh
4360 GO SUB FACEDOWN
4370 NEXT x
4400 REM **** NEXT ROUND *****
4405 LET done=0: LET s=0
4420 LET tot=0: LET n=0
4430 IF nh=4 AND nc=4 THEN LET done=1
4440 LET cgo=0: LET hgo=0
4450 GO SUB TOTAL: RETURN
4500 REM =================================== SHOW HANDS AND COUNT
4510 PRINT #1;AT 0,0;n$;
4515 LET c=5: LET rlen=2
4520 LET x=18: GO SUB CLEAR
4530 IF dlr=zx THEN GO TO 4600
4540 FOR x=1 TO 5
4550 LET h(x)=c(x): LET h$(x)=c$(x)
4560 NEXT x
4570 LET up=1: LET c=4: GO SUB ZXHAND
4575 LET m$="Counting my hand": GO SUB MESSAGE
4580 LET player=zx: GO SUB COUNT
4585 IF win THEN RETURN
4590 IF dlr=zx THEN GO TO 4660
4600 LET m$="Counting your hand": GO SUB MESSAGE
4605 FOR x=1 TO 5
4610 LET h(x)=a(x): LET h$(x)=a$(x)
4620 NEXT x
4625 LET c=4: LET y=11
4630 GO SUB MANHAND
4640 LET player=man: GO SUB COUNT
4645 IF win THEN RETURN
4650 IF dlr=zx THEN GO TO 4540
4660 LET m$="Ready to see the crib ? ": GO SUB MESSAGE
4661 PAUSE 0
4665 LET x=18: GO SUB CLEAR
4670 GO SUB CRIBHAND
4675 LET m$="Counting points in the crib": GO SUB MESSAGE
4680 GO SUB COUNT
4690 RETURN
4700 REM =================================== COUNT HAND h()
4705 LET nob=0: LET tot=0
4710 FOR x=1 TO 5
4715 IF x<5 AND h(x)=11 AND h$(x)=e$(5) THEN LET nob=1
4720 LET i(x)=FN t(h(x))
4735 LET tot=tot+i(x)
4740 NEXT x
4750 LET l=5: GO SUB SORT
4760 LET c=5: GO SUB EVALHAND
4765 PRINT
4770 LET m$="": GO SUB MESSAGE
4775 IF player=zx OR NOT mug THEN GO TO 4820
4780 INPUT "What is your score? ";ss
4785 IF ss<0 OR ss>50 THEN GO TO 4780
4790 IF ss=s+p+f+fl+nob THEN LET m$="I agree": LET s=ss: GO TO 4880
4795 LET m$=STR$ ss+" is WRONG, I get the points!"
4800 LET mug=2: LET player=zx
4820 PAPER 4
4830 IF f>0 THEN PRINT "15s - ";f;" ";
4840 IF p>0 THEN PRINT "pairs- ";p;
4845 PRINT
4850 IF fl>0 THEN PRINT "flush- ";fl;" ";
4860 IF s>0 THEN PRINT "runs - ";s;
4865 PRINT
4870 IF nob=1 THEN PRINT "and 1 for his nob"
4875 LET s=s+p+f+fl+nob
4880 PRINT "TOTAL = ";s;
4885 IF mug=2 THEN PRINT " for me!"
4890 GO SUB MESSAGE: GO SUB UPDATE
4891 IF mug=2 THEN LET player=man: LET mug=1: PAUSE 100
4895 RETURN
4900 REM =================================== CUT PACK make it 5th in hands
4905 LET y=8: GO SUB FACEDOWN
4910 LET m$="Now I cut the pack."
4915 IF player=man THEN GO SUB MESSAGE: PAUSE 50: GO TO 4930
4920 LET m$="Press any key to cut the pack.": GO SUB MESSAGE
4925 IF INKEY$="" THEN GO TO 4925
4930 LET r=RND*40+12.5
4935 LET k=INT p(r)
4940 IF k=s THEN GO TO 4930
4945 LET k$=s$(FN s(p(r)))
4950 LET x$=r$(k): LET y$=k$
4955 LET x=x-.25: LET y=7
4960 GO SUB FACEUP
4965 LET a(5)=k: LET a$(5)=k$
4970 LET c(5)=k: LET c$(5)=k$
4975 LET e(5)=k: LET e$(5)=k$
4980 RETURN
4985 LET e(5)=k: LET e$(5)=k$
5000 REM =================================== DISPLAY HUMAN HAND
5020 FOR x=1 TO c
5030 LET x$=r$(a(x)): LET y$=a$(x)
5040 GO SUB FACEUP
5050 NEXT x: RETURN
5100 REM =================================== DISPLAY ZX HAND
5110 LET y=0
5120 FOR x=1 TO c
5130 LET x$=r$(c(x)): LET y$=c$(x)
5150 GO SUB FACEUP
5170 NEXT x: RETURN
5200 REM =================================== DISPLAY CRIB and copy to h()
5210 LET crib=1: LET y=11: IF dlr=zx THEN LET y=0
5220 FOR x=1 TO 5
5230 LET h(x)=e(x): LET h$(x)=e$(x)
5240 LET x$=r$(e(x)): LET y$=e$(x)
5250 IF x<5 THEN GO SUB FACEUP
5270 NEXT x: RETURN
5300 REM =================================== ERASE CARD
5310 PAPER 4: GO TO 5370
5350 REM =================================== PRINT FACEDOWN CARD
5360 PAPER 2
5370 LET x$=" ": LET y$=x$: GO TO 5420
5400 REM =================================== PRINT FACEDOWN CARD
5410 PAPER 7: IF y$=s$(1) OR y$=s$(3) THEN INK 2
5420 LET x1=4*x-4
5440 PRINT AT y,x1;x$;" ";AT y+1,x1;y$;" "
5450 PRINT AT y+2,x1;" ";AT y+3,x1;" ";y$
5460 PRINT AT y+4,x1;" ";x$
5470 PAPER 4: INK 0: RETURN
5500 REM =================================== PRINT MESSAGE
5510 PRINT #1;AT 1,0;n$;AT 1,0;m$
5520 RETURN
5600 REM =================================== CLEAR THE SCREEN
5630 PAPER 4: PRINT AT 0,0;
5650 FOR y=1 TO 22: PRINT TAB x: NEXT y
5690 PRINT AT 0,0: RETURN
5700 REM =================================== DRAW CRIB BOARD
5710 PRINT AT 0,25; PAPER 6;"You ZX"
5715 PRINT TAB 25; PAPER 6;" "
5720 FOR y=1 TO 6
5730 PRINT TAB 25; PAPER 6;" \a \a ": REM GRAPHICS
5740 PRINT TAB 25; PAPER 6;" \a \a ": REM GRAPHICS
5750 PRINT TAB 25; PAPER 6;" \b \b ": REM GRAPHICS
5760 NEXT y
5765 PRINT TAB 25; PAPER 6;" "
5770 PRINT n$;: PAPER 6
5775 PRINT AT 2,28;"\e";AT 19,28;"\e": REM GRAPHICS
5780 LET m$="CRIBBAGE"
5790 FOR x=1 TO 8
5800 PRINT AT 2*x+1,28;m$(x)
5810 NEXT x
5820 PRINT AT 1,0;: PAPER 4: RETURN
6000 REM =================================== UPDATE SCORE
6005 IF s=0 THEN RETURN
6010 BEEP .2,10
6015 IF s=0 THEN RETURN : REM entry for demo routine
6020 LET ss=v(player)
6030 IF ss>0 THEN GO SUB 6400
6040 LET v(player)=s(player)
6050 LET s(player)=s(player)+s
6060 IF s(player)>120 THEN LET win=player: GO TO 6085
6070 LET ss=s(player)
6080 GO SUB 6400
6085 PRINT PAPER 6;AT 20,25;s(man)
6090 PRINT PAPER 6;AT 20,31-(s(zx)>99)-(s(zx)>9);s(zx)
6095 RETURN
6400 LET x=25: LET v=1
6405 IF player=zx THEN LET x=31: LET v=3
6410 IF ss>60 THEN LET ss=ss-60
6415 IF ss<31 THEN LET ss=31-ss: GO TO 6440
6420 LET ss=ss-30: LET x=27: LET v=3: IF player=zx THEN LET x=29: LET v=1
6440 LET y=1+(ss+INT ((ss-1)/5))/2
6450 IF y<>INT y THEN LET y=INT y+1: LET v=v+1
6460 PRINT OVER 1; PAPER 6;AT y,x;v$(v)
6490 RETURN
7000 REM *********************************** INITIALISATION
7005 RANDOMIZE : LET debug=0
7010 BORDER 4: PAPER 4: INK 0: CLS
7020 LET x=0: LET y=0: LET z=0: LET i=0: LET j=0
7025 DIM h(8): DIM h$(6): DIM i(6)
7030 DIM a(6): DIM a$(6): DIM b(6): REM humans hand
7035 DIM c(6): DIM c$(6): DIM d(6): REM zx hand
7040 DIM e(6): DIM e$(6): REM crib hand
7050 DIM g(2): DIM s(2): DIM v(2): DIM v$(5): REM scoring
7055 DIM p(52): DIM t(12): REM pack and table
7060 INPUT "Welcome to CRIBBAGE."'"Do you want instructions ? ";i$
7070 IF i$(1)="y" OR i$="Y" THEN GO SUB 9000: GO TO 7080
7075 PRINT #1;"Please wait for a few moments ."
7080 FOR x=1 TO 13: READ k$
7085 FOR y=0 TO 7: READ z
7090 POKE USR k$+y,z
7095 NEXT y: NEXT x
7100 LET PICK2 =500
7105 LET EVALHAND =1000
7110 LET LAYCARD =2000
7115 LET SORT =2400
7120 LET MANPLAY =2700
7125 LET TOTAL =2900
7130 LET ZXPLAY =3200
7135 LET SELECT =3700
7140 LET TAKETURNS=4000
7145 LET SHOW =4500
7150 LET COUNT =4700
7155 LET CUT =4900
7160 LET MANHAND =5000
7165 LET ZXHAND =5100
7170 LET CRIBHAND =5200
7175 LET ERASE =5300
7180 LET FACEDOWN =5350
7185 LET FACEUP =5400
7190 LET MESSAGE =5500
7195 LET CLEAR =5600
7200 LET DRAWBOARD=5700
7210 LET UPDATE =6000
7220 REM
7300 LET zx=1: LET man=2
7305 REM ***** GRAPHICS *****
7310 LET v$="\g\f\j\i\k": REM PEGS
7315 LET s$="\h\c\d\s": REM SUITS
7320 LET r$="A23456789\tJQK": REM RANKS
7330 LET n$=" ": REM 32 spaces
7335 LET o$="Press any key to continue"
7340 IF i$="y" THEN GO SUB 9050
7350 REM construct pack
7355 LET z=0
7360 FOR x=1 TO 13
7365 FOR y=.1 TO .4 STEP .1
7370 LET z=z+1: LET p(z)=x+y
7375 NEXT y
7380 NEXT x
7390 LET g(man)=0: LET g(zx)=0
7400 REM *********************************** START A NEW GAME
7404 LET mug=0
7405 INPUT "With muggins rule ? y/n ";m$: IF m$="y" OR m$="Y" THEN LET mug=1
7406 GO SUB DRAWBOARD
7410 PRINT #1;AT 0,0;"Lowest cut deals."
7420 LET s(zx)=0: LET s(man)=0: LET v(1)=0: LET v(2)=0
7425 LET dlr=zx: LET s=0: LET player=zx: LET win=0
7430 LET x=2: GO SUB CUT: LET s=k
7435 PAUSE 50
7440 LET player=man: LET x=5: GO SUB CUT
7450 IF s<k THEN LET dlr=man
7470 PAUSE 50: LET x=23: GO SUB CLEAR
7500 REM *********************************** SHUFFLE AND DEAL
7510 LET m$="I am"
7520 IF dlr=man THEN LET m$="You are"
7525 LET m$=m$+" the dealer"
7530 PRINT #0;AT 0,0;m$;n$
7535 LET m$="Shuffling the pack"
7540 GO SUB MESSAGE
7610 FOR x=1 TO 51
7620 LET y=INT (RND*(53-x))+x: LET z=p(x): LET p(x)=p(y): LET p(y)=z
7630 NEXT x
7635 LET m$="": GO SUB MESSAGE
7640 REM sort cards to be dealt
7650 FOR y=1 TO 7 STEP 6
7655 LET z=0
7660 FOR x=y TO y+4
7670 IF p(x)>p(x+1) THEN LET z=x: LET j=p(x): LET p(x)=p(x+1): LET p(x+1)=j
7680 NEXT x: IF z>0 THEN GO TO 7655
7690 NEXT y
7700 REM deal
7710 LET i=0: LET j=16
7720 IF dlr=zx THEN LET i=16: LET j=0
7730 FOR x=1 TO 6
7740 LET y=i: GO SUB FACEDOWN
7750 LET c(x)=INT p(x): LET c$(x)=s$(FN s(p(x)))
7760 LET d(x)=FN t(c(x))
7770 LET y=j: GO SUB FACEDOWN
7780 LET a(x)=INT p(x+6): LET a$(x)=s$(FN s(p(x+6)))
7790 LET b(x)=1
7795 NEXT x
7799 REM *********************************** DISCARD INTO CRIB
7800 LET c=6: LET y=16: GO SUB MANHAND
7810 LET m$="Please wait while I pick 2 cards": GO SUB MESSAGE
7820 LET c=4: LET rlen=1: LET crib=0
7825 LET max=-99: LET t(1)=1: LET t(2)=6
7830 GO SUB PICK2
7840 LET m$="Pick 2 cards using SPACE+ENTER": GO SUB MESSAGE
7845 IF i$="y" THEN GO SUB 9300: GO SUB 9400
7850 LET c=6: LET y=16: LET x=1
7860 GO SUB SELECT: GO SUB FACEDOWN
7870 LET t(3)=x: GO SUB SELECT
7880 LET x$=r$(a(x)): LET y$=a$(x)
7885 IF x=t(3) THEN GO SUB FACEUP: GO TO 7860
7890 LET t(4)=x: GO SUB FACEDOWN
7895 REM *** close up hands
7900 FOR x=1 TO 2
7905 LET e(x)=c(t(x)): LET e$(x)=c$(t(x))
7910 LET c(t(x))=0
7915 LET e(x+2)=a(t(x+2)): LET e$(x+2)=a$(t(x+2))
7920 LET a(t(x+2))=0
7925 NEXT x
7930 LET y=1: LET z=1
7935 FOR x=1 TO 6
7940 IF c(x)=0 THEN GO TO 7955
7945 LET c(y)=c(x): LET d(y)=d(x)
7950 LET c$(y)=c$(x): LET y=y+1
7955 IF a(x)=0 THEN GO TO 7970
7960 LET a(z)=a(x): LET a$(z)=a$(x): LET z=z+1
7970 NEXT x
7980 LET x=24: GO SUB CLEAR
7985 IF i$="y" THEN GO SUB 9450
7990 PRINT #0;AT 0,0;n$
7999 REM *********************************** PLAY CARDS
8000 LET s=0: LET player=dlr
8010 LET x=6: GO SUB CUT
8020 IF k=11 THEN LET m$="2 for his heels": GO SUB MESSAGE: LET s=2: GO SUB UPDATE: PAUSE 40
8030 LET c=4
8040 LET y=16: GO SUB MANHAND
8050 GO SUB TAKETURNS
8060 IF win THEN GO TO 8200
8065 IF i$="y" THEN GO SUB 9200
8070 GO SUB SHOW
8080 IF win THEN GO TO 8200
8100 LET m$="Ready for the next hand ?": GO SUB MESSAGE
8105 IF INKEY$="" THEN GO TO 8105
8110 LET dlr=dlr+1: IF dlr>2 THEN LET dlr=1
8120 LET x=25: GO SUB CLEAR
8130 IF i$<>"y" THEN GO TO 7500
8140 INPUT "Continue with instructions?";i$
8150 IF i$="Y" THEN LET i$="y"
8160 GO TO 7500
8200 REM *********************************** WINNER
8210 LET m$="Congratulations, you have won !"
8220 IF win=zx THEN LET m$="Hard luck, I have won !"
8230 PRINT #1;AT 0,0;m$
8240 PRINT PAPER 6;AT 18,28; FLASH 1;v$(5)
8250 FOR x=1 TO 60 STEP 2: BEEP .02,x: NEXT x
8260 LET g(player)=g(player)+1
8265 LET m$=o$: GO SUB MESSAGE
8270 PAUSE 0
8280 LET x=23: GO SUB CLEAR
8290 PRINT AT 4,8;"SCORE";AT 5,7;"_______"
8300 PRINT AT 7,8;"You ";g(man)
8310 PRINT AT 9,8;"ZX ";g(zx)
8320 INPUT "Another game y/n ";m$
8330 IF m$="n" OR m$="N" THEN STOP
8380 GO TO 7400
9000 REM *********************************** INSTRUCTIONS
9005 LET i$="y"
9010 CLS : PRINT " 6 card Cribbage is a game for 2 players. Each is dealt 6 cards2 of which he discards to form a third hand (the crib) which islater scored by the dealer. The 3 hands are complimented by a card cut from the pack. "
9020 PRINT '"Ace always counts as 1 and all court cards have a value of 10."
9030 PRINT : PRINT "You will see during play how points are gained for certain card combinations, but first we will see how scoring is kept."
9040 RETURN
9060 LET m$=o$: GO SUB MESSAGE
9065 PAUSE 0
9070 CLS : GO SUB DRAWBOARD
9075 PRINT "When points are scored"'"they are marked on the"
9080 PRINT "board with pegs."''"The winner is the first"
9085 PRINT "to reach 121 points"'"(twice round the board)."
9090 LET m$="Press SPACE for a demonstration.": GO SUB MESSAGE
9095 PAUSE 0: IF INKEY$<>" " THEN GO TO 9175
9100 LET s(man)=0: LET s(zx)=0
9105 LET m$="Watch my score...": GO SUB MESSAGE
9110 FOR i=zx TO man
9115 LET player=i: LET win=0
9120 LET s(player)=0: LET v(player)=0
9130 LET s=INT (RND*10): GO SUB UPDATE+15
9140 IF win=0 THEN GO TO 9130
9145 PRINT PAPER 6;AT 18,28;v$(5)
9150 LET m$="Now watch your score": GO SUB MESSAGE
9155 NEXT i
9160 LET m$="Hit SPACE to see the demo again": GO SUB MESSAGE: GO TO 9095
9180 PRINT AT 9,0;"When you have to select"'"a card use these keys:"'"SPACE to move the arrow,"'"ENTER to play the card."
9190 PRINT '"If you choose to play"'"the muggins rule then"'"you must count your own"'"score and I get your"'"points if you make a"'"mistake."
9195 RETURN
9200 LET x=25: GO SUB CLEAR
9210 PRINT "Now each player counts"'"the number of points in"
9220 PRINT "his hand, beginning with"'"the non-dealer."
9230 PRINT '"Afterwards the dealer"'"counts the crib."'
9240 GO SUB 9305: GO SUB 9400
9245 LET m$=o$: GO SUB MESSAGE
9250 PAUSE 0: LET x=25: GO SUB CLEAR
9255 LET x=6: LET y=8: GO SUB FACEDOWN
9260 LET x=x-.25: LET y=7: LET x$=r$(c(5)): LET y$=c$(5)
9270 GO SUB FACEUP
9280 RETURN
9300 PRINT AT 0,0;
9305 PRINT "Points are scored for "'"combinations as follows:"'
9310 PRINT "Each total of 15..... 2"
9320 PRINT "2 of a kind (1 pair ) 2"
9330 PRINT "3 of a kind (3 pairs) 6"
9340 PRINT "4 of a kind (6 pairs) 12"
9350 PRINT "Run of 3 or more 1/card"
9360 RETURN
9400 PRINT "4 card flush ......... 4"
9410 PRINT "5 card flush ......... 5"
9420 PRINT "Jack with same suit as"
9430 PRINT " card cut from pack .. 1"
9440 RETURN
9450 PRINT AT 0,0;"Now we each play a card"'"alternately until the"
9460 PRINT "total is as close to 31";';"as possible."
9470 PRINT "Points are scored if:"''"Total = 15 ..... 2"
9480 PRINT "Total = 31 ..... 2"'"Closest to 31 .. 1"''
9490 PRINT "Forming a run or a pair";';"with cards already on the"
9500 PRINT "table also scores points:"''
9510 GO SUB 9320
9520 PRINT '"If you cannot play a card"'"(total>31) then select"'"an empty card position."
9530 LET m$=o$: GO SUB Message
9540 PAUSE 0: LET x=25: GO SUB CLEAR
9590 RETURN
9600 DATA "a"
9610 DATA 0,195,195,0,0,195,195,0
9620 DATA "b"
9630 DATA 0,195,195,0,0,0,0,0
9640 DATA "c"
9650 DATA 56,56,254,254,214,16,16,56
9660 DATA "d"
9670 DATA 16,56,124,254,254,124,56,16
9680 DATA "e"
9690 DATA 0,24,24,0,0,0,0,0
9700 DATA "f"
9710 DATA 240,255,240,0,0,0,0,0
9720 DATA "g"
9730 DATA 0,0,0,0,240,255,240,0
9740 DATA "h"
9750 DATA 68,238,254,124,124,56,16,16
9760 DATA "i"
9770 DATA 15,255,15,0,0,0,0,0
9780 DATA "j"
9790 DATA 0,0,0,0,15,255,15,0
9800 DATA "k"
9810 DATA 28,28,28,28,8,8,8,8
9820 DATA "s"
9830 DATA 16,56,124,254,254,146,16,56
9840 DATA "t"
9850 DATA 0,76,210,82,82,82,76,0
9990 CLEAR : INPUT "prog name : ";n$
9996 SAVE n$ LINE 1: PRINT n$;" saved"
9997 VERIFY n$: PRINT n$;" verified"
9999 PAPER 7: BORDER 7: INK 0: CLS : LIST Note: Type-in program listings on this website use ZMAKEBAS notation for graphics characters.