Robert Allan James
cb4326c712
Adds LINE (Bresenham in raster space, endpoints projected once each -- valid because the cavalier projection is linear), CIRCLE/ELLIPSE (36-segment polygon approximation), and ARC (18 segments over a caller radian range) to capsules/fabric.4th (blocks 4903-4912). TO-RASTER factored out of CART-PLOT (same behavior) so LINE can reuse the projection+flip for both endpoints. Found mid-implementation: colon definitions cannot span block boundaries in this capsule loader -- verified with a throwaway test capsule, the continuation lands in a [CAPSULE][DEFER] path that never resolves. LINE's body is split across LINE-SETUP/LINE-DONE?/LINE-STUCK?/LINE-STEP, each self-contained within its block, rather than one long definition. A fourth real bug, serious this time: CIRCLE's first live test rendered only one quadrant, then hung the VM for several minutes on a follow-up call. Root cause: q48_to_u64() (include/q48_16.h and include/starkernel/q48_16.h, backing Q.TO-INT) did an unsigned logical shift, corrupting any negative Q48.16 value into a huge garbage integer instead of sign-extending -- inevitable once Q.SIN/Q.COS leave the first quadrant. That garbage became a bogus LINE target with no bound on LINE-STEP's Bresenham loop. Fixed q48_to_u64 to shift through a signed int64_t intermediate (bit-identical for the non-negative case). Also added LINE-STUCK? (LSTEPS vs FB-WIDTH+FB-HEIGHT, the true worst case for an on-screen line) as a defense-in-depth cap against any future bad target. Verified live on amd64 after both fixes: -65536 Q.TO-INT . now prints -1; LINE/CIRCLE/ARC/ELLIPSE all complete without hanging or erroring, and a combined screendump shows all four rendering correctly and distinctly. All three architectures boot clean to ok> with the DoE completing; dict_hash identical across all three and unchanged from 4.3.3a (expected -- fabric.4th isn't loaded at boot, and the Q.TO-INT fix doesn't change dictionary structure). FABRIC.md item 4.3.3b marked done with full acceptance evidence.
153 lines
4.4 KiB
Forth
153 lines
4.4 KiB
Forth
Block 4900
|
|
( fabric.4th -- Console drawing-fabric coordinate machinery )
|
|
( FABRIC.md item 4.3.3. 45-degree cavalier orthographic )
|
|
( projection. Z is depth-into-screen, not height. Q48.16 )
|
|
( throughout. Raw pixel write (PLOT/FB-WIDTH/FB-HEIGHT) is )
|
|
( C; this capsule is the FORTH-side policy on top of it. )
|
|
46341 CONSTANT COS45 ( Q48.16 cos(45)=sin(45) ~= 0.70710678 )
|
|
VARIABLE ZD
|
|
: Z->DELTA ( z -- delta )
|
|
Q.FROM-INT COS45 Q.* Q.TO-INT ;
|
|
|
|
Block 4901
|
|
( PROJECT: 3D Cartesian (x y z) -> 2D Cartesian (sx sy). )
|
|
( Cavalier projection: depth pushes diagonally up-right. )
|
|
: PROJECT ( x y z -- sx sy )
|
|
Z->DELTA ZD !
|
|
ZD @ +
|
|
SWAP ZD @ +
|
|
SWAP ;
|
|
( CART-Y: Cartesian Y (origin bottom, up positive) -> )
|
|
( raster Y (origin top, down positive). The Y-flip. )
|
|
: CART-Y ( cart-y -- raster-y )
|
|
FB-HEIGHT 1- SWAP - ;
|
|
|
|
Block 4902
|
|
( CART-PLOT: full pipeline -- 3D Cartesian point to screen. )
|
|
: CART-PLOT ( x y z color -- )
|
|
>R
|
|
PROJECT
|
|
CART-Y
|
|
R>
|
|
PLOT ;
|
|
|
|
Block 4903
|
|
( TO-RASTER: 3D Cartesian point -> raster (rx ry). Factored )
|
|
( out of CART-PLOT so LINE can reuse it for both endpoints )
|
|
( -- the projection is linear, so projecting endpoints then )
|
|
( drawing 2D is equivalent to projecting every line point. )
|
|
( Item 4.3.3b. CART-PLOT redefined in terms of it (same )
|
|
( behavior, not a change). )
|
|
: TO-RASTER ( x y z -- rx ry )
|
|
PROJECT CART-Y ;
|
|
: CART-PLOT ( x y z color -- )
|
|
>R TO-RASTER R> PLOT ;
|
|
|
|
Block 4904
|
|
( LINE: 3D Cartesian line segment, Bresenham in raster )
|
|
( space (state in VARIABLEs; LINE-SETUP below). )
|
|
VARIABLE LX VARIABLE LY VARIABLE LX2 VARIABLE LY2
|
|
VARIABLE LDX VARIABLE LDY VARIABLE LSX VARIABLE LSY
|
|
VARIABLE LERR VARIABLE LCOLOR VARIABLE LSTEPS
|
|
: LINE-SETUP ( x1 y1 z1 x2 y2 z2 color -- )
|
|
LCOLOR !
|
|
TO-RASTER LY2 ! LX2 !
|
|
TO-RASTER LY ! LX !
|
|
LX2 @ LX @ - ABS LDX !
|
|
LY2 @ LY @ - ABS NEGATE LDY !
|
|
LX @ LX2 @ < IF 1 ELSE -1 THEN LSX !
|
|
LY @ LY2 @ < IF 1 ELSE -1 THEN LSY !
|
|
LDX @ LDY @ + LERR ! 0 LSTEPS ! ;
|
|
|
|
Block 4905
|
|
( LINE-DONE?: true once current point reached target. )
|
|
: LINE-DONE? ( -- flag )
|
|
LX @ LX2 @ = LY @ LY2 @ = AND ;
|
|
( LINE-STUCK?: safety cap, width+height worst case. )
|
|
: LINE-STUCK? ( -- flag )
|
|
LSTEPS @ FB-WIDTH FB-HEIGHT + > ;
|
|
( LINE-STEP: one Bresenham step (no plot). )
|
|
: LINE-STEP ( -- )
|
|
LERR @ 2*
|
|
DUP LDY @ >= IF LERR @ LDY @ + LERR ! LX @ LSX @ + LX ! THEN
|
|
DUP LDX @ <= IF LERR @ LDX @ + LERR ! LY @ LSY @ + LY ! THEN
|
|
LSTEPS @ 1+ LSTEPS ! DROP ;
|
|
|
|
Block 4906
|
|
( LINE: draws the segment using the helpers above. )
|
|
: LINE ( x1 y1 z1 x2 y2 z2 color -- )
|
|
LINE-SETUP
|
|
BEGIN
|
|
LX @ LY @ LCOLOR @ PLOT
|
|
LINE-DONE? 0= LINE-STUCK? 0= AND
|
|
WHILE
|
|
LINE-STEP
|
|
REPEAT ;
|
|
|
|
Block 4907
|
|
( Shared state for CIRCLE/ARC/ELLIPSE. CIRC-PT: point on a )
|
|
( circle of radius CRAD centered (CX,CY) at given angle. )
|
|
VARIABLE CX VARIABLE CY VARIABLE CZ VARIABLE CRAD
|
|
VARIABLE CCOLOR VARIABLE PX VARIABLE PY
|
|
: CIRC-PT ( ang -- x y )
|
|
DUP Q.SIN CRAD @ Q.FROM-INT Q.* Q.TO-INT CY @ +
|
|
SWAP Q.COS CRAD @ Q.FROM-INT Q.* Q.TO-INT CX @ +
|
|
SWAP ;
|
|
|
|
Block 4908
|
|
( CIRCLE: 36-segment polygon approximation, flat at z=cz. )
|
|
: CIRCLE ( cx cy cz r color -- )
|
|
CCOLOR ! CRAD ! CZ ! CY ! CX !
|
|
0 CIRC-PT PY ! PX !
|
|
36 0 DO
|
|
PX @ PY @ CZ @
|
|
I 1+ 11438 * CIRC-PT
|
|
2DUP PY ! PX !
|
|
CZ @ CCOLOR @
|
|
LINE
|
|
LOOP ;
|
|
|
|
Block 4909
|
|
( ARC: partial circle, start/end angles in Q48.16 radians, )
|
|
( 18 segments. Reuses CIRC-PT/CX/CY/CZ/CRAD/CCOLOR/PX/PY. )
|
|
VARIABLE ASTART VARIABLE AEND VARIABLE ASTEP
|
|
: ARC-SETUP ( cx cy cz r a0 a1 color -- )
|
|
CCOLOR ! AEND ! ASTART !
|
|
CRAD ! CZ ! CY ! CX !
|
|
AEND @ ASTART @ - 18 / ASTEP !
|
|
ASTART @ CIRC-PT PY ! PX ! ;
|
|
|
|
Block 4910
|
|
( ARC: draws the arc using ARC-SETUP above. )
|
|
: ARC ( cx cy cz r a0 a1 color -- )
|
|
ARC-SETUP
|
|
18 0 DO
|
|
PX @ PY @ CZ @
|
|
ASTART @ I 1+ ASTEP @ * +
|
|
CIRC-PT
|
|
2DUP PY ! PX !
|
|
CZ @ CCOLOR @
|
|
LINE
|
|
LOOP ;
|
|
|
|
Block 4911
|
|
( ELLIPSE-PT: independent x/y radii, reuses CX/CY/CZ. )
|
|
VARIABLE ERX VARIABLE ERY
|
|
: ELLIPSE-PT ( ang -- x y )
|
|
DUP Q.SIN ERY @ Q.FROM-INT Q.* Q.TO-INT CY @ +
|
|
SWAP Q.COS ERX @ Q.FROM-INT Q.* Q.TO-INT CX @ +
|
|
SWAP ;
|
|
|
|
Block 4912
|
|
( ELLIPSE: 36-segment polygon, flat at z=cz. )
|
|
: ELLIPSE ( cx cy cz rx ry color -- )
|
|
CCOLOR ! ERY ! ERX ! CZ ! CY ! CX !
|
|
0 ELLIPSE-PT PY ! PX !
|
|
36 0 DO
|
|
PX @ PY @ CZ @
|
|
I 1+ 11438 * ELLIPSE-PT
|
|
2DUP PY ! PX !
|
|
CZ @ CCOLOR @
|
|
LINE
|
|
LOOP ;
|