StarClear is an arcade shoot ’em up game for the NES. This project uses an unusual approach: it bootstraps the game from a minimal gForth host environment.
This file is written in a literate programming style. The comments form the design document, and the source can be rendered directly as Markdown. The project is implemented in a single file, built up in a logical order that a reader can follow.
We are going to bootstrap the game in layers. First, we will implement a 6502 assembler that outputs an iNES ROM image directly. Using that assembler, we will build a small Forth-like runtime for the NES. From there, we will build a Forth compiler that targets the runtime, and finally implement the game itself in Forth.
By default this file exits after writing the ROM. For debugging,
define keep-going before loading this file to keep the
gForth session alive and run extra inspection code afterward:
gforth -e 'true constant keep-going' starclear.fth -e 'smiley . cr bye'[undefined] keep-going [if]
false constant keep-going
[then]First let’s set up some constants for the iNES ROM image. We are going to use the NROM-128 format, so our ROM image layout is:
This adds up to a ROM image size of $6010 bytes.
hex
6010 constant rom-size
0010 constant prg-rom-offset
4000 constant prg-rom-size
4010 constant chr-rom-offset
2000 constant chr-rom-size
8000 constant prg-cpu-baseNow let’s create the buffer for the ROM, zero it, and create a
rom-here variable to track our cursor offset into it:
create rom-buffer rom-size allot
rom-buffer rom-size 0 fill
variable rom-here
0 rom-here !Let’s create a primitive for writing bytes into the ROM image:
: rom, ( byte -- )
rom-buffer rom-here @ + c!
1 rom-here +! ;We will need a primitive for writing words (2 bytes, little endian) into the ROM image:
: romw, ( word -- )
dup ff and rom,
8 rshift ff and rom, ;We will need a way to move around in the ROM:
: rom-seek ( offset -- )
rom-here ! ;The CHR ROM has its own cursor. This lets us define tile graphics without disturbing the PRG ROM cursor used by the assembler.
variable chr-here
chr-rom-offset chr-here !
: chr, ( byte -- )
rom-buffer chr-here @ + c!
1 chr-here +! ;
: chrw, ( word -- )
dup ff and chr,
8 rshift ff and chr, ;
: chr-seek ( offset -- )
chr-rom-offset + chr-here ! ;
: chr-offset ( -- offset )
chr-here @ chr-rom-offset - ;We will need some words to translate between NES addresses and
addresses in the ROM file. For example the PRG ROM begins in the NES at
$8000 but in the ROM file it begins at $0010,
so these words convert between the two coordinate systems.
: target-offset ( target-addr -- rom-offset )
prg-cpu-base - prg-rom-size mod prg-rom-offset + ;
: target-addr ( rom-offset -- target-addr )
prg-rom-offset - prg-cpu-base + ;
: target-seek ( target-addr -- )
target-offset rom-seek ;
: target-here ( -- cpu-addr )
rom-here @ target-addr ;
: rel-offset ( target-addr -- offset )
target-here 2 + - ff and ;Let’s create a word to create labels, so we can remember target addresses. This will allow us to start implementing subroutines in assembly.
: label ( "name" -- )
create target-here ,
does> @ ;Now we can define the opcodes for the processor. Some opcodes have different addressing modes, so we will use this convention:
-acc: accumulator-imm: immediate-zp: zero-page-zpx: zero-page[x]-zpy: zero-page[y]-abs: absolute-absx: absolute[x]-absy: absolute[y]-indx: indexed indirect-indy: indirect indexed: nop, ( -- ) ea rom, ;
: brk, ( -- ) 00 rom, ;
: rts, ( -- ) 60 rom, ;
: rti, ( -- ) 40 rom, ;
: clc, ( -- ) 18 rom, ;
: sec, ( -- ) 38 rom, ;
: cli, ( -- ) 58 rom, ;
: sei, ( -- ) 78 rom, ;
: clv, ( -- ) b8 rom, ;
: cld, ( -- ) d8 rom, ;
: sed, ( -- ) f8 rom, ;
: tax, ( -- ) aa rom, ;
: txa, ( -- ) 8a rom, ;
: dex, ( -- ) ca rom, ;
: inx, ( -- ) e8 rom, ;
: tay, ( -- ) a8 rom, ;
: tya, ( -- ) 98 rom, ;
: dey, ( -- ) 88 rom, ;
: iny, ( -- ) c8 rom, ;
: tsx, ( -- ) ba rom, ;
: txs, ( -- ) 9a rom, ;
: pha, ( -- ) 48 rom, ;
: pla, ( -- ) 68 rom, ;
: php, ( -- ) 08 rom, ;
: plp, ( -- ) 28 rom, ;
: asl-acc, ( -- ) 0a rom, ;
: rol-acc, ( -- ) 2a rom, ;
: lsr-acc, ( -- ) 4a rom, ;
: ror-acc, ( -- ) 6a rom, ;
: lda-imm, ( u -- ) a9 rom, rom, ;
: ldx-imm, ( u -- ) a2 rom, rom, ;
: ldy-imm, ( u -- ) a0 rom, rom, ;
: adc-imm, ( u -- ) 69 rom, rom, ;
: and-imm, ( u -- ) 29 rom, rom, ;
: cmp-imm, ( u -- ) c9 rom, rom, ;
: cpx-imm, ( u -- ) e0 rom, rom, ;
: cpy-imm, ( u -- ) c0 rom, rom, ;
: eor-imm, ( u -- ) 49 rom, rom, ;
: ora-imm, ( u -- ) 09 rom, rom, ;
: sbc-imm, ( u -- ) e9 rom, rom, ;
: lda-zp, ( addr -- ) a5 rom, rom, ;
: lda-zpx, ( addr -- ) b5 rom, rom, ;
: lda-abs, ( addr -- ) ad rom, romw, ;
: lda-absx, ( addr -- ) bd rom, romw, ;
: lda-absy, ( addr -- ) b9 rom, romw, ;
: lda-indx, ( addr -- ) a1 rom, rom, ;
: lda-indy, ( addr -- ) b1 rom, rom, ;
: ldx-zp, ( addr -- ) a6 rom, rom, ;
: ldx-zpy, ( addr -- ) b6 rom, rom, ;
: ldx-abs, ( addr -- ) ae rom, romw, ;
: ldx-absy, ( addr -- ) be rom, romw, ;
: ldy-zp, ( addr -- ) a4 rom, rom, ;
: ldy-zpx, ( addr -- ) b4 rom, rom, ;
: ldy-abs, ( addr -- ) ac rom, romw, ;
: ldy-absx, ( addr -- ) bc rom, romw, ;
: sta-zp, ( addr -- ) 85 rom, rom, ;
: sta-zpx, ( addr -- ) 95 rom, rom, ;
: sta-abs, ( addr -- ) 8d rom, romw, ;
: sta-absx, ( addr -- ) 9d rom, romw, ;
: sta-absy, ( addr -- ) 99 rom, romw, ;
: sta-indx, ( addr -- ) 81 rom, rom, ;
: sta-indy, ( addr -- ) 91 rom, rom, ;
: stx-zp, ( addr -- ) 86 rom, rom, ;
: stx-zpy, ( addr -- ) 96 rom, rom, ;
: stx-abs, ( addr -- ) 8e rom, romw, ;
: sty-zp, ( addr -- ) 84 rom, rom, ;
: sty-zpx, ( addr -- ) 94 rom, rom, ;
: sty-abs, ( addr -- ) 8c rom, romw, ;
: adc-zp, ( addr -- ) 65 rom, rom, ;
: adc-zpx, ( addr -- ) 75 rom, rom, ;
: adc-abs, ( addr -- ) 6d rom, romw, ;
: adc-absx, ( addr -- ) 7d rom, romw, ;
: adc-absy, ( addr -- ) 79 rom, romw, ;
: adc-indx, ( addr -- ) 61 rom, rom, ;
: adc-indy, ( addr -- ) 71 rom, rom, ;
: sbc-zp, ( addr -- ) e5 rom, rom, ;
: sbc-zpx, ( addr -- ) f5 rom, rom, ;
: sbc-abs, ( addr -- ) ed rom, romw, ;
: sbc-absx, ( addr -- ) fd rom, romw, ;
: sbc-absy, ( addr -- ) f9 rom, romw, ;
: sbc-indx, ( addr -- ) e1 rom, rom, ;
: sbc-indy, ( addr -- ) f1 rom, rom, ;
: and-zp, ( addr -- ) 25 rom, rom, ;
: and-zpx, ( addr -- ) 35 rom, rom, ;
: and-abs, ( addr -- ) 2d rom, romw, ;
: and-absx, ( addr -- ) 3d rom, romw, ;
: and-absy, ( addr -- ) 39 rom, romw, ;
: and-indx, ( addr -- ) 21 rom, rom, ;
: and-indy, ( addr -- ) 31 rom, rom, ;
: ora-zp, ( addr -- ) 05 rom, rom, ;
: ora-zpx, ( addr -- ) 15 rom, rom, ;
: ora-abs, ( addr -- ) 0d rom, romw, ;
: ora-absx, ( addr -- ) 1d rom, romw, ;
: ora-absy, ( addr -- ) 19 rom, romw, ;
: ora-indx, ( addr -- ) 01 rom, rom, ;
: ora-indy, ( addr -- ) 11 rom, rom, ;
: eor-zp, ( addr -- ) 45 rom, rom, ;
: eor-zpx, ( addr -- ) 55 rom, rom, ;
: eor-abs, ( addr -- ) 4d rom, romw, ;
: eor-absx, ( addr -- ) 5d rom, romw, ;
: eor-absy, ( addr -- ) 59 rom, romw, ;
: eor-indx, ( addr -- ) 41 rom, rom, ;
: eor-indy, ( addr -- ) 51 rom, rom, ;
: cmp-zp, ( addr -- ) c5 rom, rom, ;
: cmp-zpx, ( addr -- ) d5 rom, rom, ;
: cmp-abs, ( addr -- ) cd rom, romw, ;
: cmp-absx, ( addr -- ) dd rom, romw, ;
: cmp-absy, ( addr -- ) d9 rom, romw, ;
: cmp-indx, ( addr -- ) c1 rom, rom, ;
: cmp-indy, ( addr -- ) d1 rom, rom, ;
: cpx-zp, ( addr -- ) e4 rom, rom, ;
: cpx-abs, ( addr -- ) ec rom, romw, ;
: cpy-zp, ( addr -- ) c4 rom, rom, ;
: cpy-abs, ( addr -- ) cc rom, romw, ;
: bit-zp, ( addr -- ) 24 rom, rom, ;
: bit-abs, ( addr -- ) 2c rom, romw, ;
: inc-zp, ( addr -- ) e6 rom, rom, ;
: inc-zpx, ( addr -- ) f6 rom, rom, ;
: inc-abs, ( addr -- ) ee rom, romw, ;
: inc-absx, ( addr -- ) fe rom, romw, ;
: dec-zp, ( addr -- ) c6 rom, rom, ;
: dec-zpx, ( addr -- ) d6 rom, rom, ;
: dec-abs, ( addr -- ) ce rom, romw, ;
: dec-absx, ( addr -- ) de rom, romw, ;
: asl-zp, ( addr -- ) 06 rom, rom, ;
: asl-zpx, ( addr -- ) 16 rom, rom, ;
: asl-abs, ( addr -- ) 0e rom, romw, ;
: asl-absx, ( addr -- ) 1e rom, romw, ;
: rol-zp, ( addr -- ) 26 rom, rom, ;
: rol-zpx, ( addr -- ) 36 rom, rom, ;
: rol-abs, ( addr -- ) 2e rom, romw, ;
: rol-absx, ( addr -- ) 3e rom, romw, ;
: lsr-zp, ( addr -- ) 46 rom, rom, ;
: lsr-zpx, ( addr -- ) 56 rom, rom, ;
: lsr-abs, ( addr -- ) 4e rom, romw, ;
: lsr-absx, ( addr -- ) 5e rom, romw, ;
: ror-zp, ( addr -- ) 66 rom, rom, ;
: ror-zpx, ( addr -- ) 76 rom, rom, ;
: ror-abs, ( addr -- ) 6e rom, romw, ;
: ror-absx, ( addr -- ) 7e rom, romw, ;
: jmp, ( addr -- ) 4c rom, romw, ;
: jmp-ind, ( addr -- ) 6c rom, romw, ;
: jsr, ( addr -- ) 20 rom, romw, ;
: bpl, ( offset -- ) 10 rom, rom, ;
: bmi, ( offset -- ) 30 rom, rom, ;
: bvc, ( offset -- ) 50 rom, rom, ;
: bvs, ( offset -- ) 70 rom, rom, ;
: bcc, ( offset -- ) 90 rom, rom, ;
: bcs, ( offset -- ) b0 rom, rom, ;
: bne, ( offset -- ) d0 rom, rom, ;
: beq, ( offset -- ) f0 rom, rom, ;We have everything we need to write the iNES header now. Let’s do it:
0 rom-seek
4e rom, 45 rom, 53 rom, 1a rom, \ "NES" EOF
01 rom, \ 1 x 16 KiB PRG ROM
01 rom, \ 1 x 8 KiB CHR ROM
00 rom, \ mapper 0, horizontal mirroring
00 rom, \ mapper 0
00 rom, 00 rom, 00 rom, 00 rom,
00 rom, 00 rom, 00 rom, 00 rom,Now it is time to build a runtime for the NES. This is the design of the runtime:
$0300 and grows
upwardsX register as the data stack pointer0300 constant data-stackWe will need a system to manage allocating memory in zero page, which is a precious commodity. Let’s create it:
0000 constant zp-start
0100 constant zp-end
variable zp-here
zp-start zp-here !
: zp-allot ( size -- addr )
zp-here @
swap
dup zp-here +!
zp-here @ zp-end > abort" zero page overflow"
drop ;We will need at least one scratch cell in the zero page:
2 zp-allot constant zp-addr
2 zp-allot constant zp-scratch
2 zp-allot constant zp-scratch-2
zp-addr 1 + constant zp-addr-high
zp-scratch 1 + constant zp-scratch-high
zp-scratch-2 1 + constant zp-scratch-2-highWe will also need ordinary RAM variables for game state.
0400 constant ram-start
0800 constant ram-end
variable ram-here
ram-start ram-here !
: ram-allot ( size -- addr )
ram-here @
swap
dup ram-here +!
ram-here @ ram-end > abort" RAM overflow"
drop ;8000 target-seek
label push-ay
data-stack sta-absx,
inx,
tya,
data-stack sta-absx,
inx,
rts,
label pop-ay
dex,
data-stack lda-absx,
tay,
dex,
data-stack lda-absx,
rts,
: push-ay, ( -- )
data-stack sta-absx,
inx,
tya,
data-stack sta-absx,
inx, ;
: pop-ay, ( -- )
dex,
data-stack lda-absx,
tay,
dex,
data-stack lda-absx, ;label target-drop
dex,
dex,
rts,
label target-dup
pop-ay,
zp-scratch sta-zp,
tya,
zp-scratch 1 + sta-zp,
zp-scratch lda-zp,
zp-scratch 1 + ldy-zp,
push-ay,
zp-scratch lda-zp,
zp-scratch 1 + ldy-zp,
push-ay,
rts,
label target-swap
pop-ay, \ pop b
zp-scratch sta-zp,
tya,
zp-scratch 1 + sta-zp,
pop-ay, \ pop a
zp-scratch-2 sta-zp,
tya,
zp-scratch-2 1 + sta-zp,
zp-scratch lda-zp,
zp-scratch 1 + ldy-zp,
push-ay,
zp-scratch-2 lda-zp,
zp-scratch-2 1 + ldy-zp,
push-ay,
rts,
label target-over
pop-ay, \ pop b
zp-scratch sta-zp,
tya,
zp-scratch 1 + sta-zp,
pop-ay, \ pop a
zp-scratch-2 sta-zp,
tya,
zp-scratch-2 1 + sta-zp,
zp-scratch-2 lda-zp,
zp-scratch-2 1 + ldy-zp,
push-ay,
zp-scratch lda-zp,
zp-scratch 1 + ldy-zp,
push-ay,
zp-scratch-2 lda-zp,
zp-scratch-2 1 + ldy-zp,
push-ay,
rts,
label target-plus
pop-ay, \ pop b
zp-scratch sta-zp,
tya,
zp-scratch 1 + sta-zp,
pop-ay, \ pop a
clc,
zp-scratch adc-zp, \ A = low result
zp-scratch-2 sta-zp,
tya,
zp-scratch 1 + adc-zp, \ A = high result
tay,
zp-scratch-2 lda-zp, \ A = low result
push-ay,
rts,
label target-minus
pop-ay, \ pop b
zp-scratch sta-zp,
tya,
zp-scratch 1 + sta-zp,
pop-ay, \ pop a
sec,
zp-scratch sbc-zp, \ A = low result
zp-scratch-2 sta-zp,
tya,
zp-scratch 1 + sbc-zp, \ A = high result
tay,
zp-scratch-2 lda-zp, \ A = low result
push-ay,
rts,
label target-and
pop-ay, \ pop b
zp-scratch sta-zp,
tya,
zp-scratch 1 + sta-zp,
pop-ay, \ pop a
zp-scratch and-zp, \ A = low result
zp-scratch-2 sta-zp,
tya,
zp-scratch 1 + and-zp, \ A = high result
tay,
zp-scratch-2 lda-zp, \ A = low result
push-ay,
rts,
label target-less
pop-ay, \ pop b
zp-scratch sta-zp,
tya,
zp-scratch 1 + sta-zp,
pop-ay, \ pop a
zp-scratch-2 sta-zp, \ save low byte of a
tya, \ A = high byte of a
zp-scratch 1 + cmp-zp, \ compare high bytes
10 bcc, \ high a < high b -> PUSH1 (skip 16 bytes)
06 bne, \ high a > high b -> PUSH0 (skip 6 bytes)
zp-scratch-2 lda-zp, \ high bytes equal; compare low bytes
zp-scratch cmp-zp,
08 bcc, \ low a < low b -> PUSH1 (skip 8 bytes)
00 lda-imm, \ PUSH0
00 ldy-imm,
push-ay jsr,
rts,
01 lda-imm, \ PUSH1
00 ldy-imm,
push-ay jsr,
rts,
label target-cfetch
pop-ay, \ A/Y = address
zp-addr sta-zp, \ low address
tya,
zp-addr 1 + sta-zp, \ high address
00 ldy-imm,
zp-addr lda-indy, \ A = byte at address
00 ldy-imm, \ high byte = 0
push-ay,
rts,
label target-cstore
pop-ay, \ pop addr
zp-addr sta-zp,
tya,
zp-addr 1 + sta-zp,
pop-ay, \ pop byte/value
00 ldy-imm,
zp-addr sta-indy, \ store low byte at addr
rts,
label target-fetch
pop-ay, \ pop addr
zp-addr sta-zp,
tya,
zp-addr 1 + sta-zp,
00 ldy-imm,
zp-addr lda-indy, \ low byte
zp-scratch sta-zp,
iny,
zp-addr lda-indy, \ high byte
tay,
zp-scratch lda-zp, \ low byte
push-ay,
rts,
label target-store
pop-ay, \ pop addr
zp-addr sta-zp,
tya,
zp-addr 1 + sta-zp,
pop-ay, \ pop value
zp-scratch sta-zp, \ save low byte
tya, \ A = high byte
zp-scratch 1 + sta-zp,
00 ldy-imm,
zp-scratch lda-zp, \ low byte
zp-addr sta-indy,
iny,
zp-scratch 1 + lda-zp, \ high byte
zp-addr sta-indy,
rts,
label target-test-zero
pop-ay,
zp-scratch sta-zp,
tya,
zp-scratch ora-zp,
rts,
label target-greater
pop-ay, \ pop b
zp-scratch sta-zp,
tya,
zp-scratch 1 + sta-zp,
pop-ay, \ pop a
zp-scratch-2 sta-zp, \ save low byte of a
tya, \ A = high byte of a
zp-scratch 1 + cmp-zp, \ compare high bytes
0a bcc, \ high a < high b -> PUSH0 (skip 10 bytes)
10 bne, \ high a > high b -> PUSH1 (skip 16 bytes)
zp-scratch-2 lda-zp, \ high bytes equal; compare low bytes
zp-scratch cmp-zp,
02 beq, \ low a == low b -> PUSH0 (skip 2 bytes)
08 bcs, \ low a > low b -> PUSH1 (skip 8 bytes)
00 lda-imm, \ PUSH0
00 ldy-imm,
push-ay jsr,
rts,
01 lda-imm, \ PUSH1
00 ldy-imm,
push-ay jsr,
rts,
label target-zero-equals
pop-ay,
zp-scratch sta-zp,
tya,
zp-scratch ora-zp,
08 bne, \ if not zero, PUSH0 (skip 8 bytes)
01 lda-imm, \ is zero, PUSH1
00 ldy-imm,
push-ay jsr,
rts,
00 lda-imm, \ PUSH0
00 ldy-imm,
push-ay jsr,
rts,Let’s create a host word that will let us push a literal to the target stack:
: lit, ( value -- )
dup ff and lda-imm,
8 rshift ff and ldy-imm,
push-ay jsr, ;The compiler is where we start making target code look like Forth again. Host words still emit 6502 instructions, but target words can call each other by name and use a separate wordlist for their compiled behavior.
wordlist constant target-compiler-wordlist
variable host-wordlist
get-current host-wordlist !
: named-label ( c-addr u -- )
nextname create target-here ,
does> @ ;
: named-target-call ( c-addr u addr -- )
>r nextname create r> ,
does> @ jsr, ;
: named-target-variable ( c-addr u addr -- )
>r nextname create r> ,
does> @ ;
: named-target-variable-literal ( c-addr u addr -- )
>r nextname create r> ,
does> @ lit, ;
: target-variable ( "name" -- )
parse-name
2 ram-allot >r
2dup r@ host-wordlist @ set-current named-target-variable
r> target-compiler-wordlist set-current named-target-variable-literal
host-wordlist @ set-current ;
: target-buffer ( size "name" -- )
parse-name
rot ram-allot >r
2dup r@ host-wordlist @ set-current named-target-variable
r> target-compiler-wordlist set-current named-target-variable-literal
host-wordlist @ set-current ;
: target-alias ( addr "name" -- )
parse-name
rot >r
2dup r@ host-wordlist @ set-current named-target-variable
r> target-compiler-wordlist set-current named-target-variable-literal
host-wordlist @ set-current ;
: target: ( "name" -- )
parse-name 2dup target-here >r
host-wordlist @ set-current
named-label
target-compiler-wordlist set-current
r> named-target-call
host-wordlist @ set-current
target-compiler-wordlist >order ;
: ;target ( -- )
rts,
previous ;Interrupt handlers are almost the same as target words, except they
return with RTI instead of RTS. This lets the
NMI handler be written in the same target-Forth style as the rest of the
game logic.
: interrupt: ( "name" -- )
target: ;
: ;interrupt ( -- )
rti,
previous ;These host words define the target meanings of ordinary Forth names.
target-compiler-wordlist set-current
: drop ( x -- ) target-drop jsr, ;
: dup ( x -- x x ) target-dup jsr, ;
: swap ( x1 x2 -- x2 x1 ) target-swap jsr, ;
: over ( x1 x2 -- x1 x2 x1 ) target-over jsr, ;
: + ( n1 n2 -- n3 ) target-plus jsr, ;
: - ( n1 n2 -- n3 ) target-minus jsr, ;
: and ( n1 n2 -- n3 ) target-and jsr, ;
: < ( n1 n2 -- f ) target-less jsr, ;
: > ( n1 n2 -- f ) target-greater jsr, ;
: 0= ( n -- f ) target-zero-equals jsr, ;
: c@ ( addr -- byte ) target-cfetch jsr, ;
: c! ( byte addr -- ) target-cstore jsr, ;
: @ ( addr -- n ) target-fetch jsr, ;
: ! ( n addr -- ) target-store jsr, ;
host-wordlist @ set-currentFirst we need some words to handle patching addresses:
0 constant branch-patch
1 constant jump-patch
: patch-rom-byte ( value rom-offset -- )
rom-buffer + c! ;
: patch-rom-word ( value rom-offset -- )
>r
dup ff and r@ patch-rom-byte
8 rshift ff and r> 1 + patch-rom-byte ;
: patch-branch ( patch-offset -- )
dup target-addr 1 +
target-here swap -
dup -80 < over 7f > or abort" branch out of range"
ff and
swap patch-rom-byte ;
: patch-jump ( patch-offset -- )
target-here swap patch-rom-word ;
: patch-control ( patch-offset patch-kind -- )
branch-patch = if
patch-branch
else
patch-jump
then ;
: unresolved-jmp, ( -- patch-offset patch-kind )
rom-here @ 1+
0000 jmp,
jump-patch ;That is sufficient to start building the control flow words in the target compiler wordlist:
target-compiler-wordlist set-current
: if ( -- patch-offset patch-kind )
target-test-zero jsr,
rom-here @ 1 +
00 beq,
branch-patch ;
: else ( if-patch if-kind -- else-patch else-kind )
rom-here @ 1 +
0000 jmp,
jump-patch
2swap patch-control ;
: then ( patch-offset patch-kind -- )
patch-control ;
host-wordlist @ set-currenttarget-compiler-wordlist set-current
: begin ( -- addr )
target-here ;
: again ( addr -- )
jmp, ;
: until ( addr -- )
target-test-zero jsr,
rel-offset beq, ;
: while ( begin-addr -- begin-addr patch-offset patch-kind )
target-test-zero jsr,
rom-here @ 1 +
00 beq,
branch-patch ;
: repeat ( begin-addr patch-offset patch-kind -- )
>r >r
jmp,
r> r> patch-control ;
host-wordlist @ set-currentNow we can build a “platform” layer on top of the runtime. This will be a set of words that encapsulate hardware interactions in our program.
Let’s create a word to help write to registers. For PPUDATA it’s important to use immediate addressing to avoid any dummy reads.
: reg! ( value addr -- )
swap lda-imm,
sta-abs, ;
: reg@ ( addr -- )
lda-abs, ;These words encapsulate the register addresses and facilitate writing and reading the registers.
2000 constant ppu-ctrl
: ppu-ctrl! ( value -- )
ppu-ctrl reg! ;
2001 constant ppu-mask
: ppu-mask! ( value -- )
ppu-mask reg! ;
2002 constant ppu-status
: ppu-status@ ( -- )
ppu-status reg@ ;
2003 constant oam-addr
: oam-addr! ( value -- )
oam-addr reg! ;
2004 constant oam-data
: oam-data! ( value -- )
oam-data reg! ;
2005 constant ppu-scroll
: ppu-scroll! ( x y -- )
swap ppu-scroll reg!
ppu-scroll reg! ;
2006 constant ppu-addr
: ppu-addr! ( addr -- )
dup 8 rshift ff and ppu-addr reg!
ff and ppu-addr reg! ;
2007 constant ppu-data
: ppu-data! ( value -- )
ppu-data reg! ;
: ppu-data@ ( -- )
ppu-data reg@ ;
4000 constant pulse-1-control
: pulse-1-control! ( value -- )
pulse-1-control reg! ;
4001 constant pulse-1-sweep
: pulse-1-sweep! ( value -- )
pulse-1-sweep reg! ;
4002 constant pulse-1-timer-low
: pulse-1-timer-low! ( value -- )
pulse-1-timer-low reg! ;
4003 constant pulse-1-timer-high
: pulse-1-timer-high! ( value -- )
pulse-1-timer-high reg! ;
4004 constant pulse-2-control
: pulse-2-control! ( value -- )
pulse-2-control reg! ;
4005 constant pulse-2-sweep
: pulse-2-sweep! ( value -- )
pulse-2-sweep reg! ;
4006 constant pulse-2-timer-low
: pulse-2-timer-low! ( value -- )
pulse-2-timer-low reg! ;
4007 constant pulse-2-timer-high
: pulse-2-timer-high! ( value -- )
pulse-2-timer-high reg! ;
4008 constant triangle-linear
: triangle-linear! ( value -- )
triangle-linear reg! ;
400a constant triangle-timer-low
: triangle-timer-low! ( value -- )
triangle-timer-low reg! ;
400b constant triangle-timer-high
: triangle-timer-high! ( value -- )
triangle-timer-high reg! ;
400c constant noise-control
: noise-control! ( value -- )
noise-control reg! ;
400e constant noise-period
: noise-period! ( value -- )
noise-period reg! ;
400f constant noise-length
: noise-length! ( value -- )
noise-length reg! ;
4010 constant dmc-irq
: dmc-irq! ( value -- )
dmc-irq reg! ;
4015 constant apu-status
: apu-status! ( value -- )
apu-status reg! ;
: apu-status@ ( -- )
apu-status reg@ ;
4014 constant oam-dma
: oam-dma! ( page -- )
oam-dma reg! ;OAM DMA copies a 256 byte page from CPU RAM into hardware sprite
memory. We will keep a shadow OAM buffer at $0200 and copy
page $02 during NMI.
0200 constant oam-buffer
02 constant oam-buffer-page
4016 constant controller-1The controller polling code builds a button byte with direction buttons in the low bits, which makes movement checks convenient.
80 constant button-a
40 constant button-b
20 constant button-select
10 constant button-start
08 constant button-up
04 constant button-down
02 constant button-left
01 constant button-right
4017 constant apu-frame-counter
: apu-frame-counter! ( value -- )
apu-frame-counter reg! ;Sound effects are stored as small command streams in PRG ROM. Each frame command names one APU channel, gives the four register values for that channel, and gives the number of video frames to hold those values. A zero command byte marks the end of the effect.
00 constant sfx-end-command
01 constant sfx-pulse-1
02 constant sfx-pulse-2
03 constant sfx-triangle
04 constant sfx-noise
variable sfx-channel
variable sfx-reg-0
variable sfx-reg-1
variable sfx-reg-2
variable sfx-reg-3
variable sfx-duration
: validate-sfx-byte ( value -- )
ff > abort" sound effect byte out of range" ;
: validate-sfx-channel ( channel -- )
dup sfx-pulse-1 < swap sfx-noise > or
abort" sound effect channel out of range" ;
: validate-sfx-duration ( duration -- )
0= abort" sound effect duration must be nonzero" ;
: sfx-frame, ( channel reg0 reg1 reg2 reg3 duration -- )
dup validate-sfx-byte
dup validate-sfx-duration
sfx-duration !
dup validate-sfx-byte sfx-reg-3 !
dup validate-sfx-byte sfx-reg-2 !
dup validate-sfx-byte sfx-reg-1 !
dup validate-sfx-byte sfx-reg-0 !
dup validate-sfx-byte
dup validate-sfx-channel
sfx-channel !
sfx-channel @ rom,
sfx-reg-0 @ rom,
sfx-reg-1 @ rom,
sfx-reg-2 @ rom,
sfx-reg-3 @ rom,
sfx-duration @ rom, ;
: sfx-end, ( -- )
sfx-end-command rom, ;
: sfx: ( "name" -- )
create target-here ,
does> @ ;
: ;sfx ( -- )
sfx-end, ;NES tiles are 8x8 pixels. Each pixel is a two-bit color value from 0 to 3, but the bytes in CHR ROM are stored as two bitplanes: first the low bit of each row, then the high bit of each row. These words let us write a tile in the source as pixels while buffering the rows into the CHR ROM layout.
create tile-buffer 10 allot
create row-buffer 8 allot
variable tile-row
variable tile-plane-bit
: save-row-pixels ( c0 c1 c2 c3 c4 c5 c6 c7 -- )
row-buffer 7 + c!
row-buffer 6 + c!
row-buffer 5 + c!
row-buffer 4 + c!
row-buffer 3 + c!
row-buffer 2 + c!
row-buffer 1 + c!
row-buffer c! ;
: validate-row-pixels ( -- )
8 0 do
row-buffer i + c@ 3 > abort" tile pixel out of range"
loop ;
: pack-plane ( bit -- byte )
tile-plane-bit !
0
8 0 do
1 lshift
row-buffer i + c@ tile-plane-bit @ rshift 1 and or
loop
;
: store-tile-row ( low high -- )
tile-row @ 8 + tile-buffer + c!
tile-row @ tile-buffer + c! ;
: row, ( c0 c1 c2 c3 c4 c5 c6 c7 -- )
tile-row @ 8 >= abort" too many tile rows"
save-row-pixels
validate-row-pixels
0 pack-plane
1 pack-plane
store-tile-row
1 tile-row +! ;
: emit-tile ( -- )
10 0 do
tile-buffer i + c@ chr,
loop ;
: tile: ( "name" -- )
create chr-offset 10 / ,
0 tile-row !
does> @ ;
: ;tile ( -- )
tile-row @ 8 <> abort" tile must have 8 rows"
emit-tile ;target: wait-vblank ( -- )
target-here
ppu-status bit-abs,
rel-offset bpl,
;target
target: disable-rendering ( -- )
0000 ppu-mask!
;target
target: enable-background ( -- )
0008 ppu-mask!
;target
target: enable-rendering ( -- )
0018 ppu-mask!
;target
target: reset-ppu-latch ( -- )
ppu-status@
drop
;targetThe next group of words are host-side emitters for common PPU operations. They keep setup code readable while still producing direct register writes.
: nametable-addr! ( offset -- )
2000 + ppu-addr! ;
: tile-at, ( tile offset -- )
nametable-addr!
ppu-data! ;
: palette-addr! ( offset -- )
3f00 + ppu-addr! ;
: bg-palette, ( c0 c1 c2 c3 index -- )
4 * palette-addr!
>r >r >r
ppu-data!
r> ppu-data!
r> ppu-data!
r> ppu-data! ;
: sprite-palette, ( c0 c1 c2 c3 index -- )
4 * 10 + palette-addr!
>r >r >r
ppu-data!
r> ppu-data!
r> ppu-data!
r> ppu-data! ;Sprites are stored in OAM as four bytes: Y position, tile index, attributes, and X position. The helpers below compute addresses inside the shadow OAM buffer and emit writes to initialize sprite records.
0 constant oam-y-field
1 constant oam-tile-field
2 constant oam-attr-field
3 constant oam-x-field
: oam-sprite-addr ( id field -- addr )
swap 4 * + oam-buffer + ;
: oam-y ( id -- addr )
oam-y-field oam-sprite-addr ;
: oam-tile ( id -- addr )
oam-tile-field oam-sprite-addr ;
: oam-attr ( id -- addr )
oam-attr-field oam-sprite-addr ;
: oam-x ( id -- addr )
oam-x-field oam-sprite-addr ;
: oam-buffer!, ( value addr -- )
swap lda-imm,
sta-abs, ;
: oam-dma, ( -- )
oam-buffer-page oam-dma! ;
oam-buffer ff and constant oam-buffer-low
oam-buffer 8 rshift constant oam-buffer-high
target: target-oam-address ( sprite-id field -- addr )
pop-ay, \ field
zp-scratch sta-zp,
pop-ay, \ sprite id
asl-acc,
asl-acc,
clc,
zp-scratch adc-zp,
oam-buffer-low adc-imm,
oam-buffer-high ldy-imm,
push-ay,
;target
variable sprite-id
variable sprite-tile
variable sprite-y
variable sprite-x
: sprite-at, ( x y tile id -- )
sprite-id !
sprite-tile !
sprite-y !
sprite-x !
sprite-y @ sprite-id @ oam-y oam-buffer!,
sprite-tile @ sprite-id @ oam-tile oam-buffer!,
0 sprite-id @ oam-attr oam-buffer!,
sprite-x @ sprite-id @ oam-x oam-buffer!, ;Runtime text is stored as tile IDs, not ASCII. ASCII is convenient while authoring on the host, but the PPU ultimately wants nametable tile numbers. Translating once during the build keeps the target path small: runtime text drawing is just setting PPUADDR and copying bytes from CPU-visible PRG ROM to PPUDATA during vblank-controlled setup.
The stack contract is addr len offset: the address of
the tile-ID string, the byte length, and the nametable offset where
drawing begins. This word assumes the string is shorter than 256 bytes,
which is plenty for HUD text.
target: draw-tile-string ( addr len offset -- )
pop-ay, \ offset
zp-scratch sta-zp,
tya,
clc,
20 adc-imm,
ppu-addr sta-abs,
zp-scratch lda-zp,
ppu-addr sta-abs,
pop-ay, \ len
zp-scratch sta-zp,
pop-ay, \ addr
zp-addr sta-zp,
tya,
zp-addr-high sta-zp,
00 ldy-imm,
target-here
zp-scratch cpy-zp,
08 beq,
zp-addr lda-indy,
ppu-data sta-abs,
iny,
rel-offset bne,
;targetBefore placing tiles and sprites, we clear the nametable and the
shadow OAM buffer. OAM is filled with $FE; on the NES, that
Y position hides sprites offscreen.
target: clear-nametable ( -- )
reset-ppu-latch
2000 ppu-addr!
00 lda-imm,
00 ldx-imm,
target-here
ppu-data sta-abs,
ppu-data sta-abs,
ppu-data sta-abs,
ppu-data sta-abs,
dex,
rel-offset bne,
;target
target: clear-oam-buffer ( -- )
fe lda-imm,
00 ldx-imm,
target-here
oam-buffer sta-absx,
dex,
rel-offset bne,
;targetThese are the first concrete graphics for the game. They use the tile DSL from the platform layer and are emitted directly into CHR ROM.
Tile zero is the blank tile. Clearing nametable memory to zero will fill the background with this tile.
tile: blank-tile
0 0 0 0 0 0 0 0 row,
0 0 0 0 0 0 0 0 row,
0 0 0 0 0 0 0 0 row,
0 0 0 0 0 0 0 0 row,
0 0 0 0 0 0 0 0 row,
0 0 0 0 0 0 0 0 row,
0 0 0 0 0 0 0 0 row,
0 0 0 0 0 0 0 0 row,
;tileThe text layer starts with digits. These use a compact 5x7 shape centered in an 8x8 tile, leaving a one-pixel gutter so sprites and background text do not touch adjacent tiles.
0a constant digit-tile-count
tile: digit-0-tile
0 0 1 1 1 1 0 0 row,
0 1 0 0 0 0 1 0 row,
0 1 0 0 0 1 1 0 row,
0 1 0 0 1 0 1 0 row,
0 1 0 1 0 0 1 0 row,
0 1 1 0 0 0 1 0 row,
0 1 0 0 0 0 1 0 row,
0 0 1 1 1 1 0 0 row,
;tile
tile: digit-1-tile
0 0 0 1 1 0 0 0 row,
0 0 1 0 1 0 0 0 row,
0 0 0 0 1 0 0 0 row,
0 0 0 0 1 0 0 0 row,
0 0 0 0 1 0 0 0 row,
0 0 0 0 1 0 0 0 row,
0 0 0 0 1 0 0 0 row,
0 0 1 1 1 1 1 0 row,
;tile
tile: digit-2-tile
0 0 1 1 1 1 0 0 row,
0 1 0 0 0 0 1 0 row,
0 0 0 0 0 0 1 0 row,
0 0 0 0 0 1 0 0 row,
0 0 0 0 1 0 0 0 row,
0 0 0 1 0 0 0 0 row,
0 0 1 0 0 0 0 0 row,
0 1 1 1 1 1 1 0 row,
;tile
tile: digit-3-tile
0 0 1 1 1 1 0 0 row,
0 1 0 0 0 0 1 0 row,
0 0 0 0 0 0 1 0 row,
0 0 0 1 1 1 0 0 row,
0 0 0 0 0 0 1 0 row,
0 0 0 0 0 0 1 0 row,
0 1 0 0 0 0 1 0 row,
0 0 1 1 1 1 0 0 row,
;tile
tile: digit-4-tile
0 0 0 0 0 1 0 0 row,
0 0 0 0 1 1 0 0 row,
0 0 0 1 0 1 0 0 row,
0 0 1 0 0 1 0 0 row,
0 1 0 0 0 1 0 0 row,
0 1 1 1 1 1 1 0 row,
0 0 0 0 0 1 0 0 row,
0 0 0 0 0 1 0 0 row,
;tile
tile: digit-5-tile
0 1 1 1 1 1 1 0 row,
0 1 0 0 0 0 0 0 row,
0 1 0 0 0 0 0 0 row,
0 1 1 1 1 1 0 0 row,
0 0 0 0 0 0 1 0 row,
0 0 0 0 0 0 1 0 row,
0 1 0 0 0 0 1 0 row,
0 0 1 1 1 1 0 0 row,
;tile
tile: digit-6-tile
0 0 1 1 1 1 0 0 row,
0 1 0 0 0 0 0 0 row,
0 1 0 0 0 0 0 0 row,
0 1 1 1 1 1 0 0 row,
0 1 0 0 0 0 1 0 row,
0 1 0 0 0 0 1 0 row,
0 1 0 0 0 0 1 0 row,
0 0 1 1 1 1 0 0 row,
;tile
tile: digit-7-tile
0 1 1 1 1 1 1 0 row,
0 0 0 0 0 0 1 0 row,
0 0 0 0 0 1 0 0 row,
0 0 0 0 1 0 0 0 row,
0 0 0 1 0 0 0 0 row,
0 0 1 0 0 0 0 0 row,
0 0 1 0 0 0 0 0 row,
0 0 1 0 0 0 0 0 row,
;tile
tile: digit-8-tile
0 0 1 1 1 1 0 0 row,
0 1 0 0 0 0 1 0 row,
0 1 0 0 0 0 1 0 row,
0 0 1 1 1 1 0 0 row,
0 1 0 0 0 0 1 0 row,
0 1 0 0 0 0 1 0 row,
0 1 0 0 0 0 1 0 row,
0 0 1 1 1 1 0 0 row,
;tile
tile: digit-9-tile
0 0 1 1 1 1 0 0 row,
0 1 0 0 0 0 1 0 row,
0 1 0 0 0 0 1 0 row,
0 1 0 0 0 0 1 0 row,
0 0 1 1 1 1 1 0 row,
0 0 0 0 0 0 1 0 row,
0 0 0 0 0 0 1 0 row,
0 0 1 1 1 1 0 0 row,
;tileOnly the letters needed for the first HUD label are defined for now. They are kept alphabetical so the partial font can grow without becoming a hunt.
tile: letter-c-tile
0 0 1 1 1 1 0 0 row,
0 1 0 0 0 0 1 0 row,
0 1 0 0 0 0 0 0 row,
0 1 0 0 0 0 0 0 row,
0 1 0 0 0 0 0 0 row,
0 1 0 0 0 0 0 0 row,
0 1 0 0 0 0 1 0 row,
0 0 1 1 1 1 0 0 row,
;tile
tile: letter-e-tile
0 1 1 1 1 1 1 0 row,
0 1 0 0 0 0 0 0 row,
0 1 0 0 0 0 0 0 row,
0 1 1 1 1 1 0 0 row,
0 1 0 0 0 0 0 0 row,
0 1 0 0 0 0 0 0 row,
0 1 0 0 0 0 0 0 row,
0 1 1 1 1 1 1 0 row,
;tile
tile: letter-o-tile
0 0 1 1 1 1 0 0 row,
0 1 0 0 0 0 1 0 row,
0 1 0 0 0 0 1 0 row,
0 1 0 0 0 0 1 0 row,
0 1 0 0 0 0 1 0 row,
0 1 0 0 0 0 1 0 row,
0 1 0 0 0 0 1 0 row,
0 0 1 1 1 1 0 0 row,
;tile
tile: letter-r-tile
0 1 1 1 1 1 0 0 row,
0 1 0 0 0 0 1 0 row,
0 1 0 0 0 0 1 0 row,
0 1 1 1 1 1 0 0 row,
0 1 0 0 1 0 0 0 row,
0 1 0 0 0 1 0 0 row,
0 1 0 0 0 0 1 0 row,
0 1 0 0 0 0 1 0 row,
;tile
tile: letter-s-tile
0 0 1 1 1 1 1 0 row,
0 1 0 0 0 0 0 0 row,
0 1 0 0 0 0 0 0 row,
0 0 1 1 1 1 0 0 row,
0 0 0 0 0 0 1 0 row,
0 0 0 0 0 0 1 0 row,
0 0 0 0 0 0 1 0 row,
0 1 1 1 1 1 0 0 row,
;tileThe digit tiles are contiguous, so a numeric digit can become a tile
ID by adding it to first-digit-tile. The host-side
digits-at, emitter is still useful for static numbers;
dynamic text uses draw-tile-string above.
digit-0-tile constant first-digit-tile
digit-9-tile constant last-digit-tile
: digit-tile ( digit -- tile )
dup digit-tile-count >= abort" digit out of range"
first-digit-tile + ;
: digit-at, ( digit offset -- )
>r digit-tile r> tile-at, ;
variable digits-value
variable digits-width
variable digits-offset
: digit-place-offset ( index -- offset )
digits-offset @ digits-width @ 1 - + swap - ;
: digits-at, ( value width offset -- )
digits-offset !
digits-width !
digits-value !
digits-width @ 0 do
digits-value @ 0a /mod
digits-value !
i digit-place-offset digit-at,
loop ;Tile strings are authored as quoted host strings and stored in PRG
ROM as tile IDs. tile-char is intentionally strict:
unsupported characters abort the build instead of silently drawing the
wrong tile. As the font grows, this mapper is the single place where new
source characters become tiles.
: tile-char ( char -- tile )
dup 20 = if
drop blank-tile exit
then
dup 30 3a within if
30 - digit-tile exit
then
dup 43 = if
drop letter-c-tile exit
then
dup 45 = if
drop letter-e-tile exit
then
dup 4f = if
drop letter-o-tile exit
then
dup 52 = if
drop letter-r-tile exit
then
dup 53 = if
drop letter-s-tile exit
then
abort" unsupported tile string character" ;
: emit-tile-string ( c-addr u -- )
0 do
dup i + c@ tile-char rom,
loop
drop ;
: tile-string: ( "name" -- )
label ;
: ;tile-string ( c-addr u -- )
emit-tile-string ;
tile-string: title-test-string s" 07" ;tile-string
02 constant title-test-string-length
tile-string: score-label-string s" SCORE" ;tile-string
05 constant score-label-string-lengthThe star background uses a small set of sparse tiles generated by the host while building the ROM. Each tile has one lit pixel; the pixel positions are deterministic so builds are reproducible.
04 constant star-tile-count
3d constant star-tile-seed
: star-tile-pixel ( index -- pixel )
star-tile-seed +
dup 4 lshift xor
dup 3 rshift xor
1f * 17 + 3f and ;
: emit-one-pixel-tile ( pixel -- )
8 /mod
swap
80 swap rshift
8 0 do
over i = if
dup chr,
else
00 chr,
then
loop
2drop
8 0 do 00 chr, loop ;
chr-offset 10 / constant star-tile-0
0 star-tile-pixel emit-one-pixel-tile
chr-offset 10 / constant star-tile-1
1 star-tile-pixel emit-one-pixel-tile
chr-offset 10 / constant star-tile-2
2 star-tile-pixel emit-one-pixel-tile
chr-offset 10 / constant star-tile-3
3 star-tile-pixel emit-one-pixel-tile
star-tile-0 constant first-star-tile
star-tile-3 constant last-star-tileLet’s define our first visible tile graphic:
tile: smiley
0 0 1 1 1 1 0 0 row,
0 1 0 0 0 0 1 0 row,
1 0 2 0 0 2 0 1 row,
1 0 0 0 0 0 0 1 row,
1 0 2 0 0 2 0 1 row,
1 0 0 3 3 0 0 1 row,
0 1 0 0 0 0 1 0 row,
0 0 1 1 1 1 0 0 row,
;tileThe first bullet is just a narrow vertical mark:
tile: player-bullet-tile
0 0 0 1 1 0 0 0 row,
0 0 0 1 1 0 0 0 row,
0 0 0 1 1 0 0 0 row,
0 0 0 1 1 0 0 0 row,
0 0 0 1 1 0 0 0 row,
0 0 0 1 1 0 0 0 row,
0 0 0 1 1 0 0 0 row,
0 0 0 1 1 0 0 0 row,
;tileThe first enemy is a simple target shape:
tile: enemy-tile
0 0 2 2 2 2 0 0 row,
0 2 1 1 1 1 2 0 row,
2 1 3 1 1 3 1 2 row,
2 1 1 1 1 1 1 2 row,
2 1 3 1 1 3 1 2 row,
2 1 1 3 3 1 1 2 row,
0 2 1 1 1 1 2 0 row,
0 0 2 2 2 2 0 0 row,
;tilesfx: shoot-sfx
sfx-pulse-1 9f 00 f0 08 04 sfx-frame,
sfx-pulse-1 8a 00 b0 08 03 sfx-frame,
;sfxTarget variables are visible two ways: host code can get their target address, while target code compiles the address as a literal. The player position, bullet position, enemy arrays, group movement state, and controller state are the game variables.
Enemies are stored as parallel byte arrays. enemy-count
controls how many slots are initialized, copied into OAM, and checked
for bullet collision. The enemy-x and enemy-y
aliases still name slot zero, which keeps a few older direct-address
uses readable while the rest of the enemy logic moves through indexed
helpers.
03 constant enemy-count
0000 constant state-title
0001 constant state-playing
target-variable game-state
target-variable player-x
target-variable player-y
target-variable bullet-x
target-variable bullet-y
enemy-count target-buffer enemy-xs
enemy-count target-buffer enemy-ys
target-variable controller-1-state
target-variable controller-1-prev
target-variable enemy-dx
target-variable group-hit-wall
enemy-count constant enemy-bullet-count
enemy-bullet-count target-buffer enemy-bullet-xs
enemy-bullet-count target-buffer enemy-bullet-ys
target-variable enemy-fire-index
target-variable enemy-bullet-index
target-variable enemy-fire-timer
target-variable sfx-pointer
target-variable sfx-duration-left
target-variable sfx-current-channel
05 constant enemy-bullet-sprite-base
enemy-xs target-alias enemy-x
enemy-ys target-alias enemy-y
game-state constant game-state-addr
controller-1-state constant controller-1-state-addr
controller-1-prev constant controller-1-prev-addr
player-x constant player-x-addr
player-y constant player-y-addr
bullet-x constant bullet-x-addr
bullet-y constant bullet-y-addr
enemy-x constant enemy-x-addr
enemy-y constant enemy-y-addr
enemy-xs constant enemy-xs-addr
enemy-ys constant enemy-ys-addr
enemy-bullet-xs constant enemy-bullet-xs-addr
enemy-bullet-ys constant enemy-bullet-ys-addr
sfx-pointer constant sfx-pointer-addr
sfx-duration-left constant sfx-duration-left-addr
sfx-current-channel constant sfx-current-channel-addr
oam-buffer enemy-bullet-sprite-base 4 * + oam-y-field +
constant enemy-bullet-oam-y-addr
oam-buffer enemy-bullet-sprite-base 4 * + oam-x-field +
constant enemy-bullet-oam-x-addr
00 constant player-sprite
01 constant bullet-sprite
02 constant enemy-sprite-base
enemy-sprite-base constant enemy-sprite
oam-buffer enemy-sprite-base 4 * + oam-y-field + constant enemy-oam-y-addr
oam-buffer enemy-sprite-base 4 * + oam-x-field + constant enemy-oam-x-addr
ff constant bullet-inactive
ff constant enemy-inactive
0080 constant enemy-start-x
0030 constant enemy-start-y
0008 constant sprite-sizeThe background starfield is generated by the host while building the ROM. Runtime startup only streams the resulting table to the PPU.
03c0 constant starfield-tile-count
0040 constant attribute-table-size
: starfield-hash ( index -- hash )
dup
5 lshift xor
dup
3 rshift xor
2d * 7b + ff and ;
: starfield-tile ( index -- tile )
starfield-hash
dup c0 and c0 = if
03 and first-star-tile +
else
drop blank-tile
then ;
: emit-starfield-data ( -- )
starfield-tile-count 0 do
i starfield-tile rom,
loop ;
label starfield-data
emit-starfield-data
starfield-data 0100 + constant starfield-data-page-1
starfield-data 0200 + constant starfield-data-page-2
starfield-data 0300 + constant starfield-data-page-3
target: draw-stars ( -- )
reset-ppu-latch
2000 ppu-addr!
00 ldx-imm,
target-here
starfield-data lda-absx,
ppu-data sta-abs,
starfield-data-page-1 lda-absx,
ppu-data sta-abs,
starfield-data-page-2 lda-absx,
ppu-data sta-abs,
inx,
rel-offset bne,
00 ldx-imm,
target-here
starfield-data-page-3 lda-absx,
ppu-data sta-abs,
inx,
c0 cpx-imm,
rel-offset bne,
00 lda-imm,
attribute-table-size ldx-imm,
target-here
ppu-data sta-abs,
dex,
rel-offset bne,
;targetGameplay code mostly works in slots: enemy slot, enemy bullet slot,
and OAM sprite slot. These helpers convert a slot index into a RAM
address or sprite id. The host-side *-addr constants serve
direct assembly words, while the target helpers keep setup and
orchestration code readable.
advance-enemy-fire-turn is also grouped here because it
is pure slot bookkeeping. It advances both the enemy turn and the
bullet-slot turn, wrapping each index back to zero at the end of its
array.
target: enemy-x-address ( index -- addr )
enemy-xs
+
;target
target: enemy-y-address ( index -- addr )
enemy-ys
+
;target
target: enemy-sprite-id ( index -- sprite-id )
enemy-sprite-base lit,
+
;target
target: enemy-bullet-x-address ( index -- addr )
enemy-bullet-xs
+
;target
target: enemy-bullet-y-address ( index -- addr )
enemy-bullet-ys
+
;target
target: enemy-bullet-sprite-id ( index -- sprite-id )
enemy-bullet-sprite-base lit,
+
;target
target: advance-enemy-fire-turn ( -- )
enemy-fire-index @
0001 lit,
+
dup
enemy-count lit,
<
if
enemy-fire-index !
else
drop
0000 lit,
enemy-fire-index !
then
enemy-bullet-index @
0001 lit,
+
dup
enemy-bullet-count lit,
<
if
enemy-bullet-index !
else
drop
0000 lit,
enemy-bullet-index !
then
;targetThe sound player keeps one active sound-effect stream. Each update either counts down the current frame or loads the next command and writes its channel registers.
target: init-sound ( -- )
0000 lit,
sfx-pointer !
0000 lit,
sfx-duration-left !
0000 lit,
sfx-current-channel !
0000 lit,
apu-status lit,
c!
;target
target: play-sfx ( addr -- )
sfx-pointer !
0000 lit,
sfx-duration-left !
;target
target: sfx-byte ( offset -- byte )
sfx-pointer @
+
c@
;target
target: finish-sfx-frame ( -- )
0005 lit,
sfx-byte
0001 lit,
-
sfx-duration-left !
sfx-pointer @
0006 lit,
+
sfx-pointer !
;target
target: silence-sound ( -- )
0000 lit,
apu-status lit,
c!
;target
target: end-sfx ( -- )
silence-sound
0000 lit,
sfx-pointer !
0000 lit,
sfx-duration-left !
;target
target: write-pulse-1-sfx-frame ( -- )
0001 lit,
sfx-byte
pulse-1-control lit,
c!
0002 lit,
sfx-byte
pulse-1-sweep lit,
c!
0003 lit,
sfx-byte
pulse-1-timer-low lit,
c!
0001 lit,
apu-status lit,
c!
0004 lit,
sfx-byte
pulse-1-timer-high lit,
c!
;target
target: write-pulse-2-sfx-frame ( -- )
0001 lit,
sfx-byte
pulse-2-control lit,
c!
0002 lit,
sfx-byte
pulse-2-sweep lit,
c!
0003 lit,
sfx-byte
pulse-2-timer-low lit,
c!
0002 lit,
apu-status lit,
c!
0004 lit,
sfx-byte
pulse-2-timer-high lit,
c!
;target
target: write-triangle-sfx-frame ( -- )
0001 lit,
sfx-byte
triangle-linear lit,
c!
0004 lit,
apu-status lit,
c!
0003 lit,
sfx-byte
triangle-timer-low lit,
c!
0004 lit,
sfx-byte
triangle-timer-high lit,
c!
;target
target: write-noise-sfx-frame ( -- )
0001 lit,
sfx-byte
noise-control lit,
c!
0008 lit,
apu-status lit,
c!
0003 lit,
sfx-byte
noise-period lit,
c!
0004 lit,
sfx-byte
noise-length lit,
c!
;target
target: apply-sfx-frame ( -- )
sfx-current-channel @
sfx-pulse-1 lit,
-
0=
if
write-pulse-1-sfx-frame
then
sfx-current-channel @
sfx-pulse-2 lit,
-
0=
if
write-pulse-2-sfx-frame
then
sfx-current-channel @
sfx-triangle lit,
-
0=
if
write-triangle-sfx-frame
then
sfx-current-channel @
sfx-noise lit,
-
0=
if
write-noise-sfx-frame
then
finish-sfx-frame
;target
target: update-sound ( -- )
sfx-duration-left @
if
sfx-duration-left @
0001 lit,
-
sfx-duration-left !
else
sfx-pointer @
if
0000 lit,
sfx-byte
sfx-current-channel !
sfx-current-channel @
if
apply-sfx-frame
else
end-sfx
then
then
then
;targetThe controller is a serial device. Polling latches the buttons, then
reads one bit at a time from $4016.
poll-controller stores the previous frame and builds the
current button byte.
target: poll-controller ( -- )
controller-1-state-addr lda-abs,
controller-1-prev-addr sta-abs,
01 lda-imm,
controller-1 sta-abs,
00 lda-imm,
controller-1 sta-abs,
00 lda-imm,
controller-1-state-addr sta-abs,
08 ldx-imm,
target-here
controller-1-state-addr lda-abs,
asl-acc,
controller-1-state-addr sta-abs,
controller-1 lda-abs,
01 and-imm,
controller-1-state-addr ora-abs,
controller-1-state-addr sta-abs,
dex,
rel-offset bne,
;targetinit-player writes the initial target variables and
fixed sprite fields. init-bullet gives the player bullet
its fixed sprite fields and marks it inactive by setting Y to
$FF.
target: init-player ( -- )
0050 lit,
player-x !
0050 lit,
player-y !
smiley player-sprite oam-tile oam-buffer!,
0000 player-sprite oam-attr oam-buffer!,
;target
target: init-bullet ( -- )
bullet-inactive lit,
bullet-y !
player-bullet-tile bullet-sprite oam-tile oam-buffer!,
0000 bullet-sprite oam-attr oam-buffer!,
;targetPressing B spawns the player bullet at the player position if it is inactive. Each frame, an active player bullet moves upward by two pixels until it reaches the top edge, then it is hidden by restoring its inactive Y value.
target: spawn-bullet ( -- )
bullet-y @
bullet-inactive lit,
<
if
else
player-x @
bullet-x !
player-y @
bullet-y !
shoot-sfx lit,
play-sfx
then
;target
target: update-bullet ( -- )
bullet-y @
bullet-inactive lit,
<
if
0003 lit,
bullet-y @
<
if
bullet-y @
0002 lit,
-
bullet-y !
else
bullet-inactive lit,
bullet-y !
then
then
bullet-y @
bullet-sprite oam-y lit,
c!
bullet-x @
bullet-sprite oam-x lit,
c!
;targetEnemy startup fills the enemy arrays and fixed OAM fields. X positions are computed from the slot index, while all enemies share the same starting Y. These words run only during setup and respawn, so the straightforward target Forth implementation is fine here.
target: enemy-x-offset ( index -- offset )
dup +
dup +
dup +
dup +
dup +
;target
target: init-enemy-slot ( index -- )
dup
enemy-x-offset
enemy-start-x lit,
+
over
enemy-x-address
c!
dup
enemy-y-address
enemy-start-y lit,
swap
c!
dup
enemy-sprite-id
oam-tile-field lit,
target-oam-address
enemy-tile lit,
swap
c!
dup
enemy-sprite-id
oam-attr-field lit,
target-oam-address
0000 lit,
swap
c!
drop
;target
target: init-enemy ( -- )
0001 lit,
enemy-dx !
0000 lit,
begin
dup
enemy-count lit,
<
while
dup
init-enemy-slot
0001 lit,
+
repeat
drop
;targetEnemy movement updates every enemy X position, records whether any
slot touched a horizontal boundary, and flips the group direction
afterward. After positions are updated, update-enemy copies
the enemy arrays into shadow OAM. The OAM slot update is direct 6502
because it runs once per enemy every frame and is only indexed byte
loads plus OAM stores.
target: move-enemies ( -- )
0000 lit,
group-hit-wall !
0000 lit,
begin
dup
enemy-count lit,
<
while
dup
enemy-x-address
dup
c@
enemy-dx @
+
dup 0008 lit, <
if 0001 lit, group-hit-wall ! then
dup 00f0 lit, >
if 0001 lit, group-hit-wall ! then
swap
c!
0001 lit, +
repeat
drop
group-hit-wall @
if
0000 lit,
enemy-dx @
-
enemy-dx !
then
;target
target: update-enemy-slot ( index -- )
pop-ay,
tay,
enemy-ys-addr lda-absy,
zp-scratch sta-zp,
enemy-xs-addr lda-absy,
zp-scratch-2 sta-zp,
tya,
asl-acc,
asl-acc,
tay,
zp-scratch lda-zp,
enemy-oam-y-addr sta-absy,
zp-scratch-2 lda-zp,
enemy-oam-x-addr sta-absy,
;target
target: update-enemy ( -- )
0000 lit,
begin
dup
enemy-count lit,
<
while
dup
update-enemy-slot
0001 lit,
+
repeat
drop
;targetEnemy bullets use the same parallel-array shape as enemies: one byte
array for X positions and one byte array for Y positions. A Y value of
$FF means the slot is inactive.
enemy-fire-index chooses which enemy gets the next turn,
while enemy-bullet-index chooses which bullet slot that
turn will try to fill. Both indices advance after every attempt, even if
the selected enemy is inactive or the selected bullet slot is still
occupied.
target: init-enemy-bullet ( -- )
0000 lit,
begin
dup
enemy-bullet-count lit,
<
while
dup
enemy-bullet-y-address
bullet-inactive lit,
swap
c!
dup
enemy-bullet-sprite-id
oam-tile-field lit,
target-oam-address
player-bullet-tile lit,
swap
c!
dup
enemy-bullet-sprite-id
oam-attr-field lit,
target-oam-address
0000 lit,
swap
c!
0001 lit,
+
repeat
drop
0000 lit,
enemy-fire-index !
0000 lit,
enemy-bullet-index !
003c lit, \ 60 frames
enemy-fire-timer !
;target
target: spawn-enemy-bullet ( -- )
enemy-bullet-index @
enemy-bullet-y-address
c@
bullet-inactive lit,
< if
else
enemy-fire-index @
enemy-y-address
c@
enemy-inactive lit,
<
if
enemy-fire-index @
enemy-x-address
c@
enemy-bullet-index @
enemy-bullet-x-address
c!
enemy-fire-index @
enemy-y-address
c@
enemy-bullet-index @
enemy-bullet-y-address
c!
then
then
advance-enemy-fire-turn
;target
target: update-enemy-firing ( -- )
enemy-fire-timer @
0= if
003c lit, enemy-fire-timer !
spawn-enemy-bullet
else
enemy-fire-timer @
0001 lit, -
enemy-fire-timer !
then
;targetEnemy bullet movement and OAM copying are direct 6502 because this path runs once per enemy bullet every frame. The slot word moves an active bullet down, hides it after the bottom threshold, and then writes its shadow OAM record.
target: update-enemy-bullet-slot ( index -- )
pop-ay,
tay,
enemy-bullet-ys-addr lda-absy,
bullet-inactive cmp-imm,
0c bcs,
clc,
01 adc-imm,
f1 cmp-imm,
02 bcc,
bullet-inactive lda-imm,
enemy-bullet-ys-addr sta-absy,
enemy-bullet-ys-addr lda-absy,
zp-scratch sta-zp,
enemy-bullet-xs-addr lda-absy,
zp-scratch-2 sta-zp,
tya,
asl-acc,
asl-acc,
tay,
zp-scratch lda-zp,
enemy-bullet-oam-y-addr sta-absy,
zp-scratch-2 lda-zp,
enemy-bullet-oam-x-addr sta-absy,
;target
target: update-enemy-bullet ( -- )
0000 lit,
begin
dup
enemy-bullet-count lit,
<
while
dup
update-enemy-bullet-slot
0001 lit,
+
repeat
drop
;targetBoth collision directions use axis-aligned box checks with
sprite-size as the width and height. The player bullet
still has one active slot and is checked against every enemy. Enemy
bullets scan every enemy bullet slot. The inner words are direct 6502 so
they can use indexed loads and return quickly from each failed test.
target: check-bullet-enemy-slot ( index -- )
pop-ay,
zp-scratch-2 stx-zp,
tax,
bullet-y-addr lda-abs,
bullet-inactive cmp-imm,
01 bne,
zp-scratch-2 ldx-zp,
rts,
enemy-ys-addr lda-absx,
enemy-inactive cmp-imm,
01 bne,
zp-scratch-2 ldx-zp,
rts,
enemy-xs-addr lda-absx,
clc,
sprite-size adc-imm,
zp-scratch sta-zp,
bullet-x-addr lda-abs,
zp-scratch cmp-zp,
01 bcc,
zp-scratch-2 ldx-zp,
rts,
bullet-x-addr lda-abs,
clc,
sprite-size adc-imm,
zp-scratch sta-zp,
enemy-xs-addr lda-absx,
zp-scratch cmp-zp,
01 bcc,
zp-scratch-2 ldx-zp,
rts,
enemy-ys-addr lda-absx,
clc,
sprite-size adc-imm,
zp-scratch sta-zp,
bullet-y-addr lda-abs,
zp-scratch cmp-zp,
01 bcc,
zp-scratch-2 ldx-zp,
rts,
bullet-y-addr lda-abs,
clc,
sprite-size adc-imm,
zp-scratch sta-zp,
enemy-ys-addr lda-absx,
zp-scratch cmp-zp,
01 bcc,
zp-scratch-2 ldx-zp,
rts,
bullet-inactive lda-imm,
bullet-y-addr sta-abs,
enemy-inactive lda-imm,
enemy-ys-addr sta-absx,
zp-scratch-2 ldx-zp,
;target
target: check-bullet-enemy-collision ( -- )
0000 lit,
begin
dup
enemy-count lit,
<
while
dup
check-bullet-enemy-slot
0001 lit,
+
repeat
drop
;target
target: maybe-return-to-title-when-enemies-cleared ( -- )
0001 lit,
0000 lit,
begin
dup
enemy-count lit,
<
while
dup
enemy-y-address
c@
enemy-inactive lit,
<
if
swap
drop
0000 lit,
swap
then
0001 lit,
+
repeat
drop
if
state-title lit,
game-state !
clear-oam-buffer
then
;target
target: check-player-enemy-bullet-slot ( index -- )
pop-ay,
zp-scratch-2 stx-zp,
tax,
enemy-bullet-ys-addr lda-absx,
bullet-inactive cmp-imm,
03 bne,
unresolved-jmp,
player-x-addr lda-abs,
clc,
sprite-size adc-imm,
enemy-bullet-xs-addr cmp-absx,
03 bne,
unresolved-jmp,
03 bcs,
unresolved-jmp,
enemy-bullet-xs-addr lda-absx,
clc,
sprite-size adc-imm,
player-x-addr cmp-abs,
03 bne,
unresolved-jmp,
03 bcs,
unresolved-jmp,
player-y-addr lda-abs,
clc,
sprite-size adc-imm,
enemy-bullet-ys-addr cmp-absx,
03 bne,
unresolved-jmp,
03 bcs,
unresolved-jmp,
enemy-bullet-ys-addr lda-absx,
clc,
sprite-size adc-imm,
player-y-addr cmp-abs,
03 bne,
unresolved-jmp,
03 bcs,
unresolved-jmp,
bullet-inactive lda-imm,
enemy-bullet-ys-addr sta-absx,
state-title lit,
game-state !
clear-oam-buffer
patch-control
patch-control
patch-control
patch-control
patch-control
patch-control
patch-control
patch-control
patch-control
zp-scratch-2 ldx-zp,
;target
target: check-player-enemy-bullet-collision ( -- )
0000 lit,
begin
dup
enemy-bullet-count lit,
<
while
dup
check-player-enemy-bullet-slot
0001 lit,
+
repeat
drop
;targetPressing Start restores the enemy row and hides the player bullet. This is a temporary reset rule while the game does not yet have lives, waves, or a richer state machine.
target: maybe-respawn-enemy ( -- )
controller-1-state @
button-start lit,
and
if
init-enemy
bullet-inactive lit,
bullet-y !
then
;target
target: start-playing ( -- )
init-player
init-bullet
init-enemy
init-enemy-bullet
state-playing lit,
game-state !
;targetOne NMI polls input and dispatches by overall game state. The title state only listens for a new Start press. The playing state runs one full gameplay update: movement and firing, bullet and enemy collisions, enemy movement, enemy firing, enemy bullets, and player collisions. The final player OAM write happens after collision handling so resets are visible in the next DMA copy.
target: update-title ( -- )
controller-1-state @
button-start lit,
and
if
controller-1-prev @
button-start lit,
and
if
else
start-playing
then
then
;target
target: update-playing ( -- )
controller-1-state @
button-left lit,
and
if
0008 lit,
player-x @
<
if
player-x @
0001 lit,
-
player-x !
then
then
controller-1-state @
button-right lit,
and
if
player-x @
00f0 lit,
<
if
player-x @
0001 lit,
+
player-x !
then
then
controller-1-state @
button-up lit,
and
if
0008 lit,
player-y @
<
if
player-y @
0001 lit,
-
player-y !
then
then
controller-1-state @
button-down lit,
and
if
player-y @
00e0 lit,
<
if
player-y @
0001 lit,
+
player-y !
then
then
controller-1-state @
button-b lit,
and
if
controller-1-prev @
button-b lit,
and
if
else
spawn-bullet
then
then
update-bullet
check-bullet-enemy-collision
maybe-return-to-title-when-enemies-cleared
game-state @
state-playing lit,
-
0=
if
move-enemies
update-enemy
update-enemy-firing
update-enemy-bullet
check-player-enemy-bullet-collision
then
game-state @
state-playing lit,
-
0=
if
player-y @
player-sprite oam-y lit,
c!
player-x @
player-sprite oam-x lit,
c!
then
;target
target: update-game ( -- )
poll-controller
game-state @
state-title lit,
-
0=
if
update-title
else
update-playing
then
update-sound
;targetThese setup words are early display tests. They initialize enough PPU state to show the tile graphics and sprite machinery working.
target: set-bg-color ( -- )
wait-vblank
disable-rendering
reset-ppu-latch
3f00 ppu-addr!
0016 ppu-data!
0000 0000 ppu-scroll!
enable-background
;target
0042 constant title-test-digit-offset
0062 constant score-label-offset
target: show-title ( -- )
wait-vblank
disable-rendering
state-title lit,
game-state !
clear-oam-buffer
reset-ppu-latch
000f 0016 0027 0030 0000 bg-palette,
000f 0016 0027 0030 0000 sprite-palette,
reset-ppu-latch
draw-stars
title-test-string lit,
title-test-string-length lit,
title-test-digit-offset lit,
draw-tile-string
score-label-string lit,
score-label-string-length lit,
score-label-offset lit,
draw-tile-string
0000 0000 ppu-scroll!
enable-rendering
;target
target: show-smiley ( -- )
show-title
;target
The reset handler performs the one-time startup work, enables NMI, and then loops forever. For now, the game runs from the NMI handler once per frame: update game state, copy shadow OAM to hardware OAM, reset scroll, and return from the interrupt.
target: reset-handler ( -- )
sei,
cld,
ff ldx-imm,
txs,
00 ldx-imm, \ initialize data stack pointer
0040 apu-frame-counter!
0000 ppu-ctrl!
0000 ppu-mask!
0000 dmc-irq!
init-sound
wait-vblank
show-title
0080 ppu-ctrl!
target-here jmp,
;target
interrupt: nmi-handler ( -- )
oam-dma,
update-game
0000 0000 ppu-scroll!
;interruptLet’s write out the vector table:
fffa target-seek
nmi-handler romw, \ NMI
reset-handler romw, \ RESET
reset-handler romw, \ IRQFinally, let’s write out the ROM image:
variable rom-file
s" starclear.nes" w/o bin create-file throw rom-file !
rom-buffer rom-size rom-file @ write-file throw
rom-file @ close-file throw
keep-going 0= [if]
bye
[then]