Episode 7: Let's Save Some Bytes!
(Also, Refractions.)
Before refraction comes refactoring. It's true that we had some working code last time, but we had also to admit that there was some room for improvement. So, before we move on, we may want to refactor the code to clean up the mess of straight forward implementation. — And this accounts for the better part of yesterday's workload.
Neat & Tidy
By arranging variables and constants cleverly in memory, we are able to come up with a general scheme similar the object selection, we had observed in the Battlezone repositioning routine. Thanks to this, we may put the reoccuring code in some subroutines. In fact, all the motions, ship control and firing can be done in 3 and a half subroutines.
E.g., there's one subroutine for advancing an object along an axis and to let it bounce, if it hits a border (which may vary with objects). Using the X register, we may select the object and axis (since we're dealing here mostly with 16 bit values, object/axis indices come at offsets of 2). To illustrate this, here's all we need to move the ball:
moveBall
ldx #0 ; select ball X
jsr MoveObject
ldx #6 ; select ball Y
jsr MoveObject
MoveObject ; subroutine to move an object (x selects object and axis)
clc ; DX: 0 ball, 2 missile0, 4 missile1
lda ballX,X ; DY: 6 ball, 8 missile0, 10 missile1
adc ballDX,X
sta ballX,X
lda ballX + 1,X
adc ballDX + 1,X
sta ballX + 1,X
ldy ballDX + 1,X
bpl moveInc ; branch on positive delta (incrementing)
moveDec
ldy minMaxBallX,X ; are we comparing to zero?
beq moveCmp0
cmp minMaxBallX,X ; lower boundary from table
bcs moveDone ; branch on greater or equal than boundary
lda minMaxBallX,X ; new value = boundary
jmp Bounce
moveCmp0
cmp #$F0 ; deal with wrap around
bcc moveDone ; branch on less than $F0
lda #0
jmp Bounce
moveInc
cmp minMaxBallX+1,X ; upper boundary from table
bcc moveDone ; branch on less than boundary
lda minMaxBallX+1,X
sbc #1 ; new value = boundary - 1; carry already set
jmp Bounce
moveDone
rts
Bounce ; (sub)routine to invert an object's motion
sta ballX + 1,X ; A: new pos HI-btye
lda #0 ; X = DX: 0 ball, 2 missile0, 4 missile1
sta ballX,X ; DY: 6 ball, 8 missile0, 10 missile1
sec
sbc ballDX,X
sta ballDX,X
lda #0
sbc ballDX + 1,X
sta ballDX + 1,X
rts
; table of boundaries for various motions
minMaxBallX
.byte 6
.byte 156
minMaxMsl0X
.byte 162-40-4
.byte 158
minMaxMsl1X
.byte 6
.byte 40+4+2
minMaxBallY
.byte 0
.byte PFHeight - 7
minMaxMsl0Y
.byte 4
.byte PFHeight - 4
minMaxMsl1Y
.byte 4
.byte PFHeight - 4
Moving Missile0 along the X-axis is as simple as calling:
ldx #2 ; select missile0 X
jsr MoveObject
Everything else, including checking boundaries and bouncing will be taken care by the "MoveObject" routine. This is complemented by routine handling controls and motions for any of the two ships and another one to set up and fire a missile.
Great! — Tidy! — Neat! *bows*
However, this accomplishment comes at a price, namely in CPU cycles. Since everything is now handled by lookup tables and indexed memory access, we pay a penalty of an extra processor cycle for any memory access. Moreover the sequence "jsr ... rts" for entering and returning from a subroutine is 12 CPU cycles or 36 pixels! Calling a subroutine to move along an axis twice for an object adds a penalty of 72 pixels, or more than a third of an entire scan line! Estimating the sum of the extra cycles spent for indexed addressing, we may end up with a penalty of half a scan line per major operation. And there are just 30 of them in overscan, where we intend to handle the game mechanics. — Oops!
In other words, since there are 5 objects to move, we sacrifice about 2.5 scan lines or a 12th of the available runtime for the joys of using subroutines. While we have shrinked the code quite dramatically, it comes at a cost, we may not be able to maintain in the long run. — The space vs time paradigm, again. But this time, it bites.
Refractions
However, the clarity gained allows us to move on easily and implement the basic refraction mechanics: As a missile crosses the barrier at the opposing end of the playfield, its trajectory will be refracted by a variable angle proportional to its distance from the vertical center of the playfield.
Illustrating Refractions™.
Implementation is straight forward: We check the state of a missile, where we take note, whether the missile has already crossed the barrier or not. If not so and we just have crossed the limes, we bend the trajectory and move on to the code handling the motion. This is also, where we will add another part of the player controls, to modify the angle (either to increase it or to switch the angle to the other side).
Getting the distance is trivial, but arriving at an angle, which may provide a suitable vertical delta, involves multiplication. Multiplication, as in 16-bit multiplication by 4. As illustrated by the following code snippet, where we enter with the index for the specific missile in X (0 or 2):
Refract
sec
lda #PFHeight/2 + 5 ; vertical center + center of ship sprite
sbc msl0Y + 1,X ; get difference
bcs refractAdd ; branch on positive result
adc #E0 ; add default offset of -20 (minimum angle)
sta msl0DY,X
lda #$FF ; and set up negative HI-byte
sta msl0DY + 1,X
jmp refractMult
refractAdd
clc
adc #20 ; add minimum offset of +20
sta msl0DY,X
refractMult
asl msl0DY,X ; left shift (16-bit)
rol msl0DY + 1,X
asl msl0DY,X ; left shift (16-bit)
rol msl0DY + 1,X
lda #1 ; finally modify the missile state
sta msl0State,X
refractEnd
rts ; and return
This may look like nice code, but a true 6502 crack may be screaming in pain already.
Why?
Here we have to address the weak side of the 6502, namely the lack of a barrel shifter. Moreover, shifting, if not performed on the accumulator, is prohibitively expensive. Let's have a look at the instruction table:
ASL, ROL
| OP-Code | |||||
|---|---|---|---|---|---|
| Address Mode | Assembler | ASL | ROL | Bytes | Cycles |
| Accumulator | ASL | 0C | 2A | 1 | 2 |
| Zero-Page | ASL Oper | 06 | 26 | 2 | 5 |
| Zero-Page,X | ASL Oper,X | 16 | 36 | 2 | 6 |
| Absolute | ASL Oper | 0E | 2E | 3 | 6 |
| Absolute,X | ASL Oper,X | 1E | 3E | 3 | 7 |
Feast your eyes on the last line: 7 cycles!
Shifts and rolls, the building blocks of any binary arithmetics, are the most expensive and slowest instructions there are on the 6502! And we're using the slowest of them all!
28 cycles for a shift to the left by 2 positions! — Ouch!
Note/Edit: Here, I became overly concerened, as we are, of course, using indexed zero-page addresses (6 cycles instead of 7). Please, read the following with a grain of salt and quietly subtract a cycle from the counts provided.
Since we're already wasting cycles on the subroutines, we may want to think this over. Is there a way, we may do this with registers only?
How about this one:
rol ; (2)
rol ; (2)
tay ; (2)
and #$FC ; (2)
sta LoByte ; (3+)
tya ; (2)
rol ; (2)
and #$3 ; (2)
sta HiByte ; (3+)
Neat, isn't it? However, this is still 20 cycles (or more, depending on the addressing mode of the STA instructions). The big plus here is that we may add another shift at the cost of just 4 cycles as compared to 14 using shifts on memory locations.
On the other hand, our approach works only with positive values (mind the AND instructions). So we have to normalize the value first, take note of the sign and do a 16-bit negate at the end, had it been negative. Complementing a 16-bit number is yet another feat. There are several approaches to this, implementing sign fills, and other clever ideas, but in the end, they all add up to the same cycle count as two subratcions from zero, which is the easiest and most transparent way to do it:
sec ; (2)
lda #0 ; (2)
sbc msl0DY,X ; (4)
sta msl0DY,X ; (5)
lda #0 ; (2)
sbc msl0DY+1,X ; (4)
sta msl0DY+1,X ; (5)
"SBC Abs,X" and "STA Abs,X" come at a cost of 4 and 5 cycles respectively, adding up to 24 cycles in total including the LDAs and the SEC. By this, we've lost all we may have gained by our nifty multiplication algorithm. (It's true, it's still faster for positive numbers, but, in terms of realtime computing, we're just interested in the longest path.)
The final implementation is still an open question. In the end, we may just use a look up table for determining the delta-Y.
As a minor change, the ship select is now on the Color/BW console switch, since the difficulty switches are somewhat hidden on the "newer" models (i.e., the 4-switchers).
Code
And here's the code, as-is, try it live here:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Program: Refraction
; Implements: Playfield, Sprites, Motions, Basic refractions
; 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 = $0C ; light grey
PlayerClr2 = $9E ; light blue (unused)
;-----------------------------
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 = $0C ; light grey
PlayerClr2 = $BE ; light blue (unused)
;-----------------------------
endif
; general definitions
ScoresHeight = 10
PFHeight = ScanLines - ScoresHeight - 2 * BorderHeight
shipVelocity = $0180
ballVelocityX = $0100
ballVelocityY = $0080
mslVelocity = $0180 ;$0200
mslCooling = $30
; ship X coordinates (static)
ship0X = 20
ship1X = 134
; vars
frCntr = $80
pfMask = $81
; sprite coordinates (16-bit, HI-byte used for display)
; sprite specific horizontal offsets of TIA coordinates vs logical X:
; players: X+1 (1...160)
; missiles, ball: X+2 (2...161)
; (ball and missiles start 1 px left/early as compared to player sprites)
ship0Y = $82 ; 2 bytes
ship1Y = $84 ; 2 bytes
; order and grouping is important for selecting objects by index
ballX = $86 ; 2 bytes
msl0X = $88 ; 2 bytes
msl1X = $8A ; 2 bytes
ballY = $8C ; 2 btyes
msl0Y = $8E ; 2 bytes
msl1Y = $90 ; 2 bytes
ballDX = $92 ; 2 bytes
msl0DX = $94 ; 2 bytes
msl1DX = $96 ; 2 bytes
ballDY = $98 ; 2 bytes
msl0DY = $9A ; 2 bytes
msl1DY = $9C ; 2 bytes
msl0State = $9E
msl0Cooling = $9F
msl1State = $A0
msl1Cooling = $A1
; addresses for relocated playfield scan line routine
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, 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
lda #0
sta ship0Y
sta ship1Y
sta ballX
sta ballY
sta msl0Cooling
sta msl1Cooling
sta msl0X + 1
sta msl1X + 1
lda #PFHeight / 2 - 5
sta ship0Y + 1
sta ship1Y + 1
lda #81 ; 80 + 2 offset - 1 (size = 2)
sta ballX + 1
lda #10
sta ballY + 1
lda #PFHeight
sta msl0Y + 1
sta msl1Y + 1
lda #<ballVelocityX
sta ballDX
lda #>ballVelocityX
sta ballDX + 1
lda #<ballVelocityY
sta ballDY
lda #>ballVelocityY
sta ballDY + 1
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; 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
ReadInput
lda SWCHB
and #1 ; D0: reset
bne ShipSelect
jmp Start
ShipSelect ; set up ship base addresses (select shape)
lda SWCHB
and #$8 ; D3: color/bw switch
beq shipSelect2
shipSelect1
lda #<[Ship1 - PFHeight]
sta S0Ptr
lda #>[Ship1 - PFHeight]
sta S0Ptr + 1
lda #<[Ship1 - PFHeight]
sta S1Ptr
lda #>[Ship1 - PFHeight]
sta S1Ptr + 1
jmp shipSelectDone
shipSelect2
lda #<[Ship2 - PFHeight]
sta S0Ptr
lda #>[Ship2 - PFHeight]
sta S0Ptr + 1
lda #<[Ship2 - PFHeight]
sta S1Ptr
lda #>[Ship2 - PFHeight]
sta S1Ptr + 1
shipSelectDone
ReadJoysticks
ldx #0 ; payer0
jsr SteerShip
ldy INPT4
jsr FireMissile
ldx #2 ; payer1
jsr SteerShip
ldy INPT5
jsr FireMissile
VPositioning ; vertical sprite positions (off: y = PFHeight)
lda S0Ptr
clc
adc ship0Y + 1
sta S0Ptr
bcc s0Done
inc S0Ptr + 1
s0Done
lda S1Ptr
clc
adc ship1Y + 1
sta S1Ptr
bcc s1Done
inc S1Ptr + 1
s1Done
lda #<[SpriteM - PFHeight]
clc
adc msl0Y + 1
sta M0Ptr
lda #0
adc #>[SpriteM - PFHeight]
sta M0Ptr + 1
lda #<[SpriteM - PFHeight]
clc
adc msl1Y + 1
sta M1Ptr
lda #0
adc #>[SpriteM - PFHeight]
sta M1Ptr + 1
lda #<[SpriteBL - PFHeight]
clc
adc ballY + 1
sta BlPtr
lda #0
adc #>[SpriteBL - PFHeight]
sta BlPtr + 1
HPositioning ; horizontal sprite positioning
sta WSYNC
lda #ship0X ; player0
ldx #0
jsr bzoneRepos
lda #ship1X ; player1
ldx #1
jsr bzoneRepos
lda msl0X + 1 ; missile0
ldx #2
jsr bzoneRepos
lda msl1X + 1 ; missile1
ldx #3
jsr bzoneRepos
lda ballX + 1 ; ball
ldx #4
jsr bzoneRepos
sta WSYNC
VBlankWait
lda INTIM
bne VBlankWait ; wait for timer
sta WSYNC ; finish current line
sta HMOVE ; put movement registers into effect
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 moveBall
lda pfMask ; flip playfield mask
eor #1
sta pfMask
moveBall
ldx #0 ; select ball X
jsr MoveObject
ldx #6 ; select ball Y
jsr MoveObject
moveMissile0
lda msl0State
beq moveMissile1 ; inactive
bpl moveMsl0 ; already refracted
lda msl0X + 1
cmp #116 ; crossed the barrier?
bcc moveMsl0
ldx #0
jsr Refract
moveMsl0
ldx #2 ; select missile0 Y
jsr MoveObject
ldx #8 ; select missile0 Y
jsr MoveObject
moveMissile1
lda msl1State
beq moveMissileDone ; inactive
bpl moveMsl1 ; already refracted
lda msl1X + 1
cmp #44 ; crossed the barrier?
bcs moveMsl1
ldx #2
jsr Refract
moveMsl1
ldx #4 ; select missile1 X
jsr MoveObject
ldx #10 ; select missile1 Y
jsr MoveObject
moveMissileDone
OverscanWait
lda INTIM
bne OverscanWait ; wait for timer
jmp Frame
; some subroutines
SteerShip ; X: ship (0, 2)
lda ctrlYPlayer0,X
and SWCHA ; joystick up?
bne steerDown ; active LO!
sec
lda ship0Y,X
sbc #<shipVelocity
sta ship0Y,X
lda ship0Y + 1,X
sbc #>shipVelocity
cmp #$F0
bcc steerSaveX
lda #0
steerSaveX
sta ship0Y + 1,X
steerDown
lda ctrlYPlayer0+1,X
and SWCHA ; joystick down?
bne steerDone
clc
lda ship0Y,X
adc #<shipVelocity
sta ship0Y,X
lda ship0Y + 1,X
adc #>shipVelocity
cmp #PFHeight - 13
bcc steerSaveY
lda #PFHeight - 12
steerSaveY
sta ship0Y + 1,X
steerDone
rts
MoveObject ; subroutine to move an object (x selects object and axis)
clc ; DX: 0 ball, 2 missile0, 4 missile1
lda ballX,X ; DY: 6 ball, 8 missile0, 10 missile1
adc ballDX,X
sta ballX,X
lda ballX + 1,X
adc ballDX + 1,X
sta ballX + 1,X
ldy ballDX + 1,X
bpl moveInc ; branch on positive delta (incrementing)
moveDec
ldy minMaxBallX,X ; are we comparing to zero?
beq moveCmp0
cmp minMaxBallX,X ; lower boundary from table
bcs moveDone ; branch on greater or equal than boundary
lda minMaxBallX,X ; new value = boundary
jmp Bounce
moveCmp0
cmp #$F0 ; deal with wrap around
bcc moveDone ; branch on less than $F0
lda #0
jmp Bounce
moveInc
cmp minMaxBallX+1,X ; upper boundary from table
bcc moveDone ; branch on less than boundary
lda minMaxBallX+1,X
sbc #1 ; new value = boundary - 1; carry already set
jmp Bounce
moveDone
rts
Bounce ; (sub)routine to invert an object's motion
sta ballX + 1,X ; A: new pos HI-btye
lda #0 ; X = DX: 0 ball, 2 missile0, 4 missile1
sta ballX,X ; DY: 6 ball, 8 missile0, 10 missile1
sec
sbc ballDX,X
sta ballDX,X
lda #0
sbc ballDX + 1,X
sta ballDX + 1,X
rts
FireMissile ; X = ship/player (0, 2), button input in Y
lda msl0Cooling,X ; missile available?
beq fire
dec msl0Cooling,X
rts
fire
tya
bmi fireDone
lda #mslCooling
sta msl0Cooling,X
lda ship0Y,X
sta msl0Y,X
lda ship0Y + 1,X
clc
adc #5
sta msl0Y + 1,X
lda originMsl0,X
sta msl0X + 1,X
lda #0
sta msl0X,X
sta msl0DY,X
sta msl0DY + 1,X
lda msl0Velocity,X
sta msl0DX,X
lda msl0Velocity + 1,X
sta msl0DX + 1,X
lda #$FF
sta msl0State,X
fireDone
rts
Refract
sec
lda #PFHeight/2 + 5
sbc msl0Y + 1,X
bcs refractAdd
eor #$FF
adc #1
ldy #0 ; set state to zero ($FF otherwise)
sty msl0State,X
clc
refractAdd
adc #20
refractMult ; multiply by 4 (16-bit result)
rol
rol
tay
and #$FC
sta msl0DY,X
tya
rol
and #$3
sta msl0DY + 1,X
ldy msl0State,X ; negate?
bne refractSetState
sec
lda #0
sbc msl0DY,X
sta msl0DY,X
lda #0
sbc msl0DY+1,X
sta msl0DY+1,X
refractSetState
lda #1
sta msl0State,X
refractEnd
rts
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Tables for subroutines / object selection
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; table joystick test patterns
ctrlYPlayer0
.byte %00010000 ; up
.byte %00100000 ; down
ctrlYPlayer1
.byte %00000001 ; up
.byte %00000010 ; down
; table of boundaries for various motions
minMaxBallX
.byte 6
.byte 156
minMaxMsl0X
.byte 162-40-4
.byte 158
minMaxMsl1X
.byte 6
.byte 40+4+2
minMaxBallY
.byte 0
.byte PFHeight - 7
minMaxMsl0Y
.byte 4
.byte PFHeight - 4
minMaxMsl1Y
.byte 4
.byte PFHeight - 4
barrierMsl0
.byte 116
originMsl0
.byte ship0X + 10
barrierMsl1
.byte 44
originMsl1
.byte ship1X - 1
msl0Velocity
.byte <mslVelocity
.byte >mslVelocity
msl1Velocity
.byte 255 - <mslVelocity
.byte 255 - >mslVelocity
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; 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 $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
; (lookup index is negative underflow of 241...255, 0)
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
; Battlezone style exact horizontal repositioning (modified)
;
; X = object A = position in px
; --------------------------------------
; 0 = Player0 offset 1, 1...160
; 1 = Player1 offset 1, 1...160
; 2 = Missile0 offset 2, 2...161
; 3 = Missile1 offset 2, 2...161
; 4 = Ball offset 2, 2...161
bzoneRepos ; cycles
sta WSYNC ; 3 wait for next scanline
sec ; 2 tart of scanline (0), set carry flag
divideby15
sbc #15 ; 2 waste 5 cycles by dividing X-pos by 15
bcs divideby15 ; 2/3 now at 6/11/16/21/...
tay ; 2 now at 8/13/18/23/...
lda fineAdjustTable,Y ; 5 5 cycles, as we cross a page boundary
nop ; 2 now at 15/20/25/30/...
sta HMP0,X ; 4 store fine adjustment
sta RESP0,X ; 4 (19/24/29/34/...) strobe position
rts ; 6
; Note: "bcs divideby15" must not cross a page boundary
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; 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
.byte $00
SpriteEnd
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Interrupt and reset vectors
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
org $FFFA
.word Start ; NMI
.word Start ; Reset
.word Start ; IRQ
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
▶ Next: Episode 8: Completing the Game Mechanics
◀ Previous: Episode 6: Moving On
▲ Back to the index.
April 2018, Vienna, Austria
www.masswerk.at – contact me.
— This series is part of Retrochallenge 2018/04. —