fogus/monad.bas

## monad.bas
DECLARE SUB Hugemonad ()
DECLARE SUB Colours ()

SCREEN 9
CLEAR , , 5000
WIDTH , 43
CALL Colours
CALL Hugemonad

LINE (380, 240)-(596, 303), 2, BF
LOCATE 32, 50: COLOR 6
PRINT "                        "
LOCATE , 50: PRINT "  The card game by Sid  "
LOCATE , 50: PRINT "  Sackson,  programmed  "
LOCATE , 50: PRINT "    for  the  PC  by    "
LOCATE , 50: PRINT "    George  Crawshay    "
LOCATE , 50: PRINT "                        "

SLEEP 3: COLOR 1

1 DATA B,R,T,O,G,Y,CO,BI,TR,QA,VI,1,3,7,16,36,80
  DATA 400,452,504,556,24,54,84,114,144,174
800 DIM c$(48), v(48), cx(48), p$(24), d$(24), h$(4, 14)
810 DIM vc(14), tc$(14), cc$(14), x(14), r(14), vp(14)
990 beg = 1
1010 FOR q = 1 TO 6: READ co$(q): NEXT
1020 FOR q = 1 TO 5: READ s$(q): NEXT
1030 FOR q = 1 TO 6: READ sv(q): NEXT: FOR q = 0 TO 5: nn(q) = 6: NEXT
1040 FOR q = 1 TO 4: READ lax(q): NEXT
1050 FOR q = 1 TO 6: READ lay(q): NEXT
     FOR v = 1 TO 4
       FOR h = 1 TO 6
         lx(v, h) = lax(v): ly(v, h) = lay(h)
       NEXT h
     NEXT v
     colstring$ = "XXBRTOGY": valstring$ = "CBTQV"
1075 FOR q = 0 TO 5: nn(q) = 6: NEXT: B$ = "": rx = 0: cp = 0: dp = 0
1078 FOR q = 1 TO 24: p$(q) = "": d$(q) = "": NEXT

1080 CLS : LOCATE 7, 20: INPUT "How many players (3/4)"; np
1100 IF np < 3 OR np > 4 GOTO 1080
1110 tg = 7 - np
1130 LOCATE 9, 20: INPUT "Do you want a fixed random seed (y/n)"; a$
1149 IF a$ <> "y" THEN RANDOMIZE TIMER: GOTO 1190
1150 LOCATE 10, 20: INPUT "Enter a number between 1 & 9999"; rx
1151 IF rx < 1 OR rx > 9999 GOTO 1150
1180 RANDOMIZE (-rx)
1190 LOCATE 12, 20: PRINT "Target no. of monads"
1200 PRINT TAB(20); "(just press return if you don't"
1210 PRINT TAB(23); "want to change the norm)"; : INPUT n
1221 IF n = 0 GOTO 1230
1223 IF n < 1 OR n > 5 THEN 1190
1224 tg = n
1230 x = np * 6 + 24
1250 x = INT(RND(1) * np + 1): pl = x
     PRINT : PRINT TAB(20); "OK, you are player no.1."
1260 PRINT : IF pl = 1 THEN PRINT TAB(20); "You start": GOTO 1275
1270 PRINT TAB(20); "Player no."; pl; "starts"
1275 SLEEP 2
     CLS : LOCATE 8, 15: COLOR 1

1280 REM allot identities
1290 FOR q = 1 TO np: x(q) = q: nc(q) = 6: NEXT
1300 FOR q = 1 TO np
1310 x = INT(RND(1) * np + 1): IF x(x) = 0 GOTO 1310
1320 j(q) = x: j$(q) = co$(x): x(x) = 0
1330 IF np = 3 AND j(q) = 2 THEN j$(q) = co$(5): j(q) = 5
1340 j$(np + 1) = j$(1)
1350 IF INT(j(q) / 2) = j(q) / 2 THEN jt$(q) = "h": GOTO 1370
1360 jt$(q) = "c"
1370 NEXT

1380 REM construct pack
1390 FOR q = 1 TO 6: FOR j = 1 TO 4: c$((q - 1) * np + j) = co$(q) + s$(1): NEXT: NEXT
1400 FOR q = 1 TO 4
       FOR j = 1 TO 6
1410     c$(6 * (np - 1) + q * 6 + j) = co$(j) + s$(q + 1)
1420   NEXT
     NEXT
1430 FOR q = 1 TO 24 + 6 * np
       x$ = LEFT$(c$(q), 1)
1440   IF x$ = "B" OR x$ = "G" OR x$ = "T" THEN c$(q) = c$(q) + "c": GOTO 1460
1450   c$(q) = c$(q) + "h"
1460 NEXT: col(pl) = 5

LINE (356, 8)-(632, 228), 2, BF
LOCATE 1, 59: COLOR 1: PRINT "LAYOUT"

LINE (6, 8)-(350, 53), 11, BF
LOCATE 1, 19: COLOR 1: PRINT "YOUR CARDS"

LINE (6, 240)-(632, 345), 12, BF
LOCATE 30, 20: PRINT "PLAYERS' HOLDINGS"

LINE (6, 64)-(350, 228), 10, BF
LOCATE 8, 22: PRINT "PLAY"
1470 REM estab bonus combinations
1480 LOCATE 33, 3: COLOR 13: PRINT "BONUS COMBINATIONS"
1490 FOR q = 1 TO 5 STEP 2
       sx = 25 + 45 * (q - 1) / 2: sy = 267
       col2 = q + 2: col = q + 3
       GOSUB Monad
     NEXT q
1500 LOCATE 38, 3: PRINT " MONAD TARGET -"; tg;
1510 REM values
1520 FOR q = 1 TO np * 6: v(q) = 1: NEXT
1530 FOR q = 2 TO 5
       FOR j = 1 TO 6
1540     v((np - 2) * 6 + 6 * q + j) = sv(q)
       NEXT
     NEXT
1550 FOR q = 1 TO np * 6 + 24
1560   c$(q) = LEFT$(c$(q), 2) + RIGHT$(STR$(v(q)), 2) + RIGHT$(c$(q), 1)
     NEXT

1570 REM print identities
1580 LOCATE 33, 33: PRINT "IDENTITIES & SCORES"
1590 FOR q = 1 TO np
1600   stapox = 210: IF np = 3 THEN stapox = 248
       sx = stapox + 75 * (q - 1): sy = 272: col = j(q) + 2
       GOSUB Mono: sx = sx + 5: col = 2: sy = 275
       ON q GOSUB One, Two, Three, Four
     NEXT q
1640 REM print pack-state & codes
1650 LOCATE 33, 68: COLOR 13: PRINT "DECK"
     LOCATE 37, 66: PRINT "DISCARDS"
     LOCATE 42, 3: COLOR 13: PRINT "ACTION CODES:";
     LOCATE , POS(0) + 5: PRINT "T rade";
     LOCATE , POS(0) + 5: PRINT "B uy";
     LOCATE , POS(0) + 5: PRINT "L eap";
     LOCATE , POS(0) + 5: PRINT "D raw";
     LOCATE , POS(0) + 5: PRINT "F lip";
     LOCATE , POS(0) + 5: PRINT "P ass";

1660 REM deal commons
1670 rn = 6 * np
1680 FOR q = 1 TO rn: cx(q) = q: NEXT
1690 FOR q = 1 TO 6
       FOR j = 1 TO np
1700     x = INT(RND(1) * rn + 1)
1710     IF cx(x) = 0 GOTO 1700
1720     h$(j, q) = c$(x): cx(x) = 0
1730   NEXT
     NEXT

1750 REM deal layout
1760 FOR q = 1 TO 4: FOR j = 1 TO 6: c(q, j) = j: NEXT: NEXT
1770 FOR q = 1 TO 4
       FOR j = 1 TO 6
1780     x = INT(RND(1) * 6 + 1): IF c(q, x) = 0 GOTO 1780
1790     l$(q, j) = c$(rn - 6 + 6 * q + x): c(q, x) = 0
1800   NEXT
     NEXT
1810 GOSUB Printlayout
     GOSUB Pause2
1870 p = 1: GOSUB Printhand

1880 pu$ = "  I pick up": IF pl = 1 THEN pu$ = "You pick up"
1890 FOR q = 1 TO 4: ba(q) = 0: NEXT
1900 o9 = 0: jf = 0: bu = 0: ba = 0: cu = 0: hv = 0: COLOR 1
1910 LOCATE 10, 2
     IF pl > 1 THEN PRINT "Player"; pl; : GOTO 3080
1920 PRINT "Your Turn": SLEEP 1
1940 tb = 13: wz$ = "Action"
1950 LOCATE 12, 13: PRINT "Action:"; : GOSUB Pause
1955 IF a$ = "q" THEN PRINT a$: GOTO 7800
1960 IF a$ <> "t" GOTO 2310
     LOCATE 12, 21: PRINT "Trading"

Trading:
1980 REM trading
1990 tb = 10: wz$ = "Which 2 cards"
2000 LOCATE 14, 13: PRINT wz$; : INPUT a(1), a(2)
2030 o$ = "t"
     FOR q = 1 TO 2:
       ch$(q) = h$(pl, a(q))
2040   IF a(q) = 0 AND o9 = 1 GOTO Turncont
2050   IF a(q) = 0 THEN a$ = "y": GOTO 4340
2060   al$(q) = LEFT$(ch$(q), 2): ac$(q) = LEFT$(ch$(q), 1)
2070   IF ch$(q) = "" THEN LOCATE , 13: PRINT "No card.  "; : GOSUB 4760: GOTO 2000
2080   vp(q) = VAL(MID$(ch$(q), 3, 2)): IF vp(q) >= vp(q - 1) THEN vm = vp(q)
2090 NEXT q
2100 IF tf = 1 THEN
       LOCATE 12, 15: PRINT "Trading"
       FOR q = 1 TO 2
         sx = 200 + (q - 1) * 29: sy = 86: card$ = al$(q)
         level$ = RIGHT$(card$, 1)
         value = sv(INSTR(valstring$, level$))
         GOSUB Drawsmall
       NEXT q
     END IF
2110 IF RIGHT$(ch$(1), 1) <> RIGHT$(ch$(2), 1) GOTO 2130
2120 LOCATE , 12: PRINT "Wrong match.  "; : GOSUB 4760: GOTO 2000
2130 IF vp(1) = vp(2) GOTO 2180
2140 IF vp(1) = 1 OR vp(2) = 1 GOTO 2160
2150 IF LEFT$(ch$(1), 1) = j$(pl) OR LEFT$(ch$(2), 1) = j$(pl) GOTO 2170
2160 LOCATE , 11: PRINT "Wrong values.  "; : GOSUB 4760: GOTO 2000
2170 jf = 1: PRINT : COLOR j(pl) + 2
     LOCATE , 17: PRINT "JOKER USED": jokeruse = 1: COLOR 1
2180 cu = 2
2190 GOSUB 4950: IF B = 0 OR jf = 1 GOTO Turncont
2200 B = 0: GOSUB 5980: IF bu = 0 GOTO Turncont
2210 LOCATE 20, 14: PRINT pu$;
     IF lc = 1 THEN PRINT " a common": GOTO 2254
2220 IF lc = 2 AND x$(1) = "" THEN PRINT " a common": GOTO 2254
     nnn = 0: PRINT " the ";
2230 FOR q = lc - 1 TO 1 STEP -1
       IF x$(q) = "" GOTO Nxbo
       sx = 234 + nnn * 40: sy = 150: card$ = x$(q): level$ = RIGHT$(card$, 1)
       value = sv(INSTR(valstring$, level$))
       GOSUB Drawsmall: nnn = nnn + 1
Nxbo:
     NEXT q: PRINT : IF x$(0) = "" GOTO 2254
2240 PRINT : LOCATE , 16: PRINT "and a common"
2254 IF pl = 1 THEN p = 1: GOSUB Printhand: REM comes from the Bonus-taking procedure
2260 SLEEP 2: GOSUB Printlayout
2270 IF lc = 1 GOTO 2300
2280 IF x$(0) = "" GOTO 2300
2300 GOTO Turncont

Buying:
2310 REM buying
2320 IF a$ <> "b" GOTO 2580
2330 LOCATE 12, 21: PRINT "Buying"
2333 LOCATE 14, tb: PRINT "With how many cards"; : INPUT n
     IF n = 0 THEN GOSUB Rubmost: GOTO Turncont
     IF n < 3 GOTO 2333
2340 LOCATE 16, 13: PRINT "Indicate card numbers:": PRINT
     FOR q = 1 TO n
       LOCATE , tb: PRINT q; "- Card no."; : INPUT a(q)
       IF a(q) = 0 THEN
         GOSUB Rubmost
         IF o9 = 1 GOTO Turncont
         a$ = "y": GOTO 4340
       END IF
     NEXT q
2350 x = 0: cu = 0
     FOR q = 1 TO n
2410   GOSUB 6650: IF it = 1 THEN it = 0: GOTO 2340
2420   IF a(q) = 0 GOTO 2440
2430 NEXT
2440 IF x < 3 THEN LOCATE , 12: PRINT "Not enough.  "; : GOSUB 4760: GOTO 2340
2450 o$ = "b": IF x > 2 THEN lc = 1: vx = 3
2460 IF x > 6 THEN lc = 2: vx = 7
2470 IF x > 15 THEN lc = 3: vx = 16
2480 IF x > 35 THEN lc = 4: vx = 36
2490 IF x > 79 THEN vm = 36: vx = 80
2500 FOR q = 1 TO cu
       IF vp(q) = vx GOTO 2520
2510 NEXT: GOTO 2530
2520 LOCATE , 12: PRINT "Not enough.  "; : GOSUB 4760: GOTO 2340
2530 IF tf = 0 GOTO 2560
2540 LOCATE 12, 10: PRINT "Buying with"
2550 FOR j = 1 TO n
       sx = 180 + (j - 1) * 29: sy = 86: card$ = al$(j)
       level$ = RIGHT$(card$, 1)
       value = sv(INSTR(valstring$, level$))
       GOSUB Drawsmall
     NEXT j
2560 GOSUB 5010
2570 GOTO Turncont

Leaping:
2580 REM leaping
2590 IF a$ <> "l" OR o9 = 0 GOTO 2870
2610 LOCATE 12, 21: PRINT "Leaping": PRINT
     IF o9 = 0 THEN PRINT : LOCATE , 12: PRINT "You can't.  "; : GOSUB 4760: GOTO 1940
     o$ = "l": tb = 13: wz$ = "With how many cards"
2620 LOCATE 14, 13: PRINT wz$; : INPUT n
     IF n = 0 THEN GOSUB Rubmost: GOTO Turncont
     IF n < 4 OR n > 6 GOTO 2610
2640 PRINT : LOCATE 16, 13: PRINT "Indicate card numbers:": PRINT
2660 x = 0: cu = 0: IF pl > 1 THEN LOCATE 13, 1 ELSE LOCATE 18, 1
     FOR q = 1 TO n: IF pl > 1 GOTO 2710
2670   LOCATE , tb: PRINT q; "- Card no."; : INPUT a(q)
2680   IF a(q) = 0 THEN GOSUB Rubmost: GOTO Turncont
2710   ch$(q) = h$(pl, a(q))
2720   al$(q) = LEFT$(ch$(q), 2)
2730   IF pl = 1 GOTO 2740
       sx = 180 + (q - 1) * 29: sy = 86: card$ = al$(q)
       level$ = RIGHT$(card$, 1)
       value = sv(INSTR(valstring$, level$))
       GOSUB Drawsmall
2740   vp(q) = VAL(MID$(ch$(q), 3, 2))
2750   IF ch$(q) = "" THEN LOCATE , 13: PRINT "No card.  "; : GOSUB 4760: GOTO 2640
2760   IF vp(q) = 1 THEN GOTO 2780
2770   LOCATE , 10: PRINT "Not a common.  "; : GOSUB 4760: GOTO 2640
2780   IF q = 1 OR pl > 1 GOTO 2820
2790   FOR j = 1 TO q - 1
         IF al$(q) = al$(j) GOTO 2810
2800   NEXT j: GOTO 2820
2810   LOCATE , 10: PRINT "Repetition.  "; : GOSUB 4760: GOTO 2640
2820   cu = cu + 1
     NEXT q
2830 IF cu < 4 THEN LOCATE , 11: PRINT "Not enough": GOSUB 4760: GOTO 2640
2840 lc = cu - 2
2850 GOSUB 5030
2860 GOTO Turncont

Drawing:
2870 REM drawing
2880 IF a$ <> "d" GOTO 2950 ELSE LOCATE 12, 21: PRINT "Drawing"
2890 IF cp > 0 GOTO 2910
2900 LOCATE , 13: PRINT "No cards.  "; : GOSUB 4760: GOTO 1940
2910 IF o9 = 1 THEN
       PRINT : LOCATE , 12: PRINT "You can't. "; : GOSUB 4760: GOTO 1940
     END IF
2912 IF nc(1) > 11 THEN
       PRINT : LOCATE , 5: PRINT "Sorry, your hand's full up. ";
       GOSUB 4760: GOTO 1940
     END IF
2920 LOCATE 20, 14: PRINT pu$; " a"
     sx = 225: sy = 149
     col$ = LEFT$(tc$, 1): col = INSTR(colstring$, col$)
     GOSUB Mono
2930 nc(pl) = nc(pl) + 1: h$(pl, nc(pl)) = tc$
2940 GOSUB 4720: IF pl = 1 THEN p = 1: GOSUB Printhand
     tl = 1: GOSUB Printlayout: SLEEP 2: GOTO 4370

Flipping:
2950 REM flipping
2960 IF a$ <> "f" GOTO 3030 ELSE LOCATE 12, 21: PRINT "Flipping"
2970 IF dp > 0 GOTO 2990
2980 LOCATE , 13: PRINT "No cards.  "; : GOSUB 4760: GOTO 1940
2990 IF o9 = 1 OR cp > 0 THEN LOCATE , 12: PRINT "You can't.  "; : GOSUB 4760: GOTO 1940
3000 cp = dp: FOR q = 1 TO cp: p$(q) = d$(q): d$(q) = "": NEXT: dp = 0: tc$ = p$(1)
     LINE (476, 300)-(630, 312), 12, BF: GOSUB Drawdeck
3010 IF pl = 1 THEN
       PRINT : LOCATE , 12: PRINT "OK, discard pack flipped": SLEEP 2
     END IF
3020 tl = 1: GOSUB Printlayout: GOTO 4370

Passing:
3030 REM passing
3040 IF a$ <> "p" GOTO 1940 ELSE LOCATE 12, 21: PRINT "Passing"
3050 IF o9 = 2 OR cp > 0 OR dp > 0 THEN
       LOCATE , 12: PRINT "You can't.  "; : GOSUB 4760: GOTO 1940
     END IF
3060 GOTO 4370
3070 GOTO 1940

Compturn:
3080 REM Computer turn
     nnn = 1: IF nc(pl) > 9 THEN nnn = 2
     nc$ = RIGHT$(STR$(nc(pl)), nnn)
3090 PRINT " ("; nc$; " Cards)"

3100 tf = 0
     FOR q = 1 TO nc(pl)
3110   vc(q) = VAL(MID$(h$(pl, q), 3, 2))
3120   cc$(q) = LEFT$(h$(pl, q), 1)
3130   tc$(q) = RIGHT$(h$(pl, q), 1)
3140 NEXT q
3150 GOSUB 7190: REM trade capabilities
3160 IF a$ = "e" THEN END
3170 IF m(pl) = tg - 1 AND t(5) = 1 GOTO 3910: REM get monad to win

3180 REM usable joker?
3190 FOR q = 1 TO nc(pl)
3200   IF vc(q) = 1 GOTO 3220
3210   IF cc$(q) = j$(pl) THEN GOSUB 6560: IF tf = 1 GOTO 2030
3220 NEXT q

3230 REM joker available? (bi player)
3240 IF jh(1) = 1 GOTO 3270
3250 n1 = 1: n2 = pl
3260 GOSUB 6190: IF tf = 1 THEN oz = 1: GOTO 2030

3270 REM any ba now?
3280 FOR q = 5 TO 2 STEP -1
3290   n = 0
       FOR j = 1 TO nc(pl)
3300     IF vc(j) = sv(q) THEN n = n + 1: x(n) = j
3310   NEXT j
3320   IF n > 1 AND t(q) = 1 THEN GOSUB 6780
3330   IF ba(q - 1) = 0 GOTO 3400
3350   IF bu = 1 GOTO 3400
3360   IF q = 5 GOTO 3390
3370   IF nc(pl) < 10 AND RIGHT$(l$(q, nn(q)), 1) = tb$(q + 1) GOTO 3400
3380   IF q = 2 AND cp = 0 GOTO 3410
3390   tf = 1: a(1) = x(j): a(2) = x(k): oz = 2: GOTO 2030
3400 NEXT q

3410 REM bonus pair hand & layout?
3420 GOSUB 6910: IF tf = 1 THEN oz = 3: GOTO 2030

3430 REM trade if tb is wrong
3440 FOR q = 1 TO 4
3450   IF tb$(q + 1) = "" OR tq = 0 OR nn(q) = 0 GOTO 3490
3460   IF ba(q - 1) = 1 AND (bu = 1 OR nn(q - 1) = 0) GOTO 3490
3470   IF RIGHT$(l$(q, nn(q)), 1) = tb$(q + 1) GOTO 3490
3480   tf = 1: oz = 4: a(1) = tp(q, 1): a(2) = tp(q, 2): GOTO 2030
3490 NEXT q

Leaptest:
3500 REM leap test
3510 IF nc(pl) < 5 OR o9 = 0 GOTO 3610
3520 FOR k = 1 TO 6
       c1$(k) = co$(k)
     NEXT
3530 n = 0
     FOR q = 1 TO nc(pl)
       x(q) = 0: IF vc(q) > 1 GOTO 3560
3540   FOR k = 1 TO 6
         IF cc$(q) = c1$(k) THEN n = n + 1: c1$(k) = "": x(n) = q
3550   NEXT k
3560 NEXT q: IF n < 4 GOTO 3610
3570 IF nn(n - 2) = 0 GOTO 3610
3580 IF tb$(n - 1) = RIGHT$(l$(n - 2, nn(n - 2)), 1) GOTO 3610
3590 LOCATE 12, 9: PRINT "Leaping with"
3600 tf = 1: oz = 5: FOR q = 1 TO n: a(q) = x(q): NEXT: GOTO 2660

3610 REM Joker available? (BI Oppo)
3620 IF tb$(2) = RIGHT$(l$(1, nn(1)), 1) GOTO 3650
3630 n1 = 1: n2 = pl + 1: IF n2 > np THEN n2 = 1
3640 GOSUB 6190: IF tf = 1 THEN oz = 6: GOTO 2030

3650 REM Bonus pair on layout?
3660 IF ba = 1 OR bu = 1 GOTO 3680
3670 GOSUB 7060: IF tf = 1 THEN oz = 7: GOTO 2030

3680 REM Joker available? (Tri player)
3690 IF jh(1) = 1 OR jh(2) = 1 GOTO 3750
3700 FOR q = 1 TO nc(pl)
       IF vc(q) < 16 GOTO 3720
3710   IF tc$(q) <> jt$(pl) GOTO 3730
3720 NEXT q: GOTO 3750
3730 hv = 1: n1 = 2: n2 = pl
3740 GOSUB 6190: IF tf = 1 THEN oz = 9: GOTO 2030

3750 REM Buy if joker available
3760 FOR q = 1 TO 2
       IF jh(q) = 1 GOTO 3890
3770   IF LEFT$(l$(q, nn(q)), 1) <> j$(pl) GOTO 3860
3780   n1 = 0: n2 = 0: n = 0: v = 0
       FOR j = q TO 1 STEP -1
         FOR k = 1 TO nc(pl)
3790       IF vc(k) <> sv(j) GOTO 3840
3800       IF cc$(k) = j$(pl) AND vc(k) > 1 GOTO 3840
3810       IF q = 2 THEN GOSUB 6710: IF bo = 1 GOTO 3840
3820       n = n + 1: v = v + vc(k): r(n) = k
3830       IF v >= sv(q + 1) THEN tf = 1: oz = 8: GOTO 3850
3840     NEXT k
       NEXT j: GOTO 3860
3850   FOR j = 1 TO n: a(j) = r(j): NEXT: GOTO 3870
3860 NEXT q: GOTO 3890
3870 x = 0: cu = 0: FOR q = 1 TO n: GOSUB 6650: NEXT
3880 GOTO 2450

3890 REM Monad available?
3900 IF t(5) = 0 OR (ba(4) = 1 AND bu = 1) GOTO 3920
3910 tf = 1: oz = 10: a(1) = tp(5, 1): a(2) = tp(5, 2): GOTO 2030
3920 IF o9 = 1 GOTO 4370

3930 REM if more than 8 cards
3940 IF nc(pl) <= 9 GOTO 3970
3950 x = INT(RND(1) * 6 + 1): IF x < (nc(pl) - 5) THEN GOSUB 6320
3960 IF tf = 1 THEN oz = 11: GOTO 2030

3970 REM Joker available? (tri oppo)
3980 IF tb$(3) = RIGHT$(l$(2, nn(2)), 1) GOTO 4030
3990 FOR q = 1 TO nc(pl)
       IF vc(q) = 16 GOTO 4010
4000 NEXT q: GOTO 4030
4010 n1 = 2: n2 = pl + 1: IF n2 > np THEN n2 = 1
4020 GOSUB 6190: IF tf = 1 THEN ox = 12: GOTO 2030

4030 REM Prevent draw if nc(pl)>11
4040 IF cp > 0 AND o9 = 0 AND nc(pl) > 11 GOTO 4100
4050 IF cp > 0 AND o9 = 0 THEN LOCATE 18, 19: PRINT "Drawing": GOTO 2930

4060 REM if Flip only option
4070 GOSUB 6320
4080 IF tf = 1 THEN oz = 13: GOTO 2030
4090 IF dp > 0 AND cp = 0 AND o9 = 0 THEN LOCATE 18, 19: PRINT "Flipping": GOTO 3000

4100 REM Buy to save passing
4105 FOR z = 1 TO 2
4110   FOR q = 1 TO 4
         IF nn(q) = 0 GOTO 4190
4120     n1 = 0: n2 = 0: n = 0: v = 0
         FOR j = q TO 1 STEP -1
           FOR k = 1 TO nc(pl)
4130         IF vc(k) <> sv(j) GOTO 4170
4135         IF z = 2 GOTO 4150
4140         IF cc$(k) = j$(pl) AND vc(k) > 1 GOTO 4170
4150         n = n + 1: v = v + vc(k): r(n) = k
4160         IF v >= sv(q + 1) THEN tf = 1: oz = 14: GOTO 4180
4170       NEXT k
         NEXT j: GOTO 4190
4180     FOR j = 1 TO n: a(j) = r(j): NEXT: GOTO 4200
4190   NEXT q
     NEXT z: GOTO 4220
4200 x = 0: cu = 0: FOR q = 1 TO n: GOSUB 6650: NEXT
4210 GOTO 2450

4220 REM Passing
4230 LOCATE 14, 16: PRINT "I have to pass."
4240 LOCATE 17, 15: PRINT "See my hand above"
4250 p = pl: GOSUB Printhand: GOSUB 4610
4260 GOTO 4370

Turncont:
4270 REM Turn continuation
4280 IF m(pl) = tg GOTO 4440
4290 jf = 0
4300 FOR q = 1 TO 6: ch$(q) = "": vp(q) = 0: ba(q) = 0: NEXT
     nd = 0: tf = 0: ba = 0: vm = 0
4310 hv = 0: IF pl > 1 THEN a$ = "y": GOTO 4340
4320 LOCATE 25, 18: PRINT "Going on?"; : GOSUB Pause
4330 PRINT " "; a$: SLEEP 1
4340 GOSUB Rubmost: SLEEP 1
4350 IF a$ = "n" GOTO 4370
4360 GOTO 1910

Newturn:
4370 REM New Turn
4380 pl = pl + 1: IF pl = np + 1 THEN pl = 1
4390 IF pl = 1 THEN wz$ = "    Your": tb = 14: GOTO 4410
4400 wz$ = "Player" + STR$(pl) + "'s": tb = 8
4410 wz$ = wz$ + " turn"
     LOCATE 27, 14: PRINT wz$;
4420 SLEEP 1
4430 GOSUB Ruball: p = 1: GOTO 1870

Gamend:
4440 REM End routine
4450 LOCATE , 9
4460 IF pl = 1 GOTO 4510
4470 PRINT " and have won the game!"
4480 SLEEP 2: GOSUB 4670
4490 LOCATE , 7
     IF m(1) = tg - 1 THEN
       PRINT "Better luck next time.": GOTO 4520
     END IF
4500 PRINT "That was a thrashing!": GOTO 4520
4510 LOCATE , 9: PRINT "The game is yours!"
4520 IF rx = 0 GOTO 4570
4530 PRINT : LOCATE , 3: PRINT "You chose a fixed random seed.  In case"
4550 LOCATE , 3: PRINT "you want a replay, the number was"; rx
4570 GOSUB Flasher
4580 LOCATE , 3: PRINT "If you want another game, press <y>": GOSUB Flasher
4590 IF a$ = "y" THEN FOR q = 1 TO np: m(q) = 0: NEXT: GOTO 1075
4600 END
4610

Pause:
a$ = INKEY$
WHILE a$ = ""
  GOTO Pause
WEND
RETURN

Flasher:
Pause2:
a$ = INKEY$
WHILE a$ = ""
  LINE (320, 206)-(328, 211), 1, BF
  FOR intvl = 1 TO 2000: NEXT
  LINE (320, 206)-(328, 211), 10, BF
  FOR intvl = 1 TO 2000: NEXT
  GOTO Pause2
WEND
RETURN

Ruball:
4670 REM erase s/r
4680 LINE (6, 70)-(350, 222), 10, BF
4710 RETURN

Rubmost:
LINE (6, 82)-(350, 222), 10, BF
RETURN

4720 REM s/r Move up Commons Pack
4730 FOR q = 1 TO cp - 1
4740 p$(q) = p$(q + 1): NEXT: tc$ = p$(1): IF cp = 0 THEN RETURN
cp = cp - 1: GOSUB Drawdeck
4750 RETURN

Drawdeck:
LINE (476, 268)-(630, 280), 12, BF
sx = 476: sy = 268
FOR newc = 1 TO cp
  sx = sx + 6: ex = sx + 12: ey = sy + 11
  LINE (sx, sy)-(ex, ey), 1, B
  PSET (sx, sy), 12: PSET (ex, sy), 12
  PSET (sx, ey), 12: PSET (ex, ey), 12
  LINE (sx + 1, sy + 1)-(ex - 1, ey - 1), 11, BF
NEXT newc
RETURN

4760 REM input error
4770 PRINT "Try again"
4780 SLEEP 2: GOSUB Rubmost
4790 RETURN

4800 REM Print action
4810 LOCATE 12, 14: INPUT "Action? "; a$: RETURN

4820 REM Unreverse
4830 PRINT pz$; : LOCATE , tb: PRINT wz$: RETURN

4840
Printhand:
LINE (6, 8)-(350, 53), 11, BF
FOR q = 1 TO nc(p) + cu
  h$ = h$(p, q)
  IF q > 12 GOTO Nxa
  IF h$ = "" THEN
    col = 11: sx = 10 + (q - 1) * 29: sy = 12: GOSUB Mono
    sx = sx + 5: sy = 30: LINE (sx, sy)-(sx + 12, sy + 8), 11, BF
    GOTO Nxa
  END IF
4930 sx = 10 + (q - 1) * 29: sy = 12: card$ = h$
  value = VAL(MID$(h$, 3, 2))
  GOSUB Drawsmall
  col = 1: sx = sx + 6: sy = 30
  ON q GOSUB One, Two, Three, Four, Five, Six, Seven, Eight, Nine, Ten, Eleven, Twelve
Nxa:
NEXT q
RETURN

Pickup:
4950 REM Pick up card from layout
4960 IF vm = 1 THEN lc = 1
4970 IF vm = 3 THEN lc = 2
4980 IF vm = 7 THEN lc = 3
4990 IF vm = 16 THEN lc = 4
5000 IF vm = 36 THEN lc = 0: GOTO 5030
5010 IF nn(lc) > 0 GOTO 5030
5020 LOCATE , 10: PRINT "Nothing there": LOCATE , 12: PRINT "Try again": RETURN
5030 o9 = 1: FOR q = 1 TO cu: h$(pl, a(q)) = "": NEXT
     IF vm = 36 GOTO Reorder
     nn = nn(lc): sx = lx(lc, nn): sy = ly(lc, nn)
     col = 2: GOSUB Bigmono

Reorder:
5040 REM Re-order cards
5050 REM If no re-order needed
5060 IF nc(pl) = cu THEN q = 1: GOTO 5140
5070 FOR q = 1 TO nc(pl) - cu
       IF h$(pl, q) = "" GOTO 5090
5080 NEXT: GOTO 5140
5090 x = 0
     FOR q = 1 TO nc(pl) - cu
5100   x = 1
5110   IF h$(pl, q + x) = "" THEN x = x + 1: GOTO 5110
5120   IF h$(pl, q) = "" THEN h$(pl, q) = h$(pl, q + x): h$(pl, q + x) = ""
5130 NEXT
5140 IF vm = 36 THEN GOSUB 7390: GOTO 5190: REM Get a Monad
5150 h$(pl, q) = l$(lc, nn(lc)): l$(lc, nn(lc)) = ""
5160 x$ = LEFT$(h$(pl, q), 2)
5170 tb = 12: wz$ = pu$ + " the"
5180 IF (o$ = "b" OR o$ = "l") AND pl = 1 THEN GOSUB Rubmost
     LOCATE 20, 13: PRINT wz$;
     sx = 228: sy = 149: card$ = x$: level$ = RIGHT$(x$, 1)
     value = sv(INSTR(valstring$, level$))
     GOSUB Drawsmall: SLEEP 2
     IF pl > 1 THEN GOSUB Flasher

5190 IF vm = 36 THEN nc(pl) = nc(pl) - 1: IF m(pl) = tg THEN RETURN
5230 IF vm = 36 GOTO 5280
5280 nc(pl) = nc(pl) + 1 - cu: nn(lc) = nn(lc) - 1
5290 IF pl = 1 THEN p = 1: GOSUB Printhand

Commondisc:
5300 REM Add to commons discards
5310 FOR q = 1 TO cu
       IF vp(q) = 1 GOTO 5330
5320 NEXT: GOTO 5390
5330 FOR q = 1 TO np * 6
5340   IF d$(q) = "" THEN x = q: GOTO 5360
5350 NEXT
5360 FOR j = 1 TO cu
       IF vp(j) > 1 GOTO 5380
5370   d$(x) = ch$(j): dp = dp + 1: x = x + 1
5380 NEXT: tl = 1: GOSUB Printlayout

Otherdisc:
5390 REM Place used cards on layout
5400 FOR q = 1 TO cu
       IF vp(q) > 1 GOTO 5420
5410 NEXT: RETURN
5420 IF o$ = "t" AND bu = 0 AND jf = 0 THEN GOSUB 5900: REM bonus test
5430 x = 0: du = 0
     FOR q = 1 TO cu
       FOR j = 1 TO cu
         IF j = q GOTO 5450
5440     IF vp(q) > 1 AND vp(q) = vp(j) THEN
           x = x + 1: IF x > 1 THEN du = vp(q): GOTO 5460
         END IF
5450   NEXT j
     NEXT q: GOTO 5630
5460 x = 0: GOSUB 4670
5470 LOCATE 22, 14
     IF pl = 1 THEN LOCATE 16, 11: PRINT "Choose order of discards": PRINT
5490 wz$ = ""
5500 IF pl > 1 THEN GOSUB 5680: GOTO 5610
5510 FOR q = 1 TO cu
5520   IF vp(q) <> du GOTO 5540
       sx = 250 + 29 * (q - 1): sy = 180
       col$ = LEFT$(al$(q), 1): level$ = RIGHT$(al$(q), 1)
       col = INSTR(colstring$, col$)
       value = sv(INSTR(valstring$, level$))
       IF value = 3 THEN GOSUB Bi
       IF value = 7 THEN GOSUB Tri
       IF value = 16 THEN GOSUB Quad
       IF value = 36 THEN GOSUB Quint
       col = 1: sx = sx + 5: sy = sy + 15
       ON q GOSUB One, Two, Three, Four, Five
5530   nd = nd + 1
5540 NEXT q
5550 FOR q = 1 TO nd
5560   LOCATE , 20: PRINT q; "- # ";
5570   GOSUB Pause
5580   x(q) = VAL(LEFT$(a$, 2))
5590   IF vp(x(q)) <> du GOTO 5560
5595   GOSUB 7700: IF dd = 1 GOTO 5560
5600   PRINT a$
     NEXT q
5610 GOSUB 5840
5620 GOSUB 5770
5630 y = du
     FOR j = 1 TO cu
       IF vp(j) = y OR vp(j) = 1 GOTO 5660
5640   du = vp(j): nd = 1: x = j: GOSUB 5840
5650   GOSUB 5770: wz$ = ""
5660 NEXT j
5670 GOSUB Printlayout: GOSUB 4670: RETURN

Compdisc:
5680 REM Comp's discard decisions
5690 FOR q = 1 TO cu
       IF vp(q) <> du GOTO 5710
5700   nd = nd + 1: xx(q) = 1
5710 NEXT
5720 FOR q = 1 TO nd
5730   x = INT(RND(1) * cu + 1): IF xx(x) = 0 GOTO 5730
5740   x(q) = x: xx(x) = 0
5750   REM PRINT TAB(11)q;"- ";al$(x)
5760 NEXT: RETURN

5770 REM s/r Discarding on layout
5780 FOR q = nn(lc) TO 1 STEP -1
5790   l$(lc, q + nd) = l$(lc, q)
     NEXT
5800 IF nd = 1 THEN l$(lc, 1) = ch$(x): nn(lc) = nn(lc) + 1: GOTO 5832
5810 FOR q = nd TO 1 STEP -1
5820   l$(lc, nd + 1 - q) = ch$(x(q))
5830 NEXT: nn(lc) = nn(lc) + nd
5832 FOR h = 6 TO 1 STEP -1
       IF l$(lc, h) = "" GOTO Nxh2
       sx = lx(lc, h): sy = ly(lc, h)
       col$ = LEFT$(l$(lc, h), 1)
       col = INSTR(colstring$, col$)
       ON lc GOSUB Bigbi, Bigtri, Bigquad, Bigquint
Nxh2:
     NEXT h
5834 RETURN

5840 REM s/r Obtain col. no. from value
5850 IF du = 3 THEN lc = 1
5860 IF du = 7 THEN lc = 2
5870 IF du = 16 THEN lc = 3
5880 IF du = 36 THEN lc = 4
5890 RETURN

5900 REM Bonus test
5910 B = 0: IF lc = 2 AND cp = 0 THEN RETURN
5920 IF lc = 3 AND nn(1) = 0 AND cp = 0 THEN RETURN
5930 FOR q = 1 TO 5 STEP 2
5940   IF ac$(1) = co$(q) AND ac$(2) = co$(q + 1) GOTO 5970
5950   IF ac$(2) = co$(q) AND ac$(1) = co$(q + 1) GOTO 5970
5960 NEXT: RETURN
5970 B = 1: RETURN: REM Bonus available

5980 REM Bonus option
5990 LOCATE 17, 14: IF pl > 1 THEN PRINT "  Taking bonus": GOTO 6050
6000 PRINT "Taking bonus? ";
6010 GOSUB Pause
6030 PRINT a$: IF a$ = "n" THEN RETURN
6050 bu = 1: IF lc = 1 GOTO 6150
6060 FOR q = lc - 1 TO 1 STEP -1
6070   IF nn(q) = 0 THEN x$(q) = "": GOTO 6140
6080   nc(pl) = nc(pl) + 1: h$(pl, nc(pl)) = l$(q, nn(q)): l$(q, nn(q)) = ""
6090   x$(q) = LEFT$(h$(pl, nc(pl)), 2)
       nn = nn(q): sx = lx(q, nn): sy = ly(q, nn)
       col = 2: GOSUB Bigmono
6120   SLEEP 1
6130   nn(q) = nn(q) - 1
6140 NEXT q
6150 IF cp = 0 THEN x$(0) = "": GOTO 6170
6160 nc(pl) = nc(pl) + 1: h$(pl, nc(pl)) = tc$: x$(0) = LEFT$(tc$, 2)
6170 GOSUB 4720
6180 RETURN

6190 REM Joker available?
6200 IF nn(n1) = 0 THEN RETURN
6210 l$ = LEFT$(l$(n1, nn(n1)), 1)
6220 IF l$ <> j$(n2) THEN RETURN
6230 n = 0
     FOR k = 1 TO nc(pl)
6240   IF vc(k) <> sv(n1) GOTO 6260
6250   n = n + 1: r(n) = k
6260 NEXT k: IF n < 2 THEN RETURN
6270 FOR k = 2 TO n
6280   IF tc$(r(k)) <> tc$(r(1)) THEN tf = 1: GOTO 6310
6290 NEXT k
6300 RETURN
6310 a(1) = r(1): a(2) = r(k): RETURN

6320 REM Computer trades
6330 FOR q = 1 TO 4
       IF t(q) = 0 OR nn(q) = 0 GOTO 6390
6340   IF nc(pl) > 11 OR (cp = 0 AND dp = 0) GOTO 6380
6350   IF tb$(q + 1) = RIGHT$(l$(q, nn(q)), 1) GOTO 6390
6360   IF q > 1 AND (cc$(tp(q, 1)) = j$(pl) OR cc$(tp(q, 2)) = j$(pl)) GOTO 6390
6370   IF ba(q - 1) = 1 GOTO 6390
6380   tf = 1: a(1) = tp(q, 1): a(2) = tp(q, 2): RETURN
6390 NEXT q
6400 RETURN

6410
Printlayout:
col0 = 2
sx = 476: sy = 300
IF dp = 0 GOTO 6411
FOR disc = 1 TO dp
  sx = sx + 6: ex = sx + 12: ey = sy + 11
  LINE (sx, sy)-(ex, ey), 1, B
  PSET (sx, sy), 12: PSET (ex, sy), 12
  PSET (sx, ey), 12: PSET (ex, ey), 12
  LINE (sx + 1, sy + 1)-(ex - 1, ey - 1), 11, BF
NEXT disc
6411
IF tl = 1 THEN tl = 0
IF beg = 0 GOTO 6412
FOR h = 1 TO 6
  FOR v = 1 TO 4
    sx = lx(v, h): sy = ly(v, h)
    IF l$(v, h) = "" THEN col = 2: GOSUB Bigmono: GOTO Nxv
    col$ = LEFT$(l$(v, h), 1)
    col = INSTR(colstring$, col$)
    ON v GOSUB Bigbi, Bigtri, Bigquad, Bigquint
Nxv:
  NEXT v
NEXT h: beg = 0

col = 14: sy = ly(1, 6) + 35
FOR q = 1 TO 2
  sx = lx(q, 6) + 14: ON q GOSUB Three, Seven
NEXT
sx = lx(3, 6) + 10: GOSUB One: sx = sx + 8: GOSUB Six
sx = lx(4, 6) + 9: GOSUB Three: sx = sx + 10: GOSUB Six
sx = sx + 37: GOSUB Eight: sx = sx + 7: GOSUB Zero

COLOR 1
FOR q = 1 TO 6
  LOCATE q + 19, 78
  PRINT MID$("MONADS", q, 1)
NEXT
6412 nn = nn(lc) + 1: sx = lx(lc, nn): sy = ly(lc, nn)
RETURN

6560 REM Test for J utility
6570 FOR k = 1 TO nc(pl)
6580   IF k = q OR vc(k) <= vc(q) GOTO 6640
6590   IF tc$(k) = tc$(q) GOTO 6640
6600   du = vc(k): GOSUB 5840: IF nn(lc + 1) = 0 GOTO 6640
       REM if nothing to take
6610   IF lc < 4 AND RIGHT$(l$((lc + 1), nn(lc + 1)), 1) = tb$(lc + 2) GOTO 6640
6620   tf = 1: a(1) = q: a(2) = k
6630   RETURN
6640 NEXT: RETURN

6650 REM s/r Buy total
6660 ch$(q) = h$(pl, a(q)): IF a(q) = 0 THEN RETURN
6670 al$(q) = LEFT$(ch$(q), 2)
6680 IF ch$(q) = "" THEN
       LOCATE , 13: PRINT "No card"
       GOSUB 4760: it = 1
       RETURN
     END IF
6690 vp(q) = VAL(MID$(ch$(q), 3, 2)): x = x + vp(q): cu = cu + 1
6700 RETURN

6710 REM Buy check
6720 IF hv = 0 THEN bo = 1: RETURN
6730 bo = 0: IF n1 = 2 AND vc(k) = 1 THEN bo = 1: RETURN
6750 IF vc(k) = 1 THEN n1 = n1 + 1
6760 IF vc(k) = 3 THEN n2 = n2 + 1
6770 RETURN

6780 REM s/r Comp's bonus prospects
6790 FOR j = 2 TO n
6800 IF tc$(x(j)) <> tc$(x(1)) GOTO 6820
6810 NEXT: RETURN
6820 FOR j = 1 TO n
       FOR k = 1 TO n
6830     IF j = k GOTO 6890
6840     IF tc$(x(j)) = tc$(x(k)) GOTO 6890
6850     FOR z = 1 TO 5 STEP 2
6860       IF cc$(x(j)) = co$(z) AND cc$(x(k)) = co$(z + 1) GOTO 6900
6870       IF cc$(x(k)) = co$(z) AND cc$(x(j)) = co$(z + 1) GOTO 6900
6880     NEXT z
6890   NEXT k
     NEXT j: RETURN
6900 ba = 1: ba(q - 1) = 1: RETURN

6910 REM Bonus pair hand & layout?
6920 FOR q = 4 TO 1 STEP -1
       IF t(q) = 0 OR nn(q) = 0 GOTO 7040
6930   IF ba(q - 1) = 1 THEN RETURN
6940   l$ = l$(q, nn(q)): x = VAL(MID$(l$, 3, 2))
       xl$ = LEFT$(l$, 1): xr$ = RIGHT$(l$, 1)
6950   FOR j = 1 TO nc(pl): y = vc(j)
         yl$ = cc$(j): yr$ = tc$(j)
6960     IF x <> y OR xr$ = yr$ GOTO 7030
6970     GOTO 6990
6980     IF yl$ = j$(pl) GOTO 7030
6990     FOR k = 1 TO 5 STEP 2
7000       IF xl$ = co$(k) AND yl$ = co$(k + 1) GOTO 7050
7010       IF yl$ = co$(k) AND xl$ = co$(k + 1) GOTO 7050
7020     NEXT k
7030   NEXT j
7040 NEXT q: RETURN
7050 tf = 1: a(1) = tp(q, 1): a(2) = tp(q, 2): RETURN

7060 REM Bonus pair available on layout?
7070 FOR q = 1 TO 4
       IF t(q) = 0 OR nn(q) < 2 GOTO 7170
7080   IF tb$(q + 1) = RIGHT$(l$(q, nn(q)), 1) GOTO 7170
7090   IF q > 1 AND (cc$(tp(q, 1)) = j$(pl) OR cc$(tp(q, 2)) = j$(pl)) GOTO 7170
7100   l$ = l$(q, nn(q)): xl$ = LEFT$(l$, 1): xr$ = RIGHT$(l$, 1)
7110   l$ = l$(q, nn(q) - 1): yl$ = LEFT$(l$, 1): yr$ = RIGHT$(l$, 1)
7120   IF xr$ = yr$ GOTO 7170
7130   FOR k = 1 TO 5 STEP 2
7140     IF xl$ = co$(k) AND yl$ = co$(k + 1) GOTO 7180
7150     IF yl$ = co$(k) AND xl$ = co$(k + 1) GOTO 7180
7160   NEXT k
7170 NEXT q: RETURN
7180 tf = 1: a(1) = tp(q, 1): a(2) = tp(q, 2): RETURN

7190 REM sr Test for trade capability
7200 FOR k = 1 TO 5
       t(k) = 0: IF nn(k) = 0 GOTO 7290
       tb$(k) = "": jh(k - 1) = 0
       tp(k, 1) = 0: x$ = ""
       FOR q = 1 TO nc(pl)
7210     IF vc(q) <> sv(k) GOTO 7260
7230     IF cc$(q) = j$(pl) THEN jh(k - 1) = 1
7240     IF x$ = "" THEN x$ = tc$(q): tp(k, 1) = q: GOTO 7260
7250     IF tc$(q) <> x$ THEN tp(k, 2) = q: t(k) = 1: GOTO 7280
7260   NEXT q
7270   IF tp(k, 1) > 0 THEN tb$(k) = x$
7280   IF jh(k - 1) = 1 THEN GOSUB 7300
7290 NEXT k: RETURN

7300 REM Try to avoid joker
7310 FOR q = 1 TO 2
7320   IF cc$(tp(k, q)) = j$(pl) THEN x = tp(k, q): y = q: GOTO 7340
7330 NEXT q: RETURN
7340 IF x = nc(pl) THEN RETURN
7350 FOR q = x + 1 TO nc(pl)
7360   IF vc(q) = sv(k) AND tc$(q) = tc$(x) THEN tp(k, y) = q: GOTO 7380
7370 NEXT q
7380 RETURN

7390 REM Monad s/r
7400 IF pl > 1 THEN PRINT : LOCATE , 9: PRINT "   I've got "; : GOTO 7420
7410 PRINT : LOCATE , 9: PRINT "Well done - ";
7420 IF m(pl) = 0 THEN PRINT "a"; : GOTO 7440
7430 PRINT "another";
7440 PRINT " Monad!"; : IF m(pl) = 0 THEN PRINT "   "
7450 SLEEP 2: PRINT
7460 m(pl) = m(pl) + 1
7470 numplax = 197 - tg * 7
     stapox = numplax + m(pl) * 14: IF np = 3 THEN stapox = stapox + 38
     sx = stapox + 75 * (pl - 1): sy = 289: col = 1: col2 = 2
     GOSUB Monad
7480 RETURN

7510 a = 0: PRINT po$(z); "   ": REM get s/r
7520 a$ = INKEY$: IF a$ = "e" OR a$ = "0" THEN PRINT po$(z); "]"; a$: RETURN
7530 IF VAL(a$) > 0 AND VAL(a$) < 10 THEN a = VAL(a$)
7540 IF a$ = "1" GOTO 7580
7550 IF a > 0 THEN PRINT po$(z); a
7560 IF a$ <> CHR$(13) GOTO 7520
7570 GOTO 7640
7580 B$ = INKEY$: IF B$ = "1" THEN a = 11
7590 IF B$ = "0" THEN a = 10
7600 IF B$ = "2" THEN a = 12
7610 IF VAL(B$) < 0 OR VAL(B$) > 2 GOTO 7510
7620 PRINT po$(z); a
7630 IF B$ <> CHR$(13) GOTO 7580
7640 IF a < 0 OR a > 12 GOTO 7510
7650 RETURN

7700 REM Avoid dup. discard
7710 dd = 0: FOR z = 1 TO q - 1: IF x(q) = x(q - z) THEN dd = 1: RETURN
7720 NEXT z: RETURN
7800 GOSUB 4670
7810 LOCATE , 10: PRINT "OK, game is abandoned": GOTO 4520

Drawsmall:
     col$ = LEFT$(card$, 1)
     col = INSTR(colstring$, col$)
     IF value = 1 THEN GOSUB Mono
     IF value = 3 THEN GOSUB Bi
     IF value = 7 THEN GOSUB Tri
     IF value = 16 THEN GOSUB Quad
     IF value = 36 THEN GOSUB Quint
     RETURN

One:
LINE (sx + 3, sy)-(sx + 4, sy + 6), col, BF
RETURN

Two:
LINE (sx + 2, sy)-(sx + 5, sy), col
FOR x = 0 TO 6 STEP 6
  LINE (sx + x, sy + 1)-(sx + x + 1, sy + 2), col, BF
NEXT
LINE (sx + 5, sy + 3)-(sx + 1, sy + 5), col
LINE (sx + 6, sy + 3)-(sx + 2, sy + 5), col
LINE (sx, sy + 6)-(sx + 7, sy + 6), col
RETURN

Three:
FOR y = 0 TO 6 STEP 6
  LINE (sx + 1, sy + y)-(sx + 5, sy + y), col
NEXT y
LINE (sx + 3, sy + 3)-(sx + 5, sy + 3), col
FOR y = 1 TO 4 STEP 3
  LINE (sx + 6, sy + y)-(sx + 7, sy + y + 1), col, BF
NEXT y
FOR y = 1 TO 5 STEP 4
LINE (sx, sy + y)-(sx + 1, sy + y), col
NEXT y
RETURN

Four:
LINE (sx + 4, sy)-(sx + 5, sy + 6), col, BF
LINE (sx + 3, sy + 1)-(sx + 1, sy + 3), col
LINE (sx + 3, sy + 2)-(sx + 2, sy + 3), col
LINE (sx, sy + 4)-(sx + 7, sy + 4), col
RETURN

Five:
LINE (sx, sy)-(sx + 6, sy), col
LINE (sx, sy + 1)-(sx + 1, sy + 1), col
LINE (sx, sy + 2)-(sx + 5, sy + 2), col
LINE (sx + 5, sy + 3)-(sx + 6, sy + 3), col
LINE (sx + 6, sy + 4)-(sx + 7, sy + 4), col
LINE (sx, sy + 5)-(sx + 1, sy + 5), col
LINE (sx + 5, sy + 5)-(sx + 6, sy + 5), col
LINE (sx + 1, sy + 6)-(sx + 5, sy + 6), col
RETURN

Six:
LINE (sx + 4, sy)-(sx + 6, sy), col
LINE (sx + 2, sy + 1)-(sx + 4, sy + 1), col
LINE (sx + 1, sy + 2)-(sx + 3, sy + 2), col
LINE (sx, sy + 3)-(sx + 6, sy + 3), col
FOR x = 0 TO 6 STEP 6
  FOR y = 4 TO 5
    LINE (sx + x, sy + y)-(sx + x + 1, sy + y), col, BF
  NEXT y
NEXT x
LINE (sx + 2, sy + 6)-(sx + 5, sy + 6), col
RETURN

Seven:
LINE (sx, sy)-(sx + 7, sy), col
LINE (sx + 6, sy + 1)-(sx + 1, sy + 6), col
LINE (sx + 7, sy + 1)-(sx + 2, sy + 6), col
RETURN

Eight:
FOR y = 0 TO 6 STEP 3
  LINE (sx + 2, sy + y)-(sx + 5, sy + y), col
NEXT y
FOR y = 1 TO 4 STEP 3
  FOR x = 0 TO 6 STEP 6
    LINE (sx + x, sy + y)-(sx + x + 1, sy + y + 1), col, BF
  NEXT x
NEXT y
RETURN

Nine:
LINE (sx + 1, sy + 6)-(sx + 3, sy + 6), col
LINE (sx + 3, sy + 5)-(sx + 5, sy + 5), col
LINE (sx + 4, sy + 4)-(sx + 6, sy + 4), col
LINE (sx + 1, sy + 3)-(sx + 7, sy + 3), col
FOR x = 0 TO 6 STEP 6
  FOR y = 1 TO 2
    LINE (sx + x, sy + y)-(sx + x + 1, sy + y), col, BF
  NEXT y
NEXT x
LINE (sx + 2, sy)-(sx + 5, sy), col
RETURN

Ten:
LINE (sx, sy)-(sx + 1, sy + 6), col, B
GOSUB Zero
RETURN

Zero:
LINE (sx + 5, sy)-(sx + 6, sy), col
LINE (sx + 4, sy + 1)-(sx + 7, sy + 1), col
FOR y = 2 TO 4
  LINE (sx + 3, sy + y)-(sx + 4, sy + y), col
  LINE (sx + 7, sy + y)-(sx + 8, sy + y), col
NEXT
LINE (sx + 4, sy + 5)-(sx + 7, sy + 5), col
LINE (sx + 5, sy + 6)-(sx + 6, sy + 6), col
RETURN

Eleven:
LINE (sx + 1, sy)-(sx + 2, sy + 6), col, B
LINE (sx + 5, sy)-(sx + 6, sy + 6), col, B
RETURN

Twelve:
LINE (sx, sy)-(sx + 1, sy + 6), col, B
LINE (sx + 4, sy)-(sx + 6, sy), col
LINE (sx + 3, sy + 1)-(sx + 4, sy + 1), col
LINE (sx + 6, sy + 1)-(sx + 7, sy + 2), col, B
LINE (sx + 5, sy + 3)-(sx + 6, sy + 3), col
LINE (sx + 4, sy + 4)-(sx + 5, sy + 4), col
LINE (sx + 3, sy + 5)-(sx + 4, sy + 5), col
LINE (sx + 3, sy + 6)-(sx + 7, sy + 6), col
RETURN

Circus:
x = sx + 12: y = sy + 6
CIRCLE (x, y), 8, col, , , .5
PAINT (x, y), col
RETURN

Mono:
FOR z = 1 TO 11 STEP 10
  LINE (sx + 8, sy + z)-(sx + 9, sy + z), col
NEXT
FOR z = 2 TO 10 STEP 8
  LINE (sx + 5, sy + z)-(sx + 12, sy + z), col
NEXT
FOR z = 3 TO 9 STEP 6
  LINE (sx + 3, sy + z)-(sx + 14, sy + z), col
NEXT
FOR z = 4 TO 8 STEP 4
  LINE (sx + 2, sy + z)-(sx + 15, sy + z), col
NEXT
LINE (sx + 1, sy + 5)-(sx + 16, sy + 7), col, BF
RETURN

Bi:
GOSUB Mono
LINE (sx + 1, sy + 6)-(sx + 18, sy + 6), col0
RETURN

Tri:
GOSUB Mono: sx = sx - 1: sy = sy + 1
LINE (sx + 9, sy + 1)-(sx + 10, sy + 4), col0, B
LINE (sx + 8, sy + 5)-(sx + 11, sy + 5), col0
LINE (sx + 6, sy + 6)-(sx + 7, sy + 6), col0
LINE (sx + 12, sy + 6)-(sx + 13, sy + 6), col0
LINE (sx + 4, sy + 7)-(sx + 5, sy + 7), col0
LINE (sx + 14, sy + 7)-(sx + 15, sy + 7), col0
RETURN

Quad:
GOSUB Bi: sx = sx - 1: sy = sy + 1
LINE (sx + 9, sy)-(sx + 10, sy + 10), col0, B
RETURN

Quint:
GOSUB Mono: sx = sx - 1: sy = sy + 1
LINE (sx + 9, sy + 1)-(sx + 10, sy + 4), col0, B
LINE (sx + 1, sy + 4)-(sx + 5, sy + 4), col0
LINE (sx + 14, sy + 4)-(sx + 18, sy + 4), col0
LINE (sx + 4, sy + 5)-(sx + 15, sy + 5), col0
LINE (sx + 7, sy + 6)-(sx + 12, sy + 6), col0
LINE (sx + 6, sy + 7)-(sx + 8, sy + 7), col0
LINE (sx + 11, sy + 7)-(sx + 13, sy + 7), col0
LINE (sx + 5, sy + 8)-(sx + 7, sy + 8), col0
LINE (sx + 12, sy + 8)-(sx + 14, sy + 8), col0
RETURN

Bigmono:
FOR z = 2 TO 21 STEP 19
  LINE (sx + 12, sy + z)-(sx + 21, sy + z), col
NEXT
FOR z = 3 TO 20 STEP 17
  LINE (sx + 9, sy + z)-(sx + 24, sy + z), col
NEXT
FOR z = 4 TO 19 STEP 15
  LINE (sx + 7, sy + z)-(sx + 26, sy + z), col
NEXT
FOR z = 5 TO 18 STEP 13
  LINE (sx + 5, sy + z)-(sx + 28, sy + z), col
NEXT
FOR z = 6 TO 17 STEP 11
  LINE (sx + 4, sy + z)-(sx + 29, sy + z), col
NEXT
FOR z = 7 TO 16 STEP 9
  LINE (sx + 3, sy + z)-(sx + 30, sy + z), col
NEXT
FOR z = 8 TO 14 STEP 6
  LINE (sx + 2, sy + z)-(sx + 31, sy + z + 1), col, B
NEXT
LINE (sx + 1, sy + 10)-(sx + 32, sy + 13), col, BF
RETURN

Bigbi:
GOSUB Bigmono
LINE (sx + 1, sy + 11)-(sx + 32, sy + 12), col0, B
RETURN

Bigquad:
GOSUB Bigbi
LINE (sx + 15, sy + 1)-(sx + 17, sy + 22), col0, BF
RETURN

Bigtri:
GOSUB Bigmono
LINE (sx + 16, sy + 2)-(sx + 17, sy + 11), col0, B
n1 = 17: n2 = 14
FOR y = 12 TO 18
  n1 = n1 - 2: n2 = n2 + 2
  LINE (sx + n1, sy + y)-(sx + n1 + 2, sy + y), col0
  LINE (sx + n2, sy + y)-(sx + n2 + 2, sy + y), col0
NEXT y
RETURN

Bigquint:
GOSUB Bigmono
LINE (sx + 16, sy + 2)-(sx + 17, sy + 10), col0, B
LINE (sx + 16, sy + 12)-(sx + 9, sy + 19), col0
LINE (sx + 15, sy + 12)-(sx + 8, sy + 19), col0
LINE (sx + 17, sy + 12)-(sx + 24, sy + 19), col0
LINE (sx + 18, sy + 12)-(sx + 25, sy + 19), col0
FOR z = 2 TO 27 STEP 25
  LINE (sx + z, sy + 9)-(sx + z + 4, sy + 9), col0
NEXT z
FOR z = 5 TO 22 STEP 17
  LINE (sx + z, sy + 10)-(sx + z + 6, sy + 10), col0
NEXT z
LINE (sx + 10, sy + 11)-(sx + 23, sy + 11), col0
RETURN

Monad:
GOSUB Bigmono
LINE (sx + 18, sy + 2)-(sx + 21, sy + 2), col2
LINE (sx + 15, sy + 3)-(sx + 24, sy + 3), col2
LINE (sx + 13, sy + 4)-(sx + 26, sy + 4), col2
LINE (sx + 12, sy + 5)-(sx + 28, sy + 5), col2
LINE (sx + 12, sy + 6)-(sx + 29, sy + 6), col2
LINE (sx + 11, sy + 7)-(sx + 30, sy + 7), col2
LINE (sx + 11, sy + 8)-(sx + 31, sy + 8), col2
LINE (sx + 12, sy + 9)-(sx + 31, sy + 9), col2
LINE (sx + 12, sy + 10)-(sx + 32, sy + 10), col2
LINE (sx + 15, sy + 11)-(sx + 32, sy + 11), col2
LINE (sx + 19, sy + 12)-(sx + 32, sy + 12), col2
LINE (sx + 22, sy + 13)-(sx + 32, sy + 13), col2
LINE (sx + 22, sy + 14)-(sx + 31, sy + 14), col2
LINE (sx + 23, sy + 15)-(sx + 31, sy + 15), col2
LINE (sx + 23, sy + 16)-(sx + 30, sy + 16), col2
LINE (sx + 22, sy + 17)-(sx + 29, sy + 17), col2
LINE (sx + 22, sy + 18)-(sx + 28, sy + 18), col2
LINE (sx + 21, sy + 19)-(sx + 26, sy + 19), col2
LINE (sx + 19, sy + 20)-(sx + 24, sy + 20), col2
LINE (sx + 16, sy + 21)-(sx + 21, sy + 21), col2
RETURN

Drawcard:
LINE (sx + 10, sy - 2)-(sx + 40, sy + 8), 1, BF
PRESET (sx + 10, sy - 2): PRESET (sx + 10, sy + 8)
PRESET (sx + 40, sy - 2): PRESET (sx + 40, sy + 8)
RETURN

SUB Colours
PALETTE 0, 56: REM grey
PALETTE 1, 63: REM white
PALETTE 2, 0: REM black
PALETTE 3, 25: REM blue
PALETTE 4, 36: REM red
PALETTE 5, 27: REM turquoise
PALETTE 6, 52: REM orange
PALETTE 7, 2: REM green
PALETTE 8, 54: REM yellow
PALETTE 9, 21: REM purple
PALETTE 10, 8: REM dark blue
PALETTE 11, 32: REM crimson
PALETTE 12, 16: REM dark green
PALETTE 13, 39: REM pink
PALETTE 14, 7: REM light grey
PALETTE 15, 14: REM beige

END SUB

SUB Hugemonad

col = 1: col2 = 2: sx = 50: sy = 21
FOR z = 10 TO 200 STEP 190
  LINE (sx + 110, sy + z)-(sx + 210, sy + z + 9), col, BF
NEXT
FOR z = 20 TO 190 STEP 170
  LINE (sx + 80, sy + z)-(sx + 240, sy + z + 9), col, BF
NEXT
FOR z = 30 TO 180 STEP 150
  LINE (sx + 60, sy + z)-(sx + 260, sy + z + 9), col, BF
NEXT
FOR z = 40 TO 170 STEP 130
  LINE (sx + 40, sy + z)-(sx + 280, sy + z + 9), col, BF
NEXT
FOR z = 50 TO 160 STEP 110
  LINE (sx + 30, sy + z)-(sx + 290, sy + z + 9), col, BF
NEXT
FOR z = 60 TO 150 STEP 90
  LINE (sx + 20, sy + z)-(sx + 300, sy + z + 9), col, BF
NEXT
FOR z = 70 TO 130 STEP 60
  LINE (sx + 10, sy + z)-(sx + 310, sy + z + 19), col, BF
NEXT
LINE (sx, sy + 90)-(sx + 320, sy + 129), col, BF

LINE (sx + 170, sy + 10)-(sx + 210, sy + 19), col2, BF
LINE (sx + 140, sy + 20)-(sx + 240, sy + 29), col2, BF
LINE (sx + 120, sy + 30)-(sx + 260, sy + 39), col2, BF
LINE (sx + 110, sy + 40)-(sx + 280, sy + 49), col2, BF
LINE (sx + 110, sy + 50)-(sx + 290, sy + 59), col2, BF
LINE (sx + 100, sy + 60)-(sx + 300, sy + 69), col2, BF
LINE (sx + 100, sy + 70)-(sx + 310, sy + 79), col2, BF
LINE (sx + 110, sy + 80)-(sx + 310, sy + 89), col2, BF
LINE (sx + 110, sy + 90)-(sx + 320, sy + 99), col2, BF
LINE (sx + 140, sy + 100)-(sx + 320, sy + 109), col2, BF
LINE (sx + 180, sy + 110)-(sx + 320, sy + 119), col2, BF
LINE (sx + 210, sy + 120)-(sx + 320, sy + 129), col2, BF
LINE (sx + 210, sy + 130)-(sx + 310, sy + 139), col2, BF
LINE (sx + 220, sy + 140)-(sx + 310, sy + 149), col2, BF
LINE (sx + 220, sy + 150)-(sx + 300, sy + 159), col2, BF
LINE (sx + 210, sy + 160)-(sx + 290, sy + 169), col2, BF
LINE (sx + 210, sy + 170)-(sx + 280, sy + 179), col2, BF
LINE (sx + 200, sy + 180)-(sx + 260, sy + 189), col2, BF
LINE (sx + 180, sy + 190)-(sx + 240, sy + 199), col2, BF
LINE (sx + 150, sy + 200)-(sx + 210, sy + 209), col2, BF

FOR q = 1 TO 5
  x = 135 + q * 35: y = 84: col = 6
  ON q GOSUB Big.M, Big.O, Big.N, Big.A, Big.D
  x = x + 2
  ON q GOSUB Big.M, Big.O, Big.N, Big.A, Big.D
NEXT
y = 165: col = 2
x = 150: GOSUB Big.8: x = 175: GOSUB Big.O
GOTO Finishsub

Big.A:
LINE (x + 3, y)-(x + 16, y), col
LINE (x + 1, y + 1)-(x + 18, y + 1), col
PSET (x + 4, y + 2), col: PSET (x + 15, y + 2), col
LINE (x, y + 2)-(x + 3, y + 13), col, BF
LINE (x + 16, y + 2)-(x + 19, y + 13), col, BF
LINE (x + 4, y + 6)-(x + 15, y + 7), col, B
RETURN

Big.D:
GOSUB Leftline
FOR z = 0 TO 12 STEP 12
  LINE (x + 4, y + z)-(x + 12, y + z + 1), col, B
NEXT z
FOR z = 1 TO 12 STEP 11
  LINE (x + 13, y + z)-(x + 14, y + z), col
NEXT z
FOR z = 2 TO 11 STEP 9
  LINE (x + 12, y + z)-(x + 16, y + z), col
NEXT z
FOR z = 3 TO 10 STEP 7
  LINE (x + 14, y + z)-(x + 17, y + z), col
NEXT
FOR z = 4 TO 9 STEP 5
  LINE (x + 15, y + z)-(x + 18, y + z), col
NEXT
LINE (x + 16, y + 5)-(x + 19, y + 8), col, BF
RETURN

Big.M:
GOSUB Leftline
LINE (x + 4, y)-(x + 5, y + 3), col, B
LINE (x + 14, y)-(x + 15, y + 3), col, B
PSET (x + 6, y + 1), col: PSET (x + 13, y + 1), col
LINE (x + 6, y + 2)-(x + 7, y + 2), col: LINE (x + 12, y + 2)-(x + 13, y + 2), col
LINE (x + 6, y + 3)-(x + 8, y + 3), col: LINE (x + 11, y + 3)-(x + 13, y + 3), col
LINE (x + 5, y + 4)-(x + 14, y + 4), col
LINE (x + 6, y + 5)-(x + 13, y + 5), col
LINE (x + 7, y + 6)-(x + 12, y + 6), col
LINE (x + 8, y + 7)-(x + 11, y + 7), col
GOSUB Rightline
RETURN

Big.N:
GOSUB Leftline
FOR z = 0 TO 4
  LINE (x + 1 + z, y)-(x + 14 + z, y + 13), col
NEXT z
GOSUB Rightline
RETURN

Big.O:
LINE (x + 4, y)-(x + 15, y), col
LINE (x + 1, y + 1)-(x + 18, y + 1), col
LINE (x, y + 2)-(x + 3, y + 11), col, BF: PSET (x + 4, y + 2), col
LINE (x + 16, y + 2)-(x + 19, y + 11), col, BF
LINE (x + 1, y + 12)-(x + 18, y + 12), col
LINE (x + 4, y + 13)-(x + 15, y + 13), col
PSET (x + 15, y + 11), col
PSET (x + 15, y + 2), col: PSET (x + 4, y + 11), col
RETURN

Big.8:
FOR z = 0 TO 13 STEP 13
  LINE (x + 5, y + z)-(x + 14, y + z), col
NEXT z
FOR z = 1 TO 12 STEP 11
  LINE (x + 2, y + z)-(x + 17, y + z), col
NEXT z
FOR z = 2 TO 11 STEP 3
  LINE (x + 1, y + z)-(x + 5, y + z), col: LINE (x + 14, y + z)-(x + 18, y + z), col
NEXT z
FOR z = 3 TO 9 STEP 6
  LINE (x, y + z)-(x + 3, y + z + 1), col, B: LINE (x + 16, y + z)-(x + 19, y + z + 1), col, B
NEXT z
LINE (x + 3, y + 6)-(x + 16, y + 7), col, B
RETURN

Big.0:
GOSUB Big.O
FOR z = 4 TO 6
  LINE (x + z, y + 11)-(x + z + 9, y + 2), col
NEXT z
RETURN

Leftline:
LINE (x, y)-(x + 3, y + 13), col, BF
RETURN

Rightline:
LINE (x + 16, y)-(x + 19, y + 13), col, BF
RETURN

Finishsub:
END SUB