Episode 5: Let's Waste Some Bytes!
In the previous episode, we seemingly hit a dead end: There's no way we could do our game using the approved Skip Draw method without letting go of our idea of a smooth, high-resolution single-line kernel. However, we're not going to forgo our idea of the perfect kernel that easily. Maybe, we can come up with an alternative scheme? Let's recap our timing constraints:
Timings of sprites and where they (may) show up earliest (left most) on a scan-line.
We really have to have the Ball and Missile1 ready, as soon as we're hitting the left border. The left ship (Player0) is right behind it, followed after 8 or 9 pixels by where Missile0 will appear, when fired. Then, we'll have some time for the second ship (Player1), but there are also the flickering barriers to consider. (In fact, we may want to miss the first one, as this will cause the two barriers to be out of sync, which will just improve the effect.)
So, what is the fastest method to draw a sprite?
First, we may want to get rid of the calculations for determining, whether a sprite is on or not. What, if we we could just use the index of the scan line counter? Actually, we can do so. As always, the time-vs-space paradigm is lurking in the background, and, while already dealing with scarce resources, we may put some weight on the space side of things. As it is, our code is using barely a page of the ROM, and there are still plenty. We could pad each of the sprites by a series of zero bytes in the length of the number of scan lines that make the playfield. Provided there's also a similar strip of zeros on the other side of the sprite, we could adjust the base address in our sprite-pointer to the offset required to render the sprite at the appropriate vertical position on the screen. Moreover, if we set the pointer just to the beginning of an empty space, we even may have it turned off completely.
SpriteTop
repeat PlayfieldHeight
.byte $00
repend
.byte $10 ; | X |
.byte $10 ; | X |
.byte $58 ; | X XX |
.byte $BE ; |X XXXXX |
.byte $73 ; | XXX XX|
.byte $6D ; | XX XX X|
.byte $73 ; | XXX XX|
.byte $BE ; |X XXXXX |
.byte $58 ; | X XX |
.byte $10 ; | X |
.byte $10 ; | X |
Sprite1
repeat PFHeight
.byte $00
repend
; (...)
Thus, if we adjust a pointer "S0Ptr" to an offset equal the end of the sprite less the postion from the top ("s0Y"), we could use the scan line counter in the Y register for the lookup without further ado.
lda #<Sprite1
sec
sbc #PFHeight - s0Y
sta S0Ptr
lda #>Sprite1
sbc #0
sta S0Ptr + 1
Now our playfield routine would be looking somwhat like this (drawing sprites in order of horizontal priority):
PfLoop
sta WSYNC
lda (BlPtr),Y ; draw ball
sta ENABL
lda (M1Ptr),Y ; draw missile 1
sta ENAM1
lda (S0Ptr),Y ; draw player 0
sta GRP0
lda (M0Ptr),Y ; draw missile 0
sta ENAM0
lda (S1Ptr),Y ; draw player 1
sta GRP1
tya ; flickering line animation
and #1
eor pfMask
sta PF1
dey
bne PfLoop
Sadly, this is still not good enough. — Can't we do better, in terms of runtime?
For sure, we can.
We may move the whole thing into RAM and use a normal indexed load instruction ("LDA $HHHH, Y") instead of the indirect indexed one (by this saving a cycle per sprite.) We'll have to move it into our scarce RAM, because we will have to modify the base address on the fly. While doing so, we may also want to extend the self-modifying approach and handle the switch on the barrier inline.
DASM comes with a mechanism for relocatable origins, but, apparently, it's buggy. When assigning any symbols with addresses based on this (a requirement for our code), the labels for any loop instructions elsewhere break, resulting in DASM exiting on a myriad of errors. So we'll have to arrange things the hard way, as in old-school assembly by hand:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Playfield Scan Line Routine
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; kernel scan-line routine to be relocated to RAM (addr. PFRoutine)
; relocation via 'rorg ... rend' breaks DASM (why?), so let's do it the hard way
PFStart
; * = $B0
;pfLoop
hex b9 00 00 ; lda 00,Y ; draw ball
hex 85 1f ; sta ENABL
hex b9 00 00 ; lda 00,Y ; draw missile 1
hex 85 1e ; sta ENAM1
hex b9 00 00 ; lda 00,Y ; draw player 0
hex 85 1b ; sta GRP0
hex b9 00 00 ; lda 00,Y ; draw missile 0
hex 85 1d ; sta ENAM0
hex b9 00 00 ; lda 00,Y ; draw player 1
hex 85 1c ; sta GRP1
;barrier
hex a9 00 ; lda #0 ; flickering barrier animation:
hex 49 01 ; eor #1 ; the two barriers will be out of sync, because
hex 85 0e ; sta PF1 ; at this point we already missed PF1 at the left.
hex 85 ca ; sta barrier+1 ; store pattern with D0 flipped (self-modifying)
hex 88 ; dey
hex 85 02 ; sta WSYNC
hex d0 da ; bne pfLoop ; start over 3 cycles into the scan line
hex 4c ; jmp
PFEnd
; 38 + 2 bytes in total
; subroutine to move it to RAM
relocatePFRoutine
ldx #PFEnd-PFStart
mvCode
lda PFStart,X
sta PFRoutine,X
dex
bpl mvCode
PfReturn = PFEnd - PFStart + PFRoutine
lda #<BottomBorder ; fix up return vector
sta PfReturn
lda #>BottomBorder
sta PfReturn+1
; uncomment, if PFRoutine != $B0
; lda #PFRoutine + $1a
; sta #PFRoutine + $20 ; fix up the self-modifying rewrite addr
rts
And we have to arrange the pointers into this code:
PFRoutine = $B0 ; where to place the scan line routine BlPtr = PFRoutine + $01 M1Ptr = PFRoutine + $06 S0Ptr = PFRoutine + $0b M0Ptr = PFRoutine + $10 S1Ptr = PFRoutine + $15 BrPtr = PFRoutine + $1a
And this works! — Nearly.
As an attentive reader may have already observed, we moved the strobe on WSYNC from the very beginning of the loop to the end, resulting in a penalty of 3 CPU cycles at the beginning of each scan line. We did so because of the very first playfield line, immediately following to the border. At the end of the last line of the top-border, we have to switch off the background color (switching it to black). We can do so at only at the very end of the scan-line, since it will come into effect immediately. There's no time for a WSYNC, meaning, we'll have to count cycles, and jump to the playfield routine as we swap over at the end of the scan line. In order to do so, I rearranged the top-border code:
TopBorder
sta WSYNC
lda #BorderClr
sta COLUBK
sta COLUPF ; playfield color
lda #16 ; playfield border (will not show in front of bg)
sta PF0
lda pfMask
sta BrPtr
sta PF1
ldy #BorderHeight-1
topLoop
sta WSYNC
dey
bne topLoop
; last line of border
ldy #PFHeight-1
ldx #0
sleep 64 ; sleep 64 cycles (31 NOPs)
stx COLUBK ; we're exactly at the right border
; next scan-line starts
Playfield
jmp PFRoutine ; we'll start 3 cycles into the scan line,
; same as branch after WSYNC
BottomBorder
;(...)
As we can see, all the arrangements for the playfield graphics have been moved to the first scan line of the top-border. Since the background color is the same as the playfield color, this will not be of any visual consequence. On the contrary, the presence of the right border provides us with a bit of air for the final instruction to switch the background-color to black. (Note the macro "sleep 64", which will result in the lavish number of 31 NOP instructions. We will want to replace this by a tiny loop later.)
However, as a result of this, we enter the playfield loop with a bit of a delay, which is enough to be late for drawing Missile0. The following image shows the best we can do, if we move the missile just a pixel to the left, it displays a scan line late.
Testrun in Stella, showing the left-most viable position of Missile1.
This really looks more like the ship was spitting the missile than firing it from its bow. There are two solutions to this: Either, we may move the barrier to the next playfield segment and the two ships towards the center. (Which is still not good enough and also not what we origionally intended.) Or, we may squeeze a little extra runtime out of our playfield routine. — But, can we?
Yes, we can!
We may load the byte for the ball in advance (at the end of the loop), by this gaining 4 cycles at the beginning of the scan line. By this our code looks like this:
TopBorder
sta WSYNC
lda #BorderClr
sta COLUBK
sta COLUPF ; playfield color
lda #16 ; playfield border (will not show in front of bg)
sta PF0
lda pfMask
sta PF1
sta BrPtr
ldy #PFHeight-1
lda (BlPtr),Y ; load ball in advance
dec BlPtr ; compensate for loading before dey in the pf-routine
ldx #BorderHeight-1
topLoop
sta WSYNC
dex
bne topLoop
; last line of border
sleep 68
stx COLUBK ; we're exactly at the right border
; next scan-line starts
Playfield
jmp PFRoutine ; we'll start 3 cycles into the scan line,
; same as branch after WSYNC
BottomBorder
; (...)
PFStart
; * = $B0
;pfLoop
hex 85 1f ; sta ENABL ; draw ball
hex b9 00 00 ; lda 00,Y ; draw missile 1
hex 85 1e ; sta ENAM1
hex b9 00 00 ; lda 00,Y ; draw player 0
hex 85 1b ; sta GRP0
hex b9 00 00 ; lda 00,Y ; draw missile 0
hex 85 1d ; sta ENAM0
hex b9 00 00 ; lda 00,Y ; draw player 1
hex 85 1c ; sta GRP1
;barrier
hex a9 00 ; lda #0 ; flickering barrier animation:
hex 49 01 ; eor #1 ; the two barriers will be out of sync, because
hex 85 0e ; sta PF1 ; at this point we already missed PF1 at the left.
hex 85 c7 ; sta barrier+1 ; store pattern with D0 flipped (self-modifying)
hex b9 00 00 ; lda 00,Y ; load ball for next line
hex 88 ; dey
hex 85 02 ; sta WSYNC
hex d0 da ; bne pfLoop ; start over 3 cycles into the scan line
hex 4c ; jmp
; pointers and addresses changed accordingly
And this is what we get, all objects showing up when and where they are expected!
Testrun in Stella, success!
And this is how we do it (the entire code, so far):
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Program: A Simple Playfield + Sprites
; System: Atari 2600
; Source Format: DASM
; Author: N. Landsteiner, 2018
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
processor 6502
include vcs.h
include macro.h
SEG.U config
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Constants
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; tv standard specifics
; uncomment for PAL
;PAL = 1
ifnconst PAL
;----------------------------- NTSC
; 262 lines: 3+37 VBlank, 192 kernel, 30 overscan
; timers (@ 64 cycles)
; VBlank 43 * 64 = 2752 cycles = 36.21 lines
; Overscan 35 * 64 = 2240 cycles = 29.47 lines
ScanLines = 192
T64VBlank = 43
T64Overscan = 35
BorderHeight = 6
BorderClr = $64 ; purple
ScoreClr = $EC ; yellow
PlayerClr = $0E ; white
;-----------------------------
else
;----------------------------- PAL
; 312 lines: 3+45 VBlank, 228 kernel, 36 overscan
; timers (@ 64 cycles)
; VBlank 53 * 64 = 3392 cycles = 44.63 lines
; Overscan 42 * 64 = 2688 cycles = 35.36 lines
ScanLines = 228
T64VBlank = 53
T64Overscan = 42
BorderHeight = 7
BorderClr = $C4
ScoreClr = $2C
PlayerClr = $0E
;-----------------------------
endif
; general definitions
ScoresHeight = 10
PFHeight = ScanLines - ScoresHeight - 2 * BorderHeight
; vars
frCntr = $80
pfMask = $81
PFRoutine = $B0 ; where to place the scan line routine
M1Ptr = PFRoutine + $03
S0Ptr = PFRoutine + $08
M0Ptr = PFRoutine + $0d
S1Ptr = PFRoutine + $12
BlPtr = PFRoutine + $1f
BrPtr = PFRoutine + $17
SEG cartridge
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Initialization
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
org $F000
Start
sei ; disable interrupts
cld ; clear BCD mode
ldx #$FF
txs ; reset stack pointer
lda #$00
ldx #$28 ; clear TIA registers ($04-$2C)
TIAClear
sta $04,X
dex
bpl TIAClear ; loop exits with X=$FF
; ldx #$FF
RAMClear
sta $00,X ; clear RAM ($FF-$80)
dex
bmi RAMClear ; loop exits with X=$7F
sta SWBCNT ; set console I/O to INPUT
sta SWACNT ; set controller I/O to INPUT
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Game Init
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
lda #1 + 32
sta CTRLPF ; set up symmetric playfield graphics, 2x ball width
lda #0
sta pfMask
sta frCntr
lda #PlayerClr ; set player sprite colors
sta COLUP0
sta COLUP1
lda #8 ; flip player 1 horizontally
sta REFP1
jsr relocatePFRoutine
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Start a new Frame / VBLANK
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Frame
lda #$02
sta WSYNC ; wait for horizontal sync
sta VBLANK ; turn on VBLANK
sta VSYNC ; turn on VSYNC
sta WSYNC ; leave VSYNC on for 3 lines
sta WSYNC
sta WSYNC
lda #$00
sta VSYNC ; turn VSYNC off
lda #T64VBlank ; set timer for VBlank
sta TIM64T
; vertical sprite positions (off: y = PFHeight)
s0Y = 0
m0Y = 5
s1Y = 30
m1Y = 5
blY = 1
s0X = 25
m0X = 35
s1X = 141
m1X = 9
blX = 60
lda #<Ship1
sec
sbc #PFHeight - s0Y
sta S0Ptr
lda #>Ship1
sbc #0
sta S0Ptr + 1
lda #<Ship1
sec
sbc #PFHeight - s1Y
sta S1Ptr
lda #>Ship1
sbc #0
sta S1Ptr + 1
lda #<SpriteM
sec
sbc #PFHeight - m0Y
sta M0Ptr
lda #>SpriteM
sbc #0
sta M0Ptr + 1
lda #<SpriteM
sec
sbc #PFHeight - m1Y
sta M1Ptr
lda #>SpriteM
sbc #0
sta M1Ptr + 1
lda frCntr
and #6
beq noBall ; have a pulsing ball (we may improve the effect later)
lda #<SpriteBL
sec
sbc #PFHeight - blY
sta BlPtr
lda #>SpriteBL
sbc #0
sta BlPtr + 1
jmp hPositioning
noBall ; use empty space before first sprite to switch the ball off
lda #<Sprite0
sta BlPtr
lda #>Sprite0
sta BlPtr+1
hPositioning ; horizontal sprite positioning (ships inbounds at x = 9..155)
sta WSYNC
lda #s0X ; player0
ldx #0
jsr bzoneRepos
lda #s1X ; player1
ldx #1
jsr bzoneRepos
lda #m0X ; missile0
ldx #2
jsr bzoneRepos
lda #m1X ; missile1
ldx #3
jsr bzoneRepos
lda #blX ; ball
ldx #4
jsr bzoneRepos
sta WSYNC
sta HMOVE ; strobe HMOVE to set fine adjustment (activate h-movement)
VBlankWait
lda INTIM
bne VBlankWait ; wait for timer
sta WSYNC ; finish current line
;sta HMOVE
sta VBLANK ; turn off VBLANK
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Visible Kernel
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Scores
; just a dummy, render alternating lines
ldy #ScoresHeight-1
ldx #0
stx COLUBK
ScoresLoop
sta WSYNC
tya
and #1
beq s1
lda #ScoreClr
s1 sta COLUBK
dey
bpl ScoresLoop
TopBorder
sta WSYNC
lda #BorderClr
sta COLUBK
sta COLUPF ; playfield color
lda #16 ; playfield border (will not show in front of bg)
sta PF0
lda pfMask
sta PF1
sta BrPtr
ldy #PFHeight-1
lda (BlPtr),Y ; load ball in advance
dec BlPtr ; compensate for loading before dey in the pf-routine
ldx #BorderHeight-1
topLoop
sta WSYNC
dex
bne topLoop
; last line of border
sleep 68
stx COLUBK ; we're exactly at the right border
; next scan-line starts
Playfield
jmp PFRoutine ; we'll start 3 cycles into the scan line,
; same as branch after WSYNC
BottomBorder
lda #BorderClr
sta COLUBK
lda #0
sta ENABL ; all sprites off
sta ENAM0
sta ENAM1
sta GRP0
sta GRP1
sta PF0 ; playfield off
sta PF1
sta PF2
ldy #BorderHeight
btmLoop
sta WSYNC
dey
bne btmLoop
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Overscan
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
OverscanStart
lda #$02
sta VBLANK
sta WSYNC
lda #T64Overscan ; set timer for overscan
sta TIM64T
inc frCntr ; increment frame counter
lda frCntr
and #3
bne OverscanWait
lda pfMask ; flip playfield mask
eor #1
sta pfMask
OverscanWait
lda INTIM
bne OverscanWait ; wait for timer
jmp Frame
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Playfield Scan Line Routine
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; kernel scan-line routine to be relocated to RAM (addr. PFRoutine)
; relocation via 'rorg ... rend' breaks DASM (why?), so let's do it the hard way
PFStart
; * = $B0
;pfLoop
hex 85 1f ; sta ENABL ; draw ball
hex b9 00 00 ; lda 00,Y ; draw missile 1
hex 85 1e ; sta ENAM1
hex b9 00 00 ; lda 00,Y ; draw player 0
hex 85 1b ; sta GRP0
hex b9 00 00 ; lda 00,Y ; draw missile 0
hex 85 1d ; sta ENAM0
hex b9 00 00 ; lda 00,Y ; draw player 1
hex 85 1c ; sta GRP1
;barrier
hex a9 00 ; lda #0 ; flickering barrier animation:
hex 49 01 ; eor #1 ; the two barriers will be out of sync, because
hex 85 0e ; sta PF1 ; at this point we already missed PF1 at the left.
hex 85 c7 ; sta barrier+1 ; store pattern with D0 flipped (self-modifying)
hex b9 00 00 ; lda 00,Y ; load ball for next line
hex 88 ; dey
hex 85 02 ; sta WSYNC
hex d0 da ; bne pfLoop ; start over 3 cycles into the scan line
hex 4c ; jmp
PFEnd
; 38 + 2 bytes in total
; subroutine to move it to RAM
relocatePFRoutine
ldx #PFEnd-PFStart
mvCode
lda PFStart,X
sta PFRoutine,X
dex
bpl mvCode
PfReturn = PFEnd - PFStart + PFRoutine
lda #<BottomBorder ; fix up return vector
sta PfReturn
lda #>BottomBorder
sta PfReturn+1
; uncomment, if PFRoutine != $B0
; lda #PFRoutine + $17
; sta PFRoutine + $1d ; fix up the self-modifying rewrite addr
rts
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Horizontal Positioning
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
org $F7F0
; Battlezone style exact horizontal repositioning with lookup table
; A = horizontal position in pixel
; X = object
; 0 = Player0
; 1 = Player1
; 2 = Missile0
; 3 = Missile1
; 4 = Ball
bzoneRepos ; addr,cycles
sta WSYNC ; $00, 3 start of scanline.
sec ; $02, 2 set carry flag
divideby15
sbc #15 ; $03, 2 waste 5 cycles by dividing X-pos by 15
bcs divideby15 ; $05, 2/3 now at 11/16/21/26/31/36/41/46/51/56/61/66
tay ; $07, 2
lda fineAdjustTable,Y ; $08, 5 5 cycles by guaranteeing we cross a page boundary
sta HMP0,X ; $0B, 4 store fine adjustmen
sta RESP0,X ; $0D, 4 set the rough position
rts ; $0F, 6 now at 21/26/31/36/41/46/51/56/61/66/71
; $10
; Note: "bcs divideby15" must not cross a page boundary
org $F800
;-----------------------------
; This table is on a page boundary to guarantee the processor
; will cross a page boundary and waste a cycle in order to be
; at the precise position
fineAdjustBegin
.byte %01110000 ; Left 7
.byte %01100000 ; Left 6
.byte %01010000 ; Left 5
.byte %01000000 ; Left 4
.byte %00110000 ; Left 3
.byte %00100000 ; Left 2
.byte %00010000 ; Left 1
.byte %00000000 ; No movement.
.byte %11110000 ; Right 1
.byte %11100000 ; Right 2
.byte %11010000 ; Right 3
.byte %11000000 ; Right 4
.byte %10110000 ; Right 5
.byte %10100000 ; Right 6
.byte %10010000 ; Right 7
fineAdjustTable = fineAdjustBegin - %11110001 ; Note: %11110001 = -15
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Data
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Sprite0
repeat PFHeight
.byte $00
repend
.byte $10 ; | X |
.byte $10 ; | X |
.byte $58 ; | X XX |
.byte $BE ; |X XXXXX |
.byte $73 ; | XXX XX|
.byte $6D ; | XX XX X|
.byte $73 ; | XXX XX|
.byte $BE ; |X XXXXX |
.byte $58 ; | X XX |
.byte $10 ; | X |
.byte $10 ; | X |
Ship1
repeat PFHeight
.byte $00
repend
.byte $70 ; | XXX |
.byte $78 ; | XXXX |
.byte $5C ; | X XXX |
.byte $9E ; |X XXXX |
.byte $C3 ; |XX XX|
.byte $BC ; |X XXXX |
.byte $C3 ; |XX XX|
.byte $9E ; |X XXXX |
.byte $5C ; | X XXX |
.byte $78 ; | XXXX |
.byte $70 ; | XXX |
Ship2
repeat PFHeight
.byte $00
repend
.byte $02 ; missile
SpriteM
repeat PFHeight
.byte $00
repend
.byte $02 ; ball
.byte $02
.byte $02
.byte $02
.byte $02
.byte $02
.byte $02
SpriteBL
repeat PFHeight
.byte $00
repend
SpriteEnd
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Interrupt and reset vectors
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
org $FFFA
.word Start ; NMI
.word Start ; Reset
.word Start ; IRQ
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Note / Edit:
It may be worthy to point out that there are even more versatile techniques to do this, namely using a sprite mask to sync the line count to the vertical sprite position. The general idea is to have padding just on a single sprite mask and to AND this to the actual spride data. Hence, the sprite pointer may point to anywhere in memory, if the value is masked (zeroed out) by the sprite mask and there is no need to apply any padding to the individual sprites (e.g., the sprites of an animated character). However, this comes at the cost of 6 extra cycles per sprite — which is also why we can't use this here.
; sprite mask example
; in kernel
scanLineLoop
sta WSYNC
lda (spriteMaskPtr), Y
and (spritePtr), Y
sta GRP0
dey
bne scanLineLoop
; sprite data, each sprite is 11 scan lines high
repeat PFHeight ; sprite mask, top padding (visible playfield height)
.byte $00
repend
repeat 11 ; sprite mask, visible window of 11 lines
.byte $FF
repend
spriteMask
repeat PFHeight ; sprite mask, bottom padding
.byte $00
repend
; and the individual sprites...
.byte $10 ; | X |
.byte $10 ; | X |
.byte $58 ; | X XX |
.byte $BE ; |X XXXXX |
.byte $73 ; | XXX XX|
.byte $6D ; | XX XX X|
.byte $73 ; | XXX XX|
.byte $BE ; |X XXXXX |
.byte $58 ; | X XX |
.byte $10 ; | X |
.byte $10 ; | X |
Ship1
.byte $70 ; | XXX |
.byte $78 ; | XXXX |
.byte $5C ; | X XXX |
.byte $9E ; |X XXXX |
.byte $C3 ; |XX XX|
.byte $BC ; |X XXXX |
.byte $C3 ; |XX XX|
.byte $9E ; |X XXXX |
.byte $5C ; | X XXX |
.byte $78 ; | XXXX |
.byte $70 ; | XXX |
Ship2
▶ Next: Episode 6: Moving On
◀ Previous: Episode 4: Sprites II — Positioning
▲ Back to the index.
April 2018, Vienna, Austria
www.masswerk.at – contact me.
— This series is part of Retrochallenge 2018/04. —