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]; ImagerFontFilterImpl: CEDAR PROGRAM IMPORTS Imager, ImagerFont, ImmutablePropList, IO, RefTab, Rope EXPORTS ImagerFontFilter, Imager ~ 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] }; END. ŠImagerFontFilterImpl.mesa Copyright c 1985 by Xerox Corporation. All rights reserved. Michael Plass, June 22, 1985 9:47:58 pm PDT Κ%˜™Icodešœ Οmœ1™Jšœžœ˜&Jšœžœ˜Jšžœžœ˜$Jšœžœ˜)Jšœžœ žœ˜—J˜KšΠlnœž ˜#Kšžœ(žœ˜?Kšžœ˜ šœžœžœ˜Kšžœžœžœ˜Kšœžœ˜Kšœžœ˜Kšœ žœ˜+Kšœ žœ˜Kšœžœ˜"Kšœ žœžœΟc˜CK˜Kšœžœžœžœ˜3šœžœžœ7˜YK˜—Kšœžœžœ ˜šœ žœžœ˜Kšœ˜Kšœžœ˜Kšœ$žœ˜(Kšœžœ˜Kšœ˜Kšœ˜Kšœ˜Kšœ ž˜ Kšœ˜K˜—š Οn œžœžœGžœžœ˜ŠKšœ˜Kšœ žœ]˜mKšœL˜LKšœžœ˜)Kšœ˜K˜Kšœ˜Kšœ˜Kšœ˜Kšœ˜Kšœ žœT˜aKšœ˜K˜—š‘ œžœ"˜1Kšœ žœ'˜:Kšœžœ!˜?šžœ žœžœ˜Kšœ žœ ˜Kšœžœ˜Kšœžœžœžœ˜$Kšœ˜Kšœ žœ žœ˜Kšœ žœ žœ˜+Kšœžœžœ˜šžœ#žœžœž˜4šžœ(žœžœ˜7Kšœ˜Jšœ˜Kšžœ˜Kšœ˜—Kšžœ˜—šžœ žœžœ˜Kšœžœ žœžœ ˜CKšœ žœ'˜7Kšœžœ˜ Kšœ˜—Kšžœžœ žœ žœ˜*Kšžœžœ žœ ˜9Kšžœ žœžœ˜@šžœ"žœžœž˜3KšœK˜KKšžœ žœžœ˜DJšœ žœ/˜