processor 6502 include "vcs.h" include "macro.h" include "2600basic.h" include "2600basic_variable_redefs.h" ifconst bankswitch if bankswitch == 8 ORG $1000 RORG $D000 endif if bankswitch == 16 ORG $1000 RORG $9000 endif if bankswitch == 32 ORG $1000 RORG $1000 endif else ORG $F000 endif ; This is a 2-line kernel! kernel sta WSYNC lda #255 sta TIM64T lda #1 sta VDELBL sta VDELP0 ldx ballheight inx inx stx temp4 lda player1y sta temp3 ifconst shakescreen jsr doshakescreen else ldx missile0height inx endif inx stx stack1 lda bally sta stack2 lda player0y ldx #0 sta WSYNC stx GRP0 stx GRP1 stx PF1 stx PF2 stx CXCLR ifconst readpaddle stx paddle else sleep 3 endif sta temp2,x ;store these so they can be retrieved later ifnconst pfres ldx #128-44 else ldx #132-pfres*4 endif inc player1y lda missile0y sta temp5 lda missile1y sta temp6 lda playfieldpos sta temp1 ifconst pfrowheight lda #pfrowheight+2 else ifnconst pfres lda #10 else lda #(96/pfres)+2 ; try to come close to the real size endif endif clc sbc playfieldpos sta playfieldpos jmp .startkernel .skipDrawP0 lda #0 tay jmp .continueP0 .skipDrawP1 lda #0 tay jmp .continueP1 .kerloop ; enter at cycle 59?? continuekernel sleep 2 continuekernel2 lda ballheight ifconst pfres ldy playfield+pfres*4-132,x sty PF1 ;3 ldy playfield+pfres*4-131,x sty PF2 ;3 ldy playfield+pfres*4-129,x sty PF1 ; 3 too early? ldy playfield+pfres*4-130,x sty PF2 ;3 else ldy playfield+44-128,x ;4 sty PF1 ;3 ldy playfield+45-128,x ;4 sty PF2 ;3 ldy playfield+47-128,x ;4 sty PF1 ; 3 too early? ldy playfield+46-128,x;4 sty PF2 ;3 endif dcp bally rol rol ; rol ; rol goback sta ENABL .startkernel lda player1height ;3 dcp player1y ;5 bcc .skipDrawP1 ;2 ldy player1y ;3 lda (player1pointer),y ;5; player0pointer must be selected carefully by the compiler ; so it doesn't cross a page boundary! .continueP1 sta GRP1 ;3 ifnconst player1colors lda missile1height ;3 dcp missile1y ;5 rol;2 rol;2 sta ENAM1 ;3 else lda (player1color),y sta COLUP1 ifnconst playercolors sleep 7 else lda.w player0colorstore sta COLUP0 endif endif ifconst pfres lda playfield+pfres*4-132,x sta PF1 ;3 lda playfield+pfres*4-131,x sta PF2 ;3 lda playfield+pfres*4-129,x sta PF1 ; 3 too early? lda playfield+pfres*4-130,x sta PF2 ;3 else lda playfield+44-128,x ;4 sta PF1 ;3 lda playfield+45-128,x ;4 sta PF2 ;3 lda playfield+47-128,x ;4 sta PF1 ; 3 too early? lda playfield+46-128,x;4 sta PF2 ;3 endif ; sleep 3 lda player0height dcp player0y bcc .skipDrawP0 ldy player0y lda (player0pointer),y .continueP0 sta GRP0 ifnconst no_blank_lines ifnconst playercolors lda missile0height ;3 dcp missile0y ;5 sbc stack1 sta ENAM0 ;3 else lda (player0color),y sta player0colorstore sleep 6 endif dec temp1 bne continuekernel else dec temp1 beq altkernel2 ifconst readpaddle ldy currentpaddle lda INPT0,y bpl noreadpaddle inc paddle jmp continuekernel2 noreadpaddle sleep 2 jmp continuekernel else ifnconst playercolors ifconst PFcolors txa tay lda (pfcolortable),y ifnconst backgroundchange sta COLUPF else sta COLUBK endif jmp continuekernel else sleep 12 endif else lda (player0color),y sta player0colorstore sleep 4 endif jmp continuekernel endif altkernel2 txa sbx #252 bmi lastkernelline ifconst pfrowheight lda #pfrowheight else ifnconst pfres lda #8 else lda #(96/pfres) ; try to come close to the real size endif endif sta temp1 jmp continuekernel endif altkernel ifconst PFmaskvalue lda #PFmaskvalue else lda #0 endif sta PF1 sta PF2 ;sleep 3 ;28 cycles to fix things ;minus 11=17 ; lax temp4 ; clc txa sbx #252 bmi lastkernelline ifconst PFcolorandheight ldy playfieldcolorandheight-87,x ifnconst backgroundchange sty COLUPF else sty COLUBK endif lda playfieldcolorandheight-88,x sta.w temp1 endif ifconst PFheights lsr lsr tay lda (pfheighttable),y sta.w temp1 endif ifconst PFcolors tay lda (pfcolortable),y ifnconst backgroundchange sta COLUPF else sta COLUBK endif ifconst pfrowheight lda #pfrowheight else ifnconst pfres lda #8 else lda #(96/pfres) ; try to come close to the real size endif endif sta temp1 endif ifnconst PFcolorandheight ifnconst PFcolors ifnconst PFheights ifnconst no_blank_lines ; read paddle 0 ; lo-res paddle read ; bit INPT0 ; bmi paddleskipread ; inc paddle0 ;donepaddleskip sleep 10 ifconst pfrowheight lda #pfrowheight else ifnconst pfres lda #8 else lda #(96/pfres) ; try to come close to the real size endif endif sta temp1 endif endif endif endif lda ballheight dcp bally sbc temp4 jmp goback ifnconst no_blank_lines lastkernelline ifnconst PFcolors sleep 10 else ldy #124 lda (pfcolortable),y sta COLUPF endif ifconst PFheights ldx #1 sleep 4 else ldx playfieldpos sleep 3 endif jmp enterlastkernel else lastkernelline ifconst PFheights ldx #1 sleep 5 else ldx playfieldpos sleep 4 endif cpx #1 bne .enterfromNBL jmp no_blank_lines_bailout endif if ((<*)>$d5) align 256 endif ; this is a kludge to prevent page wrapping - fix!!! .skipDrawlastP1 sleep 2 lda #0 jmp .continuelastP1 .endkerloop ; enter at cycle 59?? nop .enterfromNBL ifconst pfres ldy.w playfield+pfres*4-4 sty PF1 ;3 ldy.w playfield+pfres*4-3 sty PF2 ;3 ldy.w playfield+pfres*4-1 sty PF1 ; possibly too early? ldy.w playfield+pfres*4-2 sty PF2 ;3 else ldy.w playfield+44 sty PF1 ;3 ldy.w playfield+45 sty PF2 ;3 ldy.w playfield+47 sty PF1 ; possibly too early? ldy.w playfield+46 sty PF2 ;3 endif enterlastkernel lda ballheight ; tya dcp bally ; sleep 4 ; sbc stack3 rol rol sta ENABL lda player1height ;3 dcp player1y ;5 bcc .skipDrawlastP1 ldy player1y ;3 lda (player1pointer),y ;5; player0pointer must be selected carefully by the compiler ; so it doesn't cross a page boundary! .continuelastP1 sta GRP1 ;3 ifnconst player1colors lda missile1height ;3 dcp missile1y ;5 else lda (player1color),y sta COLUP1 endif dex ;dec temp4 ; might try putting this above PF writes beq endkernel ifconst pfres ldy.w playfield+pfres*4-4 sty PF1 ;3 ldy.w playfield+pfres*4-3 sty PF2 ;3 ldy.w playfield+pfres*4-1 sty PF1 ; possibly too early? ldy.w playfield+pfres*4-2 sty PF2 ;3 else ldy.w playfield+44 sty PF1 ;3 ldy.w playfield+45 sty PF2 ;3 ldy.w playfield+47 sty PF1 ; possibly too early? ldy.w playfield+46 sty PF2 ;3 endif ifnconst player1colors rol;2 rol;2 sta ENAM1 ;3 else ifnconst playercolors sleep 7 else lda.w player0colorstore sta COLUP0 endif endif lda.w player0height dcp player0y bcc .skipDrawlastP0 ldy player0y lda (player0pointer),y .continuelastP0 sta GRP0 ifnconst no_blank_lines lda missile0height ;3 dcp missile0y ;5 sbc stack1 sta ENAM0 ;3 jmp .endkerloop else ifconst readpaddle ldy currentpaddle lda INPT0,y bpl noreadpaddle2 inc paddle jmp .endkerloop noreadpaddle2 sleep 4 jmp .endkerloop else ; no_blank_lines and no paddle reading sleep 14 jmp .endkerloop endif endif ; ifconst donepaddleskip ;paddleskipread ; this is kind of lame, since it requires 4 cycles from a page boundary crossing ; plus we get a lo-res paddle read ; bmi donepaddleskip ; endif .skipDrawlastP0 sleep 2 lda #0 jmp .continuelastP0 ifconst no_blank_lines no_blank_lines_bailout ldx #0 endif endkernel ; 6 digit score routine stx PF1 stx PF2 stx PF0 clc ifconst pfrowheight lda #pfrowheight+2 else ifnconst pfres lda #10 else lda #(96/pfres)+2 ; try to come close to the real size endif endif sbc playfieldpos sta playfieldpos txa ifconst shakescreen bit shakescreen bmi noshakescreen2 ldx #$3D noshakescreen2 endif sta WSYNC,x ; STA WSYNC ;first one, need one more sta REFP0 sta REFP1 STA GRP0 STA GRP1 ; STA PF1 ; STA PF2 sta HMCLR sta ENAM0 sta ENAM1 sta ENABL lda temp2 ;restore variables that were obliterated by kernel sta player0y lda temp3 sta player1y ifnconst player1colors lda temp6 sta missile1y endif ifnconst playercolors ifnconst readpaddle lda temp5 sta missile0y endif endif lda stack2 sta bally ifconst no_blank_lines sta WSYNC endif lda INTIM clc ifnconst vblank_time adc #43+12+87 else adc #vblank_time+12+87 endif ; sta WSYNC sta TIM64T ifconst minikernel jsr minikernel endif ; now reassign temp vars for score pointers ; score pointers contain: ; score1-5: lo1,lo2,lo3,lo4,lo5,lo6 ; swap lo2->temp1 ; swap lo4->temp3 ; swap lo6->temp5 ifnconst noscore lda scorepointers+1 ; ldy temp1 sta temp1 ; sty scorepointers+1 lda scorepointers+3 ; ldy temp3 sta temp3 ; sty scorepointers+3 sta HMCLR tsx stx stack1 ldx #$10 stx HMP0 sta WSYNC ldx #0 STx GRP0 STx GRP1 ; seems to be needed because of vdel lda scorepointers+5 ; ldy temp5 sta temp5,x ; sty scorepointers+5 lda #>scoretable sta scorepointers+1 sta scorepointers+3 sta scorepointers+5,x sta temp2,x sta temp4,x sta temp6,x LDY #7 STA RESP0 STA RESP1 LDA #$03 STA NUSIZ0 STA NUSIZ1,x STA VDELP0 STA VDELP1 LDA #$20 STA HMP1 LDA scorecolor ; STA HMCLR ; STA WSYNC; second one STA HMOVE ; cycle 73 ? STA COLUP0 STA COLUP1 lda (scorepointers),y sta GRP0 ifconst pfscore lda pfscorecolor sta COLUPF endif lda (scorepointers+8),y sta WSYNC sleep 2 jmp beginscore if ((<*)>$d4) align 256 ; kludge that potentially wastes space! should be fixed! endif loop2 lda (scorepointers),y ;+5 68 204 sta GRP0 ;+3 71 213 D1 -- -- -- ifconst pfscore lda.w pfscore1 sta PF1 else sleep 7 endif ; cycle 0 lda (scorepointers+$8),y ;+5 5 15 beginscore sta GRP1 ;+3 8 24 D1 D1 D2 -- lda (scorepointers+$6),y ;+5 13 39 sta GRP0 ;+3 16 48 D3 D1 D2 D2 lax (scorepointers+$2),y ;+5 29 87 txs lax (scorepointers+$4),y ;+5 36 108 sleep 3 ifconst pfscore lda pfscore2 sta PF1 else sleep 6 endif lda (scorepointers+$A),y ;+5 21 63 stx GRP1 ;+3 44 132 D3 D3 D4 D2! tsx stx GRP0 ;+3 47 141 D5 D3! D4 D4 sta GRP1 ;+3 50 150 D5 D5 D6 D4! sty GRP0 ;+3 53 159 D4* D5! D6 D6 dey bpl loop2 ;+2 60 180 ldx stack1 txs ; lda scorepointers+1 ldy temp1 ; sta temp1 sty scorepointers+1 LDA #0 sta PF1 STA GRP0 STA GRP1 STA VDELP0 STA VDELP1;do we need these STA NUSIZ0 STA NUSIZ1 ; lda scorepointers+3 ldy temp3 ; sta temp3 sty scorepointers+3 ; lda scorepointers+5 ldy temp5 ; sta temp5 sty scorepointers+5 endif ;noscore LDA #%11000010 sta WSYNC STA VBLANK RETURN ifconst shakescreen doshakescreen bit shakescreen bmi noshakescreen sta WSYNC noshakescreen ldx missile0height inx rts endif start sei cld ldy #0 lda $D0 cmp #$2C ;check RAM location #1 bne MachineIs2600 lda $D1 cmp #$A9 ;check RAM location #2 bne MachineIs2600 dey MachineIs2600 ldx #0 txa clearmem inx txs pha bne clearmem sty temp1 ifconst pfrowheight lda pfrowheight else ifconst pfres lda #(96/pfres) else lda #8 endif endif sta playfieldpos ldx #5 initscore lda #(game-1) pha lda #<(game-1) pha pha pha ldx #1 jmp BS_jsr endif ; playfield drawing routines ; you get a 32x12 bitmapped display in a single color :) ; 0-31 and 0-11 pfclear ; clears playfield - or fill with pattern ifconst pfres ldx #pfres*4-1 else ldx #47 endif pfclear_loop ifnconst superchip sta playfield,x else sta playfield-128,x endif dex bpl pfclear_loop RETURN setuppointers stx temp2 ; store on.off.flip value tax ; put x-value in x lsr lsr lsr ; divide x pos by 8 sta temp1 tya asl asl ; multiply y pos by 4 clc adc temp1 ; add them together to get actual memory location offset tay ; put the value in y lda temp2 ; restore on.off.flip value rts pfread ;x=xvalue, y=yvalue jsr setuppointers lda setbyte,x and playfield,y eor setbyte,x ; beq readzero ; lda #1 ; readzero RETURN pfpixel ;x=xvalue, y=yvalue, a=0,1,2 jsr setuppointers ifconst bankswitch lda temp2 ; load on.off.flip value (0,1, or 2) beq pixelon_r ; if "on" go to on lsr bcs pixeloff_r ; value is 1 if true lda playfield,y ; if here, it's "flip" eor setbyte,x ifconst superchip sta playfield-128,y else sta playfield,y endif RETURN pixelon_r lda playfield,y ora setbyte,x ifconst superchip sta playfield-128,y else sta playfield,y endif RETURN pixeloff_r lda setbyte,x eor #$ff and playfield,y ifconst superchip sta playfield-128,y else sta playfield,y endif RETURN else jmp plotpoint endif pfhline ;x=xvalue, y=yvalue, a=0,1,2, temp3=endx jsr setuppointers jmp noinc keepgoing inx txa and #7 bne noinc iny noinc jsr plotpoint cpx temp3 bmi keepgoing RETURN pfvline ;x=xvalue, y=yvalue, a=0,1,2, temp3=endx jsr setuppointers sty temp1 ; store memory location offset inc temp3 ; increase final x by 1 lda temp3 asl asl ; multiply by 4 sta temp3 ; store it ; Thanks to Michael Rideout for fixing a bug in this code ; right now, temp1=y=starting memory location, temp3=final ; x should equal original x value keepgoingy jsr plotpoint iny iny iny iny cpy temp3 bmi keepgoingy RETURN plotpoint lda temp2 ; load on.off.flip value (0,1, or 2) beq pixelon ; if "on" go to on lsr bcs pixeloff ; value is 1 if true lda playfield,y ; if here, it's "flip" eor setbyte,x ifconst superchip sta playfield-128,y else sta playfield,y endif rts pixelon lda playfield,y ora setbyte,x ifconst superchip sta playfield-128,y else sta playfield,y endif rts pixeloff lda setbyte,x eor #$ff and playfield,y ifconst superchip sta playfield-128,y else sta playfield,y endif rts setbyte .byte $80 .byte $40 .byte $20 .byte $10 .byte $08 .byte $04 .byte $02 .byte $01 .byte $01 .byte $02 .byte $04 .byte $08 .byte $10 .byte $20 .byte $40 .byte $80 .byte $80 .byte $40 .byte $20 .byte $10 .byte $08 .byte $04 .byte $02 .byte $01 .byte $01 .byte $02 .byte $04 .byte $08 .byte $10 .byte $20 .byte $40 .byte $80 pfscroll ;(a=0 left, 1 right, 2 up, 4 down, 6=upup, 12=downdown) bne notleft ;left ifconst pfres ldx #pfres*4 else ldx #48 endif leftloop lda playfield-1,x lsr ifconst superchip lda playfield-2,x rol sta playfield-130,x lda playfield-3,x ror sta playfield-131,x lda playfield-4,x rol sta playfield-132,x lda playfield-1,x ror sta playfield-129,x else rol playfield-2,x ror playfield-3,x rol playfield-4,x ror playfield-1,x endif txa sbx #4 bne leftloop RETURN notleft lsr bcc notright ;right ifconst pfres ldx #pfres*4 else ldx #48 endif rightloop lda playfield-4,x lsr ifconst superchip lda playfield-3,x rol sta playfield-131,x lda playfield-2,x ror sta playfield-130,x lda playfield-1,x rol sta playfield-129,x lda playfield-4,x ror sta playfield-132,x else rol playfield-3,x ror playfield-2,x rol playfield-1,x ror playfield-4,x endif txa sbx #4 bne rightloop RETURN notright lsr bcc notup ;up lsr bcc onedecup dec playfieldpos onedecup dec playfieldpos beq shiftdown bpl noshiftdown2 shiftdown ifconst pfrowheight lda #pfrowheight else ifnconst pfres lda #8 else lda #(96/pfres) ; try to come close to the real size endif endif sta playfieldpos lda playfield+3 sta temp4 lda playfield+2 sta temp3 lda playfield+1 sta temp2 lda playfield sta temp1 ldx #0 up2 lda playfield+4,x ifconst superchip sta playfield-128,x lda playfield+5,x sta playfield-127,x lda playfield+6,x sta playfield-126,x lda playfield+7,x sta playfield-125,x else sta playfield,x lda playfield+5,x sta playfield+1,x lda playfield+6,x sta playfield+2,x lda playfield+7,x sta playfield+3,x endif txa sbx #252 ifconst pfres cpx #(pfres-1)*4 else cpx #44 endif bne up2 lda temp4 ifconst superchip ifconst pfres sta playfield+pfres*4-129 lda temp3 sta playfield+pfres*4-130 lda temp2 sta playfield+pfres*4-131 lda temp1 sta playfield+pfres*4-132 else sta playfield+47-128 lda temp3 sta playfield+46-128 lda temp2 sta playfield+45-128 lda temp1 sta playfield+44-128 endif else ifconst pfres sta playfield+pfres*4-1 lda temp3 sta playfield+pfres*4-2 lda temp2 sta playfield+pfres*4-3 lda temp1 sta playfield+pfres*4-4 else sta playfield+47 lda temp3 sta playfield+46 lda temp2 sta playfield+45 lda temp1 sta playfield+44 endif endif noshiftdown2 RETURN notup ;down lsr bcs oneincup inc playfieldpos oneincup inc playfieldpos lda playfieldpos ifconst pfrowheight cmp #pfrowheight+1 else ifnconst pfres cmp #9 else cmp #(96/pfres)+1 ; try to come close to the real size endif endif bcc noshiftdown lda #1 sta playfieldpos ifconst pfres lda playfield+pfres*4-1 sta temp4 lda playfield+pfres*4-2 sta temp3 lda playfield+pfres*4-3 sta temp2 lda playfield+pfres*4-4 else lda playfield+47 sta temp4 lda playfield+46 sta temp3 lda playfield+45 sta temp2 lda playfield+44 endif sta temp1 ifconst pfres ldx #(pfres-1)*4 else ldx #44 endif down2 lda playfield-1,x ifconst superchip sta playfield-125,x lda playfield-2,x sta playfield-126,x lda playfield-3,x sta playfield-127,x lda playfield-4,x sta playfield-128,x else sta playfield+3,x lda playfield-2,x sta playfield+2,x lda playfield-3,x sta playfield+1,x lda playfield-4,x sta playfield,x endif txa sbx #4 bne down2 lda temp4 ifconst superchip sta playfield-125 lda temp3 sta playfield-126 lda temp2 sta playfield-127 lda temp1 sta playfield-128 else sta playfield+3 lda temp3 sta playfield+2 lda temp2 sta playfield+1 lda temp1 sta playfield endif noshiftdown RETURN ;standard routines needed for pretty much all games ; just the random number generator is left - maybe we should remove this asm file altogether? ; repositioning code and score pointer setup moved to overscan ; read switches, joysticks now compiler generated (more efficient) randomize lda rand lsr ifconst rand16 rol rand16 endif bcc noeor eor #$B4 noeor sta rand ifconst rand16 eor rand16 endif RETURN drawscreen ifconst debugscore ldx #14 lda INTIM ; display # cycles left in the score ifconst mincycles lda mincycles cmp INTIM lda mincycles bcc nochange lda INTIM sta mincycles nochange endif ; cmp #$2B ; bcs no_cycles_left bmi cycles_left ldx #64 eor #$ff ;make negative cycles_left stx scorecolor and #$7f ; clear sign bit tax lda scorebcd,x sta score+2 lda scorebcd1,x sta score+1 jmp done_debugscore scorebcd .byte $00, $64, $28, $92, $56, $20, $84, $48, $12, $76, $40 .byte $04, $68, $32, $96, $60, $24, $88, $52, $16, $80, $44 .byte $08, $72, $36, $00, $64, $28, $92, $56, $20, $84, $48 .byte $12, $76, $40, $04, $68, $32, $96, $60, $24, $88 scorebcd1 .byte 0, 0, 1, 1, 2, 3, 3, 4, 5, 5, 6 .byte 7, 7, 8, 8, 9, $10, $10, $11, $12, $12, $13 .byte $14, $14, $15, $16, $16, $17, $17, $18, $19, $19, $20 .byte $21, $21, $22, $23, $23, $24, $24, $25, $26, $26 done_debugscore endif ifconst debugcycles lda INTIM ; if we go over, it mucks up the background color ; cmp #$2B ; BCC overscan bmi overscan sta COLUBK bcs doneoverscan endif overscan lda INTIM ;wait for sync bmi overscan doneoverscan ;do VSYNC lda #2 sta WSYNC sta VSYNC STA WSYNC STA WSYNC LDA #0 STA WSYNC STA VSYNC sta VBLANK ifnconst overscan_time lda #37+128 else lda #overscan_time+128 endif sta TIM64T ifconst legacy if legacy < 100 ldx #4 adjustloop lda player0x,x sec sbc #14 ;? sta player0x,x dex bpl adjustloop endif endif if (<*)>$F0 align 256, $EA endif sta WSYNC ldx #4 SLEEP 3 HorPosLoop ; 5 lda player0x,X ;+4 9 sec ;+2 11 DivideLoop sbc #15 bcs DivideLoop;+4 15 sta temp1,X ;+4 19 sta RESP0,X ;+4 23 sta WSYNC dex bpl HorPosLoop;+5 5 ; 4 ldx #4 ldy temp1,X lda repostable-256,Y sta HMP0,X ;+14 18 dex ldy temp1,X lda repostable-256,Y sta HMP0,X ;+14 32 dex ldy temp1,X lda repostable-256,Y sta HMP0,X ;+14 46 dex ldy temp1,X lda repostable-256,Y sta HMP0,X ;+14 60 dex ldy temp1,X lda repostable-256,Y sta HMP0,X ;+14 74 sta WSYNC sta HMOVE ;+3 3 ifconst legacy if legacy < 100 ldx #4 adjustloop2 lda player0x,x clc adc #14 ;? sta player0x,x dex bpl adjustloop2 endif endif ;set score pointers lax score+2 jsr scorepointerset sty scorepointers+5 stx scorepointers+2 lax score+1 jsr scorepointerset sty scorepointers+4 stx scorepointers+1 lax score jsr scorepointerset sty scorepointers+3 stx scorepointers vblk ; run possible vblank bB code ifconst vblank_bB_code jsr vblank_bB_code endif vblk2 LDA INTIM bmi vblk2 jmp kernel .byte $80,$70,$60,$50,$40,$30,$20,$10,$00 .byte $F0,$E0,$D0,$C0,$B0,$A0,$90 repostable scorepointerset and #$0F asl asl asl adc # 15 && switchselect then goto gamechange LDA #15 CMP t BCS .skipL046 .condpart1 lda #2 bit SWCHB BNE .skip1then .condpart2 jmp .gamechange .skip1then .skipL046 .L047 ; goto gameoverloop jmp .gameoverloop . ; .resetpf ; resetpf .L048 ; player0scorecolor = 15 : player1scorecolor = 15 LDA #15 STA player0scorecolor STA player1scorecolor .L049 ; lander0x = 15.0 : lander0y = 24.0 LDX #0 STX b LDA #15 STA lander0x LDX #0 STX c LDA #24 STA lander0y .L050 ; if gamebits{0} then lander1x = 139.0 : lander1y = 24.0 else lander1x = 0.0 : lander1y = 140.0 LDA gamebits LSR BCC .skipL050 .condpart3 LDX #0 STX h LDA #139 STA lander1x LDX #0 STX i LDA #24 STA lander1y jmp .skipelse0 .skipL050 LDX #0 STX h LDA #0 STA lander1x LDX #0 STX i LDA #140 STA lander1y .skipelse0 .L051 ; if level = 0 then gosub level1 LDA level CMP #0 BNE .skipL051 .condpart4 jsr .level1 .skipL051 .L052 ; if level = 1 then gosub level2 LDA level CMP #1 BNE .skipL052 .condpart5 jsr .level2 .skipL052 .L053 ; if level = 2 then gosub level3 LDA level CMP #2 BNE .skipL053 .condpart6 jsr .level3 .skipL053 .L054 ; if level = 3 then gosub level4 LDA level CMP #3 BNE .skipL054 .condpart7 jsr .level4 .skipL054 .L055 ; return RTS . ; .gamechange ; gamechange .L056 ; t = 0 : level = level + 1 : if level = 4 then level = 0 : gamebits{0} = !gamebits{0} LDA #0 STA t INC level LDA level CMP #4 BNE .skipL056 .condpart8 LDA #0 STA level LDA gamebits AND #1 PHP LDA gamebits PLP .byte $F0, $03 AND #254 .byte $0C ORA #1 STA gamebits .skipL056 .L057 ; goto gameoverloop jmp .gameoverloop . ; .newgame ; newgame .L058 ; player0score = 0 LDA #0 STA player0score .L059 ; player1score = 0 LDA #0 STA player1score . ; .newdiamond ; newdiamond .L060 ; gosub resetpf jsr .resetpf .L061 ; lander0xaccel = 0.0 LDX #0 STX e LDA #0 STA lander0xaccel .L062 ; lander0yaccel = 0.0 LDX #0 STX g LDA #0 STA lander0yaccel .L063 ; lander1xaccel = 0.0 LDX #0 STX k LDA #0 STA lander1xaccel .L064 ; lander1yaccel = 0.0 LDX #0 STX m LDA #0 STA lander1yaccel .L065 ; gosub hidediamond jsr .hidediamond .L066 ; timer = 0 LDA #0 STA timer .L067 ; COLUBK = 0 LDA #0 STA COLUBK . ; .gameloop ; gameloop .L068 ; CTRLPF = $15 : ballheight = 2 LDA #$15 STA CTRLPF LDA #2 STA ballheight .L069 ; if switchreset then goto newgame lda #1 bit SWCHB BNE .skipL069 .condpart9 jmp .newgame .skipL069 .L070 ; if switchselect then goto gamechange lda #2 bit SWCHB BNE .skipL070 .condpart10 jmp .gamechange .skipL070 .L071 ; gamebits{1} = 1 : gosub missilcollision LDA gamebits ORA #2 STA gamebits jsr .missilcollision .L072 ; if joy0fire then gosub p0fire lda #$80 bit INPT4 BNE .skipL072 .condpart11 jsr .p0fire .skipL072 .L073 ; missile1x = lander0missilex : missile1y = lander0missiley LDA lander0missilex STA missile1x LDA lander0missiley STA missile1y .L074 ; gosub everyframe jsr .everyframe .L075 ; drawscreen jsr drawscreen .L076 ; gamebits{1} = 0 : gosub missilcollision LDA gamebits AND #253 STA gamebits jsr .missilcollision .L077 ; if gamebits{0} && joy1fire then gosub p1fire LDA gamebits LSR BCC .skipL077 .condpart12 lda #$80 bit INPT5 BNE .skip12then .condpart13 jsr .p1fire .skip12then .skipL077 .L078 ; missile1x = lander1missilex : missile1y = lander1missiley LDA lander1missilex STA missile1x LDA lander1missiley STA missile1y .L079 ; gosub everyframe jsr .everyframe .L080 ; drawscreen jsr drawscreen .L081 ; if s > 0 then shakescreen = shakescreen + 64 : s = s - 1 LDA #0 CMP s BCS .skipL081 .condpart14 LDA shakescreen CLC ADC #64 STA shakescreen DEC s .skipL081 .L082 ; AUDV0 = s : AUDV1 = s LDA s STA AUDV0 STA AUDV1 .L083 ; if collision(player0,ball) then player0score = addbcd ( player0score , 1 ) : goto newdiamond BIT CXP0FB BVC .skipL083 .condpart15 LDY #1 LDA player0score jsr addbcd STA player0score jmp .newdiamond .skipL083 .L084 ; if collision(player1,ball) then player1score = addbcd ( player1score , 1 ) : goto newdiamond BIT CXP1FB BVC .skipL084 .condpart16 LDY #1 LDA player1score jsr addbcd STA player1score jmp .newdiamond .skipL084 .L085 ; rem *** player0 win check .L086 ; if player0score > $09 then goto gameover LDA #$09 CMP player0score BCS .skipL086 .condpart17 jmp .gameover .skipL086 .L087 ; rem *** player1 win check .L088 ; if player1score > $09 then goto gameover LDA #$09 CMP player1score BCS .skipL088 .condpart18 jmp .gameover .skipL088 .L089 ; temp4 = rand : if temp4 < 5 then pfpixel readx 0 on jsr randomize STA temp4 LDA temp4 CMP #5 BCS .skipL089 .condpart19 LDA readx LDY #0 LDX #0 jsr pfpixel .skipL089 .L090 ; goto gameloop jmp .gameloop . ; .gameover ; gameover .L091 ; AUDV0 = 0 : AUDV1 = 0 LDA #0 STA AUDV0 STA AUDV1 .L092 ; drawscreen jsr drawscreen .L093 ; if switchreset then goto newgame lda #1 bit SWCHB BNE .skipL093 .condpart20 jmp .newgame .skipL093 .L094 ; if switchselect then goto gamechange lda #2 bit SWCHB BNE .skipL094 .condpart21 jmp .gamechange .skipL094 .L095 ; goto gameover jmp .gameover . ; .hidediamond ; hidediamond .L096 ; t = 1 LDA #1 STA t .hideloop ; hideloop .L097 ; dmdx = rand jsr randomize STA dmdx .L098 ; dmdx = ( dmdx / 2 ) + 12 ; complex statement detected LDA dmdx lsr CLC ADC #12 STA dmdx .L099 ; dmdy = rand jsr randomize STA dmdy .L0100 ; dmdy = ( dmdy / 4 ) + 15 ; complex statement detected LDA dmdy lsr lsr CLC ADC #15 STA dmdy .L0101 ; ballx = dmdx : bally = dmdy LDA dmdx STA ballx LDA dmdy STA bally .L0102 ; drawscreen jsr drawscreen .L0103 ; if !collision(playfield,ball) && t > 0 then t = t + 1 : goto hideloop BIT CXBLPF BMI .skipL0103 .condpart22 LDA #0 CMP t BCS .skip22then .condpart23 INC t jmp .hideloop .skip22then .skipL0103 .L0104 ; return RTS . ; .everyframe ; everyframe .L0105 ; if timer{1} then ballx = dmdx : bally = dmdy else ballx = 0 : bally = 140 LDA timer AND #2 BEQ .skipL0105 .condpart24 LDA dmdx STA ballx LDA dmdy STA bally jmp .skipelse1 .skipL0105 LDA #0 STA ballx LDA #140 STA bally .skipelse1 .L0106 ; if collision(player0,player1) then s = 15 : gosub p0p1collision BIT CXPPMM BPL .skipL0106 .condpart25 LDA #15 STA s jsr .p0p1collision .skipL0106 .L0107 ; gosub p0handle jsr .p0handle .L0108 ; gosub handlep0missile jsr .handlep0missile .L0109 ; if gamebits{0} then gosub p1stuff LDA gamebits LSR BCC .skipL0109 .condpart26 jsr .p1stuff .skipL0109 .L0110 ; COLUP0 = 15 : COLUP1 = 15 : player0scorecolor = 15 : player1scorecolor = 15 LDA #15 STA COLUP0 STA COLUP1 STA player0scorecolor STA player1scorecolor .L0111 ; timer = timer + 1 INC timer .L0112 ; readx = readx + 1 : if readx > 30 then readx = 1 : ready = ready + 1 INC readx LDA #30 CMP readx BCS .skipL0112 .condpart27 LDA #1 STA readx INC ready .skipL0112 .L0113 ; if ready > 9 then ready = 0 LDA #9 CMP ready BCS .skipL0113 .condpart28 LDA #0 STA ready .skipL0113 .L0114 ; if pfread ( readx , ready ) then gosub checkdrop LDA readx LDY ready jsr pfread BNE .skipL0114 .condpart29 jsr .checkdrop .skipL0114 .L0115 ; temp6 = 72 - ( timer / 32 ) ; complex statement detected LDA #72 PHA LDA timer lsr lsr lsr lsr lsr TAY PLA TSX STY $00,x SEC SBC $100,x STA temp6 .L0116 ; if gamebits{3} then COLUP0 = temp6 : if timer = 0 then gosub p0blowsup LDA gamebits AND #8 BEQ .skipL0116 .condpart30 LDA temp6 STA COLUP0 LDA timer CMP #0 BNE .skip30then .condpart31 jsr .p0blowsup .skip30then .skipL0116 .L0117 ; if gamebits{4} then COLUP1 = temp6 : if timer = 0 then gosub p1blowsup LDA gamebits AND #16 BEQ .skipL0117 .condpart32 LDA temp6 STA COLUP1 LDA timer CMP #0 BNE .skip32then .condpart33 jsr .p1blowsup .skip32then .skipL0117 .L0118 ; return RTS . ; .missilcl ; missilcl .L0119 ; rockx = missile1x : rocky = missile1y LDA missile1x STA rockx LDA missile1y STA rocky .L0120 ; if rockx > 16 then rockx = rockx - 17 LDA #16 CMP rockx BCS .skipL0120 .condpart34 LDA rockx SEC SBC #17 STA rockx .skipL0120 .L0121 ; rockx = rockx / 4 LDA rockx lsr lsr STA rockx .L0122 ; rocky = rocky / 8 LDA rocky lsr lsr lsr STA rocky .L0123 ; if rockx < 31 then rockx = rockx + 1 LDA rockx CMP #31 BCS .skipL0123 .condpart35 INC rockx .skipL0123 .L0124 ; if f{0} && pfread ( rockx , rocky ) then pfpixel rockx rocky off LDA f LSR BCC .skipL0124 .condpart36 LDA rockx LDY rocky jsr pfread BNE .skip36then .condpart37 LDA rockx LDY rocky LDX #1 jsr pfpixel .skip36then .skipL0124 .L0125 ; if rockx > 1 then rockx = rockx - 2 LDA #1 CMP rockx BCS .skipL0125 .condpart38 LDA rockx SEC SBC #2 STA rockx .skipL0125 .L0126 ; if !f{0} && pfread ( rockx , rocky ) then pfpixel rockx rocky off LDA f LSR BCS .skipL0126 .condpart39 LDA rockx LDY rocky jsr pfread BNE .skip39then .condpart40 LDA rockx LDY rocky LDX #1 jsr pfpixel .skip39then .skipL0126 .L0127 ; rockx = rockx + 1 INC rockx .L0128 ; if rocky < 10 then rocky = rocky + 1 LDA rocky CMP #10 BCS .skipL0128 .condpart41 INC rocky .skipL0128 .L0129 ; if f{1} && pfread ( rockx , rocky ) then pfpixel rockx rocky off LDA f AND #2 BEQ .skipL0129 .condpart42 LDA rockx LDY rocky jsr pfread BNE .skip42then .condpart43 LDA rockx LDY rocky LDX #1 jsr pfpixel .skip42then .skipL0129 .L0130 ; if rocky > 1 then rocky = rocky - 2 LDA #1 CMP rocky BCS .skipL0130 .condpart44 LDA rocky SEC SBC #2 STA rocky .skipL0130 .L0131 ; if !f{1} && pfread ( rockx , rocky ) then pfpixel rockx rocky off LDA f AND #2 BNE .skipL0131 .condpart45 LDA rockx LDY rocky jsr pfread BNE .skip45then .condpart46 LDA rockx LDY rocky LDX #1 jsr pfpixel .skip45then .skipL0131 .L0132 ; rocky = rocky + 1 INC rocky .L0133 ; rem for t = 1 to 3 : pfpixel rockx n flip : drawscreen : next .L0134 ; pfpixel rockx rocky off LDA rockx LDY rocky LDX #1 jsr pfpixel .L0135 ; s = 17 LDA #17 STA s .L0136 ; if gamebits{1} then stopmissilep1 else stopmissilep0 LDA gamebits AND #2 if ((* - .stopmissilep1) < 127) && ((* - .stopmissilep1) > -128) BNE .stopmissilep1 else beq .0skipstopmissilep1 jmp .stopmissilep1 .0skipstopmissilep1 endif jmp .stopmissilep0 .skipelse2 .L0137 ; return RTS . ; .p1stuff ; p1stuff .L0138 ; gosub p1handle jsr .p1handle .L0139 ; gosub handlep1missile jsr .handlep1missile .L0140 ; return RTS . ; .p0p1collision ; p0p1collision .L0141 ; temp6 = 1 LDA #1 STA temp6 .L0142 ; if player0x < player1x then temp6 = 255 LDA player0x CMP player1x BCS .skipL0142 .condpart47 LDA #255 STA temp6 .skipL0142 .L0143 ; player0x = player0x + temp6 LDA player0x CLC ADC temp6 STA player0x .L0144 ; player1x = player1x - temp6 LDA player1x SEC SBC temp6 STA player1x .L0145 ; temp5 = lander0xaccel LDA lander0xaccel STA temp5 .L0146 ; lander0xaccel = lander1xaccel : lander1xaccel = temp5 LDX k STX e LDA lander1xaccel STA lander0xaccel STA lander1xaccel .L0147 ; return RTS . ; .missilcollision ; missilcollision .L0148 ; if collision(missile1,player0) then timer = 0 : gamebits{3} = 1 BIT CXM1P BPL .skipL0148 .condpart48 LDA #0 STA timer LDA gamebits ORA #8 STA gamebits .skipL0148 .L0149 ; if collision(missile1,player1) then timer = 0 : gamebits{4} = 1 BIT CXM1P BVC .skipL0149 .condpart49 LDA #0 STA timer LDA gamebits ORA #16 STA gamebits .skipL0149 .L0150 ; if collision(missile1,playfield) then gosub missilcl BIT CXM1FB BPL .skipL0150 .condpart50 jsr .missilcl .skipL0150 .L0151 ; return RTS . ; .p0blowsup ; p0blowsup .L0152 ; gamebits{3} = 0 : lander0x = 15.0 : lander0y = 0.0 : lander0xaccel = 0.0 : lander0yaccel = 0.0 : player1score = addbcd ( player1score , 1 ) LDA gamebits AND #247 STA gamebits LDX #0 STX b LDA #15 STA lander0x LDX #0 STX c LDA #0 STA lander0y LDX #0 STX e LDA #0 STA lander0xaccel LDX #0 STX g LDA #0 STA lander0yaccel LDY #1 LDA player1score jsr addbcd STA player1score .L0153 ; return RTS . ; .p1blowsup ; p1blowsup .L0154 ; gamebits{4} = 0 : lander1x = 139.0 : lander1y = 0.0 : lander1xaccel = 0.0 : lander1yaccel = 0.0 : player0score = addbcd ( player0score , 1 ) LDA gamebits AND #239 STA gamebits LDX #0 STX h LDA #139 STA lander1x LDX #0 STX i LDA #0 STA lander1y LDX #0 STX k LDA #0 STA lander1xaccel LDX #0 STX m LDA #0 STA lander1yaccel LDY #1 LDA player0score jsr addbcd STA player0score .L0155 ; return RTS . ; .p0handle ; p0handle .L0156 ; gosub p0normal jsr .p0normal .L0157 ; if collision(playfield,player0) then s = 15 : lander0xaccel = 0.0 : lander0yaccel = 0.0 : player0y = player0y - 1 : if player0x > 16 && timer{4} then gamebits{3} = 1 BIT CXP0FB BPL .skipL0157 .condpart51 LDA #15 STA s LDX #0 STX e LDA #0 STA lander0xaccel LDX #0 STX g LDA #0 STA lander0yaccel DEC player0y LDA #16 CMP player0x BCS .skip51then .condpart52 LDA timer AND #16 BEQ .skip52then .condpart53 LDA gamebits ORA #8 STA gamebits .skip52then .skip51then .skipL0157 .L0158 ; if joy0up then lander0yaccel = lander0yaccel - 0.02 : if timer{0} then gosub p0up lda #$10 bit SWCHA BNE .skipL0158 .condpart54 LDA g SEC SBC #5 STA g LDA lander0yaccel SBC #0 STA lander0yaccel LDA timer LSR BCC .skip54then .condpart55 jsr .p0up .skip54then .skipL0158 .L0159 ; if joy0down then lander0yaccel = lander0yaccel + 0.01 : if timer{0} then gosub p0down lda #$20 bit SWCHA BNE .skipL0159 .condpart56 LDA g CLC ADC #2 STA g LDA lander0yaccel ADC #0 STA lander0yaccel LDA timer LSR BCC .skip56then .condpart57 jsr .p0down .skip56then .skipL0159 .L0160 ; if joy0left then lander0xaccel = lander0xaccel - 0.02 : if timer{0} then gosub p0left lda #$40 bit SWCHA BNE .skipL0160 .condpart58 LDA e SEC SBC #5 STA e LDA lander0xaccel SBC #0 STA lander0xaccel LDA timer LSR BCC .skip58then .condpart59 jsr .p0left .skip58then .skipL0160 .L0161 ; if joy0right then lander0xaccel = lander0xaccel + 0.02 : if timer{0} then gosub p0right lda #$80 bit SWCHA BNE .skipL0161 .condpart60 LDA e CLC ADC #5 STA e LDA lander0xaccel ADC #0 STA lander0xaccel LDA timer LSR BCC .skip60then .condpart61 jsr .p0right .skip60then .skipL0161 .L0162 ; lander0yaccel = lander0yaccel + 0.005 LDA g CLC ADC #1 STA g LDA lander0yaccel ADC #0 STA lander0yaccel .L0163 ; if timer{0} then lander0x = lander0x + lander0xaccel LDA timer LSR BCC .skipL0163 .condpart62 LDA b CLC ADC e STA b LDA lander0x ADC lander0xaccel STA lander0x .skipL0163 .L0164 ; if timer{0} then lander0y = lander0y + lander0yaccel LDA timer LSR BCC .skipL0164 .condpart63 LDA c CLC ADC g STA c LDA lander0y ADC lander0yaccel STA lander0y .skipL0164 .L0165 ; if player0y > 81 then player0y = 0 LDA #81 CMP player0y BCS .skipL0165 .condpart64 LDA #0 STA player0y .skipL0165 .L0166 ; if player0x < 11 then player0x = 142 LDA player0x CMP #11 BCS .skipL0166 .condpart65 LDA #142 STA player0x .skipL0166 .L0167 ; if player0x > 142 then player0x = 11 LDA #142 CMP player0x BCS .skipL0167 .condpart66 LDA #11 STA player0x .skipL0167 .L0168 ; return RTS . ; .p1handle ; p1handle .L0169 ; gosub p1normal jsr .p1normal .L0170 ; if collision(playfield,player1) then s = s + 1 : lander1xaccel = 0.0 : lander1yaccel = 0.0 : player1y = player1y - 1 : if player1x < 138 && timer{4} then gamebits{4} = 1 BIT CXP1FB BPL .skipL0170 .condpart67 INC s LDX #0 STX k LDA #0 STA lander1xaccel LDX #0 STX m LDA #0 STA lander1yaccel DEC player1y LDA player1x CMP #138 BCS .skip67then .condpart68 LDA timer AND #16 BEQ .skip68then .condpart69 LDA gamebits ORA #16 STA gamebits .skip68then .skip67then .skipL0170 .L0171 ; if joy1up then lander1yaccel = lander1yaccel - 0.02 : if timer{0} then gosub p1up lda #1 bit SWCHA BNE .skipL0171 .condpart70 LDA m SEC SBC #5 STA m LDA lander1yaccel SBC #0 STA lander1yaccel LDA timer LSR BCC .skip70then .condpart71 jsr .p1up .skip70then .skipL0171 .L0172 ; if joy1down then lander1yaccel = lander1yaccel + 0.01 : if timer{0} then gosub p1down lda #2 bit SWCHA BNE .skipL0172 .condpart72 LDA m CLC ADC #2 STA m LDA lander1yaccel ADC #0 STA lander1yaccel LDA timer LSR BCC .skip72then .condpart73 jsr .p1down .skip72then .skipL0172 .L0173 ; if joy1left then lander1xaccel = lander1xaccel - 0.02 : if timer{0} then gosub p1left lda #4 bit SWCHA BNE .skipL0173 .condpart74 LDA k SEC SBC #5 STA k LDA lander1xaccel SBC #0 STA lander1xaccel LDA timer LSR BCC .skip74then .condpart75 jsr .p1left .skip74then .skipL0173 .L0174 ; if joy1right then lander1xaccel = lander1xaccel + 0.02 : if timer{0} then gosub p1right lda #8 bit SWCHA BNE .skipL0174 .condpart76 LDA k CLC ADC #5 STA k LDA lander1xaccel ADC #0 STA lander1xaccel LDA timer LSR BCC .skip76then .condpart77 jsr .p1right .skip76then .skipL0174 .L0175 ; lander1yaccel = lander1yaccel + 0.005 LDA m CLC ADC #1 STA m LDA lander1yaccel ADC #0 STA lander1yaccel .L0176 ; if timer{0} then lander1x = lander1x + lander1xaccel LDA timer LSR BCC .skipL0176 .condpart78 LDA h CLC ADC k STA h LDA lander1x ADC lander1xaccel STA lander1x .skipL0176 .L0177 ; if timer{0} then lander1y = lander1y + lander1yaccel LDA timer LSR BCC .skipL0177 .condpart79 LDA i CLC ADC m STA i LDA lander1y ADC lander1yaccel STA lander1y .skipL0177 .L0178 ; if player1y > 81 then player1y = 0 LDA #81 CMP player1y BCS .skipL0178 .condpart80 LDA #0 STA player1y .skipL0178 .L0179 ; if player1x < 11 then player1x = 142 LDA player1x CMP #11 BCS .skipL0179 .condpart81 LDA #142 STA player1x .skipL0179 .L0180 ; if player1x > 142 then player1x = 11 LDA #142 CMP player1x BCS .skipL0180 .condpart82 LDA #11 STA player1x .skipL0180 .L0181 ; return RTS . ; .p0fire ; p0fire .L0182 ; if dirbits{0} then return LDA dirbits LSR BCC .skipL0182 .condpart83 RTS .skipL0182 .L0183 ; if dirbits{1} then return LDA dirbits AND #2 BEQ .skipL0183 .condpart84 RTS .skipL0183 .L0184 ; if dirbits{2} then return LDA dirbits AND #4 BEQ .skipL0184 .condpart85 RTS .skipL0184 .L0185 ; if dirbits{3} then return LDA dirbits AND #8 BEQ .skipL0185 .condpart86 RTS .skipL0185 .L0186 ; gosub stopmissilep0 jsr .stopmissilep0 .L0187 ; if joy0up then dirbits{0} = 1 : gosub p0missile : lander0missiley = lander0missiley - 4 lda #$10 bit SWCHA BNE .skipL0187 .condpart87 LDA dirbits ORA #1 STA dirbits jsr .p0missile LDA lander0missiley SEC SBC #4 STA lander0missiley .skipL0187 .L0188 ; if joy0down then dirbits{1} = 1 : gosub p0missile : lander0missiley = lander0missiley + 4 lda #$20 bit SWCHA BNE .skipL0188 .condpart88 LDA dirbits ORA #2 STA dirbits jsr .p0missile LDA lander0missiley CLC ADC #4 STA lander0missiley .skipL0188 .L0189 ; if joy0left then dirbits{2} = 1 : gosub p0missile : lander0missilex = lander0missilex - 5 lda #$40 bit SWCHA BNE .skipL0189 .condpart89 LDA dirbits ORA #4 STA dirbits jsr .p0missile LDA lander0missilex SEC SBC #5 STA lander0missilex .skipL0189 .L0190 ; if joy0right then dirbits{3} = 1 : gosub p0missile : lander0missilex = lander0missilex + 4 lda #$80 bit SWCHA BNE .skipL0190 .condpart90 LDA dirbits ORA #8 STA dirbits jsr .p0missile LDA lander0missilex CLC ADC #4 STA lander0missilex .skipL0190 .L0191 ; return RTS . ; .p0missile ; p0missile .L0192 ; lander0missilex = player0x + 5 LDA player0x CLC ADC #5 STA lander0missilex .L0193 ; lander0missiley = player0y - 2 LDA player0y SEC SBC #2 STA lander0missiley .L0194 ; return RTS . ; .p1fire ; p1fire .L0195 ; if dirbits{4} then return LDA dirbits AND #16 BEQ .skipL0195 .condpart91 RTS .skipL0195 .L0196 ; if dirbits{5} then return LDA dirbits AND #32 BEQ .skipL0196 .condpart92 RTS .skipL0196 .L0197 ; if dirbits{6} then return BIT dirbits BVC .skipL0197 .condpart93 RTS .skipL0197 .L0198 ; if dirbits{7} then return BIT dirbits BPL .skipL0198 .condpart94 RTS .skipL0198 .L0199 ; gosub stopmissilep1 jsr .stopmissilep1 .L0200 ; if joy1up then dirbits{4} = 1 : gosub p1missile : lander1missiley = lander1missiley - 4 lda #1 bit SWCHA BNE .skipL0200 .condpart95 LDA dirbits ORA #16 STA dirbits jsr .p1missile LDA lander1missiley SEC SBC #4 STA lander1missiley .skipL0200 .L0201 ; if joy1down then dirbits{5} = 1 : gosub p1missile : lander1missiley = lander1missiley + 4 lda #2 bit SWCHA BNE .skipL0201 .condpart96 LDA dirbits ORA #32 STA dirbits jsr .p1missile LDA lander1missiley CLC ADC #4 STA lander1missiley .skipL0201 .L0202 ; if joy1left then dirbits{6} = 1 : gosub p1missile : lander1missilex = lander1missilex - 5 lda #4 bit SWCHA BNE .skipL0202 .condpart97 LDA dirbits ORA #64 STA dirbits jsr .p1missile LDA lander1missilex SEC SBC #5 STA lander1missilex .skipL0202 .L0203 ; if joy1right then dirbits{7} = 1 : gosub p1missile : lander1missilex = lander1missilex + 4 lda #8 bit SWCHA BNE .skipL0203 .condpart98 LDA dirbits ORA #128 STA dirbits jsr .p1missile LDA lander1missilex CLC ADC #4 STA lander1missilex .skipL0203 .L0204 ; return RTS . ; .p1missile ; p1missile .L0205 ; lander1missilex = player1x + 5 LDA player1x CLC ADC #5 STA lander1missilex .L0206 ; lander1missiley = player1y - 2 LDA player1y SEC SBC #2 STA lander1missiley .L0207 ; return RTS . ; .handlep0missile ; handlep0missile .L0208 ; if dirbits{0} then lander0missiley = lander0missiley - 1 LDA dirbits LSR BCC .skipL0208 .condpart99 DEC lander0missiley .skipL0208 .L0209 ; if dirbits{1} then lander0missiley = lander0missiley + 1 LDA dirbits AND #2 BEQ .skipL0209 .condpart100 INC lander0missiley .skipL0209 .L0210 ; if dirbits{2} then lander0missilex = lander0missilex - 1 LDA dirbits AND #4 BEQ .skipL0210 .condpart101 DEC lander0missilex .skipL0210 .L0211 ; if dirbits{3} then lander0missilex = lander0missilex + 1 LDA dirbits AND #8 BEQ .skipL0211 .condpart102 INC lander0missilex .skipL0211 .L0212 ; if lander0missiley > 81 then gosub stopmissilep0 LDA #81 CMP lander0missiley BCS .skipL0212 .condpart103 jsr .stopmissilep0 .skipL0212 .L0213 ; if lander0missilex < 10 || lander0missilex > 147 then gosub stopmissilep0 LDA lander0missilex CMP #10 BCS .skipL0213 .condpart104 jmp .condpart105 .skipL0213 LDA #147 CMP lander0missilex BCS .skip9OR .condpart105 jsr .stopmissilep0 .skip9OR .L0214 ; return RTS . ; .handlep1missile ; handlep1missile .L0215 ; if dirbits{4} then lander1missiley = lander1missiley - 1 LDA dirbits AND #16 BEQ .skipL0215 .condpart106 DEC lander1missiley .skipL0215 .L0216 ; if dirbits{5} then lander1missiley = lander1missiley + 1 LDA dirbits AND #32 BEQ .skipL0216 .condpart107 INC lander1missiley .skipL0216 .L0217 ; if dirbits{6} then lander1missilex = lander1missilex - 1 BIT dirbits BVC .skipL0217 .condpart108 DEC lander1missilex .skipL0217 .L0218 ; if dirbits{7} then lander1missilex = lander1missilex + 1 BIT dirbits BPL .skipL0218 .condpart109 INC lander1missilex .skipL0218 .L0219 ; if lander1missiley > 81 then gosub stopmissilep1 LDA #81 CMP lander1missiley BCS .skipL0219 .condpart110 jsr .stopmissilep1 .skipL0219 .L0220 ; if lander1missilex < 10 || lander1missilex > 147 then gosub stopmissilep1 LDA lander1missilex CMP #10 BCS .skipL0220 .condpart111 jmp .condpart112 .skipL0220 LDA #147 CMP lander1missilex BCS .skip10OR .condpart112 jsr .stopmissilep1 .skip10OR .L0221 ; return RTS . ; .stopmissilep0 ; stopmissilep0 .L0222 ; lander0missiley = 100 LDA #100 STA lander0missiley .L0223 ; dirbits{0} = 0 : dirbits{1} = 0 : dirbits{2} = 0 : dirbits{3} = 0 LDA dirbits AND #254 STA dirbits LDA dirbits AND #253 STA dirbits LDA dirbits AND #251 STA dirbits LDA dirbits AND #247 STA dirbits .L0224 ; return RTS . ; .stopmissilep1 ; stopmissilep1 .L0225 ; lander1missiley = 100 LDA #100 STA lander1missiley .L0226 ; dirbits{4} = 0 : dirbits{5} = 0 : dirbits{6} = 0 : dirbits{7} = 0 LDA dirbits AND #239 STA dirbits LDA dirbits AND #223 STA dirbits LDA dirbits AND #191 STA dirbits LDA dirbits AND #127 STA dirbits .L0227 ; return RTS . ; .checkdrop ; checkdrop .L0228 ; leftofread = readx - 1 LDA readx SEC SBC #1 STA leftofread .L0229 ; rightofread = readx + 1 LDA readx CLC ADC #1 STA rightofread .L0230 ; belowread = ready + 1 LDA ready CLC ADC #1 STA belowread .L0231 ; if !pfread ( readx , belowread ) then gosub dropfromtop : pfpixel readx belowread on : return LDA readx LDY belowread jsr pfread BEQ .skipL0231 .condpart113 jsr .dropfromtop LDA readx LDY belowread LDX #0 jsr pfpixel RTS .skipL0231 .L0232 ; if timer{0} then return LDA timer LSR BCC .skipL0232 .condpart114 RTS .skipL0232 .L0233 ; if timer{1} && timer{2} then goto fallleft LDA timer AND #2 BEQ .skipL0233 .condpart115 LDA timer AND #4 BEQ .skip115then .condpart116 jmp .fallleft .skip115then .skipL0233 .L0234 ; if timer{1} && !timer{2} then goto fallright LDA timer AND #2 BEQ .skipL0234 .condpart117 LDA timer AND #4 BNE .skip117then .condpart118 jmp .fallright .skip117then .skipL0234 .L0235 ; return RTS .fallleft ; fallleft .L0236 ; if !pfread ( leftofread , belowread ) then gosub dropfromtop : pfpixel leftofread belowread on LDA leftofread LDY belowread jsr pfread BEQ .skipL0236 .condpart119 jsr .dropfromtop LDA leftofread LDY belowread LDX #0 jsr pfpixel .skipL0236 .L0237 ; return RTS .fallright ; fallright .L0238 ; if !pfread ( rightofread , belowread ) then gosub dropfromtop : pfpixel rightofread belowread on LDA rightofread LDY belowread jsr pfread BEQ .skipL0238 .condpart120 jsr .dropfromtop LDA rightofread LDY belowread LDX #0 jsr pfpixel .skipL0238 .L0239 ; return RTS . ; .dropfromtop ; dropfromtop .L0240 ; dropfromtopread = ready LDA ready STA dropfromtopread .dropfromtoploop ; dropfromtoploop .L0241 ; dropfromtopread = dropfromtopread - 1 : if dropfromtopread = 255 then pfpixel readx 0 off : return DEC dropfromtopread LDA dropfromtopread CMP #255 BNE .skipL0241 .condpart121 LDA readx LDY #0 LDX #1 jsr pfpixel RTS .skipL0241 .L0242 ; if pfread ( readx , dropfromtopread ) then goto dropfromtoploop LDA readx LDY dropfromtopread jsr pfread BNE .skipL0242 .condpart122 jmp .dropfromtoploop .skipL0242 .L0243 ; belowdropfromtopread = dropfromtopread + 1 LDA dropfromtopread CLC ADC #1 STA belowdropfromtopread .L0244 ; pfpixel readx belowdropfromtopread off LDA readx LDY belowdropfromtopread LDX #1 jsr pfpixel .L0245 ; return RTS . ; .p0normal ; p0normal .L0246 ; player0: LDA #playerL0246_0 STA player0pointerhi LDA #5 STA player0height .L0247 ; return RTS . ; .p0up ; p0up .L0248 ; player0: LDA #playerL0248_0 STA player0pointerhi LDA #5 STA player0height .L0249 ; return RTS . ; .p0down ; p0down .L0250 ; player0: LDA #playerL0250_0 STA player0pointerhi LDA #5 STA player0height .L0251 ; return RTS . ; .p0right ; p0right .L0252 ; player0: LDA #playerL0252_0 STA player0pointerhi LDA #5 STA player0height .L0253 ; return RTS . ; .p0left ; p0left .L0254 ; player0: LDA #playerL0254_0 STA player0pointerhi LDA #5 STA player0height .L0255 ; return RTS . ; .p1normal ; p1normal .L0256 ; player1: LDA #playerL0256_1 STA player1pointerhi LDA #5 STA player1height .L0257 ; return RTS . ; .p1up ; p1up .L0258 ; player1: LDA #playerL0258_1 STA player1pointerhi LDA #5 STA player1height .L0259 ; return RTS . ; .p1down ; p1down .L0260 ; player1: LDA #playerL0260_1 STA player1pointerhi LDA #5 STA player1height .L0261 ; return RTS . ; .p1right ; p1right .L0262 ; player1: LDA #playerL0262_1 STA player1pointerhi LDA #5 STA player1height .L0263 ; return RTS . ; .p1left ; p1left .L0264 ; player1: LDA #playerL0264_1 STA player1pointerhi LDA #5 STA player1height .L0265 ; return RTS . ; .level1 ; level1 .L0266 ; COLUPF = 7 LDA #7 STA COLUPF .L0267 ; playfield: ifconst pfres ldx #4*pfres-1 else ldx #47 endif jmp pflabel0 PF_data0 .byte %00000000, %00000000, %00000000, %00000000 .byte %00000000, %00000000, %00000000, %00000000 .byte %00000000, %00000000, %00000000, %00000000 .byte %10000000, %11100000, %11100000, %10000000 .byte %10000000, %11100000, %11100000, %10000000 .byte %10000000, %11100000, %11100000, %10000000 .byte %10000000, %11100000, %11100000, %10000000 .byte %10000000, %11100000, %11100000, %10000000 .byte %10000000, %11110000, %11110000, %10000000 .byte %10000000, %11110000, %11110000, %10000000 .byte %11111111, %11111111, %11111111, %11111111 pflabel0 lda PF_data0,x sta playfield,x dex bpl pflabel0 .L0268 ; return RTS . ; .level2 ; level2 .L0269 ; COLUPF = 48 LDA #48 STA COLUPF .L0270 ; playfield: ifconst pfres ldx #4*pfres-1 else ldx #47 endif jmp pflabel1 PF_data1 .byte %00000000, %00000000, %00000000, %00000000 .byte %00000000, %00000010, %00000010, %00000000 .byte %00000000, %00000111, %00000111, %00000000 .byte %10000000, %00001111, %00001111, %10000000 .byte %10000000, %11111111, %11111111, %10000000 .byte %10000000, %11111111, %11111111, %10000000 .byte %10000000, %11111111, %11111111, %10000000 .byte %10000001, %11111111, %11111111, %10000001 .byte %10000011, %11111111, %11111111, %10000011 .byte %10000111, %11111111, %11111111, %10000111 .byte %11111111, %11111111, %11111111, %11111111 pflabel1 lda PF_data1,x sta playfield,x dex bpl pflabel1 .L0271 ; return RTS . ; .level3 ; level3 .L0272 ; COLUPF = 192 LDA #192 STA COLUPF .L0273 ; playfield: ifconst pfres ldx #4*pfres-1 else ldx #47 endif jmp pflabel2 PF_data2 .byte %00000000, %10000000, %11000000, %00000000 .byte %00000000, %10000000, %11000000, %00000000 .byte %00000000, %10000010, %11000001, %00000000 .byte %10110000, %10000010, %11000001, %10110000 .byte %10110000, %10000010, %11000001, %10110000 .byte %10110000, %10000010, %11000001, %10110000 .byte %10110000, %10000010, %11000001, %10110000 .byte %10110000, %11000110, %11100011, %10110000 .byte %10110000, %11111110, %11111111, %10110000 .byte %10110111, %11111111, %11111111, %10110111 .byte %11111111, %11111111, %11111111, %11111111 pflabel2 lda PF_data2,x sta playfield,x dex bpl pflabel2 .L0274 ; return RTS . ; .level4 ; level4 .L0275 ; COLUPF = 224 LDA #224 STA COLUPF .L0276 ; playfield: ifconst pfres ldx #4*pfres-1 else ldx #47 endif jmp pflabel3 PF_data3 .byte %00000000, %10000000, %10000000, %00000000 .byte %00000110, %10000000, %10000000, %00000110 .byte %00110110, %10000011, %10000011, %00110110 .byte %10110110, %11011011, %11011011, %10110110 .byte %10110110, %11011011, %11011011, %10110110 .byte %10110110, %11011011, %11011011, %10110110 .byte %10110110, %11111011, %11111011, %10110110 .byte %10110110, %11111011, %11111011, %10110110 .byte %10110110, %11111111, %11111111, %10110110 .byte %10110111, %11111111, %11111111, %10110111 .byte %11111111, %11111111, %11111111, %11111111 pflabel3 lda PF_data3,x sta playfield,x dex bpl pflabel3 .L0277 ; return RTS . ; . ; . ; . ; . ; .L0278 ; rem should be last lines in game .L0279 ; inline playerscores.asm include playerscores.asm .L0280 ; inline bcd_math.asm include bcd_math.asm if (<*) > (<(*+6)) repeat ($100-<*) .byte 0 repend endif playerL0246_0 .byte 0 .byte %00100100 .byte %00111100 .byte %01111110 .byte %00111100 .byte %00011000 if (<*) > (<(*+6)) repeat ($100-<*) .byte 0 repend endif playerL0248_0 .byte 0 .byte %00111100 .byte %00111100 .byte %01111110 .byte %00111100 .byte %00011000 if (<*) > (<(*+6)) repeat ($100-<*) .byte 0 repend endif playerL0250_0 .byte 0 .byte %00100100 .byte %00111100 .byte %01111110 .byte %00111100 .byte %00111100 if (<*) > (<(*+6)) repeat ($100-<*) .byte 0 repend endif playerL0252_0 .byte 0 .byte %00100100 .byte %00111100 .byte %11111110 .byte %00111100 .byte %00011000 if (<*) > (<(*+6)) repeat ($100-<*) .byte 0 repend endif playerL0254_0 .byte 0 .byte %00100100 .byte %00111100 .byte %01111111 .byte %00111100 .byte %00011000 if (<*) > (<(*+6)) repeat ($100-<*) .byte 0 repend endif playerL0256_1 .byte 0 .byte %00100100 .byte %00111100 .byte %01111110 .byte %00111100 .byte %00011000 if (<*) > (<(*+6)) repeat ($100-<*) .byte 0 repend endif playerL0258_1 .byte 0 .byte %00111100 .byte %00111100 .byte %01111110 .byte %00111100 .byte %00011000 if (<*) > (<(*+6)) repeat ($100-<*) .byte 0 repend endif playerL0260_1 .byte 0 .byte %00100100 .byte %00111100 .byte %01111110 .byte %00111100 .byte %00111100 if (<*) > (<(*+6)) repeat ($100-<*) .byte 0 repend endif playerL0262_1 .byte 0 .byte %00100100 .byte %00111100 .byte %11111110 .byte %00111100 .byte %00011000 if (<*) > (<(*+6)) repeat ($100-<*) .byte 0 repend endif playerL0264_1 .byte 0 .byte %00100100 .byte %00111100 .byte %01111111 .byte %00111100 .byte %00011000 echo " ",[(scoretable - *)]d , "bytes of ROM space left") ; feel free to modify the score graphics - just keep each digit 8 high ; and keep the conditional compilation stuff intact ifconst ROM2k ORG $F7AC else ifconst bankswitch if bankswitch == 8 ORG $2F94-bscode_length RORG $FF94-bscode_length endif if bankswitch == 16 ORG $4F94-bscode_length RORG $FF94-bscode_length endif if bankswitch == 32 ORG $8F94-bscode_length RORG $FF94-bscode_length endif else ORG $FF9C endif endif scoretable .byte %00111100 .byte %01100110 .byte %01100110 .byte %01100110 .byte %01100110 .byte %01100110 .byte %01100110 .byte %00111100 .byte %01111110 .byte %00011000 .byte %00011000 .byte %00011000 .byte %00011000 .byte %00111000 .byte %00011000 .byte %00001000 .byte %01111110 .byte %01100000 .byte %01100000 .byte %00111100 .byte %00000110 .byte %00000110 .byte %01000110 .byte %00111100 .byte %00111100 .byte %01000110 .byte %00000110 .byte %00000110 .byte %00011100 .byte %00000110 .byte %01000110 .byte %00111100 .byte %00001100 .byte %00001100 .byte %01111110 .byte %01001100 .byte %01001100 .byte %00101100 .byte %00011100 .byte %00001100 .byte %00111100 .byte %01000110 .byte %00000110 .byte %00000110 .byte %00111100 .byte %01100000 .byte %01100000 .byte %01111110 .byte %00111100 .byte %01100110 .byte %01100110 .byte %01100110 .byte %01111100 .byte %01100000 .byte %01100010 .byte %00111100 .byte %00110000 .byte %00110000 .byte %00110000 .byte %00011000 .byte %00001100 .byte %00000110 .byte %01000010 .byte %00111110 .byte %00111100 .byte %01100110 .byte %01100110 .byte %01100110 .byte %00111100 .byte %01100110 .byte %01100110 .byte %00111100 .byte %00111100 .byte %01000110 .byte %00000110 .byte %00111110 .byte %01100110 .byte %01100110 .byte %01100110 .byte %00111100 ifconst ROM2k ORG $F7FC else ifconst bankswitch if bankswitch == 8 ORG $2FF4-bscode_length RORG $FFF4-bscode_length endif if bankswitch == 16 ORG $4FF4-bscode_length RORG $FFF4-bscode_length endif if bankswitch == 32 ORG $8FF4-bscode_length RORG $FFF4-bscode_length endif else ORG $FFFC endif endif ifconst bankswitch if bankswitch == 8 ORG $2FFC RORG $FFFC endif if bankswitch == 16 ORG $4FFC RORG $FFFC endif if bankswitch == 32 ORG $8FFC RORG $FFFC endif else ifconst ROM2k ORG $F7FC else ORG $FFFC endif endif .word start .word start