0 REM if you *exec this file, it will save itself and run all on its own.... 5 REM Blackjack game (C) D. Fumi, 1995. 10 PROCinit 20 PROCGetdeck 40 PROCPlay 50 PROCGoodbye 70 END 999 : 1000DEFPROCinit 1001CLS 1004PRINT"Duncan's card table, enjoy!" 1005crap=RND(-TIME):REM Seed random number generator. 1008DIM cardval%(51) 1010DIM cardsuit$(51) 1020DIM cardname$(51) 1021DIM cardvalue%(51) 1022DIM playedcards%(5,10):REM max of five cards per player 1023DIM numofcards%(10):REM number of cards played 1024DIM playname$(10):REM Name of players 1025DIM score%(10):REM Player's exiting score 1034 numcard%=51 1035 quit%=0 1050 ENDPROC 1100 DEFPROCGetdeck 1110 REM Number for cards:eg. 102. First 1 suit. Last 2,value. 1111 REM Deck begins with 52 cards. cards taken from the top and 1112 REM numcard% is decremented accordingly. it is set to 51 upon 1113 REM shuffling the deck. 1114 PRINT"Making up deck, please wait...." 1120 FOR T=0TO51 1130 READ cardno% 1140 suit%=INT(cardno%/100) 1150 number%=cardno% MOD 100 1155 cardvalue%(T)=cardno% 1160 IF suit%=1 THEN cardsuit$(T)="Hearts" 1170 IF suit%=2 THEN cardsuit$(T)="Diamonds" 1180 IF suit%=3 THEN cardsuit$(T)="Spades" 1190 IF suit%=4 THEN cardsuit$(T)="Clubs" 1200 IF number%=2 THEN cardname$(T)="a 2":cardval%(T)=2 1210 IF number%=3 THEN cardname$(T)="a 3":cardval%(T)=3 1220 IF number%=4 THEN cardname$(T)="a 4":cardval%(T)=4 1230 IF number%=5 THEN cardname$(T)="a 5":cardval%(T)=5 1240 IF number%=6 THEN cardname$(T)="a 6":cardval%(T)=6 1250 IF number%=7 THEN cardname$(T)="a 7":cardval%(T)=7 1260 IF number%=8 THEN cardname$(T)="a 8":cardval%(T)=8 1270 IF number%=9 THEN cardname$(T)="a 9":cardval%(T)=9 1280 IF number%=10 THEN cardname$(T)="a 10":cardval%(T)=10 1290 IF number%=11 THEN cardname$(T)="a Jack":cardval%(T)=10 1300 IF number%=12 THEN cardname$(T)="a Queen":cardval%(T)=10 1310 IF number%=13 THEN cardname$(T)="a King":cardval%(T)=10 1320 IF number%=14 THEN cardname$(T)="an Ace":cardval%(T)=11 1330 NEXT T 1340 CLS 1350 ENDPROC 1360 : 1370 DEFPROCShuffle 1375 REM Shuffles cards by moving cards to random positions. 1376 PRINT"Shuffling....." 1380 FOR c1=0TO51 1390 REPEAT 1400 c2=RND(numcard%)-1 1410 UNTIL c2<>c1 1420 value1%=cardvalue%(c1) 1430 suit1$=cardsuit$(c1) 1440 name1$=cardname$(c1) 1445 val1%=cardval%(c1) 1450 cardvalue%(c1)=cardvalue%(c2) 1460 cardsuit$(c1)=cardsuit$(c2) 1470 cardname$(c1)=cardname$(c2) 1475 cardval%(c1)=cardval%(c2) 1480 cardvalue%(c2)=value1% 1490 cardsuit$(c2)=suit1$ 1500 cardname$(c2)=name1$ 1505 cardval%(c2)=val1% 1510 NEXT c1 1515 numcard%=51 1516 CLS 1520 ENDPROC 1600 : 1610 DEFPROCPlay 1611 quit%=0 1615 REPEAT 1616 CLS 1620 PRINT"You are now ready to play, make your choice" 1630 PRINT"1) Blackjack (simple version)" 1642 PRINT"2) Quit to basic" 1650 choice$=GET$ 1660 IF choice$="1" THEN PROCBlackjack 1670 IF choice$="2" THEN quit%=1 ELSE quit%=0 1680 UNTIL quit%=1 1690 ENDPROC 1700DEFPROCBlackjack 1710CLS 1715PROCShuffle 1720PROCBlackinit 1730PROCBlackfirst 1740FOR player%=1TOnumplayer% 1750PROCBlackplay 1760NEXT player% 1770PROCwhoone 1780ENDPROC 1790DEFPROCBlackinit 1800REM Subroutine to initialise variables and get player details. 1810REPEAT 1820 INPUT"Number of players(1>10):"playnum$ 1830 numplayer%=VAL(playnum$) 1840UNTIL numplayer%>1ANDnumplayer%<11 1880FOR getname%=1TOnumplayer% 1890 PRINT"Name of player ";getname%;:INPUT":"playname$(getname%) 1900 numofcards%(getname%)=0 1910NEXT getname% 1920ENDPROC 1930DEFPROCBlackfirst 1940REM Subroutine to deal out the first two cards to all players. 1950FOR card%=1TO2 1960 FOR player%=1TOnumplayer% 1970 playedcards%(card%,player%)=numcard% 1980 numcard%=numcard%-1 1990 numofcards%(player%)=numofcards%(player%)+1 2000 NEXT player% 2010NEXT card% 2020ENDPROC 2030DEFPROCBlackplay 2040CLS 2050PRINT"Player number ";player%;",";playname$(player%);" Press a key.." 2060crap=GET 2070stick%=0 2080REPEAT 2090CLS 2100PRINT"Player number ";player%;",";playname$(player%) 2110PROCShowcards 2120PRINT"Do you want to 1-Twist, 2-Stick or 3-Change ace value."; 2130choice1$=GET$ 2140IF choice1$="1" AND value%<22 THEN PROCTwist 2150IF choice1$="2" THEN stick%=1 2160IF choice1$="3" THEN PROCChangeace 2170UNTIL stick%=1 2180PROCgetscore 2210CLS 2220ENDPROC 2230DEFPROCChangeace 2235CLS 2240FOR card%=1 TO numofcards%(player%) 2250 dekpos%=playedcards%(card%,player%) 2260 isace%=cardvalue%(dekpos%)MOD100 2270 IF isace%=14THEN PROCChangeit 2280NEXT card% 2290ENDPROC 2300DEFPROCChangeit 2310PRINT"Card number ";card%;" is an ace, currently worth ";cardval%(dekpos%) 2320PRINT"Change it (y/n)?" 2330IF GET$="Y" THEN PROCChange 2340ENDPROC 2341DEFPROCChange 2342temp%=cardval%(dekpos%) 2343IF temp%=11 THEN cardval%(dekpos%)=1 2344IF temp%=1 THEN cardval%(dekpos%)=11 2345ENDPROC 2350DEFPROCShowcards 2360value%=0 2370PRINT"You have:" 2380FOR card%=1TOnumofcards%(player%) 2390deckno%=playedcards%(card%,player%) 2400PRINT cardname$(deckno%);" of ";cardsuit$(deckno%) 2410value%=value%+cardval%(deckno%) 2420NEXT card% 2430PRINT"With total value:";value% 2440IF value%>21 THEN PROCBust 2450ENDPROC 2460DEFPROCBust 2470PRINT"You are bust. Change the value of an ace or end your turn." 2490ENDPROC 2500DEFPROCTwist 2510IF numofcards%(player%)<5 THEN PROCAddacard ELSE PROCfiverror 2520ENDPROC 2530DEFPROCfiverror 2540PRINT"You cannot have more than five cards, press enter to continue...." 2550crap=GET 2560ENDPROC 2570DEFPROCAddacard 2580numofcards%(player%)=numofcards%(player%)+1 2590playedcards%(numofcards%(player%),player%)=numcard% 2600numcard%=numcard%-1 2610ENDPROC 2620DEFPROCgetscore 2630score%(player%)=value% 2640ENDPROC 2650DEFPROCwhoone 2660FOR scores%=1 TO numplayer% 2670 PRINT playname$(scores%);" got a total score of ";score%(scores%) 2680 PRINT "using ";numofcards%(scores%);" press enter too continue..." 2690 crap=GET 2700NEXT scores% 2710ENDPROC 2720DEFPROCtest 2730FOR deck%=0TO51 2740PRINT cardname$(deck%);" of ";cardsuit$(deck%) 2750a=GET 2760NEXT deck% 2780ENDPROC 2790DEFPROCebuf 2800REPEAT 2810a=INKEY(1) 2820UNTIL a=-1 2830ENDPROC 9950 DEFPROCGoodbye 9970 PRINT"See you later, have a nice day........." 9980 ENDPROC 9990 : 10000 DATA 102, 103, 104, 105, 106, 107, 108, 109, 110, 111 10001 DATA 112, 113, 114, 202, 203, 204, 205, 206, 207, 208 10002 DATA 209, 210, 211, 212, 213, 214, 302, 303, 304, 305 10003 DATA 306, 307, 308, 309, 310, 311, 312, 313, 314, 402 10004 DATA 403, 404, 405, 406, 407, 408, 409, 410, 411, 412 10005 DATA 413, 414 10006 REM Data for cards SAVE"DECK" RUN