;DONE Mar 3 ;play to 3 point during poorlords ;switched to dark grey for both floor and ceiling (formerly just floor, lighter ceiling) ;added ball freeze at begining of new game ;if the ball hits a player whos resting on the ground, rather than going flat (and getting caught in a likely loop) it has an upward tilt ;---------------------- ;TODO ;ballbounce ;--consider making ball horiz speed faster when vert speed is slower, vice vers ;--speed up horizontal speed as game progresses ;optional ;countdown timer at start? ;thump sound when player lands at bottom? ;decide: ok to flash at 2 when only play to 3? ;decide -pterry "looks" at player who was ahead on title? (leaning against) ; bug w/ stellax, jsut doesn't work ; bug w/ Z26: game select during game makes sound and shown frame rate go nuts, though plays ok ; JoustPong by Kirk Israel processor 6502 include vcs.h include macro.h MAC CHECKPAGE IF >. != >{1} ECHO "" ECHO "ERROR: different pages! (", {1}, ",", ., ")" ECHO "" ERR ENDIF ENDM ;-------------------------------------- ;CONSTANTS ;-------------------------------------- P0COLOR = #$7C; #$18;paul suggests #$18 P1COLOR = #$4D;paul suggests #$C8 SCOREBKCOLOR = #$02 GAMEPFCOLOR = #$9F PFMODE = #1 ; 3 = "score" mode, 1 = regular (ball/PF same color) CEILING_HEIGHT = #88 ;??? CEILING_HALF = #44 ;-16 ;SLOW_GRAV_LO_BYTE = #%11110000 ;SLOW_GRAV_HI_BYTE = #%11111111 ;-11 SLOW_GRAV_LO_BYTE = #%11110101 SLOW_GRAV_HI_BYTE = #%11111111 SLOW_REBOUND_LO_BYTE = #%00000000 SLOW_REBOUND_HI_BYTE = #%11111111 PTERRY_HIT_PUSH_LO_BYTE = #%00000000 PTERRY_HIT_PUSH_HI_BYTE = #%11111111 SLOW_FLAP_LO_BYTE = #%11001000 SLOW_FLAP_HI_BYTE = #%00000000 FAST_FLAP_LO_BYTE = #%00000000 FAST_FLAP_HI_BYTE = #%00000001 ;SLOW BALL SPEED *WAS* 192 ;170 SLOW_BALL_RIGHT_SPEED_LO_BYTE = #%10101010 SLOW_BALL_RIGHT_SPEED_HI_BYTE = #%00000000 SLOW_BALL_LEFT_SPEED_LO_BYTE = #%01010110 SLOW_BALL_LEFT_SPEED_HI_BYTE = #%11111111 ;210 FAST_BALL_RIGHT_SPEED_LO_BYTE = #%11111010 FAST_BALL_RIGHT_SPEED_HI_BYTE = #%00000000 FAST_BALL_LEFT_SPEED_LO_BYTE = #%00000110 FAST_BALL_LEFT_SPEED_HI_BYTE = #%11111111 MAX_BALL_SPEED_BOOST = #250 MIN_COMPUTER_REST_TIME_EASY = #15 MIN_COMPUTER_REST_TIME_HARD = #0 GAMEFIELD_HEIGHT_IN_BRICKS = #22 SPRITEHEIGHT = #8 ;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 = #1 FLOOR_HEIGHT_FOR_PLAYERS = #10 STRENGTH_OF_CEILING_REBOUND = #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 PITCH_OF_PONG_WALL_HIT = #25 ;was 6 pixel height, 6 scanlines per ; 74 - 36 = 38 PIXEL_HEIGHT_OF_TITLE = #30 PIXEL_HEIGHT_OF_TITLE_PONG = #7 SCANLINES_PER_TITLE_PIXEL = #2 WINNING_SCORE = #10 WINNING_SCORE_POORLORDS = #3 BALLPOS_LEFT = #5 ;had to hack so it didn't show up on right side before reset... BALLPOS_CENTER = #80 BALLPOS_RIGHT = #160 PTERRY_LEFT_BOUNDARY = #10 PTERRY_RIGHT_BOUNDARY = #138 MUSICRIFF_NOTECOUNT = #16 MUSICBEAT_NOTECOUNT = #12 PTERRYVOICE_NOTECOUNT = #10 PTERRY_LENGTH_OF_WINGCHANGE = #10 PTERRY_LENGTH_TIL_BOREDOM = #40 BALL_MAX_SPEED = #1 BALL_MIN_SPEED = #-1 BALL_FUDGE_SPEED = #%00100000 VOICE_FOR_MUSIC = #10 ;12 orig ;#3 is good enginey ;6 is good low tone, 10 ;9 ok, fartyish VOICE_FOR_BEAT = #8 BALL_FREEZE_TIME = #60 ;-------------------------------------- ;VARIABLES ;-------------------------------------- SEG.U VARS ORG $80 slowP0YCoordFromBottom ds 2 slowP0YSpeed ds 2 slowP1YCoordFromBottom ds 2 slowP1YSpeed ds 2 p0VisibleLine ds 1 p0DrawBuffer ds 1 p1VisibleLine ds 1 p1DrawBuffer ds 1 but0WasOn ds 1 but1WasOn ds 1 slowBallYSpeed ds 2 slowBallYCoordFromBot ds 2 ballVisibleLine ds 1 ballBuffer ds 1 p0score ds 1 p1score ds 1 pointerP0Score ds 2 pointerP1Score ds 2 pointerP0Graphic ds 2 pointerP1Graphic ds 2 varHowMuchTimeComputerNeedsToRest ds 1 booleanBallRight ds 1 flapsoundRemaining ds 1 booleanGameIsTwoPlayers ds 1 variableGameMode ds 1 booleanSelectSwitchIsDown ds 1 booleanResetSwitchIsDown ds 1 booleanGameOver ds 1 ;--booleanOverrideSelectChangeThisTime ds 1 bufferPFLeft ds 1;;WALL;; bufferPFRight ds 1;;WALL;; playfieldMatrixLeft ds 22;;WALL;; playfieldMatrixRight ds 22;;WALL;; ;musicRiffNotePointer ds 2 musicRiffNoteCounter ds 1 musicRiffNoteTimeLeft ds 1 ;musicBeatNotePointer ds 2 musicBeatNoteCounter ds 1 musicBeatNoteTimeLeft ds 1 winningScore ds 1 PS_temp ds 1 ballXposition ds 2 booleanPterryGoesRight ds 1 booleanPterryWingIsUp ds 1 counterPterryWingChange ds 1 pointerPterryGraphic ds 2 pterryHorizPosition ds 1 varPterryVerticalPos ds 1 varPterryBoredCounter ds 1 varPterryBehavior ds 1 varPterryWasHitWithBall ds 1 tempVar ds 1 saveStack ds 2 booleanIsOnTitleScreen ds 1 varTimeComputerResting ds 1 ;MIN_COMPUTER_REST_TIME varScoreColorP0 ds 1 varScoreColorP1 ds 1 varScoreColorFlasherP0 ds 1 varScoreColorFlasherP1 ds 1 pterryVoiceNoteCounter ds 1 pterryVoiceNoteTimeLeft ds 1 flagPterryMakeNoise ds 1 varTimeBeforeBallMoves ds 1 ;temp! varBallExtraSpeed ds 1 msgVar ds 1 Zero ds 1 ; must contain zero (for kernel) echo "----",($100 - *) , "bytes of RAM left" SEG CODE org $F000 ;MAXIMUM_SPEED = #6 ;-------------------------------------- ;BOILER PLATE STARTUP ;-------------------------------------- Start sei cld txs ldx #$FF lda #0 ClearMem sta 0,X dex bne ClearMem ;-------------------------------------- ;OTHER INITIALIZATIONS ;-------------------------------------- lda #0 sta COLUBK sta GRP0 sta GRP1 sta PF0 sta PF1 sta PF2 ;lda #1 ;sta variableGameMode lda #>GraphicsPage ;grab the hight byte of the graphic location for score graphics.... sta pointerP0Graphic+1 ;2 byte memory lookup sta pointerP1Graphic+1 sta pointerP0Score+1 sta pointerP1Score+1 sta pointerPterryGraphic+1 lda #33 sta COLUP0 ;Set P0 Reddish lda #66 sta COLUP1 ;Set P1 Purplish ;-------------------------------------- ;START THE TITLE SCREEN ;-------------------------------------- TitleStart lda #0 sta slowBallYCoordFromBot lda #100 sta slowBallYCoordFromBot+1 lda #14 sta slowP0YCoordFromBottom+1 lda #14 sta slowP1YCoordFromBottom+1 lda #14 sta varPterryVerticalPos lda #0 sta booleanBallRight ;start ball moving right lda #BALLPOS_CENTER sta pterryHorizPosition lda # 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 nop nop nop lda #$7C sta COLUPF ldx #PIXEL_HEIGHT_OF_TITLE_PONG ; 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 ; ;THEN WE DO PONG PongTitleShowLoop sta WSYNC lda PFDataTitlePong0Left-1,X ;[0]+4 sta PF0 ;[4]+3 = *7* < 23 ;PF0 visible lda PFDataTitlePong1Left-1,X ;[7]+4 sta PF1 ;[11]+3 = *14* < 29 ;PF1 visible lda PFDataTitlePong2Left-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 PFDataTitlePong0Right-1,X ;[27]+4 ;PF0 no longer visible, safe to rewrite sta PF0 ;[31]+3 = *34* lda PFDataTitlePong1Right-1,X ;[34]+4 ;PF1 no longer visible, safe to rewrite sta PF1 ;[38]+3 = *41* lda PFDataTitlePong2Right-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 NotChangingWhatPongTitlePixel ;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 DoneWithPongTitle ; ...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... NotChangingWhatPongTitlePixel ; stx tempVar ; ; lda #7 ; clc ; cmp tempVar ; bcc DoneCheckingChangePFColor ; jmp PongTitleShowLoop DoneWithPongTitle ;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.... ldy #24 TitlePostLoop sta WSYNC dey bne TitlePostLoop lda #1 sta CTRLPF ;playfield ain't reflected lda # Current scannline SEC ; 2 new SBC slowP0YCoordFromBottom+1 ; 3 copyint ADC #SPRITEHEIGHT+1 ; 2 calc if sprite is drawn STY GRP1 ; 3 Execute Write for ptery here ldy #P0COLOR ; 2 ; --------------- line 1 ; sta WSYNC ; WSYNC *** removed *** sty COLUP0 ; 3 BCC skipDrawLeftSelector ; 2/3 To skip or not to skip? TAY ; 2 not necessary when Y holds scannline lda (pointerP0Graphic),y ; 5 Select shape continueLeftSelector: STA GRP0 ; 3 Execute Write here! sta p0DrawBuffer ; 3 save for next line lda #0 ; 2 blank out playfield for this line sta PF0 ; 3 ; skipDraw routine for right player TXA ; 2 A-> Current scannline SEC ; 2 Clearing instead of setting lines up players SBC slowP1YCoordFromBottom+1 ; 3 copyIntegerCoordP1 ; 3 ADC #SPRITEHEIGHT+1 ; 2 calc if sprite is drawn BCC skipDrawRightSelector ; 2/3 To skip or not to skip? TAY ; 2 not necessary when Y holds scannline lda (pointerP1Graphic),y ; 5 Select shape continueRightSelector: STA GRP0 ; 3 Execute Write here! ldy #P1COLOR ; 2 sty COLUP0 ; 3 sta p1DrawBuffer ; 3 save for next line ; draw ball PLP ; 4 CPX slowBallYCoordFromBot+1 ; 3 PHP ; 3 ; set up playfield index txa ; 2 lsr ; 2 sta COLUPF;......3 lsr ; 2 tay ; 2 lda playfieldMatrixLeft,Y ; 4 sleep 4 ; --------------- line 2 ; sta WSYNC ; WSYNC *** removed *** between 2 and 5 ; dec $2D ; 5 free cycles sta PF0 ; 3 ; draw left player lda p0DrawBuffer ; 3 sta GRP0 ; 3 lda #P0COLOR ; 2 sta COLUP0 ; 3 SEC ; 2 for upcoming ptery skipDraw ; draw right PF lda playfieldMatrixRight,Y ; 4 sta PF0 ; 3 lda #P1COLOR ; 2 sta COLUP0 ; 3 ; draw right player lda p1DrawBuffer ; 3 sta GRP0 ; 3 ; skipDraw routine for ptery TXA ; 2 A-> Current scannline SBC varPterryVerticalPos ; 3 ADC #SPRITEHEIGHT ; 2 calc if sprite is drawn BCC skipDrawPterySelector ; 2/3 To skip or not to skip? TAY ; 2 not necessary when Y holds scannline LDA (pointerPterryGraphic),Y ; 5 Select shape continuePterySelector: tay ; 2 dex ; 2 bne scanLoopSelector ; 3 ; --------------- end of kernel stx PF0 stx ENAM1 sta WSYNC stx GRP0 stx GRP1 sta WSYNC sta WSYNC endkernalSelector ;just burning scanlines....you could do something else ldy #44 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 #CEILING_HALF sta slowP0YCoordFromBottom + 1 ;44 in integer part of players position sta slowP1YCoordFromBottom + 1 ;('bout half way up) lda #CEILING_HALF - 10 sta varPterryVerticalPos lda #0 sta varPterryBoredCounter sta varPterryBehavior lda #0 sta AUDV0 sta AUDV1 sta slowP0YCoordFromBottom ;0 in fractional part of players position sta slowP1YCoordFromBottom ;0 in all player's speed, integer and fractional sta slowP0YSpeed + 1 sta slowP0YSpeed sta slowP1YSpeed + 1 sta slowP1YSpeed ;zero out scores and game being over sta p0score sta p1score sta booleanGameOver ;temp! sta varBallExtraSpeed lda #BALL_FREEZE_TIME sta varTimeBeforeBallMoves lda #>GraphicsPage ;grab the high byte of the graphic location sta pointerP0Graphic+1 ;2 byte memory lookup sta pointerP1Graphic+1 sta pointerPterryGraphic+1 lda variableGameMode and #%00000001 bne fillBricksEmptyOnStart lda #%00100000 ; for wall... jmp doneFillBricksOnStart fillBricksEmptyOnStart lda #%00000000 ; for wall... doneFillBricksOnStart ldx #GAMEFIELD_HEIGHT_IN_BRICKS-1 InitTheBricksLoopByStart sta playfieldMatrixLeft,X sta playfieldMatrixRight,X; dex; bne InitTheBricksLoopByStart ;-------------------------------------- ;SETTING UP PLAYFIELD AND BALL ETC ;-------------------------------------- lda #GAMEPFCOLOR sta COLUPF ;color here lda #BALLPOS_CENTER sta ballXposition+1 lda #1 ;newd sta slowBallYSpeed+1 lda #0 sta slowBallYSpeed ;!!!position ball lda #41 sta slowBallYCoordFromBot+1 lda #0 sta slowBallYCoordFromBot ;double player graphic ; lda #%00000100 ; sta NUSIZ0 ;seed the sound buffers lda #TYPE_OF_FLAPSOUND sta AUDC0 ;type of sound for flaps lda #PITCH_OF_FLAPSOUND sta AUDF0 ;pitch lda #4 sta AUDC1 ;type of sound for pings ;-------------------------------------- ;-------------------------------------- ;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 SelectWasHitDuringGame ;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 LDA #VOICE_FOR_MUSIC STA AUDC0 LDA #VOICE_FOR_BEAT;8 STA AUDC1 ;we might have to reset playfield... lda variableGameMode and #%00000001 bne fillBricksEmptyOnSelectInGame lda #%00100000 ; for wall... jmp doneFillBricksOnSelectInGame fillBricksEmptyOnSelectInGame lda #%00000000 ; for wall... doneFillBricksOnSelectInGame ldx #GAMEFIELD_HEIGHT_IN_BRICKS-1 InitTheBricksLoopBySelectInGame sta playfieldMatrixLeft,X sta playfieldMatrixRight,X; dex; bne InitTheBricksLoopBySelectInGame lda #0 sta musicRiffNoteCounter sta musicRiffNoteTimeLeft sta musicBeatNoteCounter sta musicBeatNoteTimeLeft inc variableGameMode ;-- lda #1 ;-- sta booleanOverrideSelectChangeThisTime jmp TitleStart ;jmp TitleSelectIsDownNow SelectWasNotHit lda #2 sta VSYNC sta WSYNC sta WSYNC sta WSYNC lda #43 sta TIM64T lda #0 sta VSYNC lda flagPterryMakeNoise bne DoneCancellingPingNoise; abort noise... sta AUDV1 ;volume for dinger DoneCancellingPingNoise ; ; for now assume wings are up ; ;-------------------------------------- ;SEE IF BUTTON 0 IS NEWLY PRESSED ;-------------------------------------- CheckButton0 lda INPT4 bmi NoButton0 ;buttons down, graphic is down... lda #Score0Graphic ;grab the hight byte of the graphic location ; sta pointerP0Score+1 OkToDrawScoreP1 lda p1score ;accumulator = score asl ;accumulator = score * 2 asl ;accumulator = score * 4 adc p1score ;accumulator = (score * 4) + score = score * 5 adc #Score0Graphic ;grab the hight byte of the graphic location ; sta pointerP1Score+1 DoneSeeingIfWeDrawScores ;-------------------------------------- ;DIMINISH FLAP SOUND ;-------------------------------------- lda booleanGameOver bne NoFlapSound lda flapsoundRemaining bmi NoFlapSound sta AUDV0 ;volume dec flapsoundRemaining NoFlapSound ldx #22;;WALL;; lda playfieldMatrixLeft,X;;WALL;; sta bufferPFLeft;;WALL;; lda playfieldMatrixRight,X;;WALL;; sta bufferPFRight;;WALL;; ;lda slowP0YCoordFromBottom+1 ;sta copyIntegerCoordP0 ;lda slowP1YCoordFromBottom+1 ;sta copyIntegerCoordP1 ;------------------------------------ ;SET COLOR FOR SCORES ;------------------------------------ ;score flashing logic: ;(repeat for each player) ; ;(previously: if point just scored then flasher = 15) ; ;set usual color ;if flasher is zero ; if score is > 8 ; set flasher = 15 ; end if ;if flasher != 0 ; set to flashing color ;end if lda #P0COLOR sta varScoreColorP0 lda varScoreColorFlasherP0 bne DoneCheckFlasherP0WarningFlash dec winningScore lda winningScore inc winningScore cmp p0score bcs DoneCheckFlasherP0WarningFlash lda #15 sta varScoreColorFlasherP0 DoneCheckFlasherP0WarningFlash lda varScoreColorFlasherP0 beq NoP0Flash sta varScoreColorP0 dec varScoreColorFlasherP0 NoP0Flash lda #P1COLOR sta varScoreColorP1 lda varScoreColorFlasherP1 bne DoneCheckFlasherP1WarningFlash lda #8 cmp p1score bcs DoneCheckFlasherP1WarningFlash lda #15 sta varScoreColorFlasherP1 DoneCheckFlasherP1WarningFlash lda varScoreColorFlasherP1 beq NoP1Flash sta varScoreColorP1 dec varScoreColorFlasherP1 NoP1Flash ;------------------------------------ ;PTERRY PTIME!!! ;------------------------------------ ;pterry voice... lda booleanGameOver bne DoneChangingAnyPterryNoise lda flagPterryMakeNoise beq DoneChangingAnyPterryNoise bpl DoneInitializingPterryNoise lda #1 sta flagPterryMakeNoise lda #0 sta pterryVoiceNoteTimeLeft LDA #PTERRYVOICE_NOTECOUNT STA pterryVoiceNoteCounter LDA #8 STA AUDV1 lda #7 sta AUDC1 DoneInitializingPterryNoise DEC pterryVoiceNoteTimeLeft BPL DoneChangingAnyPterryNoise DEC pterryVoiceNoteCounter BPL DoneCheckEndingPterryVoice lda #0 sta flagPterryMakeNoise sta AUDV1 lda #4 sta AUDC1 ;type of sound for pings... jmp DoneChangingAnyPterryNoise DoneCheckEndingPterryVoice LDY pterryVoiceNoteCounter LDA PterryVoiceLengthData,Y STA pterryVoiceNoteTimeLeft DEC pterryVoiceNoteTimeLeft LDA PterryVoicePitchData,Y STA AUDF1 JMP DoneChangingAnyPterryNoise DoneChangingAnyPterryNoise ;make Pterry's wing flap.... lda counterPterryWingChange bne NotTimeToChangePterryWing lda #PTERRY_LENGTH_OF_WINGCHANGE sta counterPterryWingChange lda booleanPterryWingIsUp eor #%11111111 sta booleanPterryWingIsUp NotTimeToChangePterryWing dec counterPterryWingChange ;assume lda # Current scannline SEC ; 2 new SBC slowP0YCoordFromBottom+1 ; 3 copyint ADC #SPRITEHEIGHT+1 ; 2 calc if sprite is drawn STY GRP1 ; 3 Execute Write for ptery here ldy #P0COLOR ; 2 ; --------------- line 1 ; sta WSYNC ; WSYNC *** removed *** sty COLUP0 ; 3 BCC skipDrawLeft ; 2/3 To skip or not to skip? TAY ; 2 not necessary when Y holds scannline lda (pointerP0Graphic),y ; 5 Select shape continueLeft: STA GRP0 ; 3 Execute Write here! sta p0DrawBuffer ; 3 save for next line lda #0 ; 2 blank out playfield for this line sta PF0 ; 3 ; skipDraw routine for right player TXA ; 2 A-> Current scannline SEC ; 2 Clearing instead of setting lines up players SBC slowP1YCoordFromBottom+1 ; 3 copyIntegerCoordP1 ; 3 ADC #SPRITEHEIGHT+1 ; 2 calc if sprite is drawn BCC skipDrawRight ; 2/3 To skip or not to skip? TAY ; 2 not necessary when Y holds scannline lda (pointerP1Graphic),y ; 5 Select shape continueRight: STA GRP0 ; 3 Execute Write here! ldy #P1COLOR ; 2 sty COLUP0 ; 3 sta p1DrawBuffer ; 3 save for next line ; draw ball PLP ; 4 CPX slowBallYCoordFromBot+1 ; 3 PHP ; 3 ; set up playfield index txa ; 2 sta COLUPF;......3 lsr ; 2 lsr ; 2 tay ; 2 lda playfieldMatrixLeft,Y ; 4 nop;2 nop;2 ; --------------- line 2 ; sta WSYNC ; WSYNC *** removed *** between 2 and 5 ; dec $2D ; 5 free cycles sta PF0 ; 3 ; draw left player lda p0DrawBuffer ; 3 sta GRP0 ; 3 lda #P0COLOR ; 2 sta COLUP0 ; 3 SEC ; 2 for upcoming ptery skipDraw ; draw right PF lda playfieldMatrixRight,Y ; 4 sta PF0 ; 3 lda #P1COLOR ; 2 sta COLUP0 ; 3 ; draw right player lda p1DrawBuffer ; 3 sta GRP0 ; 3 ; skipDraw routine for ptery TXA ; 2 A-> Current scannline SBC varPterryVerticalPos ; 3 ADC #SPRITEHEIGHT ; 2 calc if sprite is drawn BCC skipDrawPtery ; 2/3 To skip or not to skip? TAY ; 2 not necessary when Y holds scannline LDA (pointerPterryGraphic),Y ; 5 Select shape continuePtery: tay ; 2 dex ; 2 bne scanLoop ; 3 ; --------------- end of kernel stx PF0 stx ENAM1 sta WSYNC lda #SCOREBKCOLOR sta COLUBK stx GRP0 stx GRP1 sta WSYNC sta WSYNC lda #2 sta WSYNC sta VBLANK endkernal ldx #30 OverScanWait sta WSYNC dex bne OverScanWait sta PF0 lda #$00 sta COLUBK jmp MainLoop ; ;MUSIC! ; makeminemusic LDA #VOICE_FOR_MUSIC STA AUDC0 LDA #VOICE_FOR_BEAT STA AUDC1 DEC musicRiffNoteTimeLeft BPL DoneWithChangingNote DEC musicRiffNoteCounter BPL DoneCheckResetNoteCounter LDA #MUSICRIFF_NOTECOUNT-1 STA musicRiffNoteCounter DoneCheckResetNoteCounter LDY musicRiffNoteCounter LDA MusicLengthData,Y STA musicRiffNoteTimeLeft DEC musicRiffNoteTimeLeft ;off by one error... LDA MusicPitchData,Y BMI ZeroOutSound STA AUDF0 LDA #12 ;noise STA AUDV0 JMP DoneSettingPitchAndVolume ZeroOutSound LDA #0 ;silence STA AUDV0 DoneSettingPitchAndVolume DoneWithChangingNote DEC musicBeatNoteTimeLeft BPL DoneWithChangingBeat DEC musicBeatNoteCounter BPL DoneCheckResetBeatCounter LDA #MUSICBEAT_NOTECOUNT-1 STA musicBeatNoteCounter DoneCheckResetBeatCounter LDY musicBeatNoteCounter LDA BeatLengthData,Y STA musicBeatNoteTimeLeft DEC musicBeatNoteTimeLeft ;off by one error... LDA BeatPitchData,Y BMI ZeroOutBeatSound STA AUDF1 LDA #8 ;noise STA AUDV1 JMP DoneSettingBeatPitchAndVolume ZeroOutBeatSound LDA #0 ;silence STA AUDV1 DoneSettingBeatPitchAndVolume DoneWithChangingBeat lda booleanIsOnTitleScreen beq musicReturnToGame jmp doneWithMusicOutOfGame musicReturnToGame jmp doneWithMusicInGameScreen org $FE00 ;-------------------------------------- ;GRAPHICS ;-------------------------------------- GraphicsPage .byte #%00000000 ;here to stop page errors WingUpGraphicLeft .byte #%00001100 .byte #%00001100 .byte #%10001100 .byte #%11011100 .byte #%11111100 .byte #%01111100 .byte #%00101100 .byte #%00001100 .byte #%00000000 ;here because my skipdraw's a bit off... WingDownGraphicLeft .byte #%00001100 .byte #%00011100 .byte #%00111100 .byte #%01111100 .byte #%01111100 .byte #%00111100 .byte #%00001100 .byte #%00001100 .byte #%00000000 ;here because my skipdraw's a bit off... WingUpGraphicRight .byte #%00110000 .byte #%00110000 .byte #%00110001 .byte #%00111011 .byte #%00111111 .byte #%00111110 .byte #%00110100 .byte #%00110000 .byte #%00000000 ;here because my skipdraw's a bit off... WingDownGraphicRight .byte #%00110000 .byte #%00111000 .byte #%00111100 .byte #%00111110 .byte #%00111110 .byte #%00111100 .byte #%00110000 .byte #%00110000 .byte #%00000000 ;here because my skipdraw's a bit off... PterryWingUpGraphic .byte #%00000000 .byte #%00000000 .byte #%01111101 .byte #%11111110 .byte #%01110100 .byte #%00111110 .byte #%01110001 .byte #%11100000 .byte #%00000000 ;here because my skipdraw's a bit off... PterryWingDownGraphic .byte #%11100000 .byte #%01110000 .byte #%00111000 .byte #%01111100 .byte #%11111111 .byte #%01110100 .byte #%00001111 .byte #%00000000 .byte #%00000000 ;here because my skipdraw's a bit off... SimpleFuji .byte #%00000000 .byte #%10010010 .byte #%01010100 .byte #%00101000 .byte #%00101000 .byte #%00101000 .byte #%00101000 .byte #%00000000 .byte #%00000000 .byte #%00000000 TeddyGraphic .byte #%00000000 .byte #%00011100 .byte #%00110110 .byte #%00111110 .byte #%00101010 .byte #%01011101 .byte #%01100011 .byte #%00000000 .byte #%00000000 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 #%10000010 ScoreBlankGraphic .byte #0 .byte #0 .byte #0 .byte #0 .byte #0 PFDataTitlePong0Left .byte #%11100000 .byte #%11100000 .byte #%11100000 .byte #%11100000 .byte #%11100000 .byte #%11100000 .byte #%11100000 PFDataTitleJoust0Left .byte #%00000000 .byte #%10000000 .byte #%11000000 .byte #%11000000 .byte #%11000000 .byte #%11100000 .byte #%01100000 .byte #%01100000 .byte #%01100000 .byte #%01000000 .byte #%01000000 .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 PFDataTitlePong1Left .byte #%00000000 .byte #%00000011 .byte #%00000011 .byte #%11110011 .byte #%00111011 .byte #%11110011 .byte #%11110000 PFDataTitleJoust1Left .byte #%00000001 .byte #%11000001 .byte #%11100011 .byte #%11100011 .byte #%11100011 .byte #%11100110 .byte #%01110110 .byte #%00110110 .byte #%00110110 .byte #%00110110 .byte #%00110100 .byte #%00110100 .byte #%00110100 .byte #%00110100 .byte #%00110100 .byte #%00110100 .byte #%00110110 .byte #%00110110 .byte #%00110110 .byte #%00110110 .byte #%10110110 .byte #%01110010 .byte #%00110011 .byte #%00010011 .byte #%00000011 .byte #%00000001 .byte #%00000000 .byte #%00000000 .byte #%00000000 .byte #%00000000 PFDataTitlePong2Left .byte #%00011111 .byte #%01111111 .byte #%01110001 .byte #%01110001 .byte #%01110001 .byte #%01111111 .byte #%00011111 PFDataTitleJoust2Left .byte #%00000001 .byte #%11000001 .byte #%11000011 .byte #%11000011 .byte #%11100111 .byte #%11100110 .byte #%11100110 .byte #%11100110 .byte #%01110110 .byte #%01110100 .byte #%01110100 .byte #%00110100 .byte #%00110100 .byte #%00110100 .byte #%00110100 .byte #%00110100 .byte #%00110100 .byte #%00110110 .byte #%00100110 .byte #%00100110 .byte #%00100110 .byte #%01100110 .byte #%01100111 .byte #%01000011 .byte #%01010011 .byte #%01010001 .byte #%01010000 .byte #%10110000 .byte #%10100000 .byte #%11000000 PFDataTitlePong0Right .byte #%11100000 .byte #%11100000 .byte #%11100000 .byte #%11100000 .byte #%11100000 .byte #%11100000 .byte #%11100000 PFDataTitleJoust0Right .byte #%00000000 .byte #%10110000 .byte #%10110000 .byte #%11110000 .byte #%11110000 .byte #%11110000 .byte #%11110000 .byte #%11100000 .byte #%11000000 .byte #%11000000 .byte #%11000000 .byte #%10000000 .byte #%10000000 .byte #%10000000 .byte #%10000000 .byte #%10000000 .byte #%10000000 .byte #%10000000 .byte #%10000000 .byte #%10000000 .byte #%10000000 .byte #%10000000 .byte #%10000000 .byte #%10000000 .byte #%10000000 .byte #%10000000 .byte #%10000000 .byte #%10000000 .byte #%10000000 .byte #%10000000 PFDataTitlePong1Right .byte #%00111100 .byte #%00111100 .byte #%01111101 .byte #%11111101 .byte #%11011101 .byte #%10011100 .byte #%00011100 PFDataTitleJoust1Right .byte #%00000100 .byte #%10001110 .byte #%10111110 .byte #%10111110 .byte #%10111111 .byte #%10111111 .byte #%10111111 .byte #%10110011 .byte #%10110001 .byte #%10100011 .byte #%10100010 .byte #%10100010 .byte #%10000110 .byte #%10000110 .byte #%10001100 .byte #%10011100 .byte #%10011000 .byte #%10111000 .byte #%10110000 .byte #%10110000 .byte #%10110010 .byte #%10110010 .byte #%10100110 .byte #%10111110 .byte #%10111100 .byte #%11011100 .byte #%11010000 .byte #%11000000 .byte #%10000000 .byte #%00000000 PFDataTitlePong2Right .byte #%01111110 .byte #%11111111 .byte #%11000011 .byte #%11110011 .byte #%00000011 .byte #%11111111 .byte #%01111110 PFDataTitleJoust2Right .byte #%00011000 .byte #%01111100 .byte #%01111110 .byte #%01111110 .byte #%01001110 .byte #%00001110 .byte #%00001110 .byte #%00000110 .byte #%00000110 .byte #%00000110 .byte #%00000110 .byte #%00000110 .byte #%00001110 .byte #%00001100 .byte #%00001100 .byte #%00001100 .byte #%00001100 .byte #%00011000 .byte #%00011001 .byte #%11111011 .byte #%01111111 .byte #%00111111 .byte #%00100111 .byte #%01000000 .byte #%01000000 .byte #%00000000 .byte #%00000000 .byte #%00000000 .byte #%00000000 .byte #%00000000 MusicPitchData .byte #-1 .byte #17 .byte #-1 .byte #17 .byte #-1 .byte #16 .byte #-1 .byte #16 .byte #-1 .byte #15 .byte #-1 .byte #15 .byte #-1 .byte #18 .byte #-1 .byte #18 MusicLengthData .byte #40 .byte #20 .byte #10 .byte #26 .byte #40 .byte #20 .byte #10 .byte #26 .byte #40 .byte #20 .byte #10 .byte #26 .byte #40 .byte #20 .byte #10 .byte #26 PterryVoicePitchData .byte #$0F .byte #$0E .byte #$0D .byte #$0C .byte #$0B .byte #$0A .byte #$09 .byte #$08 .byte #$07 .byte #$06 PterryVoiceLengthData .byte #6 .byte #2 .byte #2 .byte #2 .byte #2 .byte #2 .byte #2 .byte #2 .byte #2 .byte #16 BeatPitchData .byte #-1 .byte #120 .byte #-1 .byte #40 .byte #-1 .byte #120 .byte #-1 .byte #120 .byte #-1 .byte #40 .byte #-1 .byte #120 BeatLengthData .byte #16 .byte #2 .byte #4 .byte #2 .byte #10 .byte #2 .byte #22 .byte #2 .byte #10 .byte #2 .byte #22 .byte #2 org $FFFC .word Start .word Start ;;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 echo "---- Kernal alignment wastes",(kernal - waste),"bytes" if (>kernal != >endkernal) echo "WARNING: Kernel crosses a page boundary!" endif