;Blackjack ;SET COMPILER TO CASE SENSITIVE! INCLUDE "D:PMG.ACT" ; ;ASCII position of suits ; ; DEFINE HEART = "5" DEFINE CLUB = "$86" DEFINE DIAMOND = "7" DEFINE SPADE = "$88" BYTE Delt, HldCnt, tick=20, tock=19, RowCrs=$54, ChBase=$2F4, CH=$2FC, GPrior=$26F, DspFlg=$2FE, BkGrnd=$2C8, AUDC1=$D201, ChCtl=$D401, VScrol=$D405, WSync=$D40A INT PlrBank=[200], PlrBet=[0] CARD OldMemHi, SavMsc=$58, ColCrs=$55, VdsLst=$200, MemHi=$2E5, DList=$230 BYTE ARRAY NwChar, Color(3)=$2C4, Deck(52), HoldCrd($20), CrdBrd=[$0 $7E $7E $7E $7E $7E $7E $7E $7E $7E $7E $7E $7E $7E $7E $7E $7E $7E $7E $7E $7E $7E $7E ], CrdBck=[$FF $FF $FF $FF $FF $FF $FF $FF $FF $FF $FF $FF $FF $FF $FF $FF $FF $FF $FF $FF $FF $FF ], PlrLine="player", BetLine="bankbet" CARD POINTER PLAddr BYTE ChRfl=[1] TYPE WHO=[BYTE Cnt, Ace INT Amt] WHO Dealer, Player ; ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; PROC HBlnk=*() [$48 $AD ChRfl ; $49 3 $8D ChRfl $0A $8D WSync $8D ChCtl $68 $40 ] RETURN ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; PROC SetHBlk(BYTE line) BYTE POINTER Bp Bp=DList Bp==+line Bp==+4 Bp^==%$80 RETURN ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; PROC Timer(BYTE Sec) CARD Time=19, D D=Sec*60 Time =0 WHILE tick+256*tock=10 THEN Crdr.Amt==+10 ELSE Crdr.Amt==+Crd FI IF Crdr.Amt>21 THEN IF Crdr.Ace THEN Crdr.Ace==-1 Crdr.Amt==-10 ELSE Crdr.Amt==*-1 FI FI RETURN(Crdr.Amt) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; BYTE FUNC CrdClr(BYTE Value,Crd) Crd==&1 IF Crd THEN Value==+$90 ELSE Value==+$10 FI RETURN(Value) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; PROC CrdFlip(BYTE Who) CARD X,Y IF Who THEN X=(Dealer.Cnt&3)*40+52 Y=(Dealer.Cnt&$FC)+27 Who=Dealer.Cnt ELSE X=(Player.Cnt&3)*40+52 Y=(Player.Cnt&$FC)+79 Who=Player.Cnt FI Who==&3 PMCreate(Who,CrdBrd,22,4,X,Y) RETURN ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; CARD FUNC CardPos(BYTE Who) CARD X,Y CARD ARRAY XPos=[6 11 16 21], YPos=[2 3 4] IF Who THEN Y=YPos(Dealer.Cnt RSH 2)*20 Who=Dealer.Cnt Dealer.Cnt==+1 ELSE Y=YPos(Player.Cnt RSH 2)*20+220 Who=Player.Cnt Player.Cnt==+1 FI Who==&3 X=XPos(Who) X==+SavMsc+Y RETURN(X) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; BYTE FUNC DplCard(BYTE card,Who) BYTE i,Crd,Value BYTE ARRAY SUIT=[HEART CLUB DIAMOND SPADE], Face=[$1A $21] BYTE POINTER Bp,Bp1 Bp=CardPos(Who) Bp1=Bp+60 CrdFlip(Who) FOR i=0 TO 2 DO Bp1^=0 Bp1==+1 OD Bp1==+18 Value=card MOD 13 i=Value card==/13 IF Value THEN IF Value=10 THEN Crd=CrdClr(1,card) Bp1==+1 Bp1^=Crd Bp1==-2 Bp^=Crd Bp==+1 Value=0 ELSEIF Value=1 THEN Value=$11 ELSEIF Value>10 THEN Value=Face(Value-11) FI ELSE Value=$1B FI Crd=CrdClr(Value,card) Bp^=Crd Bp==+1 Bp^=SUIT(card) Bp1^=SUIT(card) Bp1==+1 Bp1^=Crd RETURN(i) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; PROC Wait() WHILE Peek(764)=255 DO OD Poke(764,255) RETURN ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; PROC Rotate(BYTE speed) BYTE Colour=$D019, VCnt=$D40B, c,w,v,nc=[0] CARD Time=19 Time=0 DO FOR w=0 TO speed DO c=nc DO WSync=0 Colour=c c==+1 UNTIL VCnt&128 OD OD nc==+1 UNTIL tick+256*tock>300 OD RETURN ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; PROC Initialize() CHAR c BYTE ARRAY Revr=[5 10 21 25] BYTE POINTER Bp,Bp1 CARD POINTER Cp Graphics(1+16) BkGrnd=$86 Color(0)=$42 Color(1)=$86 Color(2)=0 Color(3)=$D6 Bp=DList Bp==-2 FOR c=0 TO 2 DO Bp^=$70 Bp==+1 OD DList==-2 Bp=DList Bp==+3 Bp^=$47 Bp==+3 Bp^=6 Bp==+1 Bp^=6 Cp=DList Cp==+4 Cp^=SavMsc Bp==+10 Cp=Bp+1 PLAddr=Cp Bp^=$67 Cp^=PlrLine+1 Bp==+3 Cp==+3 Bp^=$46 Cp^=SavMsc Cp^==+220 Bp==+15 Cp==+15 Bp^=$41 Cp^=DList VdsLst=HBlnk [ $AD $0F $D4 $29 $40 $F0 $F9 $AD $0E $D4 $09 $80 $8D $0E $D4 ] OldMemHi=MemHi MemHi==-$D00 NwChar=MemHi&$FF00 MoveBlock(NwChar,$E000,$800) MoveBlock(NwChar+40,$E000+512,8) MoveBlock(NwChar+48,$E000+640,8) MoveBlock(NwChar+56,$E000+768,8) MoveBlock(NwChar+64,$E000+984,8) ChBase=NwChar RSH 8 PMGraphics(2) GPrior=$14 FOR c=0 TO 3 DO PMClear(c) PMColor(c,0,10) SetHBlk(Revr(c)) OD FOR c=4 TO 7 DO PMClear(c) PMCreate(c,CrdBck,21,4,0,0) OD PrintDE(6," BLACKJACK") Rotate(3) Close (1) Open(1,"K:",4) RETURN ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; PROC Shuffle() BYTE c,i SetBlock(Deck,52,1) c=0 Delt=0 WHILE HoldCrd(c) DO i=HoldCrd(c) Deck(i)=0 Delt==+1 c==+1 OD RowCrs=0 ColCrs=5 PrintD(6,"shuffling") Rotate(7) ColCrs=5 PrintD(6," Dealer ") RETURN ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; BYTE FUNC Deal() BYTE c IF (Delt&$3F)>51 THEN Shuffle() Delt==%$80 FI DO c=Rand(52) UNTIL Deck(c) OD Deck(c)=0 Delt==+1 RETURN(c) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; PROC Delay() CARD Slow FOR Slow=0 TO 1500 DO OD RETURN ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; PROC Results(BYTE Speed,Locate) Rotate(Speed) ColCrs=Locate PrintD(6," ") RETURN ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; PROC Busted() ColCrs=8 PrintD(6,"bust") Results(3,8) RETURN ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; PROC Flip() BYTE c FOR c=4 TO 7 DO PMMove(c,0,0) OD RETURN ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; INT FUNC GetCrd(BYTE w) BYTE c INT H c=Deal() HoldCrd(HldCnt)=c c=DplCard(c,w) H=CrdAmt(w,c) HldCnt==+1 RETURN(H) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; INT FUNC DlrHand() BYTE c INT Hand WHO POINTER dealer dealer=Dealer Hand=dealer.Amt DO Flip() IF (Hand>0 AND Hand<17) OR (Hand=17 AND dealer.Ace>0) THEN Timer(1) Hand=GetCrd(1) Timer(1) IF Hand<0 THEN EXIT FI ELSE EXIT FI OD RowCrs=1 RETURN(Hand) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; INT FUNC PlrHand() BYTE c INT Hand WHO POINTER player player=Player Hand=player.Amt DO RowCrs=12 ColCrs=0 IF (Hand=10 OR Hand=11) AND player.Cnt=2 THEN PrintD(6,"STAND DOUBLEDOWN HIT") ELSE PrintD(6," HITSTAND") FI DO UNTIL CH#255 OD c=CH CH=255 c==&$3F IF c=$3E THEN EXIT FI IF c=$39 THEN Hand=GetCrd(0) IF Hand<0 THEN EXIT FI FI IF c=$3A AND (Hand=10 OR Hand=11) AND player.Cnt=2 THEN PlrBet==LSH 1 Hand=GetCrd(0) Timer(1) EXIT FI IF c=$1C THEN Hand=0 EXIT FI OD ColCrs=0 RowCrs=12 PrintD(6," ") ColCrs=0 RowCrs=12 RETURN(Hand) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; PROC Scroll(BYTE dir) BYTE d IF dir THEN FOR d=0 TO 15 DO VScrol=d Delay() OD ELSE FOR d=0 TO 15 DO VScrol=15-d Delay() OD FI RETURN ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; PROC GetBet() BYTE c,i,j BYTE ARRAY BnkLn(10) DO j=1 Zero(BetLine+7,5) Zero(BetLine+15,5) StrI(PlrBank,BnkLn) FOR c=1 TO BnkLn(0) DO BnkLn(c)==+$60 OD SAssign(BetLine,BnkLn,7,BnkLn(0)+7) Scroll(1) PLAddr^=BetLine+1 Scroll(0) i=0 c=GetD(1) WHILE c#155 DO IF c=$1B THEN PlrBet=-1 RETURN ELSEIF c>='0 AND c<='9 THEN i==+1 BnkLn(i)=c BnkLn(0)=i BetLine(i+15)=c+$60 ELSEIF c=127 THEN i==-1 IF i>10 THEN i=0 FI BetLine(i+16)=0 BnkLn(0)=i FI c=GetD(1) OD Scroll(1) PLAddr^=PlrLine+1 Scroll(0) PlrBet=ValI(BnkLn) UNTIL PlrBet>1 OD RETURN ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; BYTE FUNC Insur() BYTE i CARD Time=19 Time=0 i=0 Position(6,11) PrintD(6,"Insurance?") WHILE tock=1 DO IF CH#255 THEN PrintD(6,"Yes") i=1 Timer(2) EXIT FI OD Position(6,11) PrintD(6," ") RETURN(i) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; PROC Play() BYTE c,m,i INT Hand,DlrHnd,PlrHnd,X,Y WHO POINTER player,dealer player=Player dealer=Dealer DO ClrTable() IF Delt>40 THEN Shuffle() FI GetBet() IF PlrBet<0 THEN RETURN FI FOR m= 4 TO 7 DO PMMove(m,117+m*5,28) OD FOR HldCnt=0 TO 3 DO c=Deal() HoldCrd(HldCnt)=c c=DplCard(c,HldCnt&1) CrdAmt(HldCnt&1,c) OD i=0 IF (HoldCrd(1) MOD 13)=1 THEN i=Insur() IF dealer.Amt#21 AND i=1 THEN Position(3,11) PrintD(6,"Took insurance") Timer(3) Position(3,11) PrintD(6," ") PlrBank==-(PlrBet RSH 1) FI FI DO IF dealer.Amt<21 AND player.Amt<21 THEN Hand=PlrHand() IF Hand=0 THEN RETURN FI IF Hand<0 THEN Flip() Busted() PlrBank==-PlrBet EXIT FI Hand=DlrHand() IF Hand<0 THEN Busted() PlrBank==+PlrBet EXIT FI ELSE Flip() FI IF player.Amt=21 AND player.Cnt=2 THEN PlrBet== LSH 1 FI RowCrs=12 ColCrs=7 IF player.Amt>dealer.Amt THEN PrintD(6,"winner") PlrBank==+PlrBet ELSEIF player.Amt 2 THEN mode = 0 FI Zero(PM_Hpos,8) ; move them off the screen Zero(PMHpos,8) Zero(PMVpos,8) Zero(PM_Width,5) Zero(GraphP0,5) IF PM_Mode#0 THEN HiMem=OldHiMem DMACtl=$22 GRACtl=0 FI IF mode=0 THEN ; turn off pmg DMACtl=$22 GRACtl=0 ELSE IF mode=1 THEN ;sgl line DMACtl=$3E ELSE ;dbl line DMACtl=$2E FI OldHiMem=HiMem PM_BaseAdr=(HiMem-PM_MemSize(mode)-$80)&PM_AdrMask(mode) PMBase=PM_BaseAdr RSH 8 IF PM_BaseAdr=4 THEN n=0 ELSE n==+1 FI RETURN(PM_BaseAdr+PM_Waste(PM_Mode)+(n*PM_BSize(PM_Mode))) ;************************************ ;Zero out a P/M's memory block ;************************************ PROC PMClear(BYTE n) CARD ctr BYTE ARRAY PlayAdr n==&7 PlayAdr=PMAdr(n) IF n<4 THEN Zero(PlayAdr,PM_BSize(PM_Mode)) ELSE n==-4 FOR ctr=0 TO PM_BSize(PM_Mode)-1 DO PlayAdr(ctr)==&PM_MisMask(n) OD FI RETURN ;************************************ ;Move a P/M to an absolute (x,y) po- ;sition ;************************************ PROC PMMove(BYTE n,x,y); CARD i BYTE yOffset, plLength, mask1,mask2 INT deltaY BYTE ARRAY temp(256),PlPtr IF PM_Mode=0 THEN RETURN FI n==&7 deltaY = y deltaY = deltaY-PMVpos(n) IF deltaY=0 THEN PM_Hpos(n)=x PMHpos(n)=x RETURN FI PlPtr=PMAdr(n) plLength=PM_BSize(PM_Mode) IF deltaY>=0 THEN yOffset=deltaY ELSE yOffset=plLength+deltaY FI IF n<4 THEN mask1=255 mask2=0 ELSE mask2=PM_MisMask(n&3) mask1=mask2!$FF FI ;This piece of code was replaced by the ;following code block to increase speed. ; ; FOR i=0 to plLength-1 ; DO ; temp(i)=plPtr(i)&mask1 ; OD [ $A0 0 ; LDY #0 $AD PlPtr ; LDA PLPTR $85 $A0 ; STA $A0 $AD PlPtr+1 ; LDA PLPTR+1 $85 $A1 ; STA $A1 ;LOOP $B1 $A0 ; LDA ($A0),Y $2D mask1 ; AND MASK1 $99 temp ; STA TEMP,Y $C8 ; INY $CC plLength ; CPY PLLENGTH $D0 $F2 ; BNE LOOP ] ;This piece of code was replaced by the ;following code block to increase speed. ; ; FOR i=0 to plLength-1 ; DO ; plPtr(yOffset)==&mask2 %temp(i) ; yOffset==+1 ; IF yOffset>=plLength THEN ; yOffset=0 ; FI ; OD [ $A2 0 ; LDX #0 $AC yOffset ; LDY YOFFSET $AD PlPtr ; LDA PLPTR $85 $A0 ; STA $A0 $AD PlPtr+1 ; LDA PLPTR+1 $85 $A1 ; STA $A1 ;LOOP $B1 $A0 ; LDA ($A0),Y $2D mask2 ; AND MASK2 $1D temp ; ORA TEMP,X $91 $A0 ; STA ($A0),Y $C8 ; INY $CC plLength ; CPY PLLENGTH $D0 2 ; BNE ISLOW $A0 0 ; LDY #0 ;ISLOW $E8 ; INX $EC plLength ; CPX PLLENGTH $D0 $E8 ; BNE LOOP ] PMVpos(n)=y PM_Hpos(n)=x PMHpos(n)=x RETURN ;************************************ ;Create a P/M ;************************************ PROC PMCreate(BYTE n BYTE ARRAY pm BYTE len,width,x,y) BYTE i,mask,temp,ntemp, oldwidth=[0] BYTE ARRAY plPtr, miswidth=[0 1 0 3] n==&7 IF n<4 THEN mask=0 ELSE ntemp=n&3 mask=PM_MisMask(ntemp) FI plPtr=PMAdr(n) FOR i=0 TO len-1 DO plPtr(i+y)==&mask%pm(i) OD width==-1 IF n<4 THEN PM_Width(n)=width ELSE temp=(miswidth(width) LSH (ntemp LSH 1)) oldwidth==&mask%temp PM_Width(4)=oldwidth FI PM_Hpos(n)=x PMHpos(n)=x PMVpos(n)=y RETURN ;************************************ ;Test for P/M collision ;************************************ BYTE FUNC PMHit(BYTE n,cnum) BYTE ARRAY pmtopf(8)=$D000, pmtop(8)=$D008 n==&7 IF n<4 THEN n==+4 ELSE n==-4 FI IF cnum<4 THEN RETURN ((pmtop(n) RSH cnum) & 1) ELSE cnum==&3 RETURN ((pmtopf(n) RSH cnum) & 1) FI RETURN (0) ;************************************ ;Replace Library Graphics routine so ;that P/Ms are reset when bitmap modes ;are changed. ;************************************ PROC Graphics(BYTE mode) PMGraphics(0) Close(6) Open(6,"S:",(mode&$F0)!$1C,mode) RETURN ; End of PMG.ACT MODULE ;end of pmg.act