blackjack.bas

100 REM COPYRIGHT (C) 1987-2023 SEAN WOHLGEMUTH
110 REM ::
120 REM THIS PROGRAM IS FREE SOFTWARE: YOU CAN REDISTRIBUTE IT AND/OR MODIFY IT UNDER THE TERMS OF THE GNU GENERAL PUBLIC LICENSE
130 REM AS PUBLISHED BY THE FREE SOFTWARE FOUNDATION, EITHER VERSION 3 OF THE LICENSE, OR (AT YOUR OPTION) ANY LATER VERSION.
140 REM ::
150 REM THIS PROGRAM IS DISTRIBUTED IN THE HOPE THAT IT WILL BE USEFUL, BUT WITHOUT ANY WARRANTY; WITHOUT EVEN THE IMPLIED WARRANTY
160 REM OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. SEE THE GNU GENERAL PUBLIC LICENSE FOR MORE DETAILS.
170 REM ::
180 REM YOU SHOULD HAVE RECEIVED A COPY OF THE GNU GENERAL PUBLIC LICENSE ALONG WITH THIS PROGRAM. IF NOT, SEE
190 REM <HTTPS://WWW.GNU.ORG/LICENSES/>.
200 REM ::
210 CALL INTRO
220 CALL SETCHARS
230 CALL SETCOLORSCHEME
240 REM LABEL ***GAMELOOP***
250 CALL PLAY
260 DISPLAY AT (22,2) BEEP: "DO YOU WISH TO PLAY AGAIN?"
270 A$=""
280 CALL HCHAR(23,16,30)
290 REM LABEL ***ASKAGAIN***
300 CALL KEY(0,K,S)
310 IF S=0 OR S=-1 THEN 300 :: REM GOTO ASKAGAIN
320 IF K<>78 AND K<>89 THEN 300 :: REM GOTO ASKAGAIN
330 CALL HCHAR (23,16,K)
340 A$=CHR$(K)
350 CALL HCHAR (22,4,32,25) :: CALL HCHAR (23,16,32)
360 IF A$="N" THEN CALL TERMINATE
370 GOTO 250 :: REM GOTO GAMELOOP
380 END
390 REM SUBROUTINE ***INTRO***
400 SUB INTRO
410 CALL CLEAR
420 DISPLAY AT (12,10): "BLACKJACK"
430 DISPLAY AT (13,1): "presented by Sean Wohlgemuth"
440 FOR I=1 TO 5 :: CALL SOUND(1000,110,30) :: CALL SOUND(1,110,30) :: NEXT I
450 CALL CLEAR
460 DISPLAY AT (1, 1): "PREFACE:"
470 DISPLAY AT (3, 1): "THIS IS A GAME BETWEEN YOU"
480 DISPLAY AT (4, 1): "AND THE DEALER (COMPUTER)."
490 DISPLAY AT (6, 1): "OBJECT OF THE GAME:"
500 DISPLAY AT (8, 1): "THE OBJECT OF THE GAME IS TO"
510 DISPLAY AT (9, 1): "COLLECT A SET OF CARDS LESS"
520 DISPLAY AT (10, 1): "THAN OR EQUAL TO 21. IF YOUR"
530 DISPLAY AT (11, 1): "SET OF CARDS IS HIGHER THAN"
540 DISPLAY AT (12, 1): "THE DEALER'S AND NOT OVER 21"
550 DISPLAY AT (13, 1): "THEN YOU WIN."
560 DISPLAY AT (15, 1): "CARD VALUES:"
570 DISPLAY AT (17, 1): "NUMBER CARDS = FACE VALUE"
580 DISPLAY AT (18, 1): "FACE CARDS   = 10 PTS"
590 DISPLAY AT (19, 1): "ACES         = 11 OR 1 PT(S)"
600 DISPLAY AT (24,1): "PRESS ENTER TO CONTINUE:"
610 ACCEPT AT (24,28) BEEP VALIDATE ("") : A$
620 CALL CLEAR
630 DISPLAY AT (1, 1): "HOW TO PLAY:"
640 DISPLAY AT (3, 1): "BOTH YOU AND THE DEALER WILL"
650 DISPLAY AT (4, 1): "BE GIVEN TWO CARDS TO START."
660 DISPLAY AT (5, 1): "TAKE AS MANY CARDS AS YOU"
670 DISPLAY AT (6, 1): "WISH (UP TO 5 CARDS). IF"
680 DISPLAY AT (7, 1): "THE VALUE OF YOUR HAND"
690 DISPLAY AT (8, 1): "EXCEEDS 21 YOU BUST. ONCE"
700 DISPLAY AT (9, 1): "YOU STOP TAKING CARDS, THE"
710 DISPLAY AT (10, 1): "DEALER WILL TAKE CARDS"
720 DISPLAY AT (11, 1): "TRYING NOT TO BUST AS WELL."
730 DISPLAY AT (12, 1): "THE PLAYER WITH THE HIGHEST"
740 DISPLAY AT (13, 1): "HAND VALUE WINS."
750 DISPLAY AT (24,1): "PRESS ENTER TO BEGIN:"
760 ACCEPT AT (24,28) BEEP VALIDATE ("") : A$
770 SUBEND
780 REM SUBROUTINE ***SETCHARS***
790 SUB SETCHARS
800 CALL SETCHARSRED
810 CALL SETCHARSBLACK
820 CALL SETCHARSEDGES
830 CALL GETCARDFRONT(CARDFRONT)
840 CALL CHAR (CARDFRONT, "FFFFFFFFFFFFFFFF")
850 SUBEND
860 REM SUBROUTINE ***SETCHARSRED***
870 SUB SETCHARSRED
880 CALL GETHEART(HEART)
890 CALL CHAR (HEART, "00367F7F7F3E1C08" )
900 CALL GETDIAMOND(DIAMOND)
910 CALL CHAR (DIAMOND, "00081C3E7F3E1C08" )
920 CALL GETREDVALS(REDVALS)
930 CALL SETCHARSVALS((REDVALS))
940 CALL GETCARDBACK(CARDBACK)
950 CALL CHAR (CARDBACK, "AA55AA55AA55AA55")
960 SUBEND
970 REM SUBROUTINE ***SETCHARSBLACK***
980 SUB SETCHARSBLACK
990 CALL GETSPADE(SPADE)
1000 CALL CHAR (SPADE, "0010387CFEFED638" )
1010 CALL GETCLUB(CLUB)
1020 CALL CHAR (CLUB, "00103854EE541038" )
1030 CALL GETBLACKVALS(BLACKVALS)
1040 CALL SETCHARSVALS((BLACKVALS))
1050 SUBEND
1060 REM SUBROUTINE ***SETCHARSVALS***
1070 SUB SETCHARSVALS(OFFSET)
1080 REM 2-10, JACK, QUEEN, KING, ACE
1090 CALL CHAR (OFFSET, "003844040830407C") :: OFFSET=OFFSET+1
1100 CALL CHAR (OFFSET, "0038040418040438") :: OFFSET=OFFSET+1
1110 CALL CHAR (OFFSET, "002424243C040404") :: OFFSET=OFFSET+1
1120 CALL CHAR (OFFSET, "003C20203C04043C") :: OFFSET=OFFSET+1
1130 CALL CHAR (OFFSET, "001C202038242418") :: OFFSET=OFFSET+1
1140 CALL CHAR (OFFSET, "003C040408081010") :: OFFSET=OFFSET+1
1150 CALL CHAR (OFFSET, "003C24243C24243C") :: OFFSET=OFFSET+1
1160 CALL CHAR (OFFSET, "001C24241C040404") :: OFFSET=OFFSET+1
1170 CALL CHAR (OFFSET, "004C52525252524C") :: OFFSET=OFFSET+1
1180 CALL CHAR (OFFSET, "003E080808084830") :: OFFSET=OFFSET+1
1190 CALL CHAR (OFFSET, "0018242424241C02") :: OFFSET=OFFSET+1
1200 CALL CHAR (OFFSET, "0024242830282424") :: OFFSET=OFFSET+1
1210 CALL CHAR (OFFSET, "001824243C242424") :: OFFSET=OFFSET+1
1220 SUBEND
1230 REM SUBROUTINE ***SETCHARSEDGES***
1240 SUB SETCHARSEDGES
1250 CALL GETCARDEDGE(CARDEDGE)
1260 CALL CHAR (CARDEDGE, "8080808080808080")
1270 CALL GETCARDTOP(CARDTOP)
1280 CALL CHAR (CARDTOP, "00000000000000FF")
1290 SUBEND
1300 REM SUBROUTINE ***SETCOLORSCHEME***
1310 SUB SETCOLORSCHEME
1320 CALL COLOR (9,7,16) :: REM DARK RED ON BLACK
1330 CALL COLOR (10,7,16) :: REM DARK RED ON BLACK
1340 CALL COLOR (11,2,16) :: REM BLACK ON WHITE
1350 CALL COLOR (12,2,16) :: REM BLACK ON WHITE
1360 CALL COLOR (13,2,1) :: REM BLACK ON TRANSPARENT
1370 CALL COLOR (14,16,16) :: REM WHITE ON WHITE
1380 CALL SCREEN (3) :: REM MED GREEN BACKGROUND
1390 SUBEND
1400 REM SUBROUTINE ***RENDERCARD***
1410 SUB RENDERCARD(PLAYER,CARD,FACEDOWN,HANDS(,,))
1420 IF FACEDOWN=1 THEN CALL GETCARDBACK(FILL) ELSE CALL GETCARDFRONT(FILL)
1430 COL=CARD*6 :: ROW=PLAYER*10
1440 REM RENDER SURFACE
1450 FOR I=1 TO 5
1460 CALL VCHAR (4+ROW, 1+COL+I, FILL, 7)
1470 NEXT I
1480 CALL GETCARDTOP(CARDTOP)
1490 CALL GETCARDEDGE(CARDEDGE)
1500 CALL HCHAR (3+ROW, 2+COL, CARDTOP, 5)
1510 CALL VCHAR (4+ROW, 7+COL, CARDEDGE, 7)
1520 IF FACEDOWN=1 THEN 1790 :: REM SUBEND
1530 REM SELECT SUIT
1540 IF HANDS(PLAYER,CARD,1)=1 THEN CALL GETHEART(SUIT)
1550 IF HANDS(PLAYER,CARD,1)=2 THEN CALL GETDIAMOND(SUIT)
1560 IF HANDS(PLAYER,CARD,1)=3 THEN CALL GETSPADE(SUIT)
1570 IF HANDS(PLAYER,CARD,1)=4 THEN CALL GETCLUB(SUIT)
1580 REM RENDER CARD VALUE
1590 IF HANDS(PLAYER,CARD,1)<3 THEN CALL GETREDVALS(CARDCHAR)
1600 IF HANDS(PLAYER,CARD,1)>2 THEN CALL GETBLACKVALS(CARDCHAR)
1610 CARDVAL=HANDS(PLAYER,CARD,0)
1620 CARDCHAR=CARDCHAR+CARDVAL-2
1630 CALL HCHAR (4+ROW, 2+COL, CARDCHAR, 1)
1640 CALL HCHAR (10+ROW, 6+COL, CARDCHAR, 1)
1650 REM RENDER CARD FACE
1660 IF CARDVAL=2 THEN CALL RENDER2(ROW,COL,SUIT) :: GOTO 1790 :: REM SUBEND
1670 IF CARDVAL=3 THEN CALL RENDER3(ROW,COL,SUIT) :: GOTO 1790 :: REM SUBEND
1680 IF CARDVAL=4 THEN CALL RENDER4(ROW,COL,SUIT) :: GOTO 1790 :: REM SUBEND
1690 IF CARDVAL=5 THEN CALL RENDER5(ROW,COL,SUIT) :: GOTO 1790 :: REM SUBEND
1700 IF CARDVAL=6 THEN CALL RENDER6(ROW,COL,SUIT) :: GOTO 1790 :: REM SUBEND
1710 IF CARDVAL=7 THEN CALL RENDER7(ROW,COL,SUIT) :: GOTO 1790 :: REM SUBEND
1720 IF CARDVAL=8 THEN CALL RENDER8(ROW,COL,SUIT) :: GOTO 1790 :: REM SUBEND
1730 IF CARDVAL=9 THEN CALL RENDER9(ROW,COL,SUIT) :: GOTO 1790 :: REM SUBEND
1740 IF CARDVAL=10 THEN CALL RENDER10(ROW,COL,SUIT) :: GOTO 1790 :: REM SUBEND
1750 IF CARDVAL=11 THEN CALL RENDERJACK(ROW,COL,SUIT) :: GOTO 1790 :: REM SUBEND
1760 IF CARDVAL=12 THEN CALL RENDERQUEEN(ROW,COL,SUIT) :: GOTO 1790 :: REM SUBEND
1770 IF CARDVAL=13 THEN CALL RENDERKING(ROW,COL,SUIT) :: GOTO 1790 :: REM SUBEND
1780 IF CARDVAL=14 THEN CALL RENDERACE(ROW,COL,SUIT) :: GOTO 1790 :: REM SUBEND
1790 SUBEND
1800 REM SUBROUTINE ***RENDER2***
1810 SUB RENDER2(ROW,COL,SUIT)
1820 CALL HCHAR (6+ROW,4+COL,SUIT,1)
1830 CALL HCHAR (8+ROW,4+COL,SUIT,1)
1840 SUBEND
1850 REM SUBROUTINE ***RENDER3***
1860 SUB RENDER3(ROW,COL,SUIT)
1870 CALL VCHAR (6+ROW,4+COL,SUIT,3)
1880 SUBEND
1890 REM SUBROUTINE ***RENDER4***
1900 SUB RENDER4(ROW,COL,SUIT)
1910 CALL HCHAR (6+ROW,3+COL,SUIT,1)
1920 CALL HCHAR (8+ROW,3+COL,SUIT,1)
1930 CALL HCHAR (6+ROW,5+COL,SUIT,1)
1940 CALL HCHAR (8+ROW,5+COL,SUIT,1)
1950 SUBEND
1960 REM SUBROUTINE ***RENDER5***
1970 SUB RENDER5(ROW,COL,SUIT)
1980 CALL RENDER4((ROW),(COL),(SUIT))
1990 CALL HCHAR (7+ROW,4+COL,SUIT,1)
2000 SUBEND
2010 REM SUBROUTINE ***RENDER6***
2020 SUB RENDER6(ROW,COL,SUIT)
2030 CALL vCHAR (6+ROW,3+COL,SUIT,3)
2040 CALL vCHAR (6+ROW,5+COL,SUIT,3)
2050 SUBEND
2060 REM SUBROUTINE ***RENDER7***
2070 SUB RENDER7(ROW,COL,SUIT)
2080 CALL RENDER6((ROW),(COL),(SUIT))
2090 CALL VCHAR (7+ROW,4+COL,SUIT,1) 
2100 SUBEND
2110 REM SUBROUTINE ***RENDER8***
2120 SUB RENDER8(ROW,COL,SUIT)
2130 CALL HCHAR (5+ROW,3+COL,SUIT,1)
2140 CALL HCHAR (5+ROW,5+COL,SUIT,1)
2150 CALL HCHAR (6+ROW,4+COL,SUIT,1)
2160 CALL HCHAR (7+ROW,3+COL,SUIT,1)
2170 CALL HCHAR (7+ROW,5+COL,SUIT,1)
2180 CALL HCHAR (8+ROW,4+COL,SUIT,1)
2190 CALL HCHAR (9+ROW,3+COL,SUIT,1)
2200 CALL HCHAR (9+ROW,5+COL,SUIT,1)
2210 SUBEND
2220 REM SUBROUTINE ***RENDER9***
2230 SUB RENDER9(ROW,COL,SUIT)
2240 CALL VCHAR (5+ROW,3+COL,SUIT,2)
2250 CALL VCHAR (5+ROW,5+COL,SUIT,2)
2260 CALL VCHAR (8+ROW,3+COL,SUIT,2)
2270 CALL VCHAR (8+ROW,5+COL,SUIT,2)
2280 CALL HCHAR (7+ROW,4+COL,SUIT,1)
2290 SUBEND
2300 REM SUBROUTINE ***RENDER10***
2310 SUB RENDER10(ROW,COL,SUIT)
2320 CALL VCHAR (5+ROW,3+COL,SUIT,5)
2330 CALL VCHAR (5+ROW,5+COL,SUIT,5)
2340 SUBEND
2350 REM SUBROUTINE ***RENDERJACK***
2360 SUB RENDERJACK(ROW,COL,SUIT)
2370 CALL VCHAR (5+ROW,5+COL,SUIT,5)
2380 CALL HCHAR (9+ROW,3+COL,SUIT,2)
2390 CALL HCHAR (8+ROW,3+COL,SUIT,1)
2400 SUBEND
2410 REM SUBROUTINE ***RENDERQUEEN***
2420 SUB RENDERQUEEN(ROW,COL,SUIT)
2430 CALL VCHAR (5+ROW,3+COL,SUIT,5)
2440 CALL VCHAR (5+ROW,5+COL,SUIT,5)
2450 CALL HCHAR (5+ROW,4+COL,SUIT,1)
2460 CALL HCHAR (9+ROW,4+COL,SUIT,1)
2470 SUBEND
2480 REM SUBROUTINE ***RENDERKING***
2490 SUB RENDERKING(ROW,COL,SUIT)
2500 CALL VCHAR (5+ROW,3+COL,SUIT,5)
2510 CALL VCHAR (5+ROW,5+COL,SUIT,2)
2520 CALL VCHAR (8+ROW,5+COL,SUIT,2)
2530 CALL VCHAR (7+ROW,4+COL,SUIT,1)
2540 SUBEND
2550 REM SUBROUTINE ***RENDERACE***
2560 SUB RENDERACE(ROW,COL,SUIT)
2570 CALL HCHAR (7+ROW,4+COL,SUIT,1)
2580 SUBEND
2590 REM SUBROUTINE ***PLAY***
2600 SUB PLAY
2610 DIM HANDS(1,4,1) :: REM HANDS[PLAYER,CARD,SUIT]
2620 DIM CARDS(1) :: REM CARDS[PLAYER]
2630 DIM SUMS(1) :: REM SUMS[PLAYER]
2640 CALL CLEARTABLE(HANDS(,,),CARDS(),SUMS())
2650 CALL SHUFFLE(HANDS(,,))
2660 PLAYER=0 :: FACEDOWN=0
2670 CALL DEAL(CARDS(),SUMS(),(PLAYER),(FACEDOWN),HANDS(,,))
2680 CALL DEAL(CARDS(),SUMS(),(PLAYER),(FACEDOWN),HANDS(,,))
2690 PLAYER=1 :: FACEDOWN=0
2700 CALL DEAL(CARDS(),SUMS(),(PLAYER),(FACEDOWN),HANDS(,,))
2710 PLAYER=1 :: FACEDOWN=1
2720 CALL DEAL(CARDS(),SUMS(),(PLAYER),(FACEDOWN),HANDS(,,))
2730 REM PLAYERS TURNS
2740 BUSTED=0
2750 FOR J=3 TO 5
2760 DISPLAY AT (22,2) BEEP: "DO YOU WANT ANOTHER CARD?"
2770 A$=""
2780 CALL HCHAR(23,16,30)
2790 REM LABEL ***ASKANOTHER***
2800 CALL KEY(0,K,S)
2810 IF S=0 OR S=-1 THEN 2800 :: REM GOTO ASKANOTHER
2820 IF K<>78 AND K<>89 THEN 2800 :: REM GOTO ASKANOTHER
2830 CALL HCHAR (23,16,K)
2840 A$=CHR$(K)
2850 CALL HCHAR (22,4,32,25) :: CALL HCHAR (23,16,32)
2860 IF A$="N" THEN 2940 :: REM GOTO REVEAL
2870 PLAYER=0 :: FACEDOWN=0
2880 CALL DEAL(CARDS(),SUMS(),(PLAYER),(FACEDOWN),HANDS(,,))
2890 IF SUMS(PLAYER)>21 THEN BUSTED=1
2900 IF BUSTED=1 THEN DISPLAY AT (12,4) BEEP: "YOU BUSTED. YOU LOSE."
2910 IF BUSTED=1 THEN 2940 :: REM GOTO REVEAL
2920 NEXT J
2930 REM LABEL ***REVEAL***
2940 PLAYER=1 :: FACEDOWN=0 :: CARD=1
2950 CALL RENDERCARD((PLAYER),(CARD),(FACEDOWN),HANDS(,,))
2960 IF BUSTED=1 THEN 3110 :: REM GOTO GAMEOVER
2970 REM DEALERS TURNS
2980 BUSTED=0
2990 FOR J=3 TO 5
3000 PLAYER=1 :: FACEDOWN=0
3010 CALL CALCSCORE(SCORE,(PLAYER),SUMS(),CARDS(),HANDS(,,))
3020 IF SCORE>=17 THEN 3090 :: REM GOTO TALLY
3030 CALL DEAL(CARDS(),SUMS(),(PLAYER),(FACEDOWN),HANDS(,,))
3040 IF SUMS(PLAYER)>21 THEN BUSTED=1
3050 IF BUSTED=1 THEN DISPLAY AT (12,3) BEEP: "DEALER BUSTED. YOU WIN."
3060 IF BUSTED=1 THEN 3110 :: REM GOTO GAMEOVER
3070 NEXT J
3080 REM LABEL ***TALLY***
3090 CALL WHOWON(SUMS(),CARDS(),HANDS(,,))
3100 REM LABEL ***GAMEOVER***
3110 SUBEND
3120 REM SUBROUTINE ***CLEARTABLE***
3130 SUB CLEARTABLE(HANDS(,,),CARDS(),SUMS())
3140 CALL CLEAR
3150 DISPLAY AT (1, 10): "BLACKJACK"
3160 FOR I=0 TO 1 :: SUMS(I)=0 :: CARDS(I)=0 :: NEXT I
3170 FOR I=0 TO 1 :: FOR J=0 TO 4 :: FOR K=0 TO 1 :: HANDS(I,J,K)=0 :: NEXT K :: NEXT J :: NEXT I
3180 SUBEND
3190 REM SUBROUTINE ***SHUFFLE***
3200 SUB SHUFFLE(HANDS(,,))
3210 RANDOMIZE
3220 DIM DECK(9) :: FOR I=0 TO 9 :: DECK(I)=0 :: NEXT I
3230 FOR H=0 TO 9
3240 REM LABEL ***DRAWLOOP***
3250 DISPLAY AT(12,6): "SHUFFLING THE DECK"
3260 X=INT(RND*4)+1
3270 X=X*16
3280 X=X+INT(RND*13)+2
3290 DUP=0
3300 CALL CHECKDUP(DUP,(X),DECK())
3310 IF DUP=1 THEN 3250 :: REM GOTO DRAWLOOP
3320 DECK(H)=X
3330 NEXT H
3340 FOR H=0 TO 4
3350 HANDS(0,H,1)=INT(DECK(H)/16)
3360 HANDS(0,H,0)=DECK(H)-HANDS(0,H,1)*16
3370 NEXT H
3380 FOR H=0 TO 4
3390 HANDS(1,H,1)=INT(DECK(H+5)/16)
3400 HANDS(1,H,0)=DECK(H+5)-HANDS(1,H,1)*16
3410 NEXT H
3420 DISPLAY AT(12,6): "                  "
3430 SUBEND
3440 REM SUBROUTINE ***CHECKDUP***
3450 SUB CHECKDUP(DUP,X,DECK())
3460 DUP=0
3470 FOR I=0 TO 9
3480 IF DECK(I)=X THEN DUP=1 :: GOTO 3500 :: REM SUBEND
3490 NEXT I
3500 SUBEND
3510 REM SUBROUTINE ***DEAL***
3520 SUB DEAL(CARDS(),SUMS(),PLAYER,FACEDOWN,HANDS(,,))
3530 CARDS(PLAYER)=CARDS(PLAYER)+1
3540 CARD=CARDS(PLAYER)-1
3550 CVAL=HANDS(PLAYER,CARD,0)
3560 IF CVAL>10 THEN IF CVAL=14 THEN CVAL=1 ELSE CVAL=10
3570 SUMS(PLAYER)=SUMS(PLAYER)+CVAL
3580 CALL RENDERCARD((PLAYER),(CARD),(FACEDOWN),HANDS(,,))
3590 SUBEND
3600 REM SUBROUTINE ***CALCSCORE***
3610 SUB CALCSCORE(SCORE,PLAYER,SUMS(),CARDS(),HANDS(,,))
3620 SCORE=SUMS(PLAYER)
3630 IF SCORE+10>21 THEN 3670 :: REM GOTO CALCSCORE.SUBEND
3640 FOR I=0 TO CARDS(PLAYER)-1
3650 IF HANDS(PLAYER,I,0)=14 THEN SCORE=SCORE+10 :: GOTO 3670 :: REM GOTO CALCSCORE.SUBEND
3660 NEXT I
3670 SUBEND
3680 REM SUBROUTINE ***WHOWON***
3690 SUB WHOWON(SUMS(),CARDS(),HANDS(,,))
3700 PLAYER=0 :: PSCORE=0
3710 CALL CALCSCORE(PSCORE,(PLAYER),SUMS(),CARDS(),HANDS(,,))
3720 REM DISPLAY AT (1,24): "P:"&STR$(PSCORE)
3730 PLAYER=1 :: DSCORE=0
3740 CALL CALCSCORE(DSCORE,(PLAYER),SUMS(),CARDS(),HANDS(,,))
3750 REM DISPLAY AT (2,24):"D:"&STR$(DSCORE)
3760 IF PSCORE=DSCORE THEN DISPLAY AT (12,11): "TIE GAME"
3770 IF PSCORE>DSCORE THEN DISPLAY AT (12,11): "YOU WIN!"
3780 IF PSCORE<DSCORE THEN DISPLAY AT (12,11): "YOU LOSE"
3790 SUBEND
3800 REM SUBROUTINE ***TERMINATE***
3810 SUB TERMINATE
3820 FOR I=1 TO 5 :: CALL CLEAR :: DISPLAY AT (12,7) BEEP: "GAME TERMINATED" :: CALL SOUND(100,110,30) :: CALL SOUND(1,110,30) :: NEXT I
3830 FOR I=1 TO 5 :: CALL SOUND(500,110,30) :: CALL SOUND(1,110,30) :: NEXT I
3840 END
3850 SUBEND
3860 REM SUBROUTINE ***GETHEART***
3870 SUB GETHEART(CHARVAL)
3880 CHARVAL=96
3890 SUBEND
3900 REM SUBROUTINE ***GETDIAMOND***
3910 SUB GETDIAMOND(CHARVAL)
3920 CHARVAL=97
3930 SUBEND
3940 REM SUBROUTINE ***GETREDVALS***
3950 SUB GETREDVALS(CHARVAL)
3960 CHARVAL=98
3970 SUBEND
3980 REM SUBROUTINE ***GETCARDBACK***
3990 SUB GETCARDBACK(CHARVAL)
4000 CHARVAL=111
4010 SUBEND
4020 REM SUBROUTINE ***GETSPADE***
4030 SUB GETSPADE(CHARVAL)
4040 CHARVAL=112
4050 SUBEND
4060 REM SUBROUTINE ***GETCLUB***
4070 SUB GETCLUB(CHARVAL)
4080 CHARVAL=113
4090 SUBEND
4100 REM SUBROUTINE ***GETBLACKVALS***
4110 SUB GETBLACKVALS(CHARVAL)
4120 CHARVAL=114
4130 SUBEND
4140 REM SUBROUTINE ***GETCARDEDGE***
4150 SUB GETCARDEDGE(CHARVAL)
4160 CHARVAL=128
4170 SUBEND
4180 REM SUBROUTINE ***GETCARDTOP***
4190 SUB GETCARDTOP(CHARVAL)
4200 CHARVAL=129
4210 SUBEND
4220 REM SUBROUTINE ***GETCARDFRONT***
4230 SUB GETCARDFRONT(CHARVAL)
4240 CHARVAL=136
4250 SUBEND