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 03, 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 offsuit 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 #FramesWait1 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 (04) 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 offsuit 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 offsuit lone aces, looping once through ; the hand for each nontrump 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 offsuit 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 offsuit 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 offsuit 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 ; offsuit 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 96 or 97, 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 #CardsInHand1 ; 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 (04) 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 #CardsInDeck1 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 MultiJapanese 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 hardcoded ; 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 ImgPtr14 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 ; Sixdigit 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 prerelease)" "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 