| <-prev [Thread] next-> | <-prev [Date] next-> | 
|
| Month Index | List Home | ||
|
Subject: [stella] Euchre From: "Erik J. Eid" <eeid@xxxxxxxxx> Date: Fri, 13 Jul 2001 19:46:25 -0400 |
;
; Euchre game program for the Atari 2600 video computer system
;
; Copyright 2001 by Erik Eid (eeid@xxxxxxxxx)
;
; Last update: July 13, 2001
;
; Compiled with the dasm assembler using the -f3 option
;
processor 6502
include vcs.h
; Constants
seg.u defines
CardsInDeck = $18 ; 24 cards in a Euchre deck
CardsInHand = $05
HighRandInShuffle = 240 ; when shuffling, throw out random numbers higher than
; this (256 does not divide evenly by 24, but 240 does)
Team1Color = $88
Team2Color = $38
TableRegionColor = $d4
CardTableColor = $0f
RedSuitColor = $36
BlackSuitColor = $00
MessageRegionDisplayColor = $22
MessageRegionChoiceColor = $84
MessageTextColor = $1c
CursorColor = $82
RankMask = %00000111 ; Bit mask for rank of a card
DispSuitMask = %00011000 ; Bit mask for suit displayed on a card
RealSuitMask = %01100000 ; Bit mask for suit used when following (the left
; bower becomes the suit of the right bower)
CardHiddenMask = %10000000 ; Bit mask for determining if a card is hidden
ShowCardMask = %01111111 ; Bit mask to force a card to be shown
; This mask is used only when calculating the strength of a hand
; because they rely on the original rank and suit of a card
RankSuitMask = %00011111 ; Bit mask for rank and suit combined
AceRankValue = %00000101
KingRankValue = %00000100
JackRankValue = %00000010
BlackSuitMask = %00010000
FlipColorSuitMask = %00001000 ; EOR with this to change suit to other suit
; of the same color
PlayersMask = %00000011
NoPlayer = %11111111 ; Since players are numbered 0-3, a 255 indicates
; that no player meets the condition
SWACNT = $281 ; Strangely not part of the original vcs.h
VS_Disable = 0 ; Ditto
CenterRankPos = $75 ; Player positions
CenterSuitPos = $66
LeftRankPos = $a2
RightRankPos = $57
MessageP0Pos = $44
MessageP1Pos = $c4
NoCursorPos = $05
MsgNumBlank = $00
MsgNumSelect = $01
MsgNumSwap = $02
MsgNumPass = $03
MsgNumOrder = $04
MsgNumCall = $05
MsgNumAlone = $06
MsgNumTrumpHearts = $07
MsgNumTrumpDiamonds = $08
MsgNumTrumpClubs = $09
MsgNumTrumpSpades = $0a
MsgNumDeal = $0b
MsgNumGameOver = $0c
MsgNumSouth = $0d
MsgNumWest = $0e
MsgNumNorth = $0f
MsgNumEast = $10
StageHold = $00
StageNewGame = $01
StageNewHand = $02
StageGameOver = $03
StageShuffle = $04
StageDeal = $05
StageBidding1 = $06
StageDiscarding = $07
StageBidding2 = $08
FramesWait = 90 ; Number of frames to wait for 1 1/2 seconds
SubturnShowName = $00
SubturnShowBid = $01
ChoicePass = $00
ChoiceCall = $01
ChoiceAlone = $02
TriggerOff = $00
TriggerOn = $01
TriggerHeld = $02
; Variables
seg.u vars
org $80
Team1Score ds 1
Team2Score ds 1
Team1Tricks ds 1
Team2Tricks ds 1
SouthHand ds 5 ; Cards in a player's hand
WestHand ds 5
NorthHand ds 5
EastHand ds 5
SouthCard ds 1 ; Cards down on the table
WestCard ds 1
NorthCard ds 1
EastCard ds 1
ImgPtr1 ds 2 ; Pointers to playfield and player images
ImgPtr2 ds 2
ImgPtr3 ds 2
ImgPtr4 ds 2
ImgPtr5 ds 2
ImgPtr6 ds 2
HandCard ds 1 ; Pointer to a card in a hand
T1 ds 1 ; Temporary variables used in subroutines
T2 ds 1
T3 ds 1
T4 ds 1
rand1 ds 1 ; Locations to hold bits of random number
rand2 ds 1
rand3 ds 1
rand4 ds 1
NeedShuffle ds 1 ; Flag indicating if a shuffle is needed
MessageNum ds 1 ; Number of message to display
MessagePtr ds 2
CursorPos ds 1 ; Card selection cursor position
Stage ds 1
Turn ds 1
Subturn ds 1
Dealer ds 1
FrameCounter ds 1
NumTrumps ds 1
NumOffLoneAces ds 1
NumVoids ds 1
NumInSuit ds 1
HasRight ds 1
HasLeft ds 1
HasTrumpAce ds 1
HasAce ds 1
Upcard ds 1
PossibleTricks ds 1
RightBowerMask ds 1 ; Calculated masks for bower when figuring hand strength
LeftBowerMask ds 1
Choice ds 1
TriggerTrack ds 1 ; Low four bits are number of frames held, high bit
; indicates release after a full hold
MessageRegionColor ds 1 ; Color to use as background of message area
PaddlePos ds 1
DeckStart = SouthHand
Upcards = SouthCard
; Program
seg code
org $f000 ; 4K cartridge
;
; Initialization
;
CartStart
sei ; Disable all interrupts
cld ; Clear decimal mode (so carry is at 256, not 100)
ldx #$ff
txs ; Reset the stack pointer to the highest point possible
; Clear out registers and variables
lda #$00
ClearRAM
sta $00,x
dex
bne ClearRAM ; Loop does not zero WSYNC, but it's not needed
sta SWACNT ; Tell port A to accept input
lda #$6d ; seed random number generator
sta rand1
sta rand2
sta rand3
sta rand4
lda #NoCursorPos
sta CursorPos
lda #$80
ldx #CardsInDeck
HideLoop
dex
sta DeckStart,x
bne HideLoop
jsr StartGameOver
jmp Main
ProgStart
;
; Main loop
;
Main
; Start of display kernel
; Provide three lines of vertical sync
lda #VB_DumpPots + #VB_Enable
sta VBLANK
lda #VS_Enable
sta WSYNC
sta WSYNC
sta WSYNC
sta VSYNC
sta WSYNC
sta WSYNC
; sta WSYNC
lda #VS_Disable
sta VSYNC
lda #VB_Enable
sta VBLANK ; Start recharge of paddle
; Provide 37 scanlines of vertical blank
lda #43 ; 37 lines * 76 cycles/line = 2812 cycles / 64 cycles/interval = 43.96 intervals
sta TIM64T
; When it comes time, check console switches here
lda NeedShuffle
beq PostShuffle
jsr ShuffleDeck
lda #$00
sta NeedShuffle
PostShuffle
jsr RandomBit ; keep the randomness flowing
lda #$00
sta PaddlePos ; Clear paddle position counter
lda SWCHA
and #J0_Right ; Joystick 0 right is same as paddle 0 trigger
beq TriggerPressed
lda TriggerTrack
cmp #TriggerOff
beq TriggerEnd
lda #TriggerOff
jmp TriggerEnd
TriggerPressed
lda TriggerTrack
cmp #TriggerOn
beq TriggerWasHeld
lda #TriggerOn
jmp TriggerEnd
TriggerWasHeld
lda #TriggerHeld
TriggerEnd
sta TriggerTrack
WaitVBlank
lda INTIM
nop
bne WaitVBlank
sta WSYNC ; Finish up last line
sta VBLANK ; Stop vertical blank (accumulator holds zero)
; Now we start on the visible portion of the screen
; First eight lines are blank...
lda #9 ; 8 lines * 76 cycles/line = 608 cycles / 64 cycles/interval = 9.5 intervals
sta TIM64T
; Since we have some time, prepare the playfield for displaying the scores
; and get pointers to playfield images for them.
lda #Team1Color
sta COLUP0
lda #Team2Color
sta COLUP1
lda #PF_Score
sta CTRLPF
ldx Team1Score
ldy #ImgPtr1
jsr GetScoreImage
ldx Team2Score
ldy #ImgPtr2
jsr GetScoreImage
lda INPT0
bmi Charged01
inc PaddlePos
Charged01
WaitEndScore
lda INTIM
nop
bne WaitEndScore
; Now we spend ten lines drawing the scores on the playfield
ldx #$09
ScoresLoop
sta WSYNC
txa
lsr
tay
lda (ImgPtr1),y
sta PF1
ror T1
ror T1
nop
nop
nop
lda (ImgPtr2),y
sta PF1
dex
bpl ScoresLoop
; Pause for four lines and prepare to show tricks
sta WSYNC
lda #$00
sta PF1
lda #4
sta TIM64T
lda INPT0
bmi Charged02
inc PaddlePos
Charged02
WaitBeginTricks
lda INTIM
nop
bne WaitBeginTricks
; Trick graphics are four lines with the same value, so the offset into
; the TrickImages table is for the number of tricks rather than the xth
; byte of an image.
ldy #$04
TricksLoop
sta WSYNC
ldx Team1Tricks
lda TrickImages,x
sta PF1
ror T1
ror T1
nop
nop
nop
ldx Team2Tricks
lda TrickImages,x
sta PF1
dey
bne TricksLoop
; Pause for eight more lines.
sta WSYNC
lda #$00
sta PF1
lda #7
sta TIM64T
; Position the players for display of a card. This is well in advance but
; we have time now.
lda #CenterRankPos
ldx #0
jsr PositionPlayer
lda #CenterSuitPos
ldx #1
jsr PositionPlayer
sta WSYNC
sta HMOVE
lda INPT0
bmi Charged03
inc PaddlePos
Charged03
WaitBeginTable
lda INTIM
nop
bne WaitBeginTable
; Now switch to the "card table" display
sta WSYNC
lda #TableRegionColor
sta COLUBK
lda #CardTableColor
sta COLUPF
lda #PF_Reflect
sta CTRLPF
lda #$0f
sta PF1
lda #$ff
sta PF2
lda NorthCard
ldx #ImgPtr1
ldy #ImgPtr2
jsr GetCardGraphics
sta COLUP0
sta COLUP1
jsr DrawSingleCard
lda #$00
sta GRP0
sta GRP1
lda INPT0
bmi Charged04
inc PaddlePos
Charged04
; Now we come to the hard one... both West and East
lda #P_TwoClose ; Two copies close
sta NUSIZ0
sta NUSIZ1
lda WestCard
ldx #ImgPtr1
ldy #ImgPtr3
jsr GetCardGraphics
sta COLUP0
lda EastCard
ldx #ImgPtr2
ldy #ImgPtr4
jsr GetCardGraphics
sta COLUP1
lda #LeftRankPos
ldx #0
jsr PositionPlayer
lda #RightRankPos
ldx #1
jsr PositionPlayer
; sta WSYNC
; sta HMOVE
jsr DrawTwoCards
lda #$00
sta GRP0
sta GRP1
sta NUSIZ0
sta NUSIZ1
lda #CenterRankPos
ldx #0
jsr PositionPlayer
lda #CenterSuitPos
ldx #1
jsr PositionPlayer
sta WSYNC
sta HMOVE
lda INPT0
bmi Charged05
inc PaddlePos
Charged05
lda SouthCard
ldx #ImgPtr1
ldy #ImgPtr2
jsr GetCardGraphics
sta COLUP0
sta COLUP1
jsr DrawSingleCard
lda #4
sta TIM64T
WaitEndSouth
lda INTIM
nop
bne WaitEndSouth
lda #9 ; burn 8 lines
sta TIM64T
lda #$00
sta COLUBK
sta PF1
sta PF2
lda INPT0
bmi Charged06
inc PaddlePos
Charged06
WaitBeforeHand
lda INTIM
nop
bne WaitBeforeHand
; Draw the five cards in the player's hand. For each of the cards, draw four
; black lines then twelve card lines. The middle eight lines of the card have
; the images. During the four black lines, get the image pointers and player
; colors.
lda #$00
sta HandCard
ShowHandLoop
lda #4
sta TIM64T
lda #$00
sta COLUBK
sta PF2
ldx HandCard
lda SouthHand,x
ldx #ImgPtr1
ldy #ImgPtr2
jsr GetCardGraphics
sta COLUP0
sta COLUP1
WaitToDrawHandCard
lda INTIM
nop
bne WaitToDrawHandCard
lda INPT0
bmi Charged07
inc PaddlePos
Charged07
lda #$f0
sta PF2
sta WSYNC
sta WSYNC
lda HandCard
cmp CursorPos
beq ShowCursor
lda #$00
jmp SC
ShowCursor
lda #CursorColor
SC
sta COLUBK
jsr DrawSingleCard
lda #$00
sta GRP0
sta GRP1
sta WSYNC
sta COLUBK
sta WSYNC
sta WSYNC
inc HandCard
lda HandCard
cmp #$05
bne ShowHandLoop
; Now the gap between the last card and the message region
lda #13
sta TIM64T
lda #$00
sta COLUBK
sta PF2
sta COLUP0
sta COLUP1
; Prepare for the message section
lda #MessageP0Pos
ldx #0
jsr PositionPlayer
lda #MessageP1Pos
ldx #1
jsr PositionPlayer
sta WSYNC
sta HMOVE
ldx MessageNum
ldy #MessagePtr
jsr GetMessagePointer
jsr GetMessageImages
lda INPT0
bmi Charged08
inc PaddlePos
Charged08
WaitForGap
lda INTIM
nop
bne WaitForGap
sta WSYNC
lda MessageRegionColor
sta COLUBK
lda #19 ; 16 lines of message
sta TIM64T
lda #P_ThreeClose
sta NUSIZ0
sta NUSIZ1
lda #MessageTextColor
sta COLUP0
sta COLUP1
lda #$01
sta VDELP0
sta VDELP1
sta WSYNC
sta WSYNC
jsr DrawMessageText
lda #$00
sta VDELP0
sta VDELP1
lda #$00
sta GRP0
sta GRP1
sta WSYNC
WaitForMessage
lda INTIM
nop
bne WaitForMessage
lda #$00
sta COLUPF
lda INPT0
bmi Charged09
inc PaddlePos
Charged09
lda #9 ; 8 lines
sta INTIM
lda #$00
sta WSYNC
sta PF1
sta PF2
sta COLUBK
sta COLUP0
sta COLUP1
sta COLUPF
sta CTRLPF
sta GRP0
sta GRP1
sta NUSIZ0
sta NUSIZ1
WaitForEnd
lda INTIM
nop
bne WaitForEnd
sta WSYNC
lda #35 ; 30 lines of overscan
sta TIM64T
lda #$02
sta VBLANK
CheckReset
lda SWCHB
and #$01
cmp #$01
beq CheckStages
jsr StartNewGame
jmp ProgStart
CheckStages
lda Stage
cmp #StageHold
bne CheckNewGame
;
jmp EndCase
CheckNewGame
cmp #StageNewGame
bne CheckNewHand
jsr PerformNewGame
jmp EndCase
CheckNewHand
cmp #StageNewHand
bne CheckGameOver
jsr PerformNewHand
jmp EndCase
CheckGameOver
cmp #StageGameOver
bne CheckShuffle
;
jmp EndCase
CheckShuffle
cmp #StageShuffle
bne CheckDealing
jsr PerformShuffle
jmp EndCase
CheckDealing
cmp #StageDeal
bne CheckBidding1
jsr PerformDeal
jmp EndCase
CheckBidding1
cmp #StageBidding1
bne CheckDiscarding
jsr PerformBidding1
jmp EndCase
CheckDiscarding
cmp #StageDiscarding
bne CheckBidding2
jsr PerformDiscarding
jmp EndCase
CheckBidding2
cmp #StageBidding2
bne EndCase
jsr PerformBidding2
jmp EndCase
EndCase
WaitOverscan
lda INTIM
nop
bne WaitOverscan
sta WSYNC
jmp Main
StartBidding1
lda #StageBidding1
sta Stage
clc
lda Dealer
adc #$01
and #PlayersMask
sta Turn
lda Turn
beq SB1SouthBids
lda #MessageRegionDisplayColor
jmp SB1a
SB1SouthBids
lda #MessageRegionChoiceColor
SB1a
sta MessageRegionColor
lda Turn
clc
adc #MsgNumSouth
sta MessageNum
lda #FramesWait
sta FrameCounter
lda #SubturnShowName
sta Subturn
rts
PerformBidding1
lda Turn
bne PB1NotSouth ; Handle case of human player separately
jmp PB1South ; Can't beq PB1South - too far away
PB1NotSouth
dec FrameCounter
beq PB1TimeToAct
rts ; Can't bne PB1End - too far away
PB1TimeToAct
lda Subturn
cmp #SubturnShowBid
beq PB1Advance
lda #SubturnShowBid
sta Subturn
jsr AnalyzeHand
lda Choice
cmp #ChoicePass
bne PB1Call
lda #MsgNumPass
jmp PB1SetMessage
PB1Call
cmp #ChoiceCall
bne PB1Alone
lda #MsgNumCall
jmp PB1SetMessage
PB1Alone
lda #MsgNumAlone
PB1SetMessage
sta MessageNum
lda #FramesWait
sta FrameCounter
rts
PB1Advance
lda Choice
cmp #ChoicePass
beq PB1Pass
jsr StartDiscarding
rts
PB1Pass
lda Turn
cmp Dealer ; Did the dealer just pass?
beq PB1DealerPass ; Yes!
clc ; No, advance to the next player
lda Turn
adc #$01
and #PlayersMask
sta Turn
lda Turn
beq PB1SouthBids
lda #MessageRegionDisplayColor
jmp PB1a
PB1SouthBids
lda #MessageRegionChoiceColor
PB1a
sta MessageRegionColor
lda Turn
clc
adc #MsgNumSouth
sta MessageNum
lda #FramesWait
sta FrameCounter
lda #SubturnShowName
sta Subturn
rts
PB1DealerPass
jsr StartBidding2
rts
PB1South
lda TriggerTrack
cmp #TriggerOn
beq PB1Advance
lda PaddlePos
cmp #$0a
bmi PB1S1
lda #ChoicePass
sta Choice
lda #MsgNumPass
sta MessageNum
rts
PB1S1
cmp #$04
bmi PB1S2
lda #ChoiceCall
sta Choice
lda #MsgNumCall
sta MessageNum
rts
PB1S2
lda #ChoiceAlone
sta Choice
lda #MsgNumAlone
sta MessageNum
rts
PB1End
rts
StartBidding2
lda #StageHold
sta Stage
rts
PerformBidding2
rts
StartDiscarding
lda #StageHold
sta Stage
rts
PerformDiscarding
rts
StartShuffle
lda #StageShuffle
sta Stage
lda #$08
sta Turn
lda #MsgNumDeal
sta MessageNum
rts
PerformShuffle
lda Turn
cmp #$07
bne SkipRefresh
jsr RefreshDeck
SkipRefresh
jsr ShuffleDeck
dec Turn
bpl PSOut
jsr StartDeal
PSOut
rts
StartDeal
lda #StageDeal
sta Stage
lda #MsgNumDeal
sta MessageNum
rts
PerformDeal
ldx #$04
DealLoop
lda SouthHand,x
and #ShowCardMask
sta SouthHand,x
dex
bpl DealLoop
ldx Dealer
lda Upcards,x
and #ShowCardMask
sta Upcards,x
jsr StartBidding1
rts
StartNewGame
lda #StageNewGame
sta Stage
lda #MsgNumBlank
sta MessageNum
lda #MessageRegionDisplayColor
sta MessageRegionColor
rts
PerformNewGame
lda #$00
sta Team1Score
sta Team2Score
lda rand1
and #PlayersMask
sta Dealer
jsr StartNewHand
rts
StartNewHand
lda #StageNewHand
sta Stage
lda #MsgNumBlank
sta MessageNum
lda #MessageRegionDisplayColor
sta MessageRegionColor
rts
PerformNewHand
lda #$00
sta Team1Tricks
sta Team2Tricks
lda Dealer
adc #$01
and #PlayersMask
sta Dealer
jsr StartShuffle
rts
StartGameOver
lda #StageGameOver
sta Stage
lda #MsgNumGameOver
sta MessageNum
lda #MessageRegionDisplayColor
sta MessageRegionColor
rts
; analyze a hand for its ability to take tricks
;
; x = offset to hand's first card
; y = mask of potential trump suit
AnalyzeHand
stx T1
sty T2
lda #$00
sta NumTrumps
sta NumOffLoneAces
sta NumVoids
sta HasRight
sta HasLeft
sta HasTrumpAce
lda T2
adc #JackRankValue
sta RightBowerMask
lda T2
eor #FlipColorSuitMask
adc #JackRankValue
sta LeftBowerMask
; Check on the trumps in the hand
ldx #CardsInHand-1
AHCountLoop1
lda T1,x
and #RealSuitMask
cmp T2 ; Is this card a trump?
bne AHNotTrump ; No, so do nothing more with it, unless the left bower
AHIsTrump
inc NumTrumps ; Yes! Add one more to the count
lda T1,x
and #RankSuitMask
cmp RightBowerMask ; Is the card the jack of trump?
bne AHNotRight ; No, check for other ranks
inc HasRight ; Yes, it's the right bower!
jmp AHCL1
AHNotTrump
lda T1,x
and #RankSuitMask
cmp LeftBowerMask ; It's not of the trump suit, but is it the left bower?
beq AHIsTrump ; It is the left bower; return to analyzing this card
jmp AHCL1
AHNotRight
cmp LeftBowerMask ; Is the card the jack of the suit
; of the same color as trump?
bne AHNotLeft ; No, check for other ranks
inc HasLeft ; Yes, it's the left bower!
jmp AHCL1
AHNotLeft
cmp #AceRankValue ; Is the card the ace of trump?
bne AHCL1 ; No, give up...
inc HasTrumpAce ; Yes, it's the ace of trump!
AHCL1
dex
bpl AHCountLoop1
; Check on voids and off-suit lone aces, looping once through
; the hand for each non-trump suit
ldy #$03
AHCountLoop2
ldx #$00
sta NumInSuit
ldx #CardsInHand-1
AHCountLoop3
tya
lsr
lsr
lsr ; a = mask of suit being examined
sta T3
cmp T2 ; Is this loop for trump?
beq AHCL2 ; Yes, advance out of the inner loop
lda T1,x
and #RealSuitMask
cmp T3 ; Is this card in the suit we're examining?
bne AHCL3 ; no, so ignore it
inc NumInSuit ; Yes, increase our count of the suit
lda T1,x
and #RankMask
cmp #AceRankValue ; Is this card an ace?
bne AHCL3 ; No, carry on
inc HasAce ; Yes, indicate we have the ace of this suit
AHCL3
dex
bpl AHCountLoop3
lda NumInSuit
bne AHNotVoid ; If a <> 0, we had a card in the suit
inc NumVoids ; If a = 0, we were void in the suit
jmp AHCL2
AHNotVoid
lda AHNotVoid
cmp #$01 ; Did we have just one card in the suit?
bne AHCL2 ; No, so we didn't get an off-suit lone ace
lda HasAce
beq AHCL2 ; If a = 0, we do not have any aces in the suit
inc NumOffLoneAces ; If a <> 0, we have an off-suit lone ace!
AHCL2
dey
bpl AHCountLoop2
; Now calculate the number of tricks this hand will probably take.
; It's possible to calculate for greater than five since this is just
; an estimate. Hands that will take five tricks will be played alone.
GetPossibleTricks
lda #$00
sta PossibleTricks
lda HasRight ; Do we have the right bower?
beq PT1 ; No, move on to next check
inc PossibleTricks ; Yes - a guaranteed trick!
PT1
lda NumOffLoneAces ; Do we have any off-suit lone aces?
beq PT2 ; No, move on to next check
inc PossibleTricks ; Yes - hand will likely take a trick with
; one of them (two is pushing it)
PT2
lda NumTrumps
cmp #$02 ; Does hand have more than two trumps?
bcc PT3 ; No, move on to next check
sec
sbc #$02 ; Find number of trumps over two...
clc ; then increase the likely tricks by that number
adc PossibleTricks ; (there are only seven trumps, so if one hand
sta PossibleTricks ; has three, no player is likely to have more than two)
PT3
lda HasLeft ; Does hand have the left bower?
beq PT4 ; No, move on to next check
lda NumTrumps
cmp #$01 ; Is the left bower the only trump?
bne PT3a ; No, there is more than one
lda NumVoids ; Do we have a void?
bne PT4 ; No void and the left bower is alone, so it will
; possibly be taken by the right bower
PT3a
inc PossibleTricks ; Left bower is not alone or it is and there is a void,
; so the bower should take a trick
PT4
lda HasTrumpAce ; Does hand have the ace of trump?
beq PT5 ; No, move on to next check
lda NumTrumps
cmp #$01 ; Is the ace the only trump?
bne PT4a ; No, there is more than one
lda NumVoids ; Do we have a void?
bne PT5 ; No void and the ace is alone, so it will probably
; be taken by the right or left bower
PT4a
inc PossibleTricks ; Ace is not alone or it is and there is a void, so
; the bower should take a trick
PT5
lda Dealer
eor Turn ; Bit 0 will be 1 if the upcard goes to an opponent
and #$01 ; Does upcard belong to opponent?
bne PT6 ; No, move on to next check
lda Upcard
and #RankSuitMask
cmp RightBowerMask ; Is the upcard the right bower?
beq PT5a ; Yes!
lda Upcard ; No, check for another rank
and #RankMask
cmp #KingRankValue ; Is the upcard king or better? (It can't be the
; left bower, since an upturned jack will always
; be the right bower.)
bmi PT6 ; No; upcard is queen, ten, or nine
PT5a
dec PossibleTricks ; Upcard is king, ace, or right bower, so it will
; probably get a trick.
PT6
lda Dealer
cmp Turn ; Is the dealer also the current bidder?
bne PT7 ; No, move on to next check
lda NumTrumps
cmp #$05 ; Does hand already have five trumps?
beq PT7 ; Yes, so upcard won't have much effect
cmp #$02 ; Does hand have at least two trumps?
bmi PT6a
inc PossibleTricks ; Yes, hand will therefore have from three to five
; trumps, adding a probable trick
PT6a
lda Upcard
and #RankSuitMask
cmp RightBowerMask ; Is the upcard the right bower?
bne PT6b ; No, check for another rank
inc PossibleTricks ; Yes, and it will take a trick
PT6b
lda NumTrumps
cmp #$01 ; Does hand have only one trump?
bne PT7
lda HasLeft ; Yes - find if it is the left bower or ace
ora HasTrumpAce
beq PT7 ; The trump is low
inc PossibleTricks ; Addition of upcard can be used to protect the
; left bower or ace, so it should get a trick
PT7
DecideBid
lda PossibleTricks
cmp #$05 ; Likely to take five tricks?
bne DB1 ; No, move on...
lda #ChoiceAlone ; Go alone!
jmp DBEnd
DB1
cmp #$03 ; Likely to take three or four tricks?
bmi DB2 ; No, move on...
lda #ChoiceCall ; Yes, pick or order up or call trump
jmp DBEnd
DB2
cmp #$02 ; Likely to take two tricks?
bne DB3 ; No, move on...
lda Turn
and #$01 ; If last bit is set, bidder is west or east
beq DBNS ; Bidder is north or south
lda Team2Score
tax
lda Team1Score
tay
jmp DB2a
DBNS
lda Team1Score
tax
lda Team2Score
tay
; The end result is that x has "our" score
; and y has "their" score
DB2a
txa
cmp #$09 ; Do we have nine points?
bne DB2b ; No, move on...
tya
cmp #$08 ; Does the other team have eight or more points?
bpl DB2b ; Yes, go to next check
cmp #$06 ; Does the other team have six or seven points?
bmi DB2b ; No, go to next check
lda #ChoiceCall ; With score 9-6 or 9-7, it's better to risk a euchre
; than a march
jmp DBEnd
DB2b
tya
cmp #$08 ; Does the other team have eight points?
bne DB2c ; No, move on...
lda #ChoicePass ; Pass to avoid a euchre
jmp DBEnd
DB2c
txa
cmp #$06 ; Do we have six points?
bne DB2d ; No, move on...
tya
cmp #$04 ; Does the other team have four or more points?
bpl DB2d ; Yes, go to next check
cmp #$02 ; Does the other team have two or three points?
bmi DB2d ; No, go to next check
lda #ChoiceCall ; Call to protect the lead (a march would let the
; other team catch up and another would win the
; game for them)
jmp DBEnd
DB2d
lda #ChoicePass ; With two tricks and no other compelling factors, pass
jmp DBEnd
DB3
lda #ChoicePass ; Pass when likely to take one trick or no tricks
DBEnd
sta Choice
rts ; Whew!
; Routines that get an image from a table
;
; a = image number out of the set
; y = offset to the addresses to receive the pointer
GetScoreImage
txa
asl
tax
lda ScoreImageTable,x
sta $00,y
lda ScoreImageTable+1,x
sta $01,y
rts
GetRankImage
txa
asl
tax
lda RankImageTable,x
sta $00,y
lda RankImageTable+1,x
sta $01,y
rts
GetSuitImage
txa
asl
tax
lda SuitImageTable,x
sta $00,y
lda SuitImageTable+1,x
sta $01,y
rts
GetLetterImage
txa
asl
tax
lda LetterImageTable,x
sta $00,y
lda LetterImageTable+1,x
sta $01,y
rts
GetMessagePointer
txa
asl
tax
lda MessageTable,x
sta $00,y
lda MessageTable+1,x
sta $01,y
rts
GetMessageImages
ldy #$06
MessageImageLoop
dey
sty T4
lda (MessagePtr),y
tax
tya
asl
adc #ImgPtr1
tay
jsr GetLetterImage
ldy T4
bne MessageImageLoop
rts
; All images are reversed since they are read by decrementing loops.
; routine to draw a single card
; assumes ImgPtr1 and ImgPtr2 point to proper images, sprites are
; positioned, and so on
org $fb00
DrawSingleCard
ldy #$07
DrawCardLoop
sta WSYNC
lda (ImgPtr1),y
sta GRP0
lda (ImgPtr2),y
sta GRP1
dey
bpl DrawCardLoop
rts
; routine to draw two cards
; assumes ImgPtr1-4 point to proper images, sprites are positioned,
; and so on
DrawTwoCards
sta WSYNC
sta HMOVE
ldy #$07
DrawCardLoop2
nop
nop
ror T1
ror T1
lda (ImgPtr3),y
tax
lda (ImgPtr1),y
sta GRP0
stx GRP0
pha
lda (ImgPtr4),y
tax
lda (ImgPtr2),y
sta GRP1
nop
stx GRP1
pla
sta WSYNC
dey
bpl DrawCardLoop2
rts
; Six-digit score display
; original version by Robert Colbert in the Stella mailing list message
; "Re: [stella] Displaying scores - how?" from March 11, 1997
; (http://www.biglist.com/lists/stella/archives/199703/msg00219.html)
DrawMessageText
sta WSYNC
ldy #7
sty T2
loop2
ldy T2
lda (ImgPtr1),y
sta GRP0
sta WSYNC
lda (ImgPtr2),y
sta GRP1
lda (ImgPtr3),y
sta GRP0
lda (ImgPtr4),y
sta T1
lda (ImgPtr5),y
tax
lda (ImgPtr6),y
tay
lda T1
sta GRP1
stx GRP0
sty GRP1
sta GRP0
dec T2
bne loop2
rts
; routine to shuffle the deck
RefreshDeck
ldx #CardsInDeck
RD1
dex
lda NewDeck,x
sta DeckStart,x
bne RD1
rts
ShuffleDeck
ldx #CardsInDeck
OneShuffle
dex
stx T1
SD1
jsr RandomByte
cmp #HighRandInShuffle
bcs SD1
SD2
cmp #CardsInDeck
bcc SD3
sec
sbc #CardsInDeck
jmp SD2
SD3
ldx T1
tay
lda DeckStart,x
sta T2
lda DeckStart,y
sta DeckStart,x
lda T2
sta DeckStart,y
ldx T1
bne OneShuffle
rts
org $fc00
MessageBlank
.byte $00,$00,$00,$00,$00,$00
MessageSelect
.byte $13,$05,$0c,$05,$03,$14
MessageSwap
.byte $00,$13,$17,$01,$10,$00
MessagePass
.byte $00,$10,$01,$13,$13,$00
MessageOrder
.byte $0f,$12,$04,$05,$12,$00
MessageCall
.byte $00,$03,$01,$0c,$0c,$00
MessageAlone
.byte $01,$0c,$0f,$0e,$05,$00
MessageTrumpHearts
.byte $14,$12,$15,$0d,$10,$1b
MessageTrumpDiamonds
.byte $14,$12,$15,$0d,$10,$1c
MessageTrumpClubs
.byte $14,$12,$15,$0d,$10,$1d
MessageTrumpSpades
.byte $14,$12,$15,$0d,$10,$1e
MessageDeal
.byte $00,$04,$05,$01,$0c,$00
MessageGameOver
.byte $00,$0f,$16,$05,$12,$00
MessageSouth
.byte $13,$0f,$15,$14,$08,$00
MessageWest
.byte $00,$17,$05,$13,$14,$00
MessageNorth
.byte $0e,$0f,$12,$14,$08,$00
MessageEast
.byte $00,$05,$01,$13,$14,$00
MessageTable
.word MessageBlank
.word MessageSelect
.word MessageSwap
.word MessagePass
.word MessageOrder
.word MessageCall
.word MessageAlone
.word MessageTrumpHearts
.word MessageTrumpDiamonds
.word MessageTrumpClubs
.word MessageTrumpSpades
.word MessageDeal
.word MessageGameOver
.word MessageSouth
.word MessageWest
.word MessageNorth
.word MessageEast
org $fd00
; routine to position a player
; original version by Erik Mooney in the Stella mailing list message
; "Re: [stella] sexp8.bin Multi-Japanese Sprites" from April 18, 1998
; (http://www.biglist.com/lists/stella/archives/199804/msg00170.html)
; modified to work on both player 0 and 1 and to take a hard-coded
; position value rather than look at a table (there is no motion in
; this game, so the table is not necessary)
;
; a = position value - high nybble = fine position, low nybble =
; course position
; x = player number
PositionPlayer
sta WSYNC
ror T1 ; waste 5 cycles
sta HMP0,x
and #$0f
tay
P0
dey
bpl P0
sta RESP0,x
; Rather than WSYNC and HMOVE now, let the calling routine do it. If both
; players are positioned in succession, this saves a scanline.
rts
; routine to generate a random number
; original version by Erik Mooney in the Stella mailing list message
; "Re: [stella] demo update: PCMSD20.BIN" from April 14, 1997
; (http://www.biglist.com/lists/stella/archives/199704/msg00136.html)
; requires four memory locations to be reserved for generation
;
; returns: a = random number
RandomBit
lda rand4
asl
asl
asl
eor rand4 ;new bit is now in bit 6 of A
asl
asl ;new bit is now in carry
rol rand1 ;shift new bit into bit 0 of register; bit 7 goes into carry
rol rand2 ;shift old bit 7 into bit 8, etc.
rol rand3
rol rand4
rts
RandomByte
ldx #8
RandomByte1
jsr RandomBit
dex
bne RandomByte1
lda rand1
rts
; routine for getting images and colors of a card
; a = card
; x = image pointer for rank
; y = image pointer for suit
; returns: a = color of card
GetCardGraphics
sta T1
stx T2
sty T3
and #RankMask
tax
ldy T2
jsr GetRankImage
lda T1
and #DispSuitMask
lsr
lsr
lsr
tax
ldy T3
jsr GetSuitImage
lda T1
and #CardHiddenMask
bne HideCard
lda T1
and #BlackSuitMask
bne CardIsBlack
lda #RedSuitColor
jmp LeaveGetCardGraphics
CardIsBlack
lda #BlackSuitColor
jmp LeaveGetCardGraphics
HideCard
lda #CardTableColor
LeaveGetCardGraphics
rts
org $fe00
; All images are reversed since they are read by decrementing loops.
LetterImageSpace
.byte $00,$00,$00,$00,$00,$00,$00,$00 ;
LetterImageA
.byte $00,$c6,$c6,$fe,$fe,$c6,$7c,$38 ; A
LetterImageB
.byte $00,$7c,$66,$66,$7c,$66,$66,$7c ; B
LetterImageC
.byte $00,$3c,$66,$60,$60,$60,$66,$3c ; C
LetterImageD
.byte $00,$7c,$66,$66,$66,$66,$66,$7c ; D
LetterImageE
.byte $00,$7e,$60,$60,$78,$60,$60,$7e ; E
LetterImageF
.byte $00,$60,$60,$60,$78,$60,$60,$7e ; F
LetterImageG
.byte $00,$3c,$66,$66,$6e,$60,$66,$3c ; G
LetterImageH
.byte $00,$66,$66,$66,$7e,$66,$66,$66 ; H
LetterImageI
.byte $00,$7e,$18,$18,$18,$18,$18,$7e ; I
LetterImageJ
.byte $00,$3c,$66,$06,$06,$06,$06,$0e ; J
LetterImageK
.byte $00,$66,$6c,$78,$70,$78,$6c,$66 ; K
LetterImageL
.byte $00,$7e,$60,$60,$60,$60,$60,$60 ; L
LetterImageM
.byte $00,$c6,$c6,$c6,$d6,$fe,$ee,$c6 ; M
LetterImageN
.byte $00,$c6,$c6,$ce,$de,$f6,$e6,$c6 ; N
LetterImageO
.byte $00,$3c,$66,$66,$66,$66,$66,$3c ; O
LetterImageP
.byte $00,$60,$60,$60,$7c,$66,$66,$7c ; P
LetterImageQ
.byte $00,$3a,$64,$6a,$66,$66,$66,$3c ; Q
LetterImageR
.byte $00,$66,$66,$66,$7c,$66,$66,$7c ; R
LetterImageS
.byte $00,$3c,$66,$06,$3c,$60,$66,$3c ; S
LetterImageT
.byte $00,$18,$18,$18,$18,$18,$18,$7e ; T
LetterImageU
.byte $00,$3c,$66,$66,$66,$66,$66,$66 ; U
LetterImageV
.byte $00,$10,$38,$6c,$c6,$c6,$c6,$c6 ; V
LetterImageW
.byte $00,$c6,$ee,$fe,$d6,$c6,$c6,$c6 ; W
LetterImageX
.byte $00,$c6,$c6,$6c,$38,$6c,$c6,$c6 ; X
LetterImageY
.byte $00,$18,$18,$18,$3c,$66,$66,$66 ; Y
LetterImageZ
.byte $00,$7e,$60,$30,$18,$0c,$06,$7e ; Z
SuitImageHeart
.byte $00,$10,$38,$7c,$fe,$fe,$ee,$44
SuitImageDiamond
.byte $00,$10,$38,$7c,$fe,$7c,$38,$10
SuitImageClub
.byte $00,$18,$7e,$ff,$7e,$18,$3c,$18
SuitImageSpade
.byte $00,$38,$ba,$fe,$fe,$7c,$38,$10
RankImage9
.byte $00,$3c,$46,$06,$3e,$66,$66,$3c
RankImage10
.byte $00,$ee,$5b,$5b,$5b,$5b,$db,$4e
RankImageLeft
.byte $00,$ec,$8a,$8a,$8c,$8a,$8a,$8c ; debug "LB"
RankImageRight
.byte $00,$ac,$aa,$aa,$cc,$aa,$aa,$cc ; debug "RB"
RankImageTable
.word RankImage9
.word RankImage10
.word LetterImageJ
.word LetterImageQ
.word LetterImageK
.word LetterImageA
.word RankImageLeft
.word RankImageRight
SuitImageTable
.word SuitImageHeart
.word SuitImageDiamond
.word SuitImageClub
.word SuitImageSpade
ScoreImage0
.byte $07,$05,$05,$05,$07
ScoreImage1
.byte $07,$02,$02,$06,$02
ScoreImage2
.byte $07,$04,$07,$01,$07
ScoreImage3
.byte $07,$01,$03,$01,$07
ScoreImage4
.byte $01,$05,$07,$01,$01
ScoreImage5
.byte $07,$01,$07,$04,$07
ScoreImage6
.byte $07,$04,$07,$05,$07
ScoreImage7
.byte $04,$04,$02,$01,$07
ScoreImage8
.byte $07,$05,$02,$05,$07
ScoreImage9
.byte $07,$01,$07,$05,$07
ScoreImage10
.byte $77,$25,$25,$65,$27
ScoreImage11
.byte $72,$22,$22,$62,$22
ScoreImage12
.byte $77,$24,$27,$61,$27
ScoreImage13
.byte $77,$21,$23,$61,$27
ScoreImageTable
.word ScoreImage0
.word ScoreImage1
.word ScoreImage2
.word ScoreImage3
.word ScoreImage4
.word ScoreImage5
.word ScoreImage6
.word ScoreImage7
.word ScoreImage8
.word ScoreImage9
.word ScoreImage10
.word ScoreImage11
.word ScoreImage12
.word ScoreImage13
TrickImages
.byte $00,$01,$05,$15,$55,$FF
LetterImageTable
.word LetterImageSpace
.word LetterImageA
.word LetterImageB
.word LetterImageC
.word LetterImageD
.word LetterImageE
.word LetterImageF
.word LetterImageG
.word LetterImageH
.word LetterImageI
.word LetterImageJ
.word LetterImageK
.word LetterImageL
.word LetterImageM
.word LetterImageN
.word LetterImageO
.word LetterImageP
.word LetterImageQ
.word LetterImageR
.word LetterImageS
.word LetterImageT
.word LetterImageU
.word LetterImageV
.word LetterImageW
.word LetterImageX
.word LetterImageY
.word LetterImageZ
.word SuitImageHeart
.word SuitImageDiamond
.word SuitImageClub
.word SuitImageSpade
NewDeck
.byte $80,$81,$82,$83,$84,$85
.byte $a8,$a9,$aa,$ab,$ac,$ad
.byte $d0,$d1,$d2,$d3,$d4,$d5
.byte $f8,$f9,$fa,$fb,$fc,$fd
org $fffc
.word CartStart
.word CartStart
Attachment:
Euchre.bin
Description: Binary data
"Cartridge.MD5" "66362890eb78d6ea65301592cce65f5b" "Cartridge.Name" "Euchre" "Cartridge.Manufacturer" "Erik Eid" "Cartridge.Rarity" "New Release" "Cartridge.Type" "4K" "Controller.Left" "Paddles" "Display.Format" "NTSC" ""
| Current Thread |
|---|
|
| <- Previous | Index | Next -> |
|---|---|---|
| RE: RE: [stella] ET improvements, erik-dos486 | Thread | [stella] Program.., nj bloodline |
| [stella] The Core, Andrew Davie | Date | [stella] Program.., nj bloodline |
| Month |