Robert Allan JamesandClaude Sonnet 5
82e948afe9
Punch list §25 item 4.3.6 complete. capsules/fabric.4th blocks 4916-4917: EM-UNITS, GOX/GOY/GSIZE/GCOLOR, EM-X/EM-Y/G-LINE per §27.6.1, scaling/translating em-square strokes into CART-PLOT screen coordinates via */. Verified live on amd64 via a temporary probe (built, run once, reverted): two G-LINE test shapes at GSIZE 100 and GSIZE 50, one leg each exercising a negative em-y value chosen to hit */'s truncate-toward-zero behaviour, not a multiple of EM-UNITS. Screendump pixel-bbox extraction matched hand-calculated raster coordinates exactly on both shapes. Three-arch acceptance boot clean, Stadium conservation unaffected (resident_sum=43691 reservoir=21845 sum=65536 on all three). Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
200 lines
6.0 KiB
Forth
200 lines
6.0 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 ;
|
|
|
|
Block 4913
|
|
( CUBE: wireframe, 8 vertices via bit-coded corner index n )
|
|
( (bit0=x, bit1=y, bit2=z; set=+CS, clear=-CS from center). )
|
|
VARIABLE CS
|
|
: VERT ( n -- x y z )
|
|
DUP 1 AND IF CS @ ELSE CS @ NEGATE THEN CX @ +
|
|
SWAP DUP 2 AND IF CS @ ELSE CS @ NEGATE THEN CY @ +
|
|
SWAP DUP 4 AND IF CS @ ELSE CS @ NEGATE THEN CZ @ +
|
|
SWAP DROP ;
|
|
|
|
Block 4914
|
|
( EDGE: draws one cube edge between vertex indices n1,n2. )
|
|
VARIABLE EN2
|
|
: EDGE ( n1 n2 color -- )
|
|
>R EN2 ! VERT EN2 @ VERT R> LINE ;
|
|
|
|
Block 4915
|
|
( CUBE: 12 edges -- 4 bottom, 4 top, 4 vertical. )
|
|
: CUBE ( cx cy cz s color -- )
|
|
CCOLOR ! CS ! CZ ! CY ! CX !
|
|
0 1 CCOLOR @ EDGE 1 3 CCOLOR @ EDGE
|
|
3 2 CCOLOR @ EDGE 2 0 CCOLOR @ EDGE
|
|
4 5 CCOLOR @ EDGE 5 7 CCOLOR @ EDGE
|
|
7 6 CCOLOR @ EDGE 6 4 CCOLOR @ EDGE
|
|
0 4 CCOLOR @ EDGE 1 5 CCOLOR @ EDGE
|
|
2 6 CCOLOR @ EDGE 3 7 CCOLOR @ EDGE ;
|
|
|
|
Block 4916
|
|
( EM-X/EM-Y: em-square (1000 units/em) -> CART-PLOT space. )
|
|
( Item 4.3.6. GOX/GOY are the glyph's baseline-left anchor, )
|
|
( GSIZE the requested pixel size -- set by DRAW-GLYPH later )
|
|
( (item 4.3.6b), not yet built. )
|
|
1000 CONSTANT EM-UNITS
|
|
VARIABLE GOX VARIABLE GOY VARIABLE GSIZE VARIABLE GCOLOR
|
|
: EM-X ( em-x -- cart-x ) GSIZE @ EM-UNITS */ GOX @ + ;
|
|
: EM-Y ( em-y -- cart-y ) GSIZE @ EM-UNITS */ GOY @ + ;
|
|
|
|
Block 4917
|
|
( G-LINE: one glyph stroke, em-square coords -> CART-PLOT. )
|
|
VARIABLE GX1 VARIABLE GY1 VARIABLE GX2 VARIABLE GY2
|
|
: G-LINE ( gx1 gy1 gx2 gy2 -- )
|
|
GY2 ! GX2 ! GY1 ! GX1 !
|
|
GX1 @ EM-X GY1 @ EM-Y 0
|
|
GX2 @ EM-X GY2 @ EM-Y 0
|
|
GCOLOR @
|
|
LINE ;
|