Robert Allan JamesandClaude Sonnet 5
aee09cac0a
Punch list §25 item 4.3.6e complete. Optional capsule, not wired into the boot chain, overriding DISPATCH-UPPER's codepoint 65 (G-A) with a marked alternate glyph while every other letter falls through to font.4th's originals unchanged. Corrects §27.6.5: redefining the DISPATCH-* bucket word alone is not enough, since DISPATCH-GLYPH/DRAW-GLYPH are themselves compiled early against font.4th's own dispatch words (same early-binding finding as 4.3.6c, one layer up). Verified both ways: the partial override (bucket word only) left DRAW-GLYPH still drawing the original glyph; redefining DISPATCH-GLYPH/DRAW-GLYPH too made the override take effect. Three-arch acceptance boot clean, Stadium conservation unchanged. Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
42 lines
1.6 KiB
Forth
42 lines
1.6 KiB
Forth
Block 4200
|
|
( user-font-demo.4th -- proves the 4.3.6e override mechanism. )
|
|
( Redefines DISPATCH-UPPER, overriding G-A with a marked )
|
|
( alternate (an X through the A) while every other letter )
|
|
( still calls font.4th's existing G-B..G-Z (not redefined). )
|
|
: G-A-ALT ( -- adv )
|
|
100 0 275 700 G-LINE
|
|
275 700 450 0 G-LINE
|
|
190 350 360 350 G-LINE
|
|
100 700 450 0 G-LINE
|
|
550 ;
|
|
|
|
Block 4201
|
|
: DISPATCH-UPPER ( codepoint -- adv ) CASE
|
|
65 OF G-A-ALT ENDOF 66 OF G-B ENDOF 67 OF G-C ENDOF
|
|
68 OF G-D ENDOF 69 OF G-E ENDOF 70 OF G-F ENDOF
|
|
71 OF G-G ENDOF 72 OF G-H ENDOF 73 OF G-I ENDOF
|
|
74 OF G-J ENDOF 75 OF G-K ENDOF 76 OF G-L ENDOF
|
|
77 OF G-M ENDOF 78 OF G-N ENDOF 79 OF G-O ENDOF
|
|
80 OF G-P ENDOF 81 OF G-Q ENDOF 82 OF G-R ENDOF
|
|
83 OF G-S ENDOF 84 OF G-T ENDOF 85 OF G-U ENDOF
|
|
86 OF G-V ENDOF 87 OF G-W ENDOF 88 OF G-X ENDOF
|
|
89 OF G-Y ENDOF 90 OF G-Z ENDOF
|
|
DROP TOFU ENDCASE ;
|
|
|
|
Block 4202
|
|
( DISPATCH-GLYPH/DRAW-GLYPH also redefined here -- found in )
|
|
( 4.3.6c, not just documented in 27.6.5: they were compiled )
|
|
( early too (in font.4th, against font.4th's own DISPATCH-*), )
|
|
( so redefining DISPATCH-UPPER alone would not be picked up. )
|
|
: 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 ;
|