;-hitting select during a game doesn't ; JoustPong by Kirk Israel processor 6502 include vcs.h include macro.h org $F000 ;-------------------------------------- ;CONSTANTS ;-------------------------------------- FLAP_STRENGTH = 3;!!!3 ;how strong up is a flap? GRAV_DELAY = 8 ;How often does gravity pull 'em down? CEILING_HEIGHT = 88 ;floor heights are different, because heights are actually ;relative to the 'top' of the player or ball, but we want to ;make sure that the bottoms are hitting the floor FLOOR_HEIGHT_FOR_BALL = 4 FLOOR_HEIGHT_FOR_PLAYERS = 10 STRENGTH_OF_CEILING_REBOUND = 3;!!!3 SCORE_KERNAL_LENGTH = 5 GAME_KERNAL_LENGTH = 88 LENGTH_OF_FLAPSOUND = 15 PITCH_OF_FLAPSOUND = 15 ;2!,8-,15 all kind of worked TYPE_OF_FLAPSOUND = 2 VOLUME_OF_PONGHIT = 7 PITCH_OF_PONGHIT = 7 PITCH_OF_GOAL = 15 PIXEL_HEIGHT_OF_TITLE = 6 SCANLINES_PER_TITLE_PIXEL = 6 WINNING_SCORE = 10 SCANLINES_PER_PLAYFIELD_PIXEL = 11 ;-------------------------------------- ;VARIABLES ;-------------------------------------- p0YPosFromBot = $80 p0VisibleLine = $81 p0DrawBuffer = $82 p0VertSpeed = $83 p1YPosFromBot = $84 p1VisibleLine = $85 p1DrawBuffer = $86 p1VertSpeed = $87 but0WasOn = $88 but1WasOn = $8A gravTimer = $8B ballPosFromBot = $8C ballVisibleLine = $8D ballVertSpeed = $8E ballBuffer = $8F p0score = $90 p1score = $91 pointerP0Score = $92 pointerP1Score = $94 booleanBallRight = $96 flapsoundRemaining = $97 booleanGameIsTwoPlayers = $98 booleanSelectSwitchIsDown = $99 booleanResetSwitchIsDown = $9A booleanGameOver = $9B booleanOverrideSelectChangeThisTime = $9C bufferPlayFieldLeft = $9D bufferPlayFieldRight = $9E scanlineForPlayfieldCounter = $9F ;-------------------------------------- ;BOILER PLATE STARTUP ;-------------------------------------- Start SEI CLD TXS LDX #$FF LDA #0 ClearMem STA 0,X DEX BNE ClearMem LDA #$00 STA COLUBK ;-------------------------------------- ;OTHER INITIALIZATIONS ;-------------------------------------- LDA #GRAV_DELAY STA gravTimer ;initialize gravity timer (only 1 in N ticks do we pull) LDA #33 STA COLUP0 ;Set P0 Reddish LDA #66 STA COLUP1 ;Set P1 Purplish LDA #%11111111 STA booleanGameIsTwoPlayers ;-------------------------------------- ;START THE TITLE SCREEN ;-------------------------------------- TitleStart ;ok, now we're getting the usual 'just hit reset stuff' LDA #33 STA COLUPF ;colored playfield for title LDA #0 STA CTRLPF ;playfield ain't reflected STA AUDV0 STA AUDV1 ;-------------------------------------- ;OBJECT POSITIONING--VERY PRIMITIVE! ;-------------------------------------- ;use NOPs to position the players LDA #0 STA WSYNC SLEEP 20 ;Thomas's Sleep Macro STA RESM0 STA RESP0 SLEEP 20 ;Thomas's Sleep Macro STA RESBL SLEEP 14 STA RESP1 NOP STA RESM1 ;-------------------------------------- ;-------------------------------------- ; TITLE SCREEN ;-------------------------------------- ;-------------------------------------- TitleMainLoop LDA SWCHB AND #%00000001 ;is game reset? BNE TitleResetWasNotHit ;if so jump to MainGame JMP MainGameStart TitleResetWasNotHit LDA SWCHB AND #%00000010 ;is game select? BNE TitleSelectIsNotDownNow;if so proceed TitleSelectIsDownNow LDA #1 STA booleanSelectSwitchIsDown JMP TitleDoneCheckingSelect TitleSelectIsNotDownNow ;so the switch is currently not down LDA booleanSelectSwitchIsDown ;see if it was on before BNE TitleSelectWasAlreadyOn TitleSelectWasNotOn ; it wasn't on, it's still not on, what are we worried about? JMP TitleDoneCheckingSelect TitleSelectWasAlreadyOn ;it's not on now, they just let go LDA #0 STA booleanSelectSwitchIsDown ;record that it wasn't on before LDA booleanOverrideSelectChangeThisTime BNE OverridingSelectChange LDA booleanGameIsTwoPlayers EOR #%11111111 ;toggle the boolean for # of players STA booleanGameIsTwoPlayers OverridingSelectChange LDA #0 STA booleanOverrideSelectChangeThisTime TitleDoneCheckingSelect ;MainLoop starts with usual VBLANK code, ;and the usual timer seeding LDA #2 STA VSYNC STA WSYNC STA WSYNC STA WSYNC LDA #43 STA TIM64T LDA #0 STA VSYNC ; LDA booleanGameIsTwoPlayers ; BEQ GameIsTwoPlayers ;GameIsOnePlayer ; LDA #77 ; STA COLUPF ; JMP DoneCheckingPlayerCount ;GameIsTwoPlayers ; LDA #121 ; STA COLUPF ;DoneCheckingPlayerCount TitleSelectWasNotHit TitleWaitForVblankEnd LDA INTIM BNE TitleWaitForVblankEnd STA VBLANK ;just burning scanlines....you could do something else LDY #20 TitlePreLoop STA WSYNC DEY BNE TitlePreLoop LDX #PIXEL_HEIGHT_OF_TITLE ; X will hold what letter pixel we're on LDY #SCANLINES_PER_TITLE_PIXEL ; Y will hold which scan line we're on for each pixel ; ;the next part is careful cycle counting from those ;who have gone before me.... TitleShowLoop STA WSYNC LDA PFData0Left-1,X ;[0]+4 STA PF0 ;[4]+3 = *7* < 23 ;PF0 visible LDA PFData1Left-1,X ;[7]+4 STA PF1 ;[11]+3 = *14* < 29 ;PF1 visible LDA PFData2Left-1,X ;[14]+4 STA PF2 ;[18]+3 = *21* < 40 ;PF2 visible NOP ;[21]+2 NOP ;[23]+2 NOP ;[25]+2 ;six cycles available Might be able to do something here LDA PFData0Right-1,X ;[27]+4 ;PF0 no longer visible, safe to rewrite STA PF0 ;[31]+3 = *34* LDA PFData1Right-1,X ;[34]+4 ;PF1 no longer visible, safe to rewrite STA PF1 ;[38]+3 = *41* LDA PFData2Right-1,X ;[41]+4 ;PF2 rewrite must begin at exactly cycle 45!!, no more, no less STA PF2 ;[45]+2 = *47* ; > DEY ;ok, we've drawn one more scaneline for this 'pixel' BNE NotChangingWhatTitlePixel ;go to not changing if we still have more to do for this pixel DEX ; we *are* changing what title pixel we're on... BEQ DoneWithTitle ; ...unless we're done, of course LDY #SCANLINES_PER_TITLE_PIXEL ;...so load up Y with the count of how many scanlines for THIS pixel... NotChangingWhatTitlePixel JMP TitleShowLoop DoneWithTitle ;clear out the playfield registers for obvious reasons LDA #0 STA PF2 ;clear out PF2 first, I found out through experience STA PF0 STA PF1 ;just burning scanlines....you could do something else LDY #40 ;was 138 TitlePostLoop STA WSYNC DEY BNE TitlePostLoop ;mirror player 1 LDA #%00001000 STA REFP1 LDY #8 TitlePlayerLoop STA WSYNC LDA WingUpGraphic-1,Y STA GRP0 LDA booleanGameIsTwoPlayers BEQ TitleDrawPlayer1ForTwoPlayers LDA FujiGraphic-1,Y JMP TitleDoneChooseDrawPlayer1 TitleDrawPlayer1ForTwoPlayers LDA WingUpGraphic-1,Y TitleDoneChooseDrawPlayer1 STA GRP1 DEY STA WSYNC BNE TitlePlayerLoop LDA #0 STA GRP0 STA GRP1 ;just burning scanlines....you could do something else LDY #82 TitlePostPostLoop STA WSYNC DEY BNE TitlePostPostLoop ; usual vblank LDA #2 STA VBLANK LDX #30 TitleOverScanWait STA WSYNC DEX BNE TitleOverScanWait JMP TitleMainLoop ;-------------------------------------- ;-------------------------------------- ; MAIN GAME ;-------------------------------------- ;-------------------------------------- MainGameStart LDA #%00010001 STA CTRLPF LDA #120 STA p0YPosFromBot ;P0 Initial Y Position STA p1YPosFromBot ;P1 Initial Y Position LDA #0 STA p0VertSpeed STA p1VertSpeed LDA #0 STA p0score STA p1score STA booleanGameOver ;generate the background ;this is just one dot on the edge ;reflected. we'll use it for collision ;detection to know when a goal ;is scored ;-------------------------------------- ;SETTING UP PLAYFIELD AND BALL ETC ;-------------------------------------- LDA #%00100000 STA PF0 LDA #99 STA COLUPF ;color here ; LDA #%00000010 ; STA ENABL ;moving left, booleanBallRight is alreay 0.... LDA #%00010000 STA HMBL ;TODO: don't just oddly put in ball sped ;LDA #%11111111 ;LDA #%00000001 LDA #1 STA ballVertSpeed ;position ball LDA #20 STA ballPosFromBot ;make missiles double wide LDA #%00110000 STA NUSIZ0 ;seed the sound buffers LDA #TYPE_OF_FLAPSOUND STA AUDC0 ;type of sound LDA #PITCH_OF_FLAPSOUND STA AUDF0 ;pitch LDA #4 STA AUDC1 ;type of sound ;-------------------------------------- ;-------------------------------------- ;START MAIN LOOP W/ VSYNC ;-------------------------------------- ;-------------------------------------- MainLoop LDA SWCHB AND #%00000001 ;is game reset? BNE ResetWasNotHit ;if so jump to MainGame JMP MainGameStart ResetWasNotHit LDA SWCHB AND #%00000010 ;is game select hit? BNE SelectWasNotHit ;if so jump to the title screen ;hopefully these are the only initialzations we have to perform? ;might need to change logic if not... LDA #0 STA CTRLPF ;playfield ain't reflected STA AUDV0 STA AUDV1 LDA #1 STA booleanOverrideSelectChangeThisTime JMP TitleSelectIsDownNow SelectWasNotHit LDA #2 STA VSYNC STA WSYNC STA WSYNC STA WSYNC LDA #43 STA TIM64T LDA #0 STA VSYNC STA AUDV1 ;volume for dinger ;-------------------------------------- ;SEE IF BUTTON 0 IS NEWLY PRESSED ;-------------------------------------- CheckButton0 LDA INPT4 BMI NoButton0 ;Check to see if the button was already down LDA but0WasOn BNE Button0WasAlreadyDown ;New Button Pressed Time to Flap! LDA p0VertSpeed SEC SBC #FLAP_STRENGTH STA p0VertSpeed LDA #1 STA but0WasOn LDA #LENGTH_OF_FLAPSOUND STA flapsoundRemaining Button0WasAlreadyDown JMP EndButton0 NoButton0 ;button wasn't pressed, remember that LDA #0 STA but0WasOn EndButton0 ;-------------------------------------- ;PLAYER 1 CONTROL, JOYSTICK OR AI? ;-------------------------------------- LDA booleanGameIsTwoPlayers BNE Player1AI ;-------------------------------------- ;SEE IF BUTTON 1 IS NEWLY PRESSED ;-------------------------------------- CheckButton1 LDA INPT5 BMI NoButton1 ;Check to see if the button was already down LDA but1WasOn BNE Button1WasAlreadyDown ;New Button Pressed Time to Flap! LDA p1VertSpeed SEC SBC #FLAP_STRENGTH STA p1VertSpeed LDA #1 STA but1WasOn LDA #LENGTH_OF_FLAPSOUND STA flapsoundRemaining Button1WasAlreadyDown JMP EndButton1 NoButton1 ;button wasn't pressed, remember that LDA #0 STA but1WasOn EndButton1 JMP AllDoneWithPlayer1 ;-------------------------------------- ;AI for Player 1 ;-------------------------------------- Player1AI ;don't do anything if game is over LDA booleanGameOver BEQ ContinueP1GameIsOn ;on your way LDA #0 ;don't let the guy flap up... STA but1WasOn ;needed to make wing up appear JMP DoneCheckingP1BeneathBall ContinueP1GameIsOn ;don't do anything if ball is heading away LDA booleanBallRight BEQ DoneCheckingP1BeneathBall ;is p1 lower than the ball? LDA p1YPosFromBot CMP ballPosFromBot BCS ResetP1WingGraphic ;P1 is lower, give it a flap LDA p1VertSpeed SEC SBC #FLAP_STRENGTH STA p1VertSpeed LDA #1 STA but1WasOn ;needed to make wing down appear LDA #LENGTH_OF_FLAPSOUND STA flapsoundRemaining JMP DoneCheckingP1BeneathBall ResetP1WingGraphic LDA #0 STA but1WasOn ;needed to make wing up appear DoneCheckingP1BeneathBall AllDoneWithPlayer1 ;-------------------------------------- ;SEE IF ITS TIME TO ADD 1 TO PLAYER'S SPEEDS ;THANKS TO GRAVITY ;-------------------------------------- DEC gravTimer BNE DoneWithGravity INC p0VertSpeed INC p1VertSpeed LDA #GRAV_DELAY STA gravTimer DoneWithGravity ;-------------------------------------- ;SEE IF BALL HIT PLAYER 0 ;-------------------------------------- LDA #%01000000 BIT CXP0FB BEQ NoCollisionBallP0 ;skip if not hitting... ;we have a hit LDA #%11110000 ;ball goes right STA HMBL LDA #1 STA booleanBallRight ;adjust ball vert speed w/ players speed ; LDA p0VertSpeed ;; CLC ;; ADC ballVertSpeed ; STA ballVertSpeed ;adjust ball vert speed w/ players speed ; LDA p0VertSpeed ; STA ballVertSpeed LDA #PITCH_OF_PONGHIT STA AUDF1 ;pitch LDA #VOLUME_OF_PONGHIT STA AUDV1 ;volume for dinger NoCollisionBallP0 ;-------------------------------------- ;SEE IF BALL HIT PLAYER 1 ;-------------------------------------- LDA #%01000000 BIT CXP1FB BEQ NoCollisionBallP1 ;skip if not hitting... ;we have a hit LDA #%00010000 ;ball goes left STA HMBL LDA #0 STA booleanBallRight ;adjust ball vert speed w/ players speed ; LDA p1VertSpeed ; STA ballVertSpeed LDA #PITCH_OF_PONGHIT STA AUDF1 ;pitch LDA #VOLUME_OF_PONGHIT STA AUDV1 ;volume for dinger NoCollisionBallP1 ;-------------------------------------- ;SEE IF BALL HIT PLAYER GOAL ;-------------------------------------- LDA #%10000000 BIT CXBLPF BEQ NoBallPlayfieldCollision LDA #PITCH_OF_GOAL STA AUDF1 ;pitch LDA #VOLUME_OF_PONGHIT STA AUDV1 ;volume for dinger LDA booleanBallRight BEQ HitGoingLeft HitGoingRight INC p0score LDA #%00010000 ;move ball left STA HMBL STA COLUPF LDA #0 STA booleanBallRight LDA #WINNING_SCORE-1 CMP p0score BCS DoneCheckingP0Won ;game over man, game over LDA #1 STA booleanGameOver DoneCheckingP0Won JMP DoneAddingToScore HitGoingLeft INC p1score LDA #%11110000 ;ball goes right STA HMBL STA COLUPF LDA #1 STA booleanBallRight LDA #WINNING_SCORE-1 CMP p1score BCS DoneCheckingP1Won ;game over man, game over LDA #1 STA booleanGameOver DoneCheckingP1Won DoneAddingToScore ;put ball in center ; STA WSYNC ; SLEEP 44 ; STA RESBL ;make the ball move damnit STA WSYNC STA HMOVE NoBallPlayfieldCollision STA CXCLR ;reset the collision detection for next time ;-------------------------------------- ;ADJUST BALL VERTICAL POSITION ;-------------------------------------- ;add negative of ball speed to ball to "0" LDA #0 SEC SBC ballVertSpeed ;and add old psition to that CLC ADC ballPosFromBot STA ballPosFromBot ;-------------------------------------- ;SEE IF BALL HIT FLOOR ;-------------------------------------- LDA #FLOOR_HEIGHT_FOR_BALL CLC CMP ballPosFromBot BCC DoneCheckingHitFloorBall ;ball speed is negative of previous ball speed LDA #0; SEC SBC ballVertSpeed STA ballVertSpeed ;place ball on floor LDA #FLOOR_HEIGHT_FOR_BALL ; floor for ball? STA ballPosFromBot DoneCheckingHitFloorBall ;-------------------------------------- ;SEE IF BALL HIT CEILING ;-------------------------------------- ;check if player 0 hit ceiling - full rebound LDA #CEILING_HEIGHT ;#was 180 before 2 line kernal CMP ballPosFromBot BCS DoneCheckingHitCeilingBall ;ball speed is negative of previous ball speed LDA #0; SEC SBC ballVertSpeed STA ballVertSpeed ;place ball on floor LDA #CEILING_HEIGHT ;#was 180 STA ballPosFromBot DoneCheckingHitCeilingBall ;-------------------------------------- ;MOVE THE PLAYERS ;-------------------------------------- ;Add the negative of the Player 0 Vert Speed to 0 in A LDA #0 SEC SBC p0VertSpeed ;Then add the current position of p0 CLC ADC p0YPosFromBot STA p0YPosFromBot ;Add the negative of the Player 1 Vert Speed to 0 in A LDA #0 SEC SBC p1VertSpeed ;Then add the current position p1 CLC ADC p1YPosFromBot STA p1YPosFromBot ;-------------------------------------- ;SEE IF PLAYER 0 HIT FLOOR ;-------------------------------------- ;check if player 0 hit floor LDA #FLOOR_HEIGHT_FOR_PLAYERS ;10 is floor CLC CMP p0YPosFromBot BCC DoneCheckingHitFloorP0 ;speed should be positve; let's divide it my two and then ;subtract it from zero to get the new speed (i.e. a half rebound) LDA p0VertSpeed CLC ROR STA p0VertSpeed LDA #0 SEC SBC p0VertSpeed STA p0VertSpeed LDA #FLOOR_HEIGHT_FOR_PLAYERS STA p0YPosFromBot ;putplayer on floor DoneCheckingHitFloorP0 ;-------------------------------------- ;SEE IF PLAYER 1 HIT FLOOR ;-------------------------------------- ;check if player 1 hit floor LDA #FLOOR_HEIGHT_FOR_PLAYERS ;10 is floor CLC CMP p1YPosFromBot BCC DoneCheckingHitFloorP1 ;we need a better bounce routine, like reducing the speed? ;speed should be positve; let's divide it my two and then ;subtract it from zero to get the new speed (i.e. a half rebound) LDA p1VertSpeed CLC ROR STA p1VertSpeed LDA #0 SEC SBC p1VertSpeed STA p1VertSpeed LDA #FLOOR_HEIGHT_FOR_PLAYERS STA p1YPosFromBot ;putplayer on floor DoneCheckingHitFloorP1 ;-------------------------------------- ;SEE IF PLAYER 0 HIT CEILING ;-------------------------------------- ;check if player 0 hit ceiling - LDA #CEILING_HEIGHT CMP p0YPosFromBot BCS DoneCheckingHitCeilingP0 LDA #STRENGTH_OF_CEILING_REBOUND STA p0VertSpeed LDA #CEILING_HEIGHT ;#was 180 STA p0YPosFromBot DoneCheckingHitCeilingP0 ;-------------------------------------- ;SEE IF PLAYER 1 HIT CEILING ;-------------------------------------- ;check if player 1 hit ceiling - LDA #CEILING_HEIGHT CMP p1YPosFromBot BCS DoneCheckingHitCeilingP1 LDA #STRENGTH_OF_CEILING_REBOUND STA p1VertSpeed LDA #CEILING_HEIGHT ;#was 180 STA p1YPosFromBot DoneCheckingHitCeilingP1 ;;-------------------------------------- ;;SEE IF PLAYER 0 HIT CEILING ;;-------------------------------------- ; ;;check if player 0 hit ceiling - ; LDA #CEILING_HEIGHT ;#was 180 before 2 line kernal ; CMP p0YPosFromBot ; BCS DoneCheckingHitCeilingP0 ; ; LDA #0; ; SEC ; ; SBC p0VertSpeed ; STA p0VertSpeed ; LDA #CEILING_HEIGHT ;#was 180 ; STA p0YPosFromBot ; ;DoneCheckingHitCeilingP0 ; ;;-------------------------------------- ;;SEE IF PLAYER 1 HIT CEILING ;;-------------------------------------- ; ;;check if player 1 hit ceiling - full rebound ; LDA #CEILING_HEIGHT ;#was 180 before 2 line kernal ; CMP p1YPosFromBot ; BCS DoneCheckingHitCeilingP1 ; ; LDA #0; ; SEC ; ; SBC p1VertSpeed ; STA p1VertSpeed ; LDA #CEILING_HEIGHT ; was 180 ; STA p1YPosFromBot ; ;DoneCheckingHitCeilingP1 ; ;-------------------------------------- ;CALCULATE SCORE POINTERS ;-------------------------------------- ;Erik Mooney ;So, let's create a 16-bit value in memory that is the offset to the start ;of your digit. After you've multiplied A by 5: ;Now we will create a 16-bit pointer in the memory location called ;TempPointer that points to your digit. That odd-looking LDA means "load ;the high byte of the 16-bit hardcoded value Score0Graphic". All of this ;you only need to do once, not for every line of the score. From here it's ;simple: LDA p0score ;accumulator = score ASL ;accumulator = score * 2 ASL ;accumulator = score * 4 ADC p0score ;accumulator = (score * 4) + score = score * 5 ADC #15 STA pointerP0Score LDA #>Score0Graphic STA pointerP0Score+1 LDA p1score ;accumulator = score ASL ;accumulator = score * 2 ASL ;accumulator = score * 4 ADC p1score ;accumulator = (score * 4) + score = score * 5 ADC #15 STA pointerP1Score LDA #>Score0Graphic STA pointerP1Score+1 ;-------------------------------------- ;DIMINISH FLAP SOUND ;-------------------------------------- LDA flapsoundRemaining BMI NoFlapSound STA AUDV0 ;volume DEC flapsoundRemaining NoFlapSound ;-------------------------------------- ;WAIT FOR VBLANK TO END ;-------------------------------------- WaitForVblankEnd LDA INTIM BNE WaitForVblankEnd STA VBLANK STA WSYNC STA HMOVE ;-------------------------------------- ;SCORE DISPLAY KERNAL ;-------------------------------------- LDY #SCORE_KERNAL_LENGTH ;make sure p1 isn't reversed LDA #%00000000 STA REFP1 STA WSYNC ScoreDisplayLoop LDA (pointerP0Score),Y STA GRP0 LDA (pointerP1Score),Y STA GRP1 DEY STA WSYNC STA WSYNC BNE ScoreDisplayLoop LDA #0 STA GRP0 STA GRP1 STA WSYNC STA WSYNC STA WSYNC STA WSYNC ;flip p1 before game kernal LDA #%00001000 STA REFP1 STA WSYNC ;-------------------------------------- ;MAIN GAME KERNAL ;-------------------------------------- LDA #SCANLINES_PER_PLAYFIELD_PIXEL STA scanlineForPlayfieldCounter LDY #GAME_KERNAL_LENGTH ;-------------------------------------- ;MAIN SCANLINE LOOP ;-------------------------------------- MainGameLoop STA WSYNC ;-------------------------------------- ;PLAYER BUFFER STUFFER LOGIC ; the idea is that we've already calculated ; the graphic for the players (and the enable ; of the ball) during the ; last scan line, so all we have to do now ; is jam that predrawn buffer into the right ; graphics register--which we have time for ; during the horizontal blank ;-------------------------------------- LDA bufferPlayFieldLeft STA PF0 LDA booleanGameOver BNE SkipTheBall LDA ballBuffer STA ENABL SkipTheBall LDA p0DrawBuffer ;[0]+3 STA GRP0 ;[3]+3 LDA p1DrawBuffer ;[6]+3 STA GRP1 ;[9]+3 ; here the idea is that p0VisibleLine ; is zero if the line isn't being drawn now, ; otherwise it's however many lines we have to go CheckActivatePlayer0 CPY p0YPosFromBot ;[12]+4 BNE SkipActivatePlayer0 ;[16]+3 LDA #8 ;8 lines tall ;[19]+3 STA p0VisibleLine ;[22]+3 SkipActivatePlayer0 ;turn player off then see if it should be on LDA #00 ;[25]+3 ; ;if the p0VisibleLine is non zero, ;we're drawing it ; LDX p0VisibleLine ;[28]+3 BEQ FinishPlayer0 ;[31]+3 IsPlayer0On LDA but0WasOn ;[34]+3 DoWing0 BNE DrawWing0Down ;[37]+3 DrawWing0Up LDA WingUpGraphic-1,X ;[40]+3 JMP Wing0Finish ;[43]+3 DrawWing0Down LDA WingDownGraphic-1,X Wing0Finish DEC p0VisibleLine ;[46]+3 FinishPlayer0 STA p0DrawBuffer ;[49]+3 ; here the idea is that p1VisibleLine ; is zero if the line isn't being drawn now, ; otherwise it's however many lines we have to go CheckActivatePlayer1 CPY p1YPosFromBot BNE SkipActivatePlayer1 LDA #8 ;8 lines tall STA p1VisibleLine SkipActivatePlayer1 ;turn player off then see if it should be on LDA #00 ; ;if the p0VisibleLine is non zero, ;we're drawing it ; LDX p1VisibleLine BEQ FinishPlayer1 IsPlayer1On LDA but1WasOn DoWing1 BNE DrawWing1Down DrawWing1Up LDA WingUpGraphic-1,X JMP Wing1Finish DrawWing1Down LDA WingDownGraphic-1,X Wing1Finish DEC p1VisibleLine FinishPlayer1 STA p1DrawBuffer CheckActivateBall CPY ballPosFromBot ;compare Y to the YPosFromBot... BNE SkipActivateBall ;if not equal, skip this... LDA #2 ;otherwise say that this should go STA ballVisibleLine ;on for 2 lines SkipActivateBall LDA #0 STA ballBuffer LDA ballVisibleLine ;load the value of what missile line we're showing BEQ FinishBall ;if zero we aren't showing, skip it BallMustBeOn LDA #2 ;otherwise STA ballBuffer ;showit DEC ballVisibleLine ;and decrement the missile line thing FinishBall DEC scanlineForPlayfieldCounter BEQ SetupForTheNextPlayfieldPixel JMP DoneWithThePlayfieldPixels SetupForTheNextPlayfieldPixel ;reset scanlineForPlayfieldCounter, ;which tells us how many scanlines we'll ;be drawing this for LDA #SCANLINES_PER_PLAYFIELD_PIXEL STA scanlineForPlayfieldCounter LDA bufferPlayFieldLeft BEQ LeftPlayfieldBooleanWasOff LeftPlayfieldBooleanWasOn LDA #0 JMP LeftPlayfieldDoneBoolean LeftPlayfieldBooleanWasOff LDA #%00100000 LeftPlayfieldDoneBoolean STA bufferPlayFieldLeft DoneWithThePlayfieldPixels ;now just finish counting of scanloop DEY BEQ AllDoneWithMainGameLoop JMP MainGameLoop AllDoneWithMainGameLoop LDA #2 STA WSYNC STA VBLANK LDX #30 OverScanWait STA WSYNC DEX BNE OverScanWait JMP MainLoop org $FF00 ;-------------------------------------- ;GRAPHICS ;-------------------------------------- WingUpGraphic .byte #%00001100 .byte #%00001100 .byte #%10001100 .byte #%11011100 .byte #%11111100 .byte #%01111100 .byte #%00101100 .byte #%00001100 WingDownGraphic .byte #%00001100 .byte #%00011100 .byte #%00111100 .byte #%01111100 .byte #%01111100 .byte #%00111100 .byte #%00001100 .byte #%00001100 Score0Graphic .byte #%00111100 .byte #%01000010 .byte #%01000010 .byte #%01000010 .byte #%00111100 Score1Graphic .byte #%00111110 .byte #%00001000 .byte #%00001000 .byte #%00101000 .byte #%00011000 Score2Graphic .byte #%01111110 .byte #%01100000 .byte #%00011100 .byte #%01000010 .byte #%00111100 Score3Graphic .byte #%01111100 .byte #%00000010 .byte #%00011100 .byte #%00000010 .byte #%01111100 Score4Graphic .byte #%00000100 .byte #%00000100 .byte #%01111110 .byte #%01000100 .byte #%01000100 Score5Graphic .byte #%01111100 .byte #%00000010 .byte #%01111100 .byte #%01000000 .byte #%01111110 Score6Graphic .byte #%00111100 .byte #%01000010 .byte #%01111100 .byte #%01100000 .byte #%00011110 Score7Graphic .byte #%00010000 .byte #%00001000 .byte #%00000100 .byte #%00000010 .byte #%01111110 Score8Graphic .byte #%00111100 .byte #%01000010 .byte #%00111100 .byte #%01000010 .byte #%00111100 Score9Graphic .byte #%00000010 .byte #%00000010 .byte #%00011110 .byte #%00100010 .byte #%00011100 ScoreWGraphic .byte #%01000100 .byte #%10101010 .byte #%10010010 .byte #%10000010 .byte #%00000000 PFData0Left .byte #%00000000 .byte #%00000000 .byte #%10000000 .byte #%01000000 .byte #%00000000 .byte #%00000000 PFData1Left .byte #%00000000 .byte #%00000000 .byte #%00010011 .byte #%10101010 .byte #%10010010 .byte #%10000000 PFData2Left .byte #%00000000 .byte #%00000000 .byte #%10001101 .byte #%10001001 .byte #%11011001 .byte #%10000000 PFData0Right .byte #%00000000 .byte #%00000000 .byte #%01000000 .byte #%11000000 .byte #%01010000 .byte #%11000000 PFData1Right .byte #%00000000 .byte #%00000000 .byte #%00010010 .byte #%00101010 .byte #%10010011 .byte #%00000000 PFData2Right .byte #%00001100 .byte #%00010000 .byte #%00011001 .byte #%00010101 .byte #%00011000 .byte #%00000000 FujiGraphic .byte #%00000000 .byte #%10010010 .byte #%01010100 .byte #%00101000 .byte #%00101000 .byte #%00101000 .byte #%00111000 .byte #%00000000 org $FFFC .word Start .word Start ;;;;THE JUNKYARD ;;See if we're going too darn fast ; LDA MaximumSpeed ; SEC ; ;;;;SBC MaximumSpeed ; Maximum Speed ; ; CMP p0VertSpeed ; BCS SpeedNotMaxxed ; ; ;; BMI SpeedNotMaxxed ;if speed - maxspeed is positive, we need to slow down ; LDA MaximumSpeed ; STA p0VertSpeed ; ;SpeedNotMaxxed ;;assum horiz movement will be zero ; LDX #$00 ; LDA #$40 ;Left? ; BIT SWCHA ; BNE SkipMoveLeftP0 ; LDX #$10 ; LDA #%00001000 ; STA REFP0 ;show reflected version ;SkipMoveLeftP0 ; ; LDA #$80 ;Right? ; BIT SWCHA ; BNE SkipMoveRightP0 ; LDX #$F0 ; LDA %00000000 ; STA REFP0 ;SkipMoveRightP0 ; ; STX HMP0 ;set horiz movement for player 0 ; ; ;;assum horiz movement will be zero ; LDX #$00 ; LDA #$04 ;Left? ; BIT SWCHA ; BNE SkipMoveLeftP1 ; LDX #$10 ; LDA #%00001000 ; STA REFP1 ;SkipMoveLeftP1 ; ; LDA #$08 ;Right? ; BIT SWCHA ; BNE SkipMoveRightP1 ; LDX #$F0 ; LDA %00000000 ; STA REFP1 ;SkipMoveRightP1 ; ; STX HMP1 ;set horiz movement for player 0 ;BigHeadGraphic ; .byte %00111100 ; .byte %01111110 ; .byte %11000001 ; .byte %10111111 ; .byte %11111111 ; .byte %11101011 ; .byte %01111110 ; .byte %00111100