| <-prev [Thread] next-> | <-prev [Date] next-> | 
|
| Month Index | List Home | ||
|
Subject: [stella] Euchre: successful optimization! From: "Erik J. Eid" <eeid@xxxxxxxxx> Date: Sun, 25 Nov 2001 20:02:41 -0500 |
;
; Euchre game program for the Atari 2600 video computer system
;
; Copyright 2001 by Erik Eid (eeid@xxxxxxxxx)
;
; Last update: November 25, 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
TricksInRound = $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)
FullSuitMask = %01111000 ; Bit mask for both display and real suit
CardHiddenMask = %10000000 ; Bit mask for determining if a card is hidden
ShowCardMask = %01111111 ; Bit mask to force a card to be shown
HideCardValue = %10000000 ; Bit mask to force a card to be hidden
CardPlayedMask = %10000000
CardPlayedValue = %10000000
; 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
RightRankValue = %00000111
LeftRankValue = %00000110
AceRankValue = %00000101
KingRankValue = %00000100
JackRankValue = %00000010
HeartSuitValue = %00000000
DiamondSuitValue = %00101000
ClubSuitValue = %01010000
SpadeSuitValue = %01111000
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
MsgNumAloneHearts = $0b
MsgNumAloneDiamonds = $0c
MsgNumAloneClubs = $0d
MsgNumAloneSpades = $0e
MsgNumDeal = $0f
MsgNumGameOver = $10
MsgNumSouth = $11
MsgNumWest = $12
MsgNumNorth = $13
MsgNumEast = $14
MsgNumPoint = $15
MsgNumEuchre = $16
MsgNumMarch2 = $17
MsgNumMarch4 = $18
StageHold = $00
StageNewGame = $01
StageNewHand = $02
StageGameOver = $03
StageShuffle = $04
StageDeal = $05
StageBidding1 = $06
StageDiscarding = $07
StageBidding2 = $08
StagePlaying = $09
StageAddToTricks = $0a
StageAddToScore = $0b
StageBetweenHands = $0c
FramesWait = 90 ; Number of frames to wait for 1 1/2 seconds
FramesShortWait = 45 ; Number of frames to wait for 3/4 second
SubturnShowName = $00
SubturnShowBid = $01
SubturnSelectBid = $01
SubturnSelectSuit = $02
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
RightBowerMask ds 1 ; Calculated masks for bower when figuring hand strength
LeftBowerMask 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
HighCardScore ds 1
HighCardNum ds 1
TrumpSuitMask ds 1
HandStartOffset ds 1
HandEndOffset ds 1
Choice ds 1
Overlay ds 15
DeckStart = SouthHand
Upcards = SouthCard
seg.u vars
org Overlay
PotentialTrump ds 1
Upcard ds 1
DeclinedSuit ds 1
HighPsblTrks ds 1
BestSuit ds 1
PossibleTricks ds 1
CardScore ds 1
NumInSuit ds 1
NumTrumps ds 1
NumOffLoneAces ds 1
NumVoids ds 1
HasRight ds 1
HasLeft ds 1
HasTrumpAce ds 1
HasAce ds 1
seg.u vars
org Overlay
TrickNum ds 1
Leader ds 1
LeadSuitMask ds 1
HasLeadSuit ds 1
BiddingTeam ds 1
PlayerToSkip ds 1
TrickWinner ds 1
CardInTrickNum ds 1
CardsInFullTrick ds 1
CardToPlay ds 1
CardToPlayOffset ds 1
LeadSuitCount ds 1
HighCard ds 1
; 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 ; These initializations are done when Reset is pressed
lda #NoCursorPos
sta CursorPos
lda #TriggerOff
sta TriggerTrack
;
; 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 #TriggerOff
bne TriggerWasHeld
lda #TriggerOn
jmp TriggerEnd
TriggerWasHeld
lda #TriggerHeld
TriggerEnd
sta TriggerTrack
WaitVBlank
lda INTIM
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
sta WSYNC ; Stabilizer
WaitEndScore
lda INTIM
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
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
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
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
lda #$00
sta GRP0
sta GRP1
WaitEndSouth
lda INTIM
bne WaitEndSouth
sta WSYNC ; Stabilizer
lda #9 ; burn 8 lines
sta TIM64T
lda #$00
sta COLUBK
sta PF1
sta PF2
lda INPT0
bmi Charged06
inc PaddlePos
Charged06
; sta WSYNC ; Stabilizer
WaitBeforeHand
lda INTIM
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
bne WaitToDrawHandCard
sta WSYNC
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
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
sta WSYNC
sta WSYNC
sta WSYNC
jsr DrawMessageText
lda #$00
sta GRP0
sta GRP1
sta VDELP0
sta VDELP1
WaitForMessage
lda INTIM
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
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
asl
asl
sta T1
lda Stage
asl
clc
adc T1
clc
adc #<StageJumpTable
sta T2
lda #>StageJumpTable
adc #$00
sta T3
jmp (T2)
StageJumpTable
jsr PerformHold
jmp EndCase
jsr PerformNewGame
jmp EndCase
jsr PerformNewHand
jmp EndCase
jsr PerformGameOver
jmp EndCase
jsr PerformShuffle
jmp EndCase
jsr PerformDeal
jmp EndCase
jsr PerformBidding1
jmp EndCase
jsr PerformDiscarding
jmp EndCase
jsr PerformBidding2
jmp EndCase
jsr PerformPlaying
jmp EndCase
jsr PerformAddToTricks
jmp EndCase
jsr PerformAddToScore
jmp EndCase
jsr PerformBetweenHands
EndCase
WaitOverscan
lda INTIM
bne WaitOverscan
sta WSYNC
jmp Main
StartHolding ; Stop the action - only used during development
lda #StageHold
sta Stage
PerformHold
rts
StartBidding1
lda #StageBidding1
sta Stage
jsr StartBidding
rts
StartBidding
clc
lda Dealer
adc #$01
and #PlayersMask
sta Turn
lda Turn
beq SBSouthBids
lda #SubturnShowName
sta Subturn
lda #MessageRegionDisplayColor
jmp SB1
SBSouthBids
lda #SubturnSelectBid
sta Subturn
lda #MessageRegionChoiceColor
SB1
sta MessageRegionColor
lda Turn
clc
adc #MsgNumSouth
sta MessageNum
lda #FramesWait
sta FrameCounter
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
ldx Turn
jsr GetHandOffsets
lda Upcard
and #FullSuitMask
sta PotentialTrump
jsr AnalyzeHand
jsr DecideBid
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
lda Upcard
and #FullSuitMask
sta TrumpSuitMask
jsr CreateBowers
jsr StartDiscarding
; jsr StartPlaying
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
lsr
tax
lda PaddleToChoiceValue,x
sta Choice
lda PaddleToChoiceMessage,x
sta MessageNum
PB1End
rts
StartBidding2
lda #StageBidding2
sta Stage
ldx Dealer
lda Upcards,x
ora #HideCardValue
sta Upcards,x
and #FullSuitMask
sta DeclinedSuit
jsr StartBidding
rts
PerformBidding2
lda Turn
bne PB2NotSouth ; Handle case of human player separately
jmp PB2South ; Can't beq PB2South - too far away
PB2NotSouth
dec FrameCounter
beq PB2TimeToAct
rts ; Can't bne PB2End - too far away
PB2TimeToAct
lda Subturn
cmp #SubturnShowBid
bne PB2StartShowBid
jmp PB2Advance
PB2StartShowBid
lda #SubturnShowBid
sta Subturn
ldx Turn
jsr GetHandOffsets
lda #$00
sta HighPsblTrks
lda #$03
sta T3
PB2FindBestSuit
lda T3
tax
lda PaddleToSuitValue,x
sta T4
lda DeclinedSuit
cmp T4
beq PB2Declined
lda T4
sta PotentialTrump
jsr AnalyzeHand
lda PossibleTricks
jmp PB2CheckIfHigh
PB2Declined
lda #$00
PB2CheckIfHigh
cmp HighPsblTrks ; Is the number of possible tricks with the suit
; being checked as trump better than the best
; suit so far?
bcc PB2NextSuit ; No, carry on to the next suit
sta HighPsblTrks ; Yes, store this number and set the best suit
lda T4
sta BestSuit
PB2NextSuit
dec T3
bpl PB2FindBestSuit
lda HighPsblTrks
sta PossibleTricks
jsr DecideBid ; Submit the highest possible tricks to be taken
; with this hand to get a choice
lda Choice
cmp #ChoicePass
bne PB2Bid
lda #MsgNumPass
jmp PB2SetMessage
PB2Bid
lda BestSuit
and #RealSuitMask ; Transform suit mask into index between 0 and 3
lsr ; Suit is now in bits 5 and 4
lsr ; Suit is now in bits 4 and 3
lsr ; Suit is now in bits 3 and 2
lsr ; Suit is now in bits 2 and 1
lsr ; Suit is now in bits 1 and 0
sta T1
lda Choice
cmp #ChoiceCall
bne PB2Alone
lda #MsgNumTrumpHearts
clc
adc T1 ; Add number derived from suit to message to show
; the correct chosen suit
jmp PB2SetMessage
PB2Alone
lda #MsgNumAloneHearts
clc
adc T1
PB2SetMessage
sta MessageNum
lda #FramesWait
sta FrameCounter
rts
PB2Advance
lda Choice
cmp #ChoicePass
beq PB2Pass
lda BestSuit
sta TrumpSuitMask
jsr CreateBowers
jsr StartPlaying
rts
PB2Pass
lda Turn
cmp Dealer ; Did the dealer just pass?
beq PB2DealerPass ; Yes!
clc ; No, advance to the next player
lda Turn
adc #$01
and #PlayersMask
sta Turn
lda Turn
beq PB2SouthBids
lda #SubturnShowName
sta Subturn
lda #MessageRegionDisplayColor
jmp PB2a
PB2SouthBids
lda #SubturnSelectBid
sta Subturn
lda #MessageRegionChoiceColor
PB2a
sta MessageRegionColor
lda Turn
clc
adc #MsgNumSouth
sta MessageNum
lda #FramesWait
sta FrameCounter
rts
PB2DealerPass
jsr StartHolding
; Throw hand in and start a fresh one
rts
PB2South
lda Subturn
cmp #SubturnSelectBid ; Is the player making a bid or choosing trump?
bne PB2SouthSuit ; Choosing trump, so jump
lda TriggerTrack
cmp #TriggerOn
bne PB2S0
lda Choice ; Player pressed trigger, so bid is submitted
cmp #ChoicePass ; Did the human player pass?
beq PB2Advance ; Yes, go to the next player
lda #SubturnSelectSuit ; No, in the next frame player will select a suit
sta Subturn
rts
PB2S0
lda PaddlePos
lsr
tax
lda PaddleToChoiceValue,x
sta Choice
lda PaddleToChoiceMessage,x
sta MessageNum
rts
PaddleToChoiceValue
.byte #ChoiceAlone, #ChoiceAlone, #ChoiceCall, #ChoiceCall
.byte #ChoiceCall, #ChoicePass, #ChoicePass, #ChoicePass
PaddleToChoiceMessage
.byte #MsgNumAlone, #MsgNumAlone, #MsgNumCall, #MsgNumCall
.byte #MsgNumCall, #MsgNumPass, #MsgNumPass, #MsgNumPass
PB2SouthSuit
lda TriggerTrack
cmp #TriggerOn
bne PB2SouthSelecting
lda BestSuit ; South selected a suit by pressing the trigger
cmp DeclinedSuit ; Is this suit the one that was turned down?
beq PB2ChoseDeclined ; Yes, reject the chosen suit
jmp PB2Advance ; No, accept the chosen suit
PB2ChoseDeclined
; buzz?
rts
PB2SouthSelecting
lda PaddlePos
lsr
lsr
tax
lda PaddleToSuitValue,x
sta BestSuit
lda PaddleToSuitMessage,x
sta MessageNum
rts
PaddleToSuitValue
.byte #SpadeSuitValue, #ClubSuitValue, #DiamondSuitValue, #HeartSuitValue
PaddleToSuitMessage
.byte #MsgNumTrumpSpades, #MsgNumTrumpClubs
.byte #MsgNumTrumpDiamonds, #MsgNumTrumpHearts
cmp #$0b
bmi PB2S3
lda #MsgNumTrumpHearts
sta MessageNum
lda #HeartSuitValue
sta BestSuit
rts
PB2S3
cmp #$08
bmi PB2S4
lda #MsgNumTrumpDiamonds
sta MessageNum
lda #DiamondSuitValue
sta BestSuit
rts
PB2S4
cmp #$04
bmi PB2S5
lda #MsgNumTrumpClubs
sta MessageNum
lda #ClubSuitValue
sta BestSuit
rts
PB2S5
lda #MsgNumTrumpSpades
sta MessageNum
lda #SpadeSuitValue
sta BestSuit
rts
StartDiscarding
lda #StageDiscarding
sta Stage
lda #MsgNumSwap
sta MessageNum
lda #MessageRegionDisplayColor
sta MessageRegionColor
ldx Dealer
jsr GetHandOffsets
lda Upcards,x
and #FullSuitMask
sta PotentialTrump
rts
PerformDiscarding
lda Dealer
bne PDNotSouth ; Handle case of human player separately
jmp PDSouth ; Can't beq PDSouth - too far away
PDNotSouth
lda #$00
sta HighCardScore ; Assume highest rating of a card is zero
ldx HandEndOffset
stx HighCardNum ; Assume the best card is the last one
PDCardLoop1
lda DeckStart,x ; Get a card from the hand
and #RankMask ; Extract its rank
eor #RankMask ; Effectively inverts rank, turning high to low
sta CardScore ; Starts the card's score as seven minus its rank
lda DeckStart,x
and #FullSuitMask
cmp PotentialTrump ; Is this card a trump?
beq PDCardTrump ; Yes, do not add to the score
lda CardScore
clc
adc #$08 ; Card is not trump; add 8 to its score
sta CardScore
lda DeckStart,x
and #RankMask
cmp #AceRankValue ; Is this card an off-suit ace?
beq PDCardAce ; Yes, do not check if it's alone
lda DeckStart,x
and #FullSuitMask
sta T1 ; T1 will hold the suit of this card so we can use
; it to count how many of the same suit we have
stx T2 ; Stow the current loop index for recovery later
lda #$00
sta NumInSuit
ldx HandEndOffset
PDCardLoop2
lda DeckStart,x
and #FullSuitMask
cmp T1 ; Is this card of the same suit?
bne PDC1 ; No, move on
inc NumInSuit ; Yes, increment count of the suit
PDC1
dex
cpx HandStartOffset
bpl PDCardLoop2
ldx T2 ; Restore the original loop index
lda NumInSuit
cmp #$01 ; Is this card the only one of its suit?
bne PDC2 ; No, there are others
lda CardScore ; Yes, it's the only one of the suit
clc
adc #$08 ; Add 8 to its card score to encourage voiding
sta CardScore
PDCardAce
PDC2
PDCardTrump
lda CardScore
cmp HighCardScore ; Is the score of the current card the highest?
bcc PDC3 ; No, go on to the next card
lda CardScore ; Yes, save the score and the index of the card
sta HighCardScore
stx HighCardNum
PDC3
dex
cpx HandStartOffset
bpl PDCardLoop1
lda HighCardNum
jmp PDSwap
PDSouth
lda TriggerTrack
cmp #TriggerOn
bne PDSouthSelecting
lda CursorPos
clc
adc HandStartOffset
jmp PDSwap
PDSouthSelecting
jsr GetSelection
rts
PDSwap ; Assumes index of card to swap is in accumulator
tax
lda DeckStart,x
sta T1
txa
tay ; Save its index in the y register
ldx Dealer
lda Upcards,x ; Get the upcard (need original because dealer might
; not be the bidder)
sta T2 ; Save the upcard
tya ; Retrieve index of card to swap
tax
lda T2 ; Retrieve upcard
sta DeckStart,x ; Place upcard in hand
ldx Dealer
lda T1 ; Retrieve card to be swapped
ora #HideCardValue
sta Upcards,x ; Discard it!
jsr StartPlaying
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
sta Upcard ; Save upcard for use in AnalyzeHand
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
clc
adc #$01
and #PlayersMask
sta Dealer
jsr StartShuffle
rts
StartGameOver
lda #StageGameOver
sta Stage
lda #MsgNumGameOver
sta MessageNum
lda #MessageRegionDisplayColor
sta MessageRegionColor
rts
PerformGameOver
rts
StartPlaying
lda TrumpSuitMask ; Has both display and "real" suit during bidding
and #RealSuitMask
sta TrumpSuitMask ; Now has only "real" suit
lda #$00
sta TrickNum
lda Choice
cmp #ChoiceAlone
beq SPCalcSkip
lda #$04
sta CardsInFullTrick
lda #NoPlayer
jmp SPDoSkip
SPCalcSkip
lda #$03
sta CardsInFullTrick
lda Turn
clc
adc #$02
and #PlayersMask
SPDoSkip
sta PlayerToSkip
lda Turn
and #$01
sta BiddingTeam
lda Dealer
SPAdvanceLeader
clc
adc #$01
and #PlayersMask
cmp PlayerToSkip
beq SPAdvanceLeader
sta Leader
sta Turn
ContinuePlaying
lda #StagePlaying
sta Stage
lda #MsgNumBlank
sta MessageNum
lda #NoCursorPos
sta CursorPos
lda #$00
sta CardInTrickNum
lda #FramesWait
sta FrameCounter
rts
PerformPlaying
lda Turn
bne PPNotSouth
jmp PPSouth
PPNotSouth
dec FrameCounter
lda FrameCounter
cmp #FramesWait-1
beq PPTimeToAct
cmp #$00
beq PPAdvance
rts
PPAdvance
inc CardInTrickNum
lda CardInTrickNum
cmp CardsInFullTrick
beq PPTrickComplete
lda Turn
PPAdvanceTurn
clc
adc #$01
and #PlayersMask
cmp PlayerToSkip
beq PPAdvanceTurn
sta Turn
lda #FramesWait
sta FrameCounter
rts
PPTrickComplete
jsr StartAddToTricks
rts
PPTimeToAct
ldx Turn ; This is a stub that simply picks the nth card from
; a computer player's hand, where n is the number of
; the current trick (0-4)
jsr GetHandOffsets
lda TrickNum
clc
adc HandStartOffset
sta CardToPlayOffset
jmp PPPlayCard
PPSouth
lda TriggerTrack
cmp #TriggerOn
bne PPSouthSelecting
ldx Turn
jsr GetHandOffsets
lda CursorPos
clc
adc HandStartOffset
sta CardToPlayOffset
jsr IsCardValidPlay
beq PPInvalidSelection
lda #NoCursorPos
sta CursorPos
jmp PPPlayCard
PPInvalidSelection
; buzz?
rts
PPSouthSelecting
jsr GetSelection
rts
PPPlayCard
ldx CardToPlayOffset
lda DeckStart,x
and #ShowCardMask
sta CardToPlay ; Tuck away the card to be played for safe keeping
lda CardInTrickNum ; Check if this is the first play of the trick
bne PPNotFirst ; It's not the first play of the trick
lda CardToPlay
sta HighCard ; It is the first card of the trick, so it's the
and #RealSuitMask ; winner and its suit is recorded as the led suit
sta LeadSuitMask
lda Turn
sta TrickWinner
jmp PPShowPlay
PPNotFirst
lda CardToPlay
and #RealSuitMask
cmp TrumpSuitMask ; Is the card that was played a trump?
beq PPTrumped ; Yes, go handle it
cmp LeadSuitMask ; The card wasn't trump - is it in the led suit?
beq PPFollowedSuit ; Yes, go handle it
jmp PPShowPlay ; If card isn't trump or in led suit, it can't win,
; so just go show the card
PPFollowedSuit
lda HighCard
and #RealSuitMask
cmp TrumpSuitMask ; Is the current high card a trump?
beq PPShowPlay ; Yes, and the card just played wasn't, so it can't win
lda HighCard ; No, so see if this card beat the high card
and #RankMask
sta T1
lda CardToPlay
and #RankMask
cmp T1 ; Is the card that was played higher than the current
; winning card in the trick?
bmi PPShowPlay ; No, so just show the card
lda CardToPlay ; Yes, save its information
sta HighCard
lda Turn
sta TrickWinner
jmp PPShowPlay
PPTrumped
lda HighCard
and #RealSuitMask
cmp TrumpSuitMask ; Is the current high card a trump?
bne PPTrumpSucceeds ; No, so this card will become high
lda HighCard ; Yes, so we have to see if this card is a higher trump
and #RankMask
sta T1
lda CardToPlay
and #RankMask
cmp T1 ; Is the card that was played higher than the current
; winning card in the trick?
bmi PPShowPlay ; No, so just show the card
PPTrumpSucceeds
lda CardToPlay
sta HighCard
lda Turn
sta TrickWinner
PPShowPlay
ldx Turn
lda CardToPlay
sta Upcards,x ; Put the card on the "table"
ldx CardToPlayOffset
ora #CardPlayedValue
sta DeckStart,x ; Mark the card played as "used"
lda Turn
bne PPOut
jmp PPAdvance ; Force an advance if it's south's turn (jmp needed)
PPOut
rts
StartAddToTricks
lda #StageAddToTricks
sta Stage
lda TrickWinner
and #$01
tax
inc Team1Tricks,x
; sound?
lda #MsgNumBlank
sta MessageNum
lda #MessageRegionDisplayColor
sta MessageRegionColor
lda #FramesShortWait
sta FrameCounter
rts
PerformAddToTricks
dec FrameCounter
beq PAT1
rts
PAT1
ldx #$03
PATClear
lda Upcards,x
ora #CardPlayedValue
sta Upcards,x
dex
bpl PATClear
lda #$00
sta CardInTrickNum
inc TrickNum
lda TrickNum
cmp #TricksInRound
beq PATHandComplete
lda TrickWinner
sta Leader
sta Turn
jsr ContinuePlaying
rts
PATHandComplete
jsr StartAddToScore
rts
StartAddToScore
lda #StageAddToScore
sta Stage
ldx BiddingTeam
lda Team1Tricks,x
cmp #$03
bmi SASEuchre
cmp #$05
beq SASMarch
inc Team1Score,x
lda #MsgNumPoint
sta MessageNum
jmp SAS1
SASEuchre
txa
eor #$01
tax
lda Team1Score,x
clc
adc #$02
sta Team1Score,x
lda #MsgNumEuchre
sta MessageNum
jmp SAS1
SASMarch
lda PlayerToSkip
cmp #NoPlayer
beq SASMarch2
lda #$04
sta T1
lda #MsgNumMarch4
sta T2
jmp SASFive
SASMarch2
lda #$02
sta T1
lda #MsgNumMarch2
sta T2
SASFive
lda Team1Score,x
clc
adc T1
sta Team1Score,x
lda T2
sta MessageNum
SAS1
lda #FramesWait*2
sta FrameCounter
rts
PerformAddToScore
dec FrameCounter
beq PAS1
rts
PAS1
lda Team1Score
cmp #$0a
bpl PASOver
lda Team2Score
cmp #$0a
bpl PASOver
jsr StartBetweenHands
rts
PASOver
; sound?
jsr StartGameOver
rts
StartBetweenHands
lda #StageBetweenHands
sta Stage
lda #MsgNumDeal
sta MessageNum
lda #MessageRegionChoiceColor
sta MessageRegionColor
rts
PerformBetweenHands
lda TriggerTrack
cmp #TriggerOn
bne PBH1
jsr StartNewHand
PBH1
rts
; determine if a card can be played on a trick
;
; Requires values in CardToPlayOffset, HandStartOffset, HandEndOffset,
; Turn, Leader
;
; returns: a = 00 if card cannot be played, 01 if it can
IsCardValidPlay
ldx CardToPlayOffset
lda DeckStart,x
and #CardPlayedMask ; Has the card already been played?
cmp #CardPlayedValue
bne VPAvailable ; No, continue checking
lda #$00 ; Yes, so it cannot be played again
rts
VPAvailable
lda Turn
cmp Leader ; Is this card leading the trick?
beq VPIsLeader ; Yes, so any card can be played
lda DeckStart,x ; Card is not leading the trick
and #RealSuitMask
cmp LeadSuitMask ; Does this card follow the led suit?
beq VPFollowingSuit ; Yes, so it can be played
lda #$00 ; No, check if hand has the led suit
sta LeadSuitCount
ldx HandEndOffset
VPCountLeadSuit
lda DeckStart,x
and #CardPlayedMask ; Was this card already played?
cmp #CardPlayedValue
beq VPAlreadyPlayed ; Yes, so don't bother checking its suit
lda DeckStart,x
and #RealSuitMask
cmp LeadSuitMask ; Is this card in the lead suit?
bne VPNotLeadSuit ; No, carry on
inc LeadSuitCount ; Yes!
VPNotLeadSuit
VPAlreadyPlayed
dex
cpx HandStartOffset
bpl VPCountLeadSuit
lda LeadSuitCount ; Does this hand have a card in the lead suit?
beq VPVoidInLeadSuit ; No, so an off-suit or trump can be played
lda #$00 ; Yes, so this card cannot be played
rts
VPVoidInLeadSuit
VPFollowingSuit
VPIsLeader
lda #$01
rts
; analyze a hand for its ability to take tricks
;
; Requires values in HandStartOffset, HandEndOffset, and PotentialTrump
AnalyzeHand
lda #$00
sta NumTrumps
sta NumOffLoneAces
sta NumVoids
sta HasRight
sta HasLeft
sta HasTrumpAce
lda PotentialTrump
ora #JackRankValue
and #RankSuitMask
sta RightBowerMask
lda PotentialTrump
eor #FlipColorSuitMask
ora #JackRankValue
and #RankSuitMask
sta LeftBowerMask
; Check on the trumps in the hand
ldx HandEndOffset
AHCountLoop1
lda DeckStart,x
and #FullSuitMask
cmp PotentialTrump ; 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 DeckStart,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 DeckStart,x
and #RankSuitMask
cmp LeftBowerMask ; It's not of the trump suit, but is it the left bower?
bne AHCL1 ; No, go on to next card
inc NumTrumps
inc HasLeft
jmp AHCL1
AHNotRight
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
cpx HandStartOffset
bpl AHCountLoop1
; Check on voids and off-suit lone aces, looping once through
; the hand for each non-trump suit
ldy #$03
AHCountLoop2
lda #$00
sta NumInSuit
ldx HandEndOffset
AHCountLoop3
tya ; Suit is in bits 1 and 0
asl ; Suit is in bits 2 and 1
asl ; Suit is in bits 3 and 2
asl ; Suit is in bits 4 and 3
sta T1 ; Hold on to this value
asl ; Suit is in bits 5 and 4
asl ; Suit is in bits 6 and 5
ora T1 ; Suit is in bits 6 and 5 and repeated in 4 and 3
sta T1
cmp PotentialTrump ; Is this loop for trump?
beq AHCL2 ; Yes, advance out of the inner loop
lda DeckStart,x
and #FullSuitMask
cmp T1 ; 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 DeckStart,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
cpx HandStartOffset
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 NumInSuit
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
cmp #$03 ; Do we have all three of them?
bmi PT1a ; No, two or less
lda #$02 ; Yes, count only two of them as likely
jmp PT1b
PT1a
lda NumOffLoneAces
PT1b
sta T1
lda PossibleTricks
clc
adc T1 ; Increase number of possible tricks by number of
; off-suit lone aces (up to two)
sta PossibleTricks
PT2
lda NumTrumps
cmp #$02 ; Does hand have more than two trumps?
bcc PT3 ; No, move on to next check
sbc #$02 ; Find number of trumps over two... (no need to set
; carry since it is implied by bcc not being taken)
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 Stage
cmp #StageBidding1 ; Are we in the first stage of bidding or the second?
beq PTExamineUpcard ; First stage, go ahead with checking the upcard
jmp PT7 ; Second stage, skip check of upcard
PTExamineUpcard
lda Dealer
eor Turn ; Bit 0 will be 1 if the upcard goes to an opponent
and #$01 ; Does upcard belong to opponent?
beq PT6 ; No, move on to next check
lda Upcard
and #RankSuitMask
cmp RightBowerMask ; Is the upcard the right bower?
beq PT5a ; Yes!
lda NumTrumps ; No, see how many trumps the hand has
cmp #$04 ; If this hand has at least four trumps, there are only
; three left to be distributed among three players and
; the leftovers. That makes it less likely the dealer
; will get a void from the exchange.
bcc PT6
PT5a
dec PossibleTricks ; Upcard is right bower or hand has less than four
; trumps, so upcard may take a trick or cause a void
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 #$02 ; Does hand have exactly two trumps?
bne PT6c ; No, go on to next check
lda NumVoids ; Is there a void in this hand?
bne PT6c ; Yes, go on to next check
inc PossibleTricks ; With no voids, the addition of a third trump will
; create one
PT6c
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 PT6d ; 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
PT6d
lda Upcard
and #RankMask
cmp #AceRankValue
bne PT7
inc PossibleTricks ; With only one trump in hand, if the upcard is
; an ace, it may be protected and may (but not
; definitely) cause a void
PT7
rts
DecideBid
lda Stage
cmp #StageBidding1 ; Is this the first round of bidding?
beq DB0 ; Yes...
lda #$00 ; No, then upcard is not a consideration
beq DB0a ; Knowing a = 0, a beq is a savings over a jmp
DB0
lda Dealer
eor Turn ; Bit 0 will be set if the upcard goes to an opponent
and #$01 ; Does upcard belong to opponent?
DB0a
sta T1 ; T1 = 1 if yes, 0 if no
DB1
lda PossibleTricks
cmp #$05 ; Likely to take five tricks?
bmi DB1a ; No, move on...
lda #ChoiceAlone ; Go alone!
jmp DBEnd
DB1a
cmp #$04 ; Likely to take four tricks?
bmi DB2 ; No, move on...
lda T1 ; Yes, will the upcard go to the other team?
beq DB1b ; No...
lda #ChoiceCall ; Yes, call but do not go alone
jmp DBEnd
DB1b
lda #ChoiceAlone ; The upcard does not go to the other team or this is
; the second round, so try going alone
jmp DBEnd
DB2
cmp #$03 ; Likely to take three tricks?
bmi DB3 ; No, move on...
lda #ChoiceCall ; Yes, pick or order up or call trump
jmp DBEnd
DB3
cmp #$02 ; Likely to take two tricks?
bmi DB4 ; No, move on...
lda Turn
and #$01 ; If last bit is set, bidder is west or east
beq DBNS ; Bidder is north or south
ldx Team2Score
ldy Team1Score
jmp DB3a
DBNS
ldx Team1Score
ldy Team2Score
; The end result is that x has "our" score
; and y has "their" score
DB3a
cpx #$09 ; Do we have nine points?
bne DB3b ; No, move on...
cpy #$08 ; Does the other team have eight or more points?
bpl DB3b ; Yes, go to next check
cpy #$06 ; Does the other team have six or seven points?
bmi DB3b ; 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
DB3b
cpy #$08 ; Does the other team have eight points?
bne DB3c ; No, move on...
lda #ChoicePass ; Pass to avoid a euchre
jmp DBEnd
DB3c
cpx #$06 ; Do we have six points?
bne DB3d ; No, move on...
cpy #$04 ; Does the other team have four or more points?
bpl DB3d ; Yes, go to next check
cpy #$02 ; Does the other team have two or three points?
bmi DB3d ; 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
DB3d
lda T1 ; Does upcard belong to opponent?
beq DB3e ; No...
lda #ChoicePass ; Yes, don't risk on this hand
jmp DBEnd
DB3e
lda #ChoiceCall ; With two tricks and no other compelling factors, call
jmp DBEnd
DB4
lda #ChoicePass ; Pass when likely to take one trick or no tricks
DBEnd
sta Choice
rts ; Whew!
; find the zero page address of the first and last cards of a player's hand
; x = hand (0=south, 1=west, 2=north, 3=east)
;
; returns: HandStartOffset = zero page address of first card of desired hand
; HandEndOffset = zero page address of last card of desired hand
GetHandOffsets
stx T1
txa
asl ; Take number of player...
asl ; Multiply by 4...
clc
adc T1 ; Add same number to effectively multiply by 5...
sta HandStartOffset
adc #CardsInHand-1 ; No need to clear carry; previous addition cannot
; be > 255
sta HandEndOffset
rts
; translate a paddle position into a selection of one of five cards
;
; returns: CursorPos = which card is selected (0-4)
GetSelection
ldx PaddlePos
lda PaddleToSelection,x
sta CursorPos
rts
PaddleToSelection
.byte $04, $04, $04, $03, $03, $03, $02, $02, $02, $01, $01, $01
.byte $00, $00, $00
; Change jack of trumps and jack of suit of same color as trumps to the right
; bower and left bower
;
; Requires that TrumpSuitMask be set prior to call
CreateBowers
lda TrumpSuitMask
ora #JackRankValue
sta RightBowerMask
eor #%00101000
sta LeftBowerMask
ldx #CardsInDeck-1
CBLoop
lda DeckStart,x
and #ShowCardMask ; compare against card information only
cmp RightBowerMask ; Is this card the jack of trump?
bne CBLB ; No, check if it is the other jack of the same color
lda TrumpSuitMask
ora #RightRankValue ; Grant the card the right bower rank
jmp CBSet
CBLB
cmp LeftBowerMask ; Is this card the jack of the same color as trump?
bne CBLoopEnd ; No, it is not either bower
lda TrumpSuitMask
eor #FlipColorSuitMask ; Make the "real" suit trump, but leave the display
; suit alone
ora #LeftRankValue ; Grant the card the left bower rank
CBSet
sta T4
lda DeckStart,x
and #%10000000
ora T4 ; Do not change whether card is hidden or shown
sta DeckStart,x
CBLoopEnd
dex
bpl CBLoop
rts
; 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
stx T4
txa
asl
asl
clc
adc T4
adc #<ScoreImageStart
sta $00,y
lda #>ScoreImageStart
; adc #$00
sta $01,y
rts
GetRankImage
txa
asl
sta T4
asl
clc
adc T4
adc #<RankImageStart
sta $00,y
lda #>RankImageStart
adc #$00
sta $01,y
rts
GetSuitImage
txa
asl
sta T4
asl
clc
adc T4
adc #<SuitImageStart
sta $00,y
lda #>SuitImageStart
; adc #$00
sta $01,y
rts
GetLetterImage
txa
adc #<LetterImageStart
sta $00,y
lda #>LetterImageStart
; adc #$00
sta $01,y
rts
GetMessagePointer
txa
asl
sta T1
asl
clc
adc T1
adc #<MessageTableStart
sta $00,y
lda #>MessageTableStart
; adc #$00
sta $01,y
rts
GetMessageImages
ldy #$06
MessageImageLoop
dey
sty T4
lda (MessagePtr),y
tax
tya
asl
clc
adc #ImgPtr1
tay
jsr GetLetterImage
ldy T4
bne MessageImageLoop
rts
; All images are reversed since they are read by decrementing loops.
; routine to shuffle the deck
RefreshDeck
ldx #CardsInDeck
RD1
dex
lda NewDeck,x
sta DeckStart,x
txa
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
; 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 $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 draw a single card
; assumes ImgPtr1 and ImgPtr2 point to proper images, sprites are
; positioned, and so on
DrawSingleCard
ldy #$05
DrawCardLoop
sta WSYNC
lda (ImgPtr1),y
sta GRP0
lda (ImgPtr2),y
sta GRP1
dey
bpl DrawCardLoop
sta WSYNC
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 #$05
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
lda #$01
sta VDELP0
sta VDELP1
ldy #$05
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
bpl loop2
rts
org $fe00
ScoreImageStart
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,$01,$07,$05,$01
ScoreImage5
.byte $07,$01,$07,$04,$07
ScoreImage6
.byte $07,$05,$07,$04,$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 $77,$22,$22,$66,$22
ScoreImage12
.byte $77,$24,$27,$61,$27
ScoreImage13
.byte $77,$21,$23,$61,$27
TrickImages
.byte $00,$01,$05,$15,$55,$FF
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
MessageTableStart
MessageBlank
.byte #<LetterImageSpace, #<LetterImageSpace, #<LetterImageSpace
.byte #<LetterImageSpace, #<LetterImageSpace, #<LetterImageSpace
MessageSelect
.byte #<LetterImageS, #<LetterImageE, #<LetterImageL
.byte #<LetterImageE, #<LetterImageC, #<LetterImageT
MessageSwap
.byte #<LetterImageSpace, #<LetterImageS, #<LetterImageW
.byte #<LetterImageA, #<LetterImageP, #<LetterImageSpace
MessagePass
.byte #<LetterImageSpace, #<LetterImageP, #<LetterImageA
.byte #<LetterImageS, #<LetterImageS, #<LetterImageSpace
MessageOrder
.byte #<LetterImageO, #<LetterImageR, #<LetterImageD
.byte #<LetterImageE, #<LetterImageR, #<LetterImageSpace
MessageCall
.byte #<LetterImageSpace, #<LetterImageC, #<LetterImageA
.byte #<LetterImageL, #<LetterImageL, #<LetterImageSpace
MessageAlone
.byte #<LetterImageA, #<LetterImageL, #<LetterImageO
.byte #<LetterImageN, #<LetterImageE, #<LetterImageSpace
MessageTrumpHearts
.byte #<LetterImageT, #<LetterImageR, #<LetterImageU
.byte #<LetterImageM, #<LetterImageP, #<SuitImageHeart
MessageTrumpDiamonds
.byte #<LetterImageT, #<LetterImageR, #<LetterImageU
.byte #<LetterImageM, #<LetterImageP, #<SuitImageDiamond
MessageTrumpClubs
.byte #<LetterImageT, #<LetterImageR, #<LetterImageU
.byte #<LetterImageM, #<LetterImageP, #<SuitImageClub
MessageTrumpSpades
.byte #<LetterImageT, #<LetterImageR, #<LetterImageU
.byte #<LetterImageM, #<LetterImageP, #<SuitImageSpade
MessageAloneHearts
.byte #<LetterImageA, #<LetterImageL, #<LetterImageO
.byte #<LetterImageN, #<LetterImageE, #<SuitImageHeart
MessageAloneDiamonds
.byte #<LetterImageA, #<LetterImageL, #<LetterImageO
.byte #<LetterImageN, #<LetterImageE, #<SuitImageDiamond
MessageAloneClubs
.byte #<LetterImageA, #<LetterImageL, #<LetterImageO
.byte #<LetterImageN, #<LetterImageE, #<SuitImageClub
MessageAloneSpades
.byte #<LetterImageA, #<LetterImageL, #<LetterImageO
.byte #<LetterImageN, #<LetterImageE, #<SuitImageSpade
MessageDeal
.byte #<LetterImageSpace, #<LetterImageD, #<LetterImageE
.byte #<LetterImageA, #<LetterImageL, #<LetterImageSpace
MessageGameOver
.byte #<LetterImageSpace, #<LetterImageO, #<LetterImageV
.byte #<LetterImageE, #<LetterImageR, #<LetterImageSpace
MessageSouth
.byte #<LetterImageS, #<LetterImageO, #<LetterImageU
.byte #<LetterImageT, #<LetterImageH, #<LetterImageSpace
MessageWest
.byte #<LetterImageSpace, #<LetterImageW, #<LetterImageE
.byte #<LetterImageS, #<LetterImageT, #<LetterImageSpace
MessageNorth
.byte #<LetterImageN, #<LetterImageO, #<LetterImageR
.byte #<LetterImageT, #<LetterImageH, #<LetterImageSpace
MessageEast
.byte #<LetterImageSpace, #<LetterImageE, #<LetterImageA
.byte #<LetterImageS, #<LetterImageT, #<LetterImageSpace
MessagePoint
.byte #<LetterImageP, #<LetterImageO, #<LetterImageI
.byte #<LetterImageN, #<LetterImageT, #<LetterImageSpace
MessageEuchre
.byte #<LetterImageE, #<LetterImageU, #<LetterImageC
.byte #<LetterImageH, #<LetterImageR, #<LetterImageE
MessageMarch2
.byte #<LetterImageM, #<LetterImageA, #<LetterImageR
.byte #<LetterImageC, #<LetterImageH, #<DigitImage2
MessageMarch4
.byte #<LetterImageM, #<LetterImageA, #<LetterImageR
.byte #<LetterImageC, #<LetterImageH, #<DigitImage4
org $ff00
; All images are reversed since they are read by decrementing loops.
; These must stay within one page!
LetterImageStart
RankImageStart
RankImage9
.byte $3c,$46,$06,$3e,$66,$3c
RankImage10
.byte $ee,$5b,$5b,$5b,$db,$4e
RankImageJ
LetterImageJ
.byte $3c,$66,$06,$06,$06,$0e ; J
RankImageQ
LetterImageQ
.byte $3a,$64,$6a,$66,$66,$3c ; Q
RankImageK
LetterImageK
.byte $66,$66,$6c,$78,$6c,$66 ; K
RankImageA
LetterImageA
.byte $66,$66,$7e,$66,$3c,$18 ; A
RankImageLeft
.byte $ec,$8a,$8a,$8c,$8a,$8c ; debug "LB"
RankImageRight
.byte $ac,$aa,$aa,$cc,$aa,$cc ; debug "RB"
LetterImageSpace
.byte $00,$00,$00,$00,$00,$00 ;
LetterImageC
.byte $3c,$66,$60,$60,$66,$3c ; C
LetterImageD
.byte $7c,$66,$66,$66,$66,$7c ; D
LetterImageE
.byte $7e,$60,$60,$78,$60,$7e ; E
LetterImageH
.byte $66,$66,$66,$7e,$66,$66 ; H
LetterImageI
.byte $7e,$18,$18,$18,$18,$7e ; I
LetterImageL
.byte $7e,$60,$60,$60,$60,$60 ; L
LetterImageM
.byte $c6,$c6,$d6,$fe,$ee,$c6 ; M
LetterImageN
.byte $c6,$ce,$de,$f6,$e6,$c6 ; N
LetterImageO
.byte $3c,$66,$66,$66,$66,$3c ; O
LetterImageP
.byte $60,$60,$7c,$66,$66,$7c ; P
LetterImageR
.byte $66,$66,$66,$7c,$66,$7c ; R
LetterImageS
.byte $3c,$06,$06,$3c,$60,$3c ; S
LetterImageT
.byte $18,$18,$18,$18,$18,$7e ; T
LetterImageU
.byte $3c,$66,$66,$66,$66,$66 ; U
LetterImageV
.byte $10,$38,$6c,$c6,$c6,$c6 ; V
LetterImageW
.byte $c6,$ee,$fe,$d6,$c6,$c6 ; W
SuitImageStart
SuitImageHeart
.byte $10,$38,$7c,$fe,$ee,$44
SuitImageDiamond
.byte $18,$3c,$7e,$7e,$3c,$18
SuitImageClub
.byte $18,$7e,$ff,$18,$3c,$18
SuitImageSpade
.byte $38,$ba,$fe,$7c,$38,$10
DigitImage2
.byte $7e,$60,$3c,$06,$46,$3c
DigitImage4
.byte $0c,$7e,$4c,$2c,$1c,$0c
org $fffc
.word CartStart
.word CartStart
Attachment:
Euchre.bin
Description: Binary data
"Cartridge.MD5" "eb71743c6c7ccce5b108fad70a326ad9" "Cartridge.Name" "Euchre (November 25, 2001 pre-release)" "Cartridge.Manufacturer" "Erik Eid" "Cartridge.Rarity" "New Release" "Cartridge.Type" "4K" "Controller.Left" "Paddles" "Display.Format" "NTSC" ""
| Current Thread |
|---|
|
| <- Previous | Index | Next -> |
|---|---|---|
| Re: [stella] Poker Solitaire, build, Manuel Polik | Thread | [stella] Farewell, StellaList, John K. Harvey |
| Re: [stella] VCS.H standardization, B. Watson | Date | Re: [stella] VCS.H standardization, Erik J. Eid |
| Month |