Retrochallenge 2018/04 (Now in COLOR)
Refraction for the Atari 2600

Episode 6: Moving On

This episode we're moving on in order to implement the basic dynamic design, as in motions and player controls. But things are not that straight forward: Last episode, we thought we had positioning figured out, but the famous Battlezone repositioning routine proves to have some issues. Also, we discover some quirks in TIA timings, regarding when the various objects are actually displayed. However, we manage to figure it out, eventually, arriving at a decent half time result.

Since we finally have some interactive content, there's also an online demo showing the current state of affairs:

Atari VCS online demo

Online demo of our humble project (powered by Javatari.js).

As we're making some progress on our project, we also progress beyond were it's easy to dwell on every assembler instruction in detail. So we'll pick up the interesting parts and show general concepts and discoveries, while leaving the details to the code listing at the end.

Horizontal Positioning Revisited

First, I implemented the Pong-style ball (or "bouncer", since it will collide with the other objects), simply progressing along 16-bit coordinates by vertical and horizontal deltas (the high-byte is used for screen coordinates, the low-byte allows us to move by fractions of pixels a frame). When colliding with the border, we bounce. (A Pong-like sound is yet to be imagined.)

On first glance, everything looked seemingly fine, but there were some irritations: Left of the 14th pixel (or so), there was some flicker. At closer inspection, the ball was jumping back and forth, while travelling through this left-most vertical segment. A sure sign of timing issues with our horizontal positioning routine. Moreover, the coordinates were not what we would have expected them to be. Odd! After all, this was the famous Battlezoney routine (or, rather, a table-based variant), referenced everywhere on the Web. Clearly, there were some issues, which hadn't shown up in our static alignment tests.

Hm.

So I put on the study cap for a closer audit of the code. It was not about page boundaries (which are required being crossed for the indexed lookup and are must not be crossed by the dvide-by-15 loop). Tested. If we move boundaries and memory alignments, things become even more odd. So, it must be about the timing, when there's no iteration of the devide-loop and we simply fall through, since our coordinates are of a low value. Having a closer look, the cycle counts commonly provided with the code were also off. The entire canonical interpretation of the code was not without issues. I tried to shift the timing und shuffle the code, and lo and behold, by inserting a NOP (2 cycles) things began to look well.

Here's my revised version of the Battlezone repositioning routine:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; 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)
; A = horizontal position in pixel
; X = object
;     0 = Player0
;     1 = Player1
;     2 = Missile0
;     3 = Missile1
;     4 = Ball

bzoneRepos                 ; cycles
    sta WSYNC              ; 3    wait for next scanline
    sec                    ; 2    start 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

However, new oddities emerged, namely regarding differences in positioning of the various sprites. Not all sprites are made equal by the TIA. They are implemented by polinomial counters of varying complexity, apparently resulting in varying timing. At least, when using the code above. This may be related to us now hitting the strobe for RESPx at cycle 19 for the earliest, while we're expected to to so at cycle 20. On the other hand, we're using an indexed store instruction, which probably accounts for an extra cycle before the data is actually written to the target address. The difference in offsets is probably due to the internal architecture of the TIA (there are several sources listing delays for strobes taking effect for various cobinations of registers and cycle counts). So we're going to make peace with the minor oddites in the coordinates and live with them. In respect to coordinates as we expect them, the ball and the two missiles are displayed a pixel (or TIA color cycle) early.

We get the following range of coordinates for the various sprites:

Player0, Player1 1...160
Missile0, Missile1, Ball 2...162

However.

At least, our ball is now moving smooth as butter and the ship coordinates are what they should be. We finally have arrived at a consistent model!

Reading Input

The next thing is to read some input to enter the terrific realms of interactivity. (The interesting part here is that every source will tell you how to read the button of the left joystick for Player0, but none will tell you about the button of the second one. Not even the Stella Programmer's Guide! It is only from the source code of the "vcs.h" symbol definitions that we may learn how to read it. — By the way: Did you know that the VCS supports full keyboard scanning, including actively sending scan signals to an external keyboard controller?)

Here is how (from which registers) to read the joysticks, inputs are active LO and we have to configure the ports for input/read (as opposed to output).

Joysticks, register SWCHA (port A, set SWACNT to all zero for input):

BitPlayer0Player1
D7right
D6left
D5down
D4up
D3right
D2left
D1down
D0up

(Active LO: 1 = inactive, 0 = active.)

Joystick button, Player0, register INPT4 (bit D7, active LO):

INPT4D7D6D5D4D3D2D1D0
Player01.......

Joystick button, Player1, register INPT5 (BIT D7, active LO):

INPT5D7D6D5D4D3D2D1D0
Player11.......

Currently, we're reading only up, down, and fire, but we'll have to add left and right as soon as we implement the refraction effect. Pressing the button fires the missile, but by now it will not bounce. There's also a cooling effect for the missiles, which will block the button for a certain time. Pressing the button while the missile is still engaged, will reset the missile for a new shot. (In the final game, a player may either let a missile bounce or may abbort it and fire a new shot.)

Console Switches

Console switches are in SWCHB, bi-state latched inputs, active LO (port B, set SWBCNT to all zero for input)

BitSwitchMeaning
D7P1 difficulty0 = amateur (B), 1 = pro (A)
D6P0 difficulty0 = amateur (B), 1 = pro (A)
D5– not used –
D4– not used –
D3color - B/W0 = B/W, 1 = color
D2– not used –
D1game select0 = switch pressed (active LO)
D0game reset0 = switch pressed (active LO)

Notably, we're all professionals by default and become amateurs by dementia, since difficulty A (up = 1) is “pro”. — The VCS was clearly designed with retro gaming in mind!

Currently, we've implemented the difficulty switches to select the shape of the ships individually per player and the reset switch.

Code

Reading inputs and setting up things accordingly is done in VBLANK, while moving existing objects, like missiles or the ball is done in overscan. The ships are moving vertically by one and a half pixel per frame. (We may want to implement a smooth acceleration and maybe a smooth fade-out of the moving action in one of the iterations to come.) Some further optimizations may be not completely out of discussion…

And here's the code, try it live here:


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Program:        Basic Screen + Motions
; 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   = $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
ballX       = $86  ; 2 bytes
ballY       = $88  ; 2 btyes
ballDX      = $8A  ; 2 bytes
ballDY      = $8C  ; 2 bytes

msl0X       = $8E  ; 2 bytes
msl0Y       = $90  ; 2 bytes
msl1X       = $92  ; 2 bytes
msl1Y       = $94  ; 2 bytes
msl0DX      = $96  ; 2 bytes
msl0DY      = $98  ; 2 bytes
msl1DX      = $9A  ; 2 bytes
msl1DY      = $9C  ; 2 bytes

msl0Cooling = $9E
msl1Cooling = $9F


; 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 by difficulty switches
    lda SWCHB
    and #$40            ; D6: difficulty player0
    bne swd0
    lda #<[Ship1 - PFHeight]
    sta S0Ptr
    lda #>[Ship1 - PFHeight]
    sta S0Ptr + 1
    jmp swd1
swd0
    lda #<[Ship2 - PFHeight]
    sta S0Ptr
    lda #>[Ship2 - PFHeight]
    sta S0Ptr + 1
swd1
    lda SWCHB
    and #$80            ; D7: difficulty player1
    bne swd2
    lda #<[Ship1 - PFHeight]
    sta S1Ptr
    lda #>[Ship1 - PFHeight]
    sta S1Ptr + 1
    jmp swd3
swd2
    lda #<[Ship2 - PFHeight]
    sta S1Ptr
    lda #>[Ship2 - PFHeight]
    sta S1Ptr + 1
swd3

ReadJoysticks
    lda SWCHA            ; joystick player1
    and #%00010000       ; up?
    bne js0down           ; active LO!
    sec
    lda ship0Y
    sbc #<shipVelocity
    sta ship0Y
    lda ship0Y + 1
    sbc #>shipVelocity
    cmp #$F0
    bcc js0st0
    lda #0
js0st0
    sta ship0Y + 1
js0down
    lda SWCHA
    and #%00100000       ; down?
    bne js0done
    clc
    lda ship0Y
    adc #<shipVelocity
    sta ship0Y
    lda ship0Y + 1
    adc #>shipVelocity
    cmp #PFHeight-13
    bcc js0st1
    lda #PFHeight-12
js0st1
    sta ship0Y + 1
js0done

    lda SWCHA            ; joystick player1
    and #%00000001       ; up?
    bne js1down
    sec
    lda ship1Y
    sbc #<shipVelocity
    sta ship1Y
    lda ship1Y + 1
    sbc #>shipVelocity
    cmp #$F0
    bcc js1st0
    lda #
js1st0
    sta ship1Y + 1
js1down
    lda SWCHA
    and #%00000010       ; down?
    bne js1done
    clc
    lda ship1Y
    adc #<shipVelocity
    sta ship1Y
    lda ship1Y + 1
    adc #>shipVelocity
    cmp #PFHeight-13
    bcc js1st1
    lda #PFHeight-12
js1st1
    sta ship1Y + 1
js1done

ReadButtons
    lda msl0Cooling     ; missile 0 available?
    beq fire0
    dec msl0Cooling
    jmp fire0done
fire0
    lda INPT4           ; check joystick 0 button
    bmi fire0done
    lda #mslCooling
    sta msl0Cooling
    lda ship0Y
    sta msl0Y
    lda ship0Y+1
    clc
    adc #5
    sta msl0Y+1
    lda #ship0X+10
    sta msl0X+1
    lda #0
    sta msl0X
    sta msl0DY
    sta msl0DY+1
    lda #<mslVelocity
    sta msl0DX
    lda #>mslVelocity
    sta msl0DX+1
fire0done

    lda msl1Cooling     ; missile 1 available?
    beq fire1
    dec msl1Cooling
    jmp fire1done
fire1
    lda INPT5           ; check joystick 1 button
    bmi fire1done
    lda #mslCooling
    sta msl1Cooling
    lda ship1Y
    sta msl1Y
    lda ship1Y+1
    clc
    adc #5
    sta msl1Y+1
    lda #ship1X-1
    sta msl1X+1
    lda #0
    sta msl1X
    sta msl1DY
    sta msl1DY+1
    sec
    sbc #<mslVelocity
    sta msl1DX
    lda #0
    sbc #>mslVelocity
    sta msl1DX+1
fire1done

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 moveBallX
    lda pfMask          ; flip playfield mask
    eor #1
    sta pfMask


moveBallX
    clc
    lda ballX
    adc ballDX
    sta ballX
    lda ballX + 1
    adc ballDX + 1
    sta ballX + 1
    cmp #6
    bcs ballRight
    lda #6
    sta ballX + 1
bounceX
    sec
    lda #0
    sta ballX
    sbc ballDX
    sta ballDX
    lda #0
    sbc ballDX + 1
    sta ballDX + 1
    jmp moveBallY
ballRight
    cmp #156
    bcc moveBallY
    lda #155
    sta ballX + 1
    jmp bounceX

moveBallY
    clc
    lda ballY
    adc ballDY
    sta ballY
    lda ballY + 1
    adc ballDY + 1
    sta ballY + 1
    cmp #$F0
    bcc ballBottom
    lda #0
    sta ballY + 1
bounceY
    sec
    lda #0
    sta ballY
    sbc ballDY
    sta ballDY
    lda #0
    sbc ballDY + 1
    sta ballDY + 1
    jmp moveBallYDone
ballBottom
    cmp #PFHeight-7
    bcc moveBallYDone
    lda #PFHeight-7
    sta ballY + 1
    jmp bounceY
moveBallYDone

moveMissile0
    lda msl0X +1
    beq mvMsl0Done
    clc
    lda msl0X
    adc msl0DX
    sta msl0X
    lda msl0X+1
    adc msl0DX+1
    sta msl0X+1
    cmp #158
    bcc mvMsl0Done
    lda #0
    sta msl0X+1
    sta msl0Cooling
    lda #PFHeight
    sta msl0Y+1
mvMsl0Done

moveMissile1
    lda msl1X +1
    beq mvMsl1Done
    clc
    lda msl1X
    adc msl1DX
    sta msl1X
    lda msl1X+1
    adc msl1DX+1
    sta msl1X+1
    cmp #6
    bcS mvMsl1Done
    lda #0
    sta msl1X+1
    sta msl1Cooling
    lda #PFHeight
    sta msl1Y+1
mvMsl1Done

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 $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    start 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 7: Let's Save Some Bytes!

Previous:   Episode 5: Let's Waste Some Bytes!

Back to the index.

— This series is part of Retrochallenge 2018/04. —