;******************************************************************************* ; ; BattlePong ; ---------- ;******************************************************************************* ; Yet another game attempt ; Jeff Haber ; July 2016 ; ; compile using DASM: ; dasm BP2n.asm -f3 -v0 -sBP2.sym -lBP2.lst -oBP2.bin ;=============================================================================== ; Change Log ;=============================================================================== ; Pill1d. Added ball though with shearing on right side. ; Pill1e. Corrected shearing by moving ball to line 2 ; Pill1f. Attempting to add missiles. Failed ; Pill1fb. Had the friggin BNE in the same spot it was before I added the ; missile stuff. Had a totally blank screen until I removed the line ; 1 WSYNC. Works now, but ball shearing is back due to removing the ; WSYNC. ; Pill1g. Created muticolored heads. Caused some kernal issues- warping. ; Commented out pills which fixed most of it except ball shear. ; Pill1h. Minor maintenance changes ; Pill1i. Learned a new player color change scheme from Darrell. Partially ; successful. Glitchy ; Pill1j Continuation. Color issues corrected- though there is massive ; shearing probably because line one of the kernal is very small ; Pill1k Re-introduced pills into band 4 ; Pill1m Introduced player colors to band 4 ; Pill1n Set up band 2 framework ; Pill1o Set up band 5 framework ; Pill1p Set up band 1 framework ; Pill1q Maintenance ; Pill1r Adding score loop. Working, with glitches ; Pill1s Attempting to correct PF ; Pill1sb Score screen working well. ; ; Pill2b Fixing Ball shear ; Pill2d Colored the pills. Reduced pill graphics ; Pill2e Added static screen ; Pill2f Adding Test Pattern ; Pill2i Cleanup ; Pill2j Cleanup continued ; BP1 Changed name to BattlePong ; BP1a Adding player 1 joystick control ; BP1b Removed Player 1 random reposition at collision. ; BP1c ; BP1h Added Player/Ball collision ; BP1i Altering missile y to mathplayers ; BP1j added ball/missile collisions ; BP1k correcting coin issue. Partially corrected. ; BP1k continuing ; BP1m Attempting to correct re-positioning in band 3. Moning to 2 ; BP1n Clean up band 2 ; BP1p Adding new score routine ; BP2a Moved ball to show score glitch ; BP2b Adding ball mood ; BP2c Darrell corrected score calculation ; BP2f Successfuly added JumboTron rotation ; BP2g Added Jumbotron sounds ; BP2j Implementing Omegamatrix's index suggestions ; BP2k Implementing Omegamatrix's state machine ; BP2n Fixed reset problem ;=============================================================================== ; Initialize DASM ;=============================================================================== PROCESSOR 6502 include vcs.h include macro.h include TwoScores.h ;*** ;=============================================================================== ; Define Constants ;=============================================================================== ARENA_HEIGHT = 90 ; height of gameplay area ?Was 100 PF_COLOR = $1C ; yellow BALL_HEIGHT = 8 ; 8 MISSILE_HEIGHT = 1 ; 1 SHOULDER_COLOR = $06 ;$E4 HELMET_COLOR = $22 ;$24 HEAD_COLOR = $0A ;$4C BODY_COLOR = $08 ;$82 BASE_COLOR = $04 ;$22 BELT_COLOR = $82 ;*** RAM_SCORE_HI_MED_LO = 1 ; If MSB and LSB of score appear to be exchanged, change this to 0. VERT_SEGMENT_HEIGHT = 5 ; Change to adjust digit height COL_BACKGROUND = $00 COL_DIGITS = $8A TIME_VBLANK = 46 TIME_OVERSCAN = 23 TOP_BLANK_LINES = 2 BOT_BLANK_LINES = 192-VERT_SEGMENT_HEIGHT*2 ;--- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; SCORE LOOP CONSTANTS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; SHAPE_DASH = $44 SHAPE_SIDES = $1C ;=============================================================================== ; Define RAM Usage ;=============================================================================== SEG.U VARS ORG $80 ; holds background color BackgroundColor: ds 1 ; stored in $80 ; holds X locations in $81-82 ObjectX: ds 2 ; player0, player1 ; holds Y locations in $83-84 ObjectY: ds 2 ; player0, player1 ; DoDraw storage in $85-86 Player0Draw: ds 1 ; used for drawing player0 Player1Draw: ds 1 ; used for drawing player1 ; DoDraw Graphic Pointers in $87-8a Player0Ptr: ds 2 ; used for drawing player0 Player1Ptr: ds 2 ; used for drawing player1 ; current random number Rand8: ds 1 ; stored in $8b ; DoDraw storage in $8c ;PillDraw: ds 1 ;used for drawing pills PillY: ds 1 ; PillPtr: ds 2 ; PillRAMGfx: ds 12 ; BallDraw: ds 1 ; BallY: ds 1 ; Missile0Draw: ds 1 Missile1Draw: ds 1 Missile0Y: ds 1 Missile1Y: ds 1 FrameCounter: ds 1 PlayerColorPtr: ds 2 ; used for drawing player0 Player1ColorPtr: ds 2 BallMood: ds 1 JumboState: ds 1 jumbo_JumpInd: ds 2 ;*** pfMasks ds 14 leftScore ds 3 rightScore ds 3 ;--- ;=============================================================================== ; Define Start of Cartridge ;=============================================================================== SEG CODE ; 2K ROM starts at $F800, 4K ROM starts at $F000 ORG $F000 ;=============================================================================== ; Subroutines ;=============================================================================== ;------------------------------------------------------------------------------- ; PosObject ;---------- ; subroutine for setting the X position of any TIA object ; when called, set the following registers: ; A - holds the X position of the object ; X - holds which object to position ; 0 = player0 ; 1 = player1 ; 2 = missile0 ; 3 = missile1 ; 4 = ball ; the routine will set the coarse X position of the object, as well as the ; fine-tune register. The fine-tune register will be used to adjust the objects ; final position when an HMOVE is strobed. The HMOVE must be strobed ; immediately after the WSYNC is strobed. ; ; Note: The X position differs based on the object, for player0 and player1 ; 0 is the leftmost pixel while for missile0, missile1 and ball 1 is ; the leftmost pixel: ; players - X range is 0-159 ; missiles - X range is 1-160 ; ball - X range is 1-160 ; ; Note: Setting players to double or quad size will affect the position of ; the players. ;------------------------------------------------------------------------------- PosObject: sec sta WSYNC DivideLoop sbc #15 ; 2 2 - each time thru this loop takes 5 cycles, which is bcs DivideLoop ; 2 4 - the same amount of time it takes to draw 15 pixels eor #7 ; 2 6 - The EOR & ASL statements convert the remainder asl ; 2 8 - of position/15 to the value needed to fine tune asl ; 2 10 - the X position asl ; 2 12 asl ; 2 14 sta.wx HMP0,X ; 5 19 - store fine tuning of X sta RESP0,X ; 4 23 - set coarse X position of object rts ; 6 29 - ReTurn from Subroutine ;------------------------------------------------------------------------------- ; Random ;------------------------------------------------------------------------------- Random: lda Rand8 ; 3 3 lsr ; 2 5 bcc noeor ; 2,3 7,8 eor #$B4 ; 2 9 noeor: sta Rand8 ; 3 12 or 11 from bcc rts ; 6 18 ; also the jsr ; 6 24 ;=============================================================================== ; Initialize Atari ;=============================================================================== InitSystem: CLEAN_START ; set initial player0 position lda #40 sta ObjectX lda #(ARENA_HEIGHT - PLAYER0_HEIGHT)/2 sta ObjectY ; set initial player 1 position lda #120 sta ObjectX+1 lda #(ARENA_HEIGHT - PLAYER1_HEIGHT)/2 sta ObjectY+1 ; set initial pill position lda #15 ;(ARENA_HEIGHT - COIN_HEIGHT)/2 sta PillY ; set initial ball position lda #55 ;#(ARENA_HEIGHT - BALL_HEIGHT)/2 sta BallY ; set initial missile0 position lda #(ARENA_HEIGHT - MISSILE_HEIGHT)/2 sta Missile0Y ; set initial missile1 position lda #(ARENA_HEIGHT - MISSILE_HEIGHT)/2 sta Missile1Y lda #0 ; black sta BackgroundColor lda #PF_COLOR sta COLUPF lda #$84 sta Rand8 ; also use $84 as seed for the LFSR lda #%00000000 sta PillRAMGfx lda #%00000000 sta PillRAMGfx+1 lda #%01010100 sta PillRAMGfx+2 lda #%01010100 sta PillRAMGfx+3 lda #%01010100 sta PillRAMGfx+4 lda #%01010100 sta PillRAMGfx+5 lda #%01010100 sta PillRAMGfx+6 lda #%01010100 sta PillRAMGfx+7 lda #%00010100 sta PillRAMGfx+8 lda #%00010000 sta PillRAMGfx+9 lda #%00010000 sta PillRAMGfx+10 lda #%00010000 sta PillRAMGfx+11 ; Set temporary ball speed lda #%00010000 ; Move left slow sta HMBL ; Set temporary Missile0 speed lda #%11000000 ; sta HMM0 ; Set temporary missile1 speed lda #%01000000 ; sta HMM1 ; Set temporary ball size and reflect lda #%1111001 sta CTRLPF sta VDELBL ;D0 to delay ;sta REFP0 ;D3 to reflect ;sta REFP1 ;D3 to reflect ;*** ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; temp code... to display some numbers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; lda #$00 ;98 sta leftScore lda #$00 ;76 sta leftScore+1 lda #$00 ;54 sta leftScore+2 lda #$00 ;01 sta rightScore lda #$00 ;23 sta rightScore+1 lda #$00 ;45 sta rightScore+2 lda #COL_BACKGROUND sta COLUBK ;--- ;=============================================================================== ; Main Program Loop ;=============================================================================== Main: jsr VerticalSync ; Jump to SubRoutine VerticalSync jsr VerticalBlank ; Jump to SubRoutine VerticalBlank jsr Kernel ; Jump to SubRoutine Kernel jsr OverScan ; Jump to SubRoutine OverScan jmp Main ; JuMP to Main ;======================================== ; Sync Signal ;======================================== VerticalSync: lda #2 ; LoaD Accumulator with 2 sta WSYNC ; STore Accumulator to WSYNC, any value halts CPU until start of next scanline sta VSYNC ; Accumulator D1=1, turns on Vertical Sync signal sta VBLANK ; Accumulator D1=1, turns on Vertical Blank signal (image output off) lda #47 sta TIM64T ; set timer for end of Vertical Blank sta WSYNC ; 1st scanline of VSYNC sta WSYNC ; 2nd scanline of VSYNC lda #0 ; LoaD Accumulator with 0 sta GRP0 sta GRP1 sta WSYNC ; 3rd scanline of VSYNC sta VSYNC ; Accumulator D1=0, turns off Vertical Sync signal rts ;======================================== ; Vertical Blank ; -------------- ; game logic runs here. ; ;======================================== VerticalBlank: jsr Random ;Called and not used to advance the register jsr ProcessJoystick jsr PositionObjectsY ;*** jsr GetScoreLeftPlayfield jsr GetScoreRightPlayfield ;--- VBwait: sta WSYNC bit TIMINT bpl VBwait ; wait for the timer to denote end of Vertical Blank rts ;=============================================================================== ; ProcessJoystick ; -------------- ; Read joystick and move player0 ; ; joystick directions are held in the SWCHA register of the RIOT chip. ; Directions are read via the following bit pattern: ; 76543210 ; RLDUrldu - RIGHT LEFT DOWN UP right left down up ; ; UPPERCASE denotes the left joystick directions ; lowercase denotes the right joystick directions ; ; Note: The values are the opposite of what you might expect. If the direction ; is held, the bit value will be 0. ; ; Note: Fire buttons are read via INPT4 (left) and INPT5 (right). ;=============================================================================== ;ProcessJoystick: ; lda SWCHA ; fetch state of both joysticks ; asl ; shift A bits left, R is now in carry bit ; bcs CheckLeft ; branch if joystick is not held right ; ldy ObjectX ; get position of player0 ; iny ; and move it right ; cpy #160 ; test for edge of screen ; bne SaveX ; save value as is if we're not at edge ; ldy #0 ; else wrap to left edge of screen ;SaveX: sty ObjectX ; save player0's new X position ; ldy #0 ; turn off reflect of player0, which ; sty REFP0 ; makes player0 image face right ;CheckLeft: ; asl ; shift A bits left, L is now in the carry bit ; bcs CheckDown ; branch if joystick not held left ; ldy ObjectX ; get the object's X position ; dey ; and move it left ; cpy #255 ; test for edge of screen ; bne SaveX2 ; save X if we're not at the edge ; ldy #159 ; else wrap to right edge ;SaveX2: sty ObjectX ; save player0's new X position ; ldy #0 ;8 ; turn on reflect of player0, which. ;Disabled for score ; sty REFP0 ; makes player0 image face left ; ;CheckDown: ; asl ; shift A bits left, D is now in the carry bit ; bcs CheckUp ; branch if joystick not held down ; ldy ObjectY ; get the object's Y position ; dey ; move it down ; cpy #255 ; test for bottom of screen ; bne SaveY ; save Y if we're not at the bottom ; ldy #ARENA_HEIGHT ; else wrap to top ;SaveY: sty ObjectY ; save Y ;CheckUp: ; asl ; shift A bits left, U is now in the carry bit ; bcs DoneWithJoystick ; branch if joystick not held up ; ldy ObjectY ; get the object's Y position ; iny ; move it up ; cpy #ARENA_HEIGHT ; test for top of screen ; bne SaveY2 ; save Y if we're not at the top ; ldy #0 ; else wrap to bottom ;SaveY2: sty ObjectY ; save Y ; ;DoneWithJoystick: ; rts ;******************************************************************************* ;Changing joystick processing ProcessJoystick: lda SWCHA ; reads joystick positions ldx #0 ; x=0 for left joystick, x=1 for right PJloop: ;ldy ObjectX,x ; save original X location so the player can be ;sty SavedX,x ; bounced back upon colliding with the playfield ;ldy ObjectY,x ; save original Y location so the player can be ;sty SavedY,x ; bounced back upon colliding with the playfield asl ; shift A bits left, R is now in the carry bit bcs CheckLeft ; branch if joystick is not held right ldy ObjectX,x ; get the object's X position iny ; and move it right cpy #160 ; test for edge of screen bne SaveX ; save Y if we're not at the edge ldy #0 ; else wrap to left edge SaveX: sty ObjectX,x ; saveX ldy #0 ; turn off reflect of player, which sty REFP0,x ; makes humanoid image face right CheckLeft: asl ; shift A bits left, L is now in the carry bit bcs CheckDown ; branch if joystick not held left ldy ObjectX,x ; get the object's X position dey ; and move it left cpy #255 ; test for edge of screen bne SaveX2 ; save X if we're not at the edge ldy #159 ; else wrap to right edge SaveX2: sty ObjectX,x ; save X ldy #0 ;#8 ; turn on reflect of player, which; ;Disabled for score sty REFP0,x ; makes humanoid image face left CheckDown: asl ; shift A bits left, D is now in the carry bit bcs CheckUp ; branch if joystick not held down ldy ObjectY,x ; get the object's Y position dey ; move it down cpy #255 ; test for bottom of screen bne SaveY ; save Y if we're not at the bottom ldy #ARENA_HEIGHT;*2+1 ; else wrap to top SaveY: sty ObjectY,x ; save Y CheckUp: asl ; shift A bits left, U is now in the carry bit bcs NextJoystick ; branch if joystick not held up ldy ObjectY,x ; get the object's Y position iny ; move it up cpy #ARENA_HEIGHT;*2+2 ; test for top of screen bne SaveY2 ; save Y if we're not at the top ldy #0 ; else wrap to bottom SaveY2: sty ObjectY,x ; save Y NextJoystick: ; Bypassed the bit test to make it 2 player game. ;bit Players ; test number of players by putting D7 into N ;bpl OnePlayer ; if N is off, it's a 1 player game so abort loop inx ; increase loop control cpx #2 ; check if we've processed both joysticks bne PJloop ; branch if we haven't OnePlayer: rts ;=============================================================================== ; PositionObjects ; -------------- ; Updates TIA for X position of both player objects ; Updates Kernel variables for Y position of both player objects ;=============================================================================== PositionObjectsX: ldx #1 ; 2 position players 0 and 1 POloop: lda ObjectX,x ; 4 get the object's X position jsr PosObject ; 6 set coarse X position and fine-tune amount ; 29 time of PosObjext after its WSYNC dex ; 2 DEcrement X bpl POloop ; 2 Branch PLus so we position all objects sta WSYNC ; 3 wait for end of scanline sta HMOVE ; 3 3Tell TIA to use fine-tune values to set final X positions rts ; 6 9 after 2 wsyncs PositionObjectsY: ; Player0Draw = ARENA_HEIGHT + PLAYER0_HEIGHT - Y_position lda #(ARENA_HEIGHT + PLAYER0_HEIGHT) sec sbc ObjectY sta Player0Draw ; Set Player0Ptr to proper value for drawing player0 lda #<(Player0Gfx + PLAYER0_HEIGHT - 1) sec sbc ObjectY sta Player0Ptr lda #>(Player0Gfx + PLAYER0_HEIGHT - 1) sbc #0 sta Player0Ptr+1 ; Set PlayerColorPtr to proper value for drawing player0 lda #<(PlayerColor + COLOR_HEIGHT - 1) sec sbc ObjectY sta PlayerColorPtr lda #>(PlayerColor + COLOR_HEIGHT - 1) sbc #0 sta PlayerColorPtr+1 ; Player1Draw = ARENA_HEIGHT + PLAYER1_HEIGHT - Y_position lda #(ARENA_HEIGHT + PLAYER1_HEIGHT) sec sbc ObjectY+1 sta Player1Draw ; Set Player1Ptr to proper value for drawing player1 lda #<(Player1Gfx + PLAYER1_HEIGHT - 1) sec sbc ObjectY+1 sta Player1Ptr lda #>(Player1Gfx + PLAYER1_HEIGHT - 1) sbc #0 sta Player1Ptr+1 ; Set Player1ColorPtr to proper value for drawing player1 lda #<(PlayerColor + COLOR_HEIGHT - 1) sec sbc ObjectY+1 sta Player1ColorPtr lda #>(PlayerColor + COLOR_HEIGHT - 1) sbc #0 sta Player1ColorPtr+1 ; Set PillPtr to proper value for drawing pills ;lda #<(CoinGfx + COIN_HEIGHT - 1) lda #<(PillRAMGfx + COIN_HEIGHT - 1) sec sbc PillY sta PillPtr ;lda #>(CoinGfx + COIN_HEIGHT - 1) lda #>(PillRAMGfx + COIN_HEIGHT - 1) sbc #0 sta PillPtr+1 ; BallDraw = ARENA_HEIGHT + BALL_HEIGHT - Y_position lda #(ARENA_HEIGHT + BALL_HEIGHT) sec sbc BallY sta BallDraw ; Missile0Draw = ARENA_HEIGHT + MISSILE_HEIGHT - Y_position lda #(ARENA_HEIGHT + MISSILE_HEIGHT) sec sbc Missile0Y sta Missile0Draw ; Missile1Draw = ARENA_HEIGHT + MISSILE_HEIGHT - Y_position lda #(ARENA_HEIGHT + MISSILE_HEIGHT) sec sbc Missile1Y sta Missile1Draw rts ;======================================== ; Kernel ; -------------- ; generate the display ;======================================== Kernel: lda #0 ldy #ARENA_HEIGHT ; init loop counter sta WSYNC sta VBLANK ; 3 3 - turn on video output ;lda BackgroundColor ; 3 6 ;sta COLUBK ; 3 9 ;111111111111111111111111111111111111111111111111111111111111111111111111111111 ;111111111111111111111111111111111111111111111111111111111111111111111111111111 ;111111111111111111111111111111111111111111111111111111111111111111111111111111 ;111111111111111111111111111111111111111111111111111111111111111111111111111111 ldy JumboState lda JumboLo,Y sta jumbo_JumpInd lda JumboHi,Y sta jumbo_JumpInd+1 ;ldy giant_GiantSequence jmp.ind (jumbo_JumpInd) ; indirect jump into code segment ;lda JumboState ;cmp #0 ;beq StaticDisplayJump ;cmp #1 ;beq TestPatternJump ; All other values will default to Scoreboard ;jmp TwoScore ;TestPatternJump: ;remove ;jsr TestPattern ;jmp Band2Prep ;StaticDisplayJump: ;remove ;jsr StaticDisplay ;jmp Band2Prep TwoScore: sta WSYNC sta WSYNC sta WSYNC TWO_SCORE_KERNEL ;*** sta WSYNC sta WSYNC lda #PF_COLOR sta COLUPF ; Set temporary ball size and reflect lda #%1111001 sta CTRLPF sta VDELBL ;D0 to delay ;sta REFP0 ;D3 to reflect ;sta REFP1 ;D3 to reflect sta WSYNC Band2Prep: ldy #90 ; compensate for score loop ;dec BallDraw ; ;dec Missile0Draw ;dec Missile1Draw ;222222222222222222222222222222222222222222222222222222222222222222222222222222 ;222222222222222222222222222222222222222222222222222222222222222222222222222222 ;222222222222222222222222222222222222222222222222222222222222222222222222222222 ;222222222222222222222222222222222222222222222222222222222222222222222222222222 ldx #20 ; Was 20, but jsr contains 3 WsYNCs ArenaLoop2: ; sta WSYNC ; 3 0 ;---------------------------- start of line 1 of the 2LK ;stx COLUP0 ;stx COLUP1 lda TopBand0,x ; 4 4 sta PF0 ; 3 7 ;lda TransformerGfx,x ;sta GRP0 ;sta GRP1 lda TopBand1,x ; 4 11 sta PF1 ; 3 14 lda TopBand2,x ; 4 18 sta PF2 ; 3 21 dex ; 2 23 lda #TRANSFORMER_HEIGHT-1 ; 2 25 - height of the transformer graphics dcp Player0Draw ; 5 30 - Decrement Player0Draw and compare with height ;bcs BDoDrawGrp0 ; 2 32 - (3 10) if Carry is Set then player0 is on current scanline ;lda #0 ; 2 34 - otherwise use 0 to turn off player0 ;.byte $2C ; 4 38 - $2C = BIT with absolute addressing, trick that ; causes the lda (Player0Ptr),y to be skipped BDoDrawGrp0: ; 33 - from bcs DoDrawGRP0 ;lda (Player0Ptr),y ; 5 38 - load the shape for player0 ;sta GRP0 ; 3 41 sta WSYNC ; 3 44 ;---------------------------- start of line 2 of the 2LK lda TopBand0,x ;4 4 sta PF0 ;3 7 lda TopBand1,x ;4 11 sta PF1 ;3 14 lda TopBand2,x ;4 18 sta PF2 ;3 21 dex ;2 23 lda #TRANSFORMER_HEIGHT-1 ; 2 25 - height of the transformer graphics, subtract 1 due to starting with 0 dcp Player1Draw ; 5 30 - Decrement Player1Draw and compare with height ;bcs BDoDrawGrp1 ; 2 32 - (3 10) if Carry is Set, then player1 is on current scanline ;lda #0 ; 2 34 - otherwise use 0 to turn off player1 ;.byte $2C ; 4 38 - $2C = BIT with absolute addressing, trick that ; causes the lda (Player1Ptr),y to be skipped BDoDrawGrp1: ; 33 - from bcs DoDrawGrp1 ;lda (Player1Ptr),y ; 5 38 - load the shape for player1 ;sta GRP1 ; 3 41 dey ; 2 43 - update loop counter cpy #83 ; 2 45 was 80 Compensated for 3 WSYNCs in jsr bne ArenaLoop2 ; 2 47 - 3 48 if taken lda #0 ; 2 sta NUSIZ0 ; 3 sta NUSIZ1 ; 3 jsr PositionObjectsX ; Contains 4 WSYNCs currently ; 9 after the last WSYNC from the subroutine. ldx #%10000000 ;2 stx PF0 ;3 ldx #%11101111 ;2 stx PF1 ;3 ldx #%11110111 ;2 stx PF2 ;3 sta WSYNC ;3 ldx #0 ;2 stx PF1 ;3 stx PF2 ;3 dey ;2 dey ;2 dey ;2 dec Player0Draw ;5 dec Player0Draw ;5 dec Player0Draw ;5 dec Player1Draw ;5 dec Player1Draw ;5 dec Player1Draw ;5 ;3333333333333333333333333333333333333333333333333333333333333333333333333333333 ;3333333333333333333333333333333333333333333333333333333333333333333333333333333 ;3333333333333333333333333333333333333333333333333333333333333333333333333333333 ;3333333333333333333333333333333333333333333333333333333333333333333333333333333 ArenaLoop3: ; ? - worse case time to get here sta WSYNC ; 3 ? ;---------------------------- start of line 1 of the 2LK lda #PLAYER0_HEIGHT-1 ; 2 2 - height of the player graphics, dcp Player0Draw ; 5 7 - Decrement Player0Draw and compare with height bcs CDoDrawGrp0 ; 2 9 - (3 10) if Carry is Set then player0 is on current scanline lda #0 ; 2 11 - otherwise use 0 to turn off player0 .byte $2C ; 4 15 - $2C = BIT with absolute addressing, trick that ; causes the lda (Player0Ptr),y to be skipped CDoDrawGrp0: ; 10 - from bcs DoDrawGRP0 lda (Player0Ptr),y ; 5 15 - load the shape for player0 sta GRP0 ; 3 18 sta ENAM0 ; 3 21 lda (PlayerColorPtr),y ; 5 26 sta COLUP0 ; 3 29 lda BallMood ; 3 32 sta COLUPF ; 3 35 Ball: lda #BALL_HEIGHT-1 ; 2 37 dcp BallDraw ; 5 42 bcs DoDrawBall ; 2 44 lda #0 ; 2 46 .byte $2C ; 4 50 DoDrawBall: ; 45 - from bcs DoDrawBall lda #2 ; 2 47 sta ENABL ; 3 50 nop ; 2 52 nop ; 2 54 nop ; 2 56 nop ; 2 58 nop lda #PF_COLOR ; 2 sta COLUPF ; 3 sta WSYNC ; 3 44 ;---------------------------- start of line 2 of the 2LK lda #PLAYER1_HEIGHT-1 ; 2 2 - height of the player 1 graphics, subtract 1 due to starting with 0 dcp Player1Draw ; 5 7 - Decrement Player1Draw and compare with height bcs CDoDrawGrp1 ; 2 9 - (3 10) if Carry is Set, then player1 is on current scanline lda #0 ; 2 11 - otherwise use 0 to turn off player1 .byte $2C ; 4 15 - $2C = BIT with absolute addressing, trick that ; causes the lda (Player1Ptr),y to be skipped CDoDrawGrp1: ; 10 - from bcs DoDrawGrp1 lda (Player1Ptr),y ; 5 15 - load the shape for player1 sta GRP1 ; 3 18 sta ENAM1 lda (Player1ColorPtr),y ; 5 23 sta COLUP1 ; 3 26 lda BallMood sta COLUPF Missile0: lda #MISSILE_HEIGHT-1 ; 2 28 ;dcp Missile0Draw ; 5 33 ;bcs DoDrawMis0 ; 2 35 ;lda #0 ; 2 37 ;.byte $2C ; 4 41 DoDrawMis0: ; 36 - from bcs DoDrawBall lda #2 ; 2 38 ;sta ENAM0 ; 3 41 Missile1: lda #MISSILE_HEIGHT-1 ; 2 43 ;dcp Missile1Draw ; 5 48 ;bcs DoDrawMis1 ; 2 50 ;lda #0 ; 2 52 ;.byte $2C ; 4 56 nop nop nop nop nop nop nop nop ;nop lda #PF_COLOR sta COLUPF DoDrawMis1: ; 51 - from bcs DoDrawBall ;lda #2 ; 2 53 ;sta ENAM1 ; 3 56 dey ; 2 58 - update loop counter cpy #20 ; 2 60 bne ArenaLoop3 ; 2 62 - 3 63 if taken ;444444444444444444444444444444444444444444444444444444444444444444444444444444 ;444444444444444444444444444444444444444444444444444444444444444444444444444444 ;444444444444444444444444444444444444444444444444444444444444444444444444444444 ;444444444444444444444444444444444444444444444444444444444444444444444444444444 ldx #3 ArenaLoop4: sta WSYNC ; 3 0 ;---------------------------- start of line 1 of the 2LK DoDrawPills: lda #PLAYER0_HEIGHT-1 ; 2 2 - height of the player graphics, dcp Player0Draw ; 5 7 - Decrement Player0Draw and compare with height bcs DDoDrawGrp0 ; 2 9 - (3 10) if Carry is Set then player0 is on current scanline lda #0 ; 2 11 - otherwise use 0 to turn off player0 .byte $2C ; 4 15 - $2C = BIT with absolute addressing, trick that ; causes the lda (Player0Ptr),y to be skipped DDoDrawGrp0: ; 10 - from bcs DoDrawGRP0 lda (Player0Ptr),y ; 5 15 - load the shape for player0 sta GRP0 ; 3 18 lda (PlayerColorPtr),y ; 5 23 sta COLUP0 ; 3 26 lda CoinColor,x ; 4 30 sta COLUPF ; 3 33 nop ; 2 35 nop ; 2 37 nop ; 2 39 nop ; 2 41 nop ; 2 43 nop ; 2 45 nop ; 2 47 nop ; 2 49 nop ; 2 51 nop ; 2 53 nop ; 2 55 nop ; 2 57 lda #PF_COLOR ; 2 59 sta COLUPF ; 2 61 dex ; 2 63 sta WSYNC ; 3 66 ;---------------------------- start of line 2 of the 2LK lda #PLAYER1_HEIGHT-1 ; 2 2 - height of the player 1 graphics, subtract 1 due to starting with 0 dcp Player1Draw ; 5 7 - Decrement Player1Draw and compare with height bcs DDoDrawGrp1 ; 2 9 - (3 10) if Carry is Set, then player1 is on current scanline lda #0 ; 2 11 - otherwise use 0 to turn off player1 .byte $2C ; 4 15 - $2C = BIT with absolute addressing, trick that ; causes the lda (Player1Ptr),y to be skipped DDoDrawGrp1: ; 10 - from bcs DoDrawGrp1 lda (Player1Ptr),y ; 5 15 - load the shape for player1 sta GRP1 ; 3 18 lda (Player1ColorPtr),y ; 5 23 sta COLUP1 ; 3 26 lda CoinColor,x ; 4 30 sta COLUPF ; 3 33 nop ; 2 35 nop ; 2 37 nop ; 2 39 nop ; 2 41 nop ; 2 43 dey ; 2 45 dex ; 2 47 txa ; 2 49 and #%00000011 ; 2 51 tax ; 2 53 lda #PF_COLOR ; 2 55 sta COLUPF ; 3 58 lda (PillPtr),y ; 5 63 sta PF2 ; 3 66 ;dey ; moved up for timing cpy #10 ; 2 68 bne ArenaLoop4 ; 2 70 - 3 73 if taken ;5555555555555555555555555555555555555555555555555555555555555555555555555555555 ;5555555555555555555555555555555555555555555555555555555555555555555555555555555 ;5555555555555555555555555555555555555555555555555555555555555555555555555555555 ;5555555555555555555555555555555555555555555555555555555555555555555555555555555 ldx #0 ArenaLoop5: ; 23 - worse case time to get here sta WSYNC ; 3 26 ;---------------------------- start of line 1 of the 2LK lda TopBand0,x sta PF0 lda TopBand1,x sta PF1 lda TopBand2,x sta PF2 inx lda #PLAYER0_HEIGHT-1 ; 2 2 - height of the player graphics, dcp Player0Draw ; 5 7 - Decrement Player0Draw and compare with height bcs EDoDrawGrp0 ; 2 9 - (3 10) if Carry is Set then player0 is on current scanline lda #0 ; 2 11 - otherwise use 0 to turn off player0 .byte $2C ; 4 15 - $2C = BIT with absolute addressing, trick that ; causes the lda (Player0Ptr),y to be skipped EDoDrawGrp0: ; 10 - from bcs DoDrawGRP0 lda (Player0Ptr),y ; 5 15 - load the shape for player0 sta GRP0 ; 3 18 sta WSYNC ; 3 21 ;---------------------------- start of line 2 of the 2LK lda TopBand0,x sta PF0 lda TopBand1,x sta PF1 lda TopBand2,x sta PF2 inx lda #PLAYER1_HEIGHT-1 ; 2 2 - height of the player 1 graphics, subtract 1 due to starting with 0 dcp Player1Draw ; 5 7 - Decrement Player1Draw and compare with height bcs EDoDrawGrp1 ; 2 9 - (3 10) if Carry is Set, then player1 is on current scanline lda #0 ; 2 11 - otherwise use 0 to turn off player1 .byte $2C ; 4 15 - $2C = BIT with absolute addressing, trick that ; causes the lda (Player1Ptr),y to be skipped EDoDrawGrp1: ; 10 - from bcs DoDrawGrp1 lda (Player1Ptr),y ; 5 15 - load the shape for player1 sta GRP1 ; 3 18 dey ; 2 20 - update loop counter bne ArenaLoop5 ; 2 22 - 3 23 if taken rts ; 6 28 ;======================================== ; ; Overscan ; ;======================================== OverScan: sta WSYNC ; Wait for SYNC (start of next scanline) lda #2 ; LoaD Accumulator with 2 sta VBLANK ; STore Accumulator to VBLANK, D1=1 turns image output off lda #22 sta TIM64T ; set timer for end of Overscan jsr ProcessCollisions FrameCount: inc FrameCounter lda FrameCounter cmp #255 beq IncDisplay jmp EndIncDisplay IncDisplay: inc JumboState lda JumboState and #%00000011 sta JumboState EndIncDisplay: lda JumboState cmp #0 beq StaticSound cmp #1 beq TestPatternSound jmp EndSound StaticSound: lda #%00001000 sta AUDC0 lda #%00001010 sta AUDF0 lda #%00000001 sta AUDV0 jmp ContinueSound TestPatternSound: lda #%00001100 sta AUDC0 sta AUDF0 lda #%00000001 sta AUDV0 jmp ContinueSound EndSound: lda #0 sta AUDV0 sta AUDC0 sta AUDF0 ContinueSound: OSwait: sta WSYNC bit TIMINT bpl OSwait ; wait for the timer to denote end of Overscan rts ;======================================== ; Process Collisions ; -------------- ; If player0 touchs player 1 then change the background color and reposition the player 1 ;======================================== ProcessCollisions: ;nop ;sed bit CXP0FB ;Player 0 with Ball bvc notP0BL ;Branch if not ldy #%11110000 ;Change ball speed to -1 sty HMBL ;Store it ;sed ; inc leftScore+2 ;cld lda Rand8 sta BallMood ldx #2 ; 2 = left score lda #$01 ; BCD for 1 point jsr AddToScore notP0BL bit CXP1FB ; Player 1 with Ball bvc notP1BL ldy #%00010000 sty HMBL lda Rand8 sta BallMood ldx #5 ; 5 = right score lda #$01 ; BCD for 1 point jsr AddToScore notP1BL bit CXM0FB bvc notM0BL ldy #%11110000 sty HMBL ldx #2 ; 2 = left score lda #$10 ; BCD for 10 points jsr AddToScore notM0BL bit CXM1FB bvc notM1BL ldy #%00010000 sty HMBL ldx #5 ; 5 = right score lda #$10 ; BCD for 10 points jsr AddToScore notM1BL jmp ExitPC ; Temporarily disabled the code below bit CXPPMM ; check to see if player0 collided with player1 ; (also used to check if missile collided with missile) ;cld bpl ExitPC NewX: jsr Random ; get a random value between 0-255 cmp #152 ; compare it with 152 bcs NewX ; get a new random number if >= 152 sta ObjectX+1 ; save player 1's new X location NewY: jsr Random ; get a random value between 0-255 cmp #ARENA_HEIGHT-PLAYER1_HEIGHT bcs NewY ; get a new random number if Y position is offscreen adc #PLAYER1_HEIGHT ; adjust value so player 1 is fully onscreen sta ObjectY+1 ; save Player 1's new Y location ExitPC: sta CXCLR ; clear collision detection latches rts JumboLo: .byte StaticDisplay .byte >TestPattern .byte >TwoScore .byte >TwoScore ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ;Static Display ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; StaticDisplay: ; 6 from the jsr ldy #10 ; 2 8 lda #$0C ; 2 10 sta COLUPF ; 3 13 ;lda #0 ;sta CTRLPF SD: sta WSYNC ; 3 16 lda Rand8 ; 3 19 sta PF0 ; 3 22 eor #$FF ; 2 24 sta PF1 ; 3 37 eor #$FF ; 3 40 sta PF2 ; 3 43 ;and #%00111000 background color filter ;sta COLUBK jsr Random ; 24 67 ;dec BallDraw ; ;dec Missile0Draw ;dec Missile1Draw sta WSYNC ; 3 70 lda Rand8 ; 3 3 sta PF0 ; 3 6 sta PF1 ; 3 9 sta PF2 ; 3 12 jsr Random ; 24 36 dey ; 2 38 bne SD ; 2,3 40 not taken lda #PF_COLOR ; 2 42 sta COLUPF ; 3 45 lda #0 ; 2 47 sta COLUBK ; 3 50 nop ;nop nop nop sta PF2 ; 3 sta PF1 ; 3 sta PF0 ; 3 ;rts ; 6 jmp Band2Prep ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ;Test Pattern Display ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; TestPattern: ; 6 from the jsr ldy #20 ; 2 8 lda #PF_COLOR sta COLUPF lda #%11111111 sta PF0 TP: sta WSYNC nop lda #$34 ; 2 10 sta COLUBK ; 3 13 ror ; 2 15 sta COLUBK ; 3 18 ror ; 2 20 sta COLUBK ; 3 23 ror ; 2 25 sta COLUBK ; 3 28 ror ; 2 30 sta COLUBK ; 3 33 ror ; 2 35 sta COLUBK ; 3 38 ror ; 2 40 sta COLUBK ; 3 43 ror ; 2 45 sta COLUBK ; 3 48 ror ; 2 50 sta COLUBK ; 3 53 ror ; 2 55 sta COLUBK ; 3 58 ror ; 2 60 sta COLUBK ; 3 63 ror ; 2 65 sta COLUBK ; 3 68 lda #0 ; 2 70 sta COLUBK ; 3 73 ;sta WSYNC dey ; 2 bne TP ; 2,3 40 not taken ;rts ; 6 jmp Band2Prep AddToScore: ; A holds points to add ($00 thru $99) ; Y holds score to update, 2= Left Score, 5=Right Score sed clc adc leftScore,x sta leftScore,x lda #0 adc leftScore-1,x sta leftScore-1,x lda #0 adc leftScore-2,x sta leftScore-2,x cld rts ;======================================== ; Graphics ; ;======================================== align 256 Player0Gfx: .byte %00111100 .byte %00000000 .byte %00111100 .byte %00111100 .byte %00111100 .byte %10111101 .byte %10111101 .byte %10111101 .byte %11111111 .byte %00111100 .byte %00100100 .byte %00111100 .byte %00011000 PLAYER0_HEIGHT = * - Player0Gfx Player1Gfx: .byte %00111100 .byte %00000000 .byte %00111100 .byte %00111100 .byte %00111100 .byte %00111100 .byte %00111100 .byte %00111100 .byte %11111111 .byte %10100101 .byte %10111101 .byte %10011001 .byte %10011001 PLAYER1_HEIGHT = * - Player1Gfx TransformerGfx: .byte %10100101 .byte %10100101 .byte %10100101 .byte %10100101 .byte %10100101 .byte %10100101 .byte %10100101 .byte %10100101 .byte %10100101 .byte %10100101 .byte %10100101 .byte %10100101 .byte %10100101 .byte %10100101 .byte %10100101 .byte %10100101 TRANSFORMER_HEIGHT = * - TransformerGfx CoinGfx: ; .byte %11111111 ; .byte %00000000 ; .byte %10000001 ; .byte %00000000 ; .byte %10000001 ; .byte %00000000 .byte %10000001 ; Not currently used .byte %00000000 .byte %10000001 .byte %00000000 .byte %10000001 .byte %11111111 COIN_HEIGHT = * - CoinGfx PlayerColor: .byte BASE_COLOR .byte BODY_COLOR .byte BODY_COLOR .byte BODY_COLOR .byte BODY_COLOR .byte BODY_COLOR .byte BELT_COLOR .byte SHOULDER_COLOR .byte SHOULDER_COLOR .byte SHOULDER_COLOR .byte SHOULDER_COLOR .byte HEAD_COLOR .byte HELMET_COLOR COLOR_HEIGHT = * - PlayerColor CoinColor: .byte $50 .byte $46 .byte $50 .byte $00 ;Bookmark- Rolling Cleanup Edit TopBand0: ;.byte %00000000 ;Not necessary .byte %10000000 ; Last Line .byte %10000000 .byte %10000000 .byte %10000000 .byte %10000000 .byte %10000000 .byte %10000000 .byte %10000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000;added .byte %00000000 .byte %11111111 .byte %01000100 .byte %10101010 .byte %00010001 .byte %11111111 TopBand1: .byte %00000000 .byte %00000000 .byte %11101111 .byte %11111111 .byte %11111111 .byte %11111111 .byte %11111111 .byte %11111111 .byte %11111111 .byte %00111000 .byte %00010000 .byte %00010000 .byte %00000000 .byte %00010000 .byte %00000000 .byte %00010000 .byte %00000000 .byte %00010000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %11111111 .byte %01000100 .byte %10101010 .byte %00010001 .byte %11111111 TopBand2: .byte %00000000 .byte %00000000 .byte %11110111 .byte %11111111 .byte %11111111 .byte %11111111 .byte %11111111 .byte %11111111 .byte %11111111 .byte %00011100 .byte %00001000 .byte %00001000 .byte %00000000 .byte %00001000 .byte %00000000 .byte %00001000 .byte %00000000 .byte %00001000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %00000000 .byte %11111111 .byte %01000100 .byte %10101010 .byte %00010001 .byte %11111111 ;added extra ;*** ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; SUBROUTINES ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ALIGN 256 LEFT_SCORE_MASK_SUBROUTINE RIGHT_SCORE_MASK_SUBROUTINE DRAW_HORIZONTAL_SEGMENT ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; DATA ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ALIGN 256 PF_MASK_TABLES ;--- ;======================================== ; Define End of Cartridge ;======================================== ORG $FFFA ; set address to 6507 Interrupt Vectors .WORD InitSystem ; NMI .WORD InitSystem ; RESET .WORD InitSystem ; IRQ