\ src/stars/stars.fs: Perspective warp starfield in RG6 \ \ Up to 200 stars fly at the camera through a 3D field. Each holds a \ fixed (X, Y) and a projection coefficient p = 1/z, and is drawn at \ centre + 128 * (X, Y) * p. Stars crawl while far away and rush past \ in the last few frames, which is what perspective actually looks like. \ \ Distant stars are born ALL OVER the screen, not just at the centre. \ The field is wide enough that its far cross-section fills the view, \ so a new star can appear anywhere and streams outward from there. \ \ RG6: 256x192 SQUARE pixels, 1 bit per pixel, 6144 bytes at $0400. \ Single buffer, erase-then-draw per star. \ \ ── Projection without division (issue 66) ──────────────────────── \ Stepping z -> z-1 takes p = 1/z to 1/(z-1) = p/(1-p), which needs a \ divide. p' = p * (1 + p) = p + p^2 is the same series cut after two \ terms, erring by order p^3. Idea from Jonathan David Gilbert. \ \ p is a 16-bit unsigned fraction, so p >= 1 is simply the CARRY out \ of p + p^2, and that carry is the respawn test. p^2 must be ROUNDED, \ not truncated: truncation makes far stars crawl, and below 256/65536 \ it rounds p^2 to zero and freezes the star forever. See \ projection_sim.py for the numbers behind that decision. \ \ ── Four ways to spend the frame (issue 69) ─────────────────────── \ Updating 64 stars every frame would need ~230 cycles a star, and one \ costs ~500. Each frame therefore updates the next PER-FRAME stars, \ round robin over the stars in use, and each update takes as many \ depth steps as frames have passed, so every star moves at the same \ rate and flight time in frames is the same in every option. Giving \ near stars a faster rate than far ones was tried and rejected: a star \ visibly changed character as it crossed from one rate to the other. \ The title screen picks the trade: \ \ 1 24 stars, 24 a frame, 1 step every star at 60 Hz \ 2 48 stars, 24 a frame, 2 steps every star at 30 Hz \ 3 64 stars, 64 a frame, 1 step free-running, about 26 Hz \ 4 200 stars, 20 a frame, 10 steps every star at 6 Hz \ \ Option 3 overruns the frame on purpose: vsync finds its flag already \ set and returns at once, which is how the demo ran before issue 69. \ \ ── Why RG6 and not SG4 ─────────────────────────────────────────── \ This demo was attempted once before (38f4c6e) on a 64x32 SG4 grid \ and reverted (0778b95) for "visible oscillation and zigzag". 64x32 \ is simply too coarse for a starfield: a slow star sits in one cell \ for a dozen frames and then jumps, and there is no room for the \ near/far spread that sells the effect. 256x192 gives 48 times the \ addressable points, square pixels, and a black background. \ \ The LEFT joystick steers the vanishing point. Only new stars are \ launched from the moved centre; the ones already in flight keep \ their birth centre, which is exactly how a real course change looks. \ \ 1 to 4 on the title screen pick an option, SPACE a random one. In \ flight SPACE returns to the title. There is no exit. \ ── Libraries ───────────────────────────────────────────────────── INCLUDE ../../../coco/lib/screen.fs INCLUDE ../../../coco/lib/rng.fs INCLUDE ../../../coco/lib/vdg.fs \ ── Memory map ──────────────────────────────────────────────────── \ $0400-$1BFF RG6 VRAM, 6144 bytes, 32 per scanline, SAM V=6, F=2 \ $5000-$5EFF 240 star records x 16 bytes: the title ages all 240, and the \ options use the first 24, 48, 64 or 200 (moved from $4000: \ 240 would reach the scratch bytes at $4400) \ $4404-$4405 scratch word for the multiplies \ $4407 scratch byte for the multiplies \ $4408 centre x, set from the left joystick each frame \ $4409 centre y \ $440A quiet: nonzero = advance stars but draw nothing \ $440B projected x this frame \ $440C projected y this frame \ $440D joystick: result so far \ $440E joystick: bit under test \ $440F frame number, +1 per tick (joystick read one frame in 4) \ $4412-$4413 record the next frame's updates start from \ $4417-$4418 scratch: 2 * round(p^2), for ten steps \ $441A stars in use: 24, 48, 64, 200, or 240 while ageing \ $441B PER-FRAME, stars updated each frame \ $441D-$441E end of the records in use: $5000 + 16 * stars in use \ $441F step mode: 0, 1, 2, 3 = 1, 2, 4, 10 depth steps per update \ $4420 preset, copied at startup; nonzero makes space? ignore SPACE \ $4424-$4425 address of this frame's step handler, from the step mode \ \ Star record: \ +0 |X| 0..127 field offset +8,9 VRAM address last drawn \ +1 |Y| 0..127 +10 size: 0 = point, 1 = 2 tall \ +2,3 p 0.16 fraction, = 1/z +11 drawn flag \ +4 cx centre at birth +12 colour as a pair mask at bit 7: \ +5 cy $80 blue, $40 orange, $C0 white \ +6 signs: bit 7 = X negative +13 mask last drawn \ bit 6 = Y negative +14 pair x last drawn \ +15 y last drawn, $FF = not on screen \ \ RG6 pixel: addr = $0400 + y*32 + (x>>3), bit = $80 >> (x and 7). \ A 2-tall star is the same mask one line down, at addr + 32. \ ── The frame (CODE) ────────────────────────────────────────────── \ Erase and redraw happen at the TOP of the frame, before the beam has \ scanned far. Writing moving markers late in the frame puts them into \ VRAM after the beam has already passed, so they never appear. CODE tick-stars ( -- ) PSHS X INC $440F ; frame number ; ---- the joystick, one frame in four ---- LDA $440F BITA #3 BNE @nojoy LBSR @joy @nojoy ; ---- this frame's step handler, chosen once rather than per star ---- ; PC-relative, not LDX #@s1: a CODE word is assembled at 0 and moved, ; so an absolute label is its offset in the word, not its address. ; Branches survive the move; LDX #@label jumped into low memory. LEAX @s1,PCR LDA $441F BEQ @mset LEAX @s2,PCR DECA BEQ @mset LEAX @s4,PCR DECA BEQ @mset LEAX @s10,PCR @mset STX $4424 ; ---- the next PER-FRAME stars, round robin ---- LDY $4412 ; carry on from last frame LDA $441B PSHS A @loop ; ---- one step nearer: p += round(p * p) ---- ; With p = a:b, p^2 = a*a<<16 + 2*a*b<<8 + b*b. In units of the ; result: a*a, plus the high 9 bits of 2ab, plus whatever carries ; out of the fraction byte, which is lo(2ab) + hi(b*b) + $80. ; The $80 is the rounding. lo(b*b) cannot reach the result. LDA 2,Y LDB 3,Y MUL ; D = a*b ASLB ROLA ; D = low 16 bits of 2ab, C = bit 16 STD $4404 LDA #0 ; LDA, not CLRA: keep the carry ROLA STA $4407 ; bit 16 of 2ab LDA 3,Y TFR A,B MUL ; A = hi(b*b) CLRB ADDA #$80 ; round ADCB #0 ADDA $4405 ; + lo(2ab) ADCB #0 ; B = carries out of the fraction byte LDA $4407 ; D = bit16 * 256 + carries ADDB $4404 ; + hi(2ab) ADCA #0 STD $4404 LDA 2,Y TFR A,B MUL ; D = a*a ADDD $4404 ; D = round(p^2), cannot overflow: p < 1 ; ---- a star updated every S frames takes S steps at once ---- ; p += S * p^2 is the same series to first order, erring by order ; S*p, so flight time in frames is the same in every option. S is ; 1, 2, 4 or 10, done by shifts and one add, never a multiply: ; measured, two MULs cost ~100 cycles a star and pushed option 2 to ; 112% of a frame. Each handler falls into the next smaller one. ; A carry out of any shift or add means the star reached the camera. LDX $4424 JMP ,X @s10 ASLB ROLA LBCS @respawn STD $4417 ; 2R ASLB ROLA LBCS @respawn ASLB ROLA LBCS @respawn ; 8R ADDD $4417 ; 10R LBCS @respawn BRA @s1 @s4 ASLB ROLA LBCS @respawn @s2 ASLB ROLA LBCS @respawn @s1 ADDD 2,Y LBCS @respawn ; carry: p reached 1, the star is here STD 2,Y ; ---- project x: centre + 128 * X * p ---- ; T = |X| * p >> 8 from two MULs (the low partial is only used ; for its high byte). The offset on screen is T >> 1. If that ; leaves anything in the high byte the offset is 256 or more, ; off screen whatever the centre. LDA ,Y LDB 3,Y MUL STA $4404 LDA ,Y LDB 2,Y MUL ADDB $4404 ADCA #0 ; D = T LSRA ; T >> 1 RORB TSTA LBNE @respawn TFR B,A LDB 6,Y BMI @xneg ADDA 4,Y LBCS @respawn ; past x = 255 BRA @xset @xneg PSHS A LDA 4,Y SUBA ,S+ LBCS @respawn ; past x = 0 @xset STA $440B ; ---- project y, the same way ---- LDA 1,Y LDB 3,Y MUL STA $4404 LDA 1,Y LDB 2,Y MUL ADDB $4404 ADCA #0 LSRA RORB TSTA LBNE @respawn TFR B,A LDB 6,Y BITB #$40 BNE @yneg ADDA 5,Y LBCS @respawn BRA @yset @yneg PSHS A LDA 5,Y SUBA ,S+ LBCS @respawn @yset CMPA #192 LBHS @respawn STA $440C ; ---- quiet ticks age the field without touching the screen ---- TST $440A LBNE @next ; ---- same pair and same line as last frame? Then it did not move ---- ; Measured (#69): about two updates in three land exactly where the ; star already is. Those skip the size, mask, address and erase, and ; only re-OR the saved mask at the saved address. Re-plotting instead ; of skipping outright repairs a pixel that another star's erase ; knocked out where the two overlap, which in the centre cluster they ; do. Size is deliberately NOT compared: it changes once in a star's ; life, and a star that crosses the threshold while standing still ; just grows when it next moves. A star not on screen has $FF as its ; saved line, which no projection produces, so it always redraws. LDA $440C CMPA 15,Y BNE @redraw LDA $440B ANDA #$FE CMPA 14,Y BNE @redraw LDX 8,Y BRA @plot ; ---- it moved. Near stars (p >= 1/64, z <= 64) are two tall ---- ; except on line 191, where the second line would be past VRAM. @redraw CLRA LDB 2,Y CMPB #4 BLO @szst LDB $440C CMPB #191 BEQ @szst INCA @szst STA $4407 ; size for this draw ; ---- erase where we drew last frame ---- ; The draw saved its VRAM address and mask, so erasing is just an AND. TST 11,Y BEQ @noerase LDX 8,Y LDB 13,Y COMB TFR B,A ANDA ,X STA ,X TST 10,Y BEQ @noerase ANDB 32,X STB 32,X @noerase LDA $4407 STA 10,Y ; ---- draw at the new position ---- ; An artifact colour comes from the pixel's X PARITY, so a star ; drawn at its exact x flips blue/red every time it crosses a ; pixel. Snap to the containing pair and use the pair mask this ; star was born with: horizontal motion quantises to two pixels, ; and the colour is then stable for the star's whole life. White ; lights BOTH pixels of the pair. Both pixels of a pair are ; always in the same byte, so one mask covers the star. LDB $440B ANDB #6 ; pair offset within the byte: 0, 2, 4, 6 LDA 12,Y @msh TSTB BEQ @mst LSRA LSRA SUBB #2 BRA @msh @mst STA 13,Y LDA $440C LDB #32 MUL ADDD #$0400 TFR D,X LDB $440B LSRB LSRB LSRB ABX STX 8,Y LDA $440B ANDA #$FE STA 14,Y ; where it is drawn now, for next frame's test LDA $440C STA 15,Y LDA #1 STA 11,Y @plot LDA 13,Y ORA ,X STA ,X TST 10,Y BEQ @next LDA 13,Y ORA 32,X STA 32,X @next LEAY 16,Y CMPY $441D ; past the last star in use: wrap BNE @nwrap LDY #$5000 @nwrap DEC ,S LBNE @loop STY $4412 ; next frame carries on from here LEAS 1,S PULS X ;NEXT ; ---- respawn far away, at a fresh point in the field ---- ; Its old pixels come off first, through @erase. HALF of new stars ; take X and Y in -127..127, which at this depth lands them anywhere ; within about 100 pixels of the centre: the whole screen. The other ; half take -15..15, a cluster within about 13 pixels, so the vanishing ; point stays busy and those are the stars that come close enough to ; rush past. Spawns below the screen or past a joystick-moved edge ; simply respawn again next frame. Depth is ; z = 121..158 (p = 415..542): no deeper, because rounded 16-bit p^2 ; starts to lag the true curve past z = 158. The spread in depth stops ; stars arriving in waves. @respawn LBSR @erase ; it may still be on screen from last frame LBSR @rng STA 6,Y ; bits 7, 6 are the signs LDB #$7F ; bit 5 picks wide field or centre cluster BITA #$20 BEQ @wide LDB #$0F @wide STB $4407 LBSR @rng ANDA $4407 STA ,Y LBSR @rng ANDA $4407 STA 1,Y LBSR @rng ANDA #$7F TFR A,B CLRA ADDD #415 STD 2,Y LDA $4408 ; launch from where we point NOW STA 4,Y LDA $4409 STA 5,Y CLR 10,Y LBSR @rng ; colour for this life: blue, orange or white ANDA #7 CMPA #3 BLO @cb CMPA #6 BLO @co LDA #$C0 ; white: both pixels of the pair BRA @cst @cb LDA #$80 ; blue: even pixel BRA @cst @co LDA #$40 ; orange: odd pixel @cst STA 12,Y CLR 11,Y ; nothing drawn yet LDA #$FF STA 15,Y ; so the unchanged test cannot match LBRA @next ; ---- erase a star's saved pixels, if it has any (respawn path) ---- ; The main path inlines the same AND. The respawn reaches here straight ; from the depth step or a bounds test, before any erase has happened. @erase TST 11,Y BEQ @erx LDB 13,Y LDX 8,Y COMB TFR B,A ANDA ,X STA ,X TST 10,Y BEQ @erc ANDB 32,X STB 32,X @erc CLR 11,Y @erx RTS ; ---- Inline LCG: seed = seed * 25173 + 13849 ---- @rng LDA VAR_SEED+1 LDB #$55 MUL PSHS D LDA VAR_SEED LDB #$55 MUL ADDB ,S STB ,S LDA VAR_SEED+1 LDB #$62 MUL ADDB ,S STB ,S PULS D ADDD #$3619 STD VAR_SEED RTS ; ---- the left joystick sets the centre new stars launch from ---- ; CODE, not coco/lib/dac.fs. The library's joy-sample is threaded Forth ; and measured ~8,000 cycles a frame. Each axis samples 0..63: X scales ; by 4 and Y by 3 to span 256x192, at most 252 and 189, both on screen. ; Axis select is SEL1 on PIA0 CA2 ($FF01) and SEL2 on CB2 ($FF03): $34 ; drives the line low, $3C high. Left X is (0, 1), left Y (1, 1). @joy LDA #$34 STA $FF01 LDA #$3C STA $FF03 BSR @samp ASLA ASLA STA $4408 LDA #$3C STA $FF01 BSR @samp TFR A,B ASLA PSHS B ADDA ,S+ STA $4409 RTS ; ---- one axis, 0..63: binary search the DAC against the comparator ---- @samp CLR $440D LDA #32 STA $440E @sbit LDA $440D ORA $440E ASLA ; DAC is the top six bits of $FF20 ASLA STA $FF20 LDA $FF00 ; bit 7 set: stick is above the DAC BPL @snext LDA $440D ORA $440E STA $440D @snext LSR $440E BNE @sbit LDA $440D RTS ;CODE \ ── Title screen ────────────────────────────────────────────────── : vemit ( char -- ) $3F AND kvar-cur @ $0400 + C! kvar-cur @ 1 + kvar-cur ! ; : vtype ( addr len -- ) 0 DO DUP I + C@ vemit LOOP DROP ; : .title ( -- ) 11 1 AT S" STARFIELD" vtype 5 4 AT S" 1 24 STARS 60 HZ" vtype 5 6 AT S" 2 48 STARS 30 HZ" vtype 5 8 AT S" 3 64 STARS FREE RUN" vtype 5 10 AT S" 4 200 STARS 6 HZ" vtype 5 13 AT S" SPACE RANDOM" vtype ; \ ── Choosing the variant ────────────────────────────────────────── \ preset: 0 means ask on the title screen. measure_budget.py patches \ the low byte of this LDD to 1 to 4 in a copy of the binary, so it \ can measure a variant with no key press; $5A marks it for the search. \ It applies to the first title screen only. CODE preset ( -- n ) LDD #$5A00 CLRA STD ,--U ;NEXT ;CODE : variant! ( stars per-frame step-mode -- ) $441F C! $441B C! $441A C! ; \ Options 1 to 4, and 5: the title's quiet ageing, 240 stars at 60 a \ frame and 4 steps, so all 240 records are spread through depth \ whichever option is then picked. : configure ( n -- ) DUP 1 = IF 24 24 0 variant! THEN DUP 2 = IF 48 24 1 variant! THEN DUP 3 = IF 64 64 0 variant! THEN DUP 4 = IF 200 20 3 variant! THEN 5 = IF 240 60 2 variant! THEN $441A C@ 16 * $5000 + $441D ! $5000 $4412 ! ; VARIABLE cycle \ 1, 2, 3, 4, 1, ... once per title frame VARIABLE started \ nonzero once the first title screen is past \ pick: 1 to 4 for those keys, SPACE for whichever option the cycle \ is on (random, because nobody can time it), else 0. There is no \ division in the kernel to pick one arithmetically. Every other key \ is ignored. : pick ( -- n ) cycle @ 1 + DUP 4 > IF DROP 1 THEN cycle ! KEY? DUP 32 = IF DROP cycle @ ELSE 48 - DUP 1 < OVER 4 > OR IF DROP 0 THEN THEN ; \ Wait for the key to come up, so the SPACE that left one screen does not \ also act on the next. The field keeps ageing, but QUIET: this runs in \ text mode, where a drawn star would land on the title. : released ( -- ) 1 $440A C! BEGIN tick-stars vsync KEY? 0= UNTIL ; \ ── Main ────────────────────────────────────────────────────────── \ The field runs QUIET behind the title screen, as configuration 5 so \ all 240 records age. Whichever option is picked then uses the first \ 24, 48, 64 or 200 of them, already spread through depth instead of \ launching as one wave. There is no division to scatter starting depths with, so \ they are simply flown there. \ \ There is no way out: SPACE moves between the title and flight, and the \ demo runs until the machine is reset. : new-field ( -- ) $5000 3840 0 FILL 240 0 DO $FFFF $5000 I 16 * + 2 + ! LOOP \ p = 1: respawn on first tick 0 $440F C! 128 $4408 C! 96 $4409 C! \ centred until the first joystick read 5 configure 1 $440A C! ; : choose ( -- n ) started @ IF 0 ELSE preset THEN 1 started ! DUP IF 150 0 DO tick-stars LOOP \ preset: no key to wait for, age and go ELSE DROP BEGIN tick-stars vsync pick ?DUP UNTIL released THEN ; : graphics ( -- ) $0400 6144 0 FILL \ blank first: this FILL is slow enough to 6 set-sam-v \ show as garbage if the mode is set first 2 set-sam-f $F8 set-pia ; \ RG6, CSS=1: black background, artifact colour \ space?: nonzero while SPACE is down. It reads only that key, straight \ from the matrix (column 7, row 3 in the kernel's KEY_TABLE, active \ low). Measured, filtering KEY? in Forth cost ~450 cycles a frame and \ pushed option 2 to 103% of a frame; this is a few dozen. A measurement \ copy (preset set) never sees it, so a stray keystroke from XRoar's \ -run cannot end the trace. CODE space? ( -- flag ) LDD #0 TST $4420 ; preset, copied at startup: nonzero = no keys BNE @spdone LDA #$7F ; column 7 STA $FF02 LDA $FF00 BITA #$08 ; row 3: SPACE BNE @spoff LDB #1 @spoff LDA #$FF STA $FF02 ; deselect all columns CLRA @spdone STD ,--U ;NEXT ;CODE : fly ( -- ) 0 $440A C! BEGIN tick-stars vsync space? UNTIL ; \ SAM R=1 ($FFD7), "address-dependent" fast mode. It does not speed up a \ single RAM or VRAM access, but the 6809's internal dead cycles put $FFFF \ on the address bus and those run at double speed: 9 of MUL's 11 cycles. \ Measured on option 3, 24.6 -> 26.3 fps (#69, #71). The picture is \ unaffected, unlike R=2 ($FFD9). : stars ( -- ) 0 seed ! preset $4420 C! $FF $FFD7 C! \ SAM R=1: see above BEGIN reset-text cls-black .title new-field choose configure graphics fly reset-text released AGAIN ; stars