DIRECTORY
Atom USING [PropList],
Commander USING [Handle],
Imager USING [ClassRep, Context, ContextRep, GetProp, SetFont, Show],
ImagerFont USING [Find, Font, MapText, Modify, XChar, XStringProc],
ImagerFontFilter USING [CharacterCodeMap, FontMap, OutputMap],
ImagerPrivate USING [Class, ClassRep],
ImmutablePropList USING [Put],
IO USING [int, PutF, PutRope, rope],
RefTab USING [Create, Fetch, Ref, Store],
Rope USING [Equal, ROPE];
~
BEGIN
OPEN ImagerFontFilter;
ROPE: TYPE ~ Rope.ROPE;
Font: TYPE ~ ImagerFont.Font;
XChar: TYPE ~ ImagerFont.XChar;
XStringProc: TYPE ~ ImagerFont.XStringProc;
Context: TYPE ~ Imager.Context;
Class: TYPE ~ ImagerPrivate.Class;
ClassRep: PUBLIC TYPE ~ ImagerPrivate.ClassRep; -- export to Imager
BoundOutputMap: TYPE ~ LIST OF BoundOutputMapEntry;
BoundOutputMapEntry:
TYPE ~
RECORD [newFont: ImagerFont.Font, charMap: CharacterCodeMap];
Data: TYPE ~ REF DataRep;
DataRep:
TYPE ~
RECORD[
c: Imager.Context,
curFont: Font ← NIL,
curBoundOutputMap: BoundOutputMap ← NIL,
curMappedFont: Font ← NIL,
fontMap: FontMap,
fontTable: RefTab.Ref,
cmd: Commander.Handle,
verbose: BOOL
];
FilterFonts:
PUBLIC
PROC [c: Imager.Context, fontMap: FontMap, cmd: Commander.Handle, verbose:
BOOL]
RETURNS [context: Imager.Context] ~ {
oldClass: Class ~ c.class;
data: Data ~ NEW[DataRep ← [c: c, fontMap: fontMap, fontTable: RefTab.Create[], cmd: cmd, verbose: verbose]];
props: Atom.PropList ~ ImmutablePropList.Put[c.propList, $FontFilter, data];
class: Class ~ NEW[ClassRep ← oldClass^];
class.type ← $FontFilter;
class.DoSave ← MyDoSave;
class.SetFont ← MySetFont;
class.GetFont ← MyGetFont;
class.Show ← MyShow;
class.ShowText ← MyShowText;
context ← NEW[Imager.ContextRep ← [class: class, state: c.state, data: c.data, propList: props]];
};
MySetFont:
PROC[context: Context, font: Font] ~ {
data: Data ~ NARROW[Imager.GetProp[context, $FontFilter]];
subst: BoundOutputMap ← NARROW[data.fontTable.Fetch[font].val];
IF subst =
NIL
THEN {
oldName: ROPE ~ font.name;
outputMap: OutputMap ← NIL;
h: BoundOutputMap ~ LIST[[NIL,NIL]];
t: BoundOutputMap ← h;
canPrint: BOOL ~ data.cmd#NIL;
printing: BOOL ← canPrint AND data.verbose;
warn: BOOL ← FALSE;
FOR p: FontMap ← data.fontMap, p.rest
UNTIL p=
NIL
DO
IF Rope.Equal[oldName, p.first.inputName,
FALSE]
THEN {
outputMap ← p.first.output;
warn ← p.first.warn;
EXIT;
};
ENDLOOP;
IF outputMap =
NIL
THEN {
charMap: CharacterCodeMap ~ LIST[[bc: 0, ec: WORD.LAST, newbc: 0]];
outputMap ← LIST[[newName: oldName, charMap: charMap]];
warn ← TRUE;
};
IF warn AND canPrint THEN printing ← TRUE;
IF warn AND printing THEN data.cmd.out.PutF[" WARNING:"];
IF printing THEN data.cmd.out.PutF[" (%g =>", IO.rope[oldName]];
FOR o: OutputMap ← outputMap, o.rest
UNTIL o=
NIL
DO
newFont: Font ~ ImagerFont.Find[o.first.newName].Modify[font.charToClient];
IF printing THEN data.cmd.out.PutF[" %g", IO.rope[o.first.newName]];
t.rest ← LIST[[newFont: newFont, charMap: o.first.charMap]];
t ← t.rest;
ENDLOOP;
IF printing THEN data.cmd.out.PutRope[")"];
subst ← h.rest;
[] ← data.fontTable.Store[font, subst];
};
data.curFont ← font;
IF subst = NIL THEN ERROR;
data.curBoundOutputMap ← subst;
data.curMappedFont ← NIL;
};
MapChar:
PROC [data: Data, charCode:
WORD]
RETURNS [f: Font, tchar:
WORD] ~ {
boundMap: BoundOutputMap ~ data.curBoundOutputMap;
FOR b: BoundOutputMap ← boundMap, b.rest
UNTIL b =
NIL
DO
FOR c: CharacterCodeMap ← b.first.charMap, c.rest
UNTIL c =
NIL
DO
IF charCode
IN [c.first.bc..c.first.ec]
THEN {
f ← b.first.newFont;
tchar ← c.first.newbc+(charCode-c.first.bc);
RETURN;
};
ENDLOOP;
ENDLOOP;
f ← boundMap.first.newFont;
tchar ← charCode;
IF data.cmd#NIL THEN data.cmd.out.PutF[" WARNING: (%03BB|%03BB) not in %g", IO.int[charCode/256], IO.int[charCode MOD 256], IO.rope[data.curFont.name]];
};
MyShow:
PROC[context: Context, string: XStringProc, xrel:
BOOL] ~ {
data: Data ~ NARROW[Imager.GetProp[context, $FontFilter]];
short: NAT ~ 100;
buf: ARRAY [0..short) OF WORD;
xbuf: REF ARRAY [short..NAT.LAST) OF WORD ← NIL;
nChars: NAT ← 0;
i: NAT ← 0;
myCharAction:
PROC [char: XChar] ~ {
IF nChars = short THEN xbuf ← NEW[ARRAY [short..NAT.LAST) OF WORD];
IF nChars < short THEN buf[nChars] ← LOOPHOLE[char]
ELSE {
IF xbuf = NIL THEN xbuf ← NEW[ARRAY [short..NAT.LAST) OF WORD];
xbuf[nChars] ← LOOPHOLE[char];
};
nChars ← nChars + 1;
};
C: PROC [index: NAT] RETURNS [WORD] ~ INLINE {RETURN [IF index < short THEN buf[index] ELSE xbuf[index]]};
deltaChars: NAT ← 0;
f: Font ← NIL;
myString: XStringProc ~ {
c: WORD;
[f, c] ← MapChar[data, C[i]];
deltaChars ← 0;
DO
ff: Font;
charAction[LOOPHOLE[c]];
deltaChars ← deltaChars + 1;
IF i+deltaChars = nChars THEN EXIT;
[ff, c] ← MapChar[data, C[i+deltaChars]];
IF ff # f THEN EXIT;
ENDLOOP;
};
string[myCharAction];
UNTIL i = nChars
DO
[f, ----] ← MapChar[data, C[i]];
IF f # data.curMappedFont
THEN {
Imager.SetFont[data.c, f];
data.curMappedFont ← f;
};
Imager.Show[data.c, myString, xrel];
i ← i + deltaChars;
ENDLOOP;
};
MyShowText:
PROC [context: Context,
text:
REF
READONLY
TEXT, start, len:
NAT, xrel:
BOOL] ~ {
string: XStringProc ~ { ImagerFont.MapText[text, start, len, charAction] };
Imager.Show[context, string, xrel];
};
MyDoSave:
PROC[context: Context, action:
PROC, all:
BOOL] ~ {
data: Data ~ NARROW[Imager.GetProp[context, $FontFilter]];
cClass: Class ~ data.c.class;
curFont: Font ← data.curFont;
curBoundOutputMap: BoundOutputMap ← data.curBoundOutputMap;
curMappedFont: Font ← data.curMappedFont;
Restore:
PROC ~ {
data.curMappedFont ← curMappedFont;
data.curBoundOutputMap ← curBoundOutputMap;
data.curFont ← curFont;
};
cClass.DoSave[context, action, all ! UNWIND => Restore[]];
Restore[];
};
MyGetFont:
PROC[context: Context]
RETURNS[Font] ~ {
data: Data ~ NARROW[Imager.GetProp[context, $FontFilter]];
RETURN [data.curFont]
};