admin/LithosAnanake
1
0
Fork 0
Code Issues Pull Requests Actions 15 Packages Projects Releases Wiki Activity

fabric: codepoint -> glyph dispatch (DISPATCH-GLYPH, TOFU)

Browse Source 
Punch list §25 item 4.3.6b complete.
capsules/fabric.4th blocks 4921-4924: DISPATCH-GLYPH routing via
WITHIN to six bucket words (DISPATCH-DIGIT/-UPPER/-LOWER/
-ASCII-PUNCT/-LATIN1/-GENPUNCT), TOFU fallback, DRAW-GLYPH. Buckets
carry one placeholder stroke word each (G-TEST-*), not the real
113-glyph set -- that's item 4.3.6c's scope, deliberately deferred.

Also: merged two lines in block 4920 (DECODE-UTF8) to fit mkcapsule's
real 64-char x 16-line block limit once a trailing blank separator
line is counted against it -- mechanical reformat, re-verified via a
DECODE-UTF8 regression check (65/176/8212, unchanged).

Verified live on amd64: one representative codepoint per bucket plus
one out-of-range codepoint, all seven DRAW-GLYPH results matched
expected exactly (400/600/450/250/550/700/500-TOFU). Three-arch
acceptance boot clean, Stadium conservation unaffected.

Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
This commit is contained in:
Robert Allan James
2026-08-09 19:15:05 -04:00
co-authored by Claude Sonnet 5
parent 24d6b9e20e
commit 4427986c96
13 changed files with 54536 additions and 100 deletions
Download Patch File Download Diff File Expand all files Collapse all files
capsules/fabric.4th
+50 -2
View File
@@ -230,8 +230,7 @@ Block 4920
UADDR @ 2 + C@ 63 AND 6 LSHIFT OR
UADDR @ 3 + C@ 63 AND OR ;
: DECODE-UTF8 ( addr u -- codepoint addr' u' )
ULEN ! UADDR !
UADDR @ C@ ULEAD !
ULEN ! UADDR ! UADDR @ C@ ULEAD !
ULEAD @ UTF8-SEQ-LEN USEQLEN !
USEQLEN @ 1 = IF UTF8-ASSEMBLE-1 UCP ! ELSE
USEQLEN @ 2 = IF UTF8-ASSEMBLE-2 UCP ! ELSE
@@ -239,3 +238,52 @@ Block 4920
USEQLEN @ 4 = IF UTF8-ASSEMBLE-4 UCP ! ELSE
65533 UCP ! 1 USEQLEN ! THEN THEN THEN THEN
UCP @ UADDR @ USEQLEN @ + ULEN @ USEQLEN @ - ;
Block 4921
( 4.3.6b placeholder test glyphs -- one per dispatch bucket. )
( Minimal, NOT the real 113-glyph set (item 4.3.6c). Proves )
( DISPATCH-GLYPH routes to the correct stroke word only. )
: G-TEST-DIGIT ( -- adv ) 0 0 500 700 G-LINE 400 ;
: G-TEST-UPPER ( -- adv ) 0 0 600 700 G-LINE 600 ;
: G-TEST-LOWER ( -- adv ) 0 0 500 500 G-LINE 450 ;
: G-TEST-PUNCT ( -- adv ) 0 0 200 200 G-LINE 250 ;
: G-TEST-LATIN1 ( -- adv ) 0 0 500 500 G-LINE 550 ;
: G-TEST-GENPUNCT ( -- adv ) 0 0 1000 0 G-LINE 700 ;
: TOFU ( -- adv )
100 0 100 700 G-LINE
100 700 400 700 G-LINE
400 700 400 0 G-LINE
400 0 100 0 G-LINE
500 ;
Block 4922
( Dispatch buckets 1/2/3 -- digit/upper/lower. Item 4.3.6b. )
: DISPATCH-DIGIT ( codepoint -- adv )
CASE 48 OF G-TEST-DIGIT ENDOF DROP TOFU ENDCASE ;
: DISPATCH-UPPER ( codepoint -- adv )
CASE 65 OF G-TEST-UPPER ENDOF DROP TOFU ENDCASE ;
: DISPATCH-LOWER ( codepoint -- adv )
CASE 97 OF G-TEST-LOWER ENDOF DROP TOFU ENDCASE ;
Block 4923
( Dispatch buckets 4/5/6 -- punct/latin1/genpunct. 4.3.6b. )
: DISPATCH-ASCII-PUNCT ( codepoint -- adv )
CASE 33 OF G-TEST-PUNCT ENDOF DROP TOFU ENDCASE ;
: DISPATCH-LATIN1 ( codepoint -- adv )
CASE 176 OF G-TEST-LATIN1 ENDOF DROP TOFU ENDCASE ;
: DISPATCH-GENPUNCT ( codepoint -- adv )
CASE 8212 OF G-TEST-GENPUNCT ENDOF DROP TOFU ENDCASE ;
Block 4924
( DISPATCH-GLYPH: codepoint -> bucket, via WITHIN. 4.3.6b. )
: DISPATCH-GLYPH ( codepoint -- adv )
DUP 48 58 WITHIN IF DISPATCH-DIGIT EXIT THEN
DUP 65 91 WITHIN IF DISPATCH-UPPER EXIT THEN
DUP 97 123 WITHIN IF DISPATCH-LOWER EXIT THEN
DUP 32 127 WITHIN IF DISPATCH-ASCII-PUNCT EXIT THEN
DUP 160 256 WITHIN IF DISPATCH-LATIN1 EXIT THEN
DUP 8192 8304 WITHIN IF DISPATCH-GENPUNCT EXIT THEN
DROP TOFU ;
: DRAW-GLYPH ( codepoint x y size color -- adv )
GCOLOR ! GSIZE ! GOY ! GOX !
DISPATCH-GLYPH ;