home *** CD-ROM | disk | FTP | other *** search
AmigaBASIC Source Code | 1987-04-02 | 11.4 KB | 546 lines |
- 'BLACKJACK
- SCREEN 1,640,200,3,2
- WINDOW 2," BLACKJACK ",,16,1
- BREAK ON
- ON BREAK GOSUB terminate
- OPTION BASE 1
- DIM clubs%(100),diamonds%(100),hearts%(100),spades%(100),wvshp%(256)
- DIM shoe(4,13)
- DIM comp(8,3),play1(8,3),play2(8,3)
- GOSUB dfwave
- GOSUB setcolors
- GOSUB titlepage
- setup:
- CLS:LINE(192,32)-(440,152),1,bf
- COLOR 2,3
- LOCATE 6,26:PRINT " OPTIONS MENU "
- COLOR 3,2
- LOCATE 8,26:PRINT " 0) HOUSE RULES "
- LOCATE 10,26:PRINT " 1) DEAL 1 DECK SHOES "
- LOCATE 12,26:PRINT " 2) DEAL 2 DECK SHOES "
- LOCATE 14,26:PRINT " 3) DEAL 3 DECK SHOES "
- LOCATE 16,26:PRINT " 4) DEAL 4 DECK SHOES "
- COLOR 2,3
- LOCATE 18,26:PRINT " SELECT NUMBER OR USE MOUSE "
- mouseclear=MOUSE(0)
- GOSUB startselect
- COLOR 1,0:CLS
- IF qa$="0" THEN
- GOSUB instructions
- GOTO setup
- END IF
- decks=VAL(qa$)
- CLS
- totcards=decks*52
- playbet=0:handsdealt=0
- playmoney=10000
- compmoney=100000
- handbin=0:hand2bin=0
- newshoe:
- GOSUB shuffle
- sameshoe:
- GOSUB takebet
- GOSUB dealcards
- GOSUB totalhands
- GOSUB displaytext
- GOSUB player
- GOSUB computer
- GOSUB results
- handsdealt=handsdealt+1
- IF compmoney=0 THEN GOTO terminate
- IF playmoney=0 THEN GOTO terminate
- IF totcards-totdealt>7 THEN sameshoe :ELSE newshoe
- setcolors:
- PALETTE 0,0.4,0.77,0.3 ' green
- PALETTE 1,0,0,0 ' black
- PALETTE 2,1,1,1 ' white
- PALETTE 3,0.93,0.2,0 'red
- PALETTE 4,1,1,0.13 ' yellow
- PALETTE 5,0.4,0.6,1 'blue
- PALETTE 6,0,0.93,0.87 'aqua
- PALETTE 7,0.53,0.53,0.53 'grey
- RETURN
- terminate:
- COLOR 1,7:CLS:COLOR 2,1
- PRINT:PRINT
- IF compmoney=0 THEN
- PRINT " CONGRATULATIONS YOU BROKE THE BANK !!!!!!! "
- PRINT:PRINT" NOW GO AWAY !!!!!!!! "
- ELSEIF playmoney=0 THEN
- PRINT" NO MONEY LEFT.........BYE SEE YA!!!!!!!! "
- PRINT:PRINT" COME BACK REAL SOON..........BRING CASH!!!!!!! "
- ELSE
- PRINT" QUITTER !!!!!!!!!!!!!"
- END IF
- PRINT:PRINT:COLOR 1,7
- PRINT " THERE WERE ";handsdealt;"HANDS PLAYED"
- FOR x=1 TO 15000:NEXT x
- WINDOW CLOSE 2
- SCREEN CLOSE 1
- PALETTE 0,0.2,0.3,0.5
- PALETTE 1,1,1,1
- PALETTE 2,0,0,0
- PALETTE 3,0.9,0.59,0
- CLS
- END
- titlepage:
- COLOR 1,0:CLS
- LINE(18,8)-(540,152),,b:PAINT(28,28),4,1
- LINE(144,64)-(416,96),,b:PAINT(154,71),1,1
- COLOR 3,2
- LOCATE 10,28:PRINT " ' BLACKJACK ' "
- COLOR 1,0
- whohand=1
- suit=4:card=11:whatcard=0:GOSUB drwcrd:x1=38:y1=33:GOSUB spade
- suit=3:card=1:whatcard=1:GOSUB drwcrd:x1=101:y1=31:GOSUB heart
- suit=1:card=11:whatcard=6:GOSUB drwcrd:x1=424:y1=30:GOSUB club
- suit=2:card=1:whatcard=7:GOSUB drwcrd:x1=489:y1=29:GOSUB diamond
- whohand=2
- suit=2:card=11:whatcard=0:GOSUB drwcrd:x1=41:y1=101:GOSUB diamond
- suit=1:card=1:whatcard=1:GOSUB drwcrd:x1=102:y1=102:GOSUB club
- suit=3:card=11:whatcard=6:GOSUB drwcrd:x1=421:y1=103:GOSUB heart
- suit=4:card=1:whatcard=7:GOSUB drwcrd:x1=486:y1=105:GOSUB spade
- GET (32,28)-(52,39),spades%
- GET (96,28)-(116,39),hearts%
- GET (416,28)-(436,39),clubs%
- GET (480,28)-(500,39),diamonds%
- FOR x=1 TO 5000: NEXT x
- RETURN
- club:
- CIRCLE(x1,y1),3,1:PAINT STEP (0,0),1,1
- CIRCLE STEP (-4,3),3,1:PAINT STEP (0,0),1,1
- CIRCLE STEP (8,0),3,1:PAINT STEP (0,0),1,1
- LINE STEP (-5,1) - STEP (2,2),,bf
- RETURN
- diamond:
- COLOR 3,2
- AREA(x1,y1):AREA STEP(6,3):AREA STEP(-7,3):AREA STEP(-6,-3)
- AREAFILL
- COLOR 1,0
- RETURN
- heart:
- COLOR 3,2
- CIRCLE(x1,y1),4,3:PAINT STEP(0,0),3,3
- CIRCLE STEP(8,0),4,3:PAINT STEP(0,0),3,3
- AREA STEP(4,0):AREA STEP(-8,4):AREA STEP(-8,-4)
- AREAFILL
- COLOR 1,0
- RETURN
- spade:
- CIRCLE(x1,y1),4,1:PAINT STEP(0,0),1,1
- CIRCLE STEP(8,0),4,1:PAINT STEP(0,0),1,1
- AREA STEP(4,0):AREA STEP(-8,-4):AREA STEP(-8,4)
- AREAFILL
- LINE STEP(7,2) - STEP(2,2),,bf
- RETURN
- instructions:
- COLOR 1,7:CLS:COLOR 2,1
- PRINT:PRINT:LOCATE 3,10
- PRINT " HOUSE RULES ":PRINT:COLOR 1,7
- PRINT:PRINT " BLACKJACKS PAY ONE AND A HALF TIMES THE BET ON THE FIRST HAND ONLY"
- PRINT:PRINT " DEALER HITS ON 16 OR LESS AND STAYS ON 17 OR MORE"
- PRINT:PRINT " NO MONEY CHANGES HANDS ON A TIE"
- PRINT:PRINT " YOU CAN SPLIT CARDS OF EQUAL VALUE ON THE FIRST HAND ONLY"
- PRINT:PRINT " YOU CAN DOUBLE THE BET FOR ONE CARD ON THE FIRST HAND ONLY"
- PRINT:PRINT " HIT ENTER IN THE BET WINDOW TO REPEAT LAST BET VALUE"
- LOCATE 20,10:COLOR 2,1
- PRINT " CLICK LEFT MOUSE BUTTON TO CONTINUE "
- COLOR 1,0
- loop1:
- IF MOUSE(0)=0 THEN loop1
- RETURN
- shuffle:
- RANDOMIZE TIMER
- FOR x=1 TO 4
- FOR z=1 TO 13
- shoe(x,z)=0
- NEXT z
- NEXT x
- totdealt=0
- GOSUB shuffsound
- RETURN
- takebet:
- WINDOW 3," BET ",(540,106)-(630,180),0,1
- COLOR 3,2
- ON BREAK GOSUB winowbreak
- rebet:
- CLS
- lstcash=playmoney:lstbet=playbet
- PRINT
- PRINT " BANK ":PRINT " ";compmoney
- PRINT
- PRINT " YOU ":PRINT " ";playmoney
- PRINT
- PRINT " ENTER BET"
- INPUT playbet$: playbet=VAL(playbet$)
- IF playbet$="" THEN playbet=lstbet
- IF playbet>playmoney OR playbet>compmoney OR playbet<1 THEN rebet
- playmoney=playmoney-playbet
- compmoney=compmoney-playbet
- handbin=2*playbet:hand2bin=0
- WINDOW CLOSE 3
- COLOR 1,0
- ON BREAK GOSUB terminate
- RETURN
- dealcards:
- CLS:prntmenu=1:blackjack=0
- bnkbusted=0:sbusted=0:double=0
- dealt=1:playdone=0:onecard=0:busted=0:split=0
- redeal:
- IF totcards-totdealt<2 THEN GOSUB shuffle
- suit = INT((RND(1)*4)+1)
- card = INT((RND(1)*13)+1)
- IF shoe(suit,card)>=decks THEN redeal
- shoe(suit,card)=shoe(suit,card)+1
- cvalue=card
- IF cvalue>10 THEN cvalue=10
- IF cvalue=1 THEN cvalue=11
- IF onecard =1 THEN RETURN
- IF dealt=1 THEN
- play1(1,1)=suit:play1(1,2)=card:play1(1,3)=cvalue
- whohand=2:whatcard=0:GOSUB drwcrd
- END IF
- IF dealt=2 THEN
- comp(1,1)=suit:comp(1,2)=card:comp(1,3)=cvalue
- whohand=1:whatcard=0:GOSUB drwcrd
- END IF
- IF dealt=3 THEN
- play1(2,1)=suit:play1(2,2)=card:play1(2,3)=cvalue
- whohand=2:whatcard=1:GOSUB drwcrd
- END IF
- IF dealt=4 THEN
- comp(2,1)=suit:comp(2,2)=card:comp(2,3)=cvalue
- LINE(96,28)-(144,60),,b:SOUND 20,1,255,1
- PAINT(106,38),5,1
- END IF
- dealt=dealt+1
- IF dealt <5 THEN redeal
- totdealt=totdealt+4
- play1dealt=2
- play2dealt=0
- compdealt=2
- RETURN
- totalhands:
- play1tot=0:play2tot=0:comptot=0
- FOR x=1 TO play1dealt
- play1tot = play1tot + play1(x,3)
- NEXT x
- FOR x=1 TO compdealt
- comptot = comptot + comp(x,3)
- NEXT x
- IF play2dealt = 0 THEN RETURN
- FOR x=1 TO play2dealt
- play2tot = play2tot + play2(x,3)
- NEXT x
- RETURN
- displaytext:
- COLOR 1,0
- IF prntmenu=1 THEN
- LOCATE 3,5:PRINT "COMPUTER HAND: TOTAL = "
- LOCATE 12,5:PRINT "PLAYER HAND #1: TOTAL = "
- LOCATE 19,5:PRINT "PLAYER HAND #2: TOTAL = "
- LOCATE 3,45:PRINT "LAST BET = "
- LOCATE 12,45:PRINT "LAST CASH = "
- LINE(540,0)-(635,88),,b:PAINT(550,20),3,1
- COLOR 2,1
- LOCATE 2,70:PRINT " OPTIONS "
- COLOR 1,4
- LOCATE 4,70:PRINT "(S) STAND"
- LOCATE 6,70:PRINT "(H) HIT "
- LOCATE 8,70:PRINT "(D) DBLE "
- LOCATE 10,70:PRINT "(X) SPLIT"
- COLOR 1,0:prntmenu=0
- END IF
- LOCATE 12,32:PRINT play1tot;" "
- LOCATE 3,57:PRINT playbet;" "
- LOCATE 12,57:PRINT lstcash;" "
- IF playdone=1 THEN LOCATE 3,32:PRINT comptot;" "
- IF play2dealt=0 THEN RETURN
- LOCATE 19,32:PRINT play2tot;" "
- RETURN
- player:
- IF comptot=21 AND play1tot<> 21 THEN RETURN
- IF play1tot=21 AND play1dealt=2 AND split=0 THEN
- IF comptot <> 21 THEN
- handbin=handbin+0.5*playbet
- compmoney=compmoney-0.5*playbet
- blackjack=1
- RETURN
- END IF
- RETURN
- END IF
- IF play1tot>21 AND play1dealt=2 GOTO doubleace
- GOSUB imouser
- IF qa$="s" THEN RETURN
- IF qa$="h" THEN
- doubleit:
- onecard=1:GOSUB redeal
- play1dealt=play1dealt+1:totdealt=totdealt+1
- play1(play1dealt,1)=suit:play1(play1dealt,2)=card:play1(play1dealt,3)=cvalue
- whohand=2:whatcard=play1dealt-1:GOSUB drwcrd
- GOSUB totalhands
- doubleace:
- IF play1tot > 21 THEN
- switch=0:busted=1
- FOR x=1 TO play1dealt
- IF play1(x,2)=1 AND play1(x,3)=11 AND switch=0 THEN
- play1(x,3)=1:play1tot=play1tot-10:switch=1:busted=0
- END IF
- NEXT x
- END IF
- GOSUB displaytext
- IF busted=1 THEN
- COLOR 1,3:LOCATE 13,8
- PRINT " BUSTED "
- COLOR 1,0
- RETURN
- END IF
- IF double =1 THEN RETURN
- GOTO player
- END IF
- IF qa$="d" AND playmoney>=playbet AND play1dealt =2 AND split=0 THEN
- compmoney=compmoney-playbet
- playmoney=playmoney-playbet
- playbet=playbet*2
- handbin=handbin*2
- double=1
- GOSUB doubleit
- RETURN
- END IF
- IF qa$="x" AND split=0 AND playmoney>=playbet AND play1dealt=2 THEN
- IF play1(1,3)<>play1(2,3)THEN
- IF play1(1,2)<>play1(2,2) THEN GOTO player
- END IF
- hand2bin=handbin:split=1
- compmoney=compmoney-playbet
- playmoney=playmoney-playbet
- play2(1,1)=play1(2,1):play2(1,2)=play1(2,2):play2(1,3)=play1(2,3)
- IF play1(1,2)=1 AND play1(1,3)=1 THEN play1(1,3)=11
- IF play2(1,2)=1 AND play2(1,3)=1 THEN play2(1,3)=11
- suit=play2(1,1):card=play2(1,2)
- whohand=3:whatcard=0
- GOSUB drwcrd
- onecard=1:GOSUB redeal
- play1(2,1)=suit:play1(2,2)=card:play1(2,3)=cvalue
- whohand=2:whatcard=1
- PAINT (106,110),0,0:GOSUB drwcrd
- onecard=1:GOSUB redeal
- play2(2,1)=suit:play(2,2)=card:play2(2,3)=cvalue
- whohand=3:whatcard=1
- GOSUB drwcrd
- totdealt=totdealt+2:play2dealt=2
- GOSUB totalhands
- GOSUB displaytext
- END IF
- GOTO player
- secondhand:
- IF play2tot>21 AND play2dealt=2 GOTO twinace
- GOSUB imouser
- IF qa$="s" THEN RETURN
- IF qa$="h" THEN
- onecard=1:GOSUB redeal
- play2dealt=play2dealt+1:totdealt=totdealt+1
- play2(play2dealt,1)=suit:play2(play2dealt,2)=card:play2(play2dealt,3)=cvalue
- whohand=3:whatcard=play2dealt-1:GOSUB drwcrd
- GOSUB totalhands
- twinace:
- IF play2tot>21 THEN
- switch=0:sbusted=1
- FOR x=1 TO play2dealt
- IF play2(x,2)=1 AND play2(x,3)=11 AND switch=0 THEN
- play2(x,3)=1:play2tot=play2tot-10:switch=1:sbusted=0
- END IF
- NEXT x
- END IF
- GOSUB displaytext
- IF sbusted=1 THEN
- COLOR 1,3:LOCATE 20,8
- PRINT " BUSTED "
- COLOR 1,0
- RETURN
- END IF
- END IF
- GOTO secondhand
- computer:
- IF split=1 THEN BEEP:CIRCLE(22,160),6,3:PAINT(22,160),3,3:GOSUB secondhand
- playdone=1:whohand=1:whatcard=1
- suit=comp(2,1):card=comp(2,2)
- PAINT (106,38),0,1:GOSUB drwcrd
- IF blackjack=1 THEN GOSUB displaytext: RETURN
- IF comptot>21 AND compdealt=2 THEN dblace=1:GOTO twoaces
- GOSUB displaytext
- FOR x=1 TO 3000:NEXT x
- adjusted:
- IF split=0 AND busted=1 THEN RETURN
- IF split=1 AND busted=1 AND sbusted=1 THEN RETURN
- WHILE (comptot<17)
- onecard=1:GOSUB redeal
- compdealt=compdealt+1:totdealt=totdealt+1
- comp(compdealt,1)=suit:comp(compdealt,2)=card:comp(compdealt,3)=cvalue
- whocard=1:whatcard=compdealt-1:GOSUB drwcrd
- GOSUB totalhands
- twoaces:
- IF comptot>21 THEN
- switch=0:bnkbusted=1
- FOR x=1 TO compdealt
- IF comp(x,2)=1 AND comp(x,3)=11 AND switch=0 THEN
- comp(x,3)=1:comptot=comptot-10:switch=1:bnkbusted=0
- END IF
- NEXT x
- END IF
- GOSUB displaytext
- IF dblace=1 THEN dblace=0:GOTO adjusted
- FOR x = 1 TO 3000:NEXT x
- WEND
- IF bnkbusted=1 THEN LOCATE 4,8:COLOR 1,3:PRINT " BUSTED "
- COLOR 1,0
- RETURN
- results:
- IF busted = 1 THEN
- compmoney=compmoney+handbin
- ELSEIF bnkbusted=1 THEN
- playmoney=playmoney+handbin
- ELSEIF comptot > play1tot THEN
- compmoney=compmoney+handbin
- ELSEIF play1tot>comptot THEN
- playmoney=playmoney+handbin
- ELSE
- playmoney=playmoney+playbet
- compmoney=compmoney+playbet
- END IF
- IF split <>0 THEN
- IF sbusted=1 THEN
- compmoney=compmoney+hand2bin
- ELSEIF bnkbusted=1 THEN
- playmoney=playmoney+hand2bin
- ELSEIF comptot>play2tot THEN
- compmoney=compmoney+hand2bin
- ELSEIF play2tot>comptot THEN
- playmoney=playmoney+hand2bin
- ELSE
- playmoney=playmoney+playbet
- compmoney=compmoney+playbet
- END IF
- END IF
- RETURN
- imouser:
- qa$=""
- WHILE(qa$="")
- IF MOUSE(0)>0 THEN
- IF MOUSE(1)>552 AND MOUSE(1)<632 THEN
- IF MOUSE(2)>24 AND MOUSE(2)<32 THEN
- qa$="s"
- ELSEIF MOUSE(2)>40 AND MOUSE(2)<48 THEN
- qa$="h"
- ELSEIF MOUSE(2)>56 AND MOUSE(2)<64 THEN
- qa$="d"
- ELSEIF MOUSE(2)>72 AND MOUSE(2)<80 THEN
- qa$="x"
- ELSE
- qa$=""
- END IF
- END IF
- END IF
- IF qa$="" THEN qa$=INKEY$
- WEND
- RETURN
- startselect:
- qa$=""
- WHILE(qa$="")
- IF MOUSE(0)>0 THEN
- IF MOUSE(1)>200 AND MOUSE(1)<432 THEN
- IF MOUSE(2)>56 AND MOUSE(2)<64 THEN
- qa$="0"
- ELSEIF MOUSE(2)>72 AND MOUSE(2)<80 THEN
- qa$="1"
- ELSEIF MOUSE(2)>88 AND MOUSE(2)<96 THEN
- qa$="2"
- ELSEIF MOUSE(2)>104 AND MOUSE(2)<112 THEN
- qa$="3"
- ELSEIF MOUSE(2)>120 AND MOUSE(2)<128 THEN
- qa$="4"
- ELSE
- qa$=""
- END IF
- END IF
- END IF
- IF qa$="" THEN qa$=INKEY$
- WEND
- RETURN
- drwcrd:
- IF suit=1 OR suit=4 THEN COLOR 1,0 :ELSE COLOR 3,0
- IF whohand=1 THEN
- y1=28:y2=60:numlin=6
- ELSEIF whohand=2 THEN
- y1=100:y2=132:numlin=15
- ELSE
- y1=156:y2=186:numlin=22
- END IF
- LINE(whatcard*64+32,y1)-(whatcard*64+80,y2),,b
- SOUND 20,1,255,1
- IF suit=1 OR suit=4 THEN
- PAINT (whatcard*64+42,y1+10),2,1
- ELSE
- PAINT (whatcard*64+42,y1+10),2,3
- END IF
- IF suit=1 THEN
- COLOR 1,2:PUT (whatcard*64+32,y1),clubs%,PSET
- ELSEIF suit=2 THEN
- COLOR 3,2:PUT (whatcard*64+32,y1),diamonds%,PSET
- ELSEIF suit=3 THEN
- COLOR 3,2:PUT (whatcard*64+32,y1),hearts%,PSET
- ELSE
- COLOR 1,2:PUT (whatcard*64+32,y1),spades%,PSET
- END IF
-
- LOCATE numlin,whatcard*8+7
- GOSUB altchar
- COLOR 1,0
- RETURN
- altchar:
- IF suit=2 OR suit=3 THEN
- COLOR 3,2
- ELSE
- COLOR 1,2
- END IF
- IF card>10 OR card=1 THEN
- IF card=11 THEN PRINT "J "
- IF card=12 THEN PRINT "Q "
- IF card =13 THEN PRINT "K "
- IF card=1 THEN PRINT "A "
- ELSE
- IF card=10 THEN
- PRINT RIGHT$(STR$(card),2)
- ELSE
- PRINT RIGHT$(STR$(card),1)+" "
- END IF
- END IF
- RETURN
- dfwave:
- xvalue=127
- FOR xx=0 TO 15
- FOR yy=1 TO 16
- wvshp%(xx*16+yy)=xvalue
- NEXT yy
- xvalue=INT(xvalue*0.63)
- NEXT xx
- WAVE 1,wvshp%
- ERASE wvshp%
- RETURN
- shuffsound:
- FOR qq=1 TO 3
- FOR xx=1 TO 8
- SOUND 50,1,255,1
- FOR zz= 1 TO 140:NEXT zz
- NEXT xx
- FOR zz= 1 TO 1000:NEXT zz
- SOUND 40,1,255,1
- FOR zz= 1 TO 500:NEXT zz
- SOUND 40,1,255,1
- FOR zz= 1 TO 3000:NEXT zz
- NEXT qq
- RETURN
- winowbreak:
- RETURN
-
-