Robert Allan James
fa300ef4c6
Adds VERT/EDGE/CUBE to capsules/fabric.4th (blocks 4913-4915). VERT ( n -- x y z ) reads bits 0/1/2 of a corner index as the X/Y/Z sign (+-CS from center), so all 8 cube corners come from one word. EDGE resolves both corners via VERT and calls LINE; CUBE is 12 EDGE calls (4 bottom, 4 top, 4 vertical). First item in the 4.3.3.x sequence with no new bug found -- a small signal that Q.TO-INT, the VARIABLE alignment fix, and the LINE-STUCK? cap were the real gaps rather than something still lurking in LINE/PROJECT/CART-Y. Verified live on amd64: a centered, half-size-100 cube renders correctly -- front/back face squares, back face offset diagonally up-right by exactly the 45-degree cavalier projection's depth term, all 12 edges connecting at the right corners. All three architectures boot clean to ok> with the DoE completing; dict_hash identical across all three and unchanged from 4.3.3a/4.3.3b. FABRIC.md item 4.3.4 marked done. This is the checkpoint -- 4.3.x groundwork stops here for review per this item's own acceptance criterion.
180 lines
5.3 KiB
Forth
180 lines
5.3 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 ;
|