Robert Allan JamesandClaude Sonnet 5
e40134da0d
First entry in the "cookbook" track: a demo capsule plus HOWTO, per the sequencing laid out after the POST-coverage sweep. Built entirely in FORTH on top of existing primitives -- fabric.4th's LINE (raster Bresenham) and Q.SIN/Q.COS (Q48.16 trig), plus PLOT/FB-WIDTH/FB-HEIGHT -- no new C words. FORWARD/BACK/LEFT/RIGHT/PENUP/PENDOWN/HOME/SETXY/SETHEADING/SETCOLOR give the classic turtle model; POLYGON and STAR compose FORWARD+turn into simple demo shapes; TURTLE-DEMO is a one-call visual smoke test. Not wired into init.4th -- REPL-invoked only, matching the original idea's own scope. Verified: mkcapsule --lint clean, hosted-build logic trace shows zero VM errors and correct stack balance through the whole vocabulary, zero build warnings and capsule loads cleanly on all three kernel architectures. Visual pixel-level confirmation not yet done (needs an interactive gtk-display session or driving past the ~25-30 min DoE-before-REPL wall), documented as an open item in the HOWTO. HOWTO: docs/working/architecture/TURTLE-GRAPHICS-HOWTO-20260819.md Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
100 lines
3.2 KiB
Forth
100 lines
3.2 KiB
Forth
Block 5100
|
|
( turtle.4th -- limited LOGO-style turtle graphics. Cookbook )
|
|
( demo capsule. Built on capsules/fabric.4th's LINE and )
|
|
( Q48.16 Q.SIN/Q.COS -- pure FORTH, no new C words. Load )
|
|
( fabric.4th first: uses LINE, FB-WIDTH, FB-HEIGHT, PLOT, )
|
|
( Q.SIN, Q.COS, Q.FROM-INT, Q.TO-INT, Q.*, Q.+. )
|
|
1144 CONSTANT DEG2RAD ( Q48.16 rad/deg, pi/180 ~= 0.0174533 )
|
|
VARIABLE TX VARIABLE TY VARIABLE THEAD
|
|
VARIABLE TPEN VARIABLE TCOLOR
|
|
|
|
Block 5101
|
|
( HOME: turtle to screen center, heading 0 (east), pen down, )
|
|
( color white. Does not clear the screen -- see CS for that. )
|
|
: HOME ( -- )
|
|
FB-WIDTH 2/ TX !
|
|
FB-HEIGHT 2/ TY !
|
|
0 THEAD !
|
|
1 TPEN !
|
|
16777215 TCOLOR ! ;
|
|
|
|
Block 5102
|
|
( PENUP / PENDOWN: whether FORWARD/BACK draw while moving. )
|
|
( SETCOLOR: 24-bit 0xRRGGBB, matches PLOT's own format. )
|
|
( SETXY: jump to (x y) without drawing, any pen state. )
|
|
( SETHEADING: absolute heading in degrees, 0=east, CCW+. )
|
|
: PENUP ( -- ) 0 TPEN ! ;
|
|
: PENDOWN ( -- ) 1 TPEN ! ;
|
|
: SETCOLOR ( color -- ) TCOLOR ! ;
|
|
: SETXY ( x y -- ) TY ! TX ! ;
|
|
: SETHEADING ( deg -- ) Q.FROM-INT DEG2RAD Q.* THEAD ! ;
|
|
|
|
Block 5103
|
|
( FORWARD / BACK: move n pixels along current heading )
|
|
( (THEAD, Q48.16 radians), drawing a LINE from old to new )
|
|
( position if pen is down. z is always 0 -- turtle graphics )
|
|
( is flat; fabric.4th's LINE just carries z through for the )
|
|
( 3D case it also supports. )
|
|
VARIABLE TNX VARIABLE TNY
|
|
: FORWARD ( n -- )
|
|
DUP Q.FROM-INT THEAD @ Q.COS Q.* Q.TO-INT TX @ + TNX !
|
|
Q.FROM-INT THEAD @ Q.SIN Q.* Q.TO-INT TY @ + TNY !
|
|
TPEN @ IF
|
|
TX @ TY @ 0 TNX @ TNY @ 0 TCOLOR @ LINE
|
|
THEN
|
|
TNX @ TX ! TNY @ TY ! ;
|
|
: BACK ( n -- ) NEGATE FORWARD ;
|
|
|
|
Block 5104
|
|
( LEFT / RIGHT: turn in place by n degrees, CCW / CW. )
|
|
: LEFT ( deg -- )
|
|
Q.FROM-INT DEG2RAD Q.* THEAD @ Q.+ THEAD ! ;
|
|
: RIGHT ( deg -- ) NEGATE LEFT ;
|
|
|
|
Block 5105
|
|
( CS: clear the framebuffer to black. framebuffer_words.c )
|
|
( only exposes PLOT (no fill primitive), so this is a plain )
|
|
( nested PLOT loop -- slow under TCG for a full screen, fine )
|
|
( for a one-shot demo clear, not meant to run per-frame. )
|
|
: CS ( -- )
|
|
FB-HEIGHT 0 DO
|
|
FB-WIDTH 0 DO
|
|
I J 0 PLOT
|
|
LOOP
|
|
LOOP ;
|
|
|
|
Block 5106
|
|
( POLYGON: regular polygon, SIDES corners, LEN pixels per )
|
|
( edge, drawn from the turtle's current position/heading )
|
|
( (call HOME first for a clean start). Classic LOGO idiom: )
|
|
( forward + turn 360/sides, repeated SIDES times. )
|
|
VARIABLE PLEN
|
|
: POLYGON ( sides len -- )
|
|
PLEN !
|
|
DUP 0 DO
|
|
PLEN @ FORWARD
|
|
DUP 360 SWAP / LEFT
|
|
LOOP
|
|
DROP ;
|
|
|
|
Block 5107
|
|
( STAR: self-intersecting 5-pointed LOGO star -- forward + )
|
|
( a 144-degree turn (not 360/5=72, a plain pentagon), 5x. )
|
|
: STAR ( len -- )
|
|
DUP 5 0 DO
|
|
DUP FORWARD
|
|
144 LEFT
|
|
LOOP
|
|
DROP ;
|
|
|
|
Block 5108
|
|
( TURTLE-DEMO: visual smoke test -- clear screen, a cyan )
|
|
( hexagon, then a magenta star from the same start point. )
|
|
( Run after loading: S" turtle.4th" EXEC TURTLE-DEMO )
|
|
: TURTLE-DEMO ( -- )
|
|
CS
|
|
HOME 65535 SETCOLOR ( cyan 0x00FFFF )
|
|
6 80 POLYGON
|
|
HOME 16711935 SETCOLOR ( magenta 0xFF00FF )
|
|
100 STAR ;
|