<> <> <> <> <<>> DIRECTORY Atom USING [MakeAtomFromRefText], BasicTime USING [GMT, nullGMT], Convert USING [AppendCard], FS USING [ComponentPositions, EnumerateForNames, Error, ErrorDesc, ExpandName, GetInfo, GetName, NameProc, nullOpenFile, Open, OpenFile], Imager, ImagerBox, ImagerFont USING [CorrectionType, nullXChar], ImagerTypeface, IO USING [PutFR1, rope], RefText USING [AppendRope, ObtainScratch, ReleaseScratch], Rope, SymTab USING [Create, Delete, Fetch, Insert, Pairs, Ref, Store]; ImagerTypefaceImpl: CEDAR MONITOR IMPORTS Atom, Convert, FS, Imager, ImagerBox, IO, RefText, Rope, SymTab EXPORTS ImagerTypeface ~ BEGIN OPEN ImagerTypeface; ROPE: TYPE ~ Rope.ROPE; nullXChar: XChar ~ ImagerFont.nullXChar; creators: SymTab.Ref ~ SymTab.Create[mod: 7, case: FALSE]; Creator: TYPE ~ REF CreatorRep; CreatorRep: TYPE ~ RECORD[extension: ROPE, create: CreateProc]; Register: PUBLIC PROC [extension: ROPE, create: CreateProc] ~ { creator: Creator ~ NEW[CreatorRep _ [extension: extension, create: create]]; [] _ SymTab.Store[x: creators, key: extension, val: creator]; }; FetchCreator: PUBLIC PROC [extension: ROPE] RETURNS [CreateProc] ~ { found: BOOL; val: REF; [found, val] _ SymTab.Fetch[creators, extension]; IF found THEN WITH val SELECT FROM creator: Creator => RETURN[creator.create]; ENDCASE => ERROR -- val is wrong type or NIL ELSE RETURN[NIL]; }; RopeFromRef: PROC [x: REF] RETURNS [ROPE] ~ { WITH x SELECT FROM text: REF TEXT => RETURN[Rope.FromRefText[text]]; text: REF READONLY TEXT => RETURN[Rope.FromRefText[text]]; ENDCASE => RETURN[NARROW[x]]; }; typefaces: SymTab.Ref ~ SymTab.Create[mod: 37, case: FALSE]; FlushTypefaces: ENTRY PROC RETURNS [ok: BOOL _ TRUE] ~ { someKey: ROPE _ NIL; epa: PROC [key: ROPE, val: REF] RETURNS [quit: BOOL _ TRUE] ~ {someKey _ key}; WHILE SymTab.Pairs[typefaces, epa] DO IF NOT SymTab.Delete[typefaces, someKey] THEN RETURN [FALSE]; ENDLOOP; }; FetchTypeface: PROC [name: ROPE] RETURNS [Typeface] ~ { found: BOOL; val: REF; [found, val] _ SymTab.Fetch[typefaces, name]; IF found THEN WITH val SELECT FROM typeface: Typeface => RETURN[typeface]; ENDCASE => ERROR -- val is wrong type or NIL ELSE RETURN[NIL]; }; races: INT _ 0; generics: LIST OF GenericCreator ~ LIST[NIL]; RegisterGenericCreator: PUBLIC ENTRY PROC [genericCreator: GenericCreator] ~ { priority: INTEGER ~ genericCreator.priority; prev: LIST OF GenericCreator _ generics; FOR p: LIST OF GenericCreator _ prev.rest, p.rest UNTIL p = NIL OR p.first.priority < priority DO IF p.first.priority = priority THEN {p.first _ genericCreator; RETURN}; prev _ p; ENDLOOP; prev.rest _ CONS[genericCreator, prev.rest]; }; GetGeneric: ENTRY PROC [list: LIST OF GenericCreator] RETURNS [first: GenericCreator _ NIL, rest: LIST OF GenericCreator _ NIL] ~ { IF list#NIL THEN {first _ list.first; rest _ list.rest}; }; Create: PROC [name: ROPE] RETURNS [typeface: Typeface] ~ { current: GenericCreator _ NIL; rest: LIST OF GenericCreator _ NIL; [current, rest] _ GetGeneric[generics.rest]; UNTIL current = NIL OR current.priority <= 0 DO IF (typeface _ current.proc[current, name])#NIL THEN RETURN; [current, rest] _ GetGeneric[rest]; ENDLOOP; IF (typeface _ NormalCreate[name])#NIL THEN RETURN; UNTIL current = NIL DO IF (typeface _ current.proc[current, name])#NIL THEN RETURN; [current, rest] _ GetGeneric[rest]; ENDLOOP; ERROR Imager.Error[[code: $fontNotFound, explanation: IO.PutFR1["Could not find font \"%g\".", IO.rope[name]]]]; }; NormalCreate: PROC [name: ROPE] RETURNS [typeface: Typeface] ~ { fontsDir: ROPE ~ "Fonts/"; pattern: ROPE ~ Rope.Cat["///", fontsDir, name, ".*!h"]; file: FS.OpenFile _ FS.nullOpenFile; created: BasicTime.GMT _ BasicTime.nullGMT; fullFName: ROPE _ NIL; cp: FS.ComponentPositions; nameStart, nameStop: INT _ 0; fontName, extension: ROPE _ NIL; convertToSlashes: Rope.TranslatorType ~ { RETURN[IF old='> THEN '/ ELSE old] }; create: CreateProc _ NIL; nameProc: FS.NameProc ~ { file _ FS.Open[fullFName]; RETURN[continue: FALSE] }; FS.EnumerateForNames[pattern: pattern, proc: nameProc]; IF file=FS.nullOpenFile THEN RETURN [NIL]; [fullFName: fullFName, cp: cp] _ FS.ExpandName[name: FS.GetName[file].fullFName]; created _ FS.GetInfo[file].created; nameStart _ cp.subDirs.start+Rope.Length[fontsDir]; nameStop _ cp.base.start+cp.base.length; fontName _ Rope.Translate[base: fullFName, start: nameStart, len: nameStop-nameStart, translator: convertToSlashes]; IF NOT Rope.Equal[s1: name, s2: fontName, case: FALSE] THEN ERROR Imager.Error[[code: $bug, explanation: "Typeface file name doesn't match requested name."]]; extension _ Rope.Substr[base: fullFName, start: cp.ext.start, len: cp.ext.length]; create _ FetchCreator[extension]; IF create=NIL THEN ERROR Imager.Error[[code: $fontTypeNotFound, explanation: Rope.Concat[fullFName, " is a font file of unknown type"]]]; typeface _ create[file]; typeface.name _ fontName; typeface.created _ created; RETURN[typeface]; }; Find: PUBLIC PROC [name: ROPE] RETURNS [Typeface] ~ { typeface: Typeface _ FetchTypeface[name]; errorDesc: FS.ErrorDesc; IF typeface=NIL THEN typeface _ Create[name ! FS.Error => { errorDesc _ error; CONTINUE }]; IF typeface=NIL THEN ERROR Imager.Error[[code: $fontFileError, explanation: errorDesc.explanation]]; IF typeface.info = NIL THEN BuildInfoTable[typeface]; IF NOT SymTab.Insert[typefaces, typeface.name, typeface] THEN races _ races+1; RETURN[typeface]; }; BuildInfoTable: PROC[typeface: Typeface] ~ { info: InfoTable ~ NEW[InfoTableRep _ ALL[[]]]; FOR code: BYTE IN BYTE DO char: XChar ~ [set: 0, code: code]; exists: BOOL ~ typeface.class.Contains[typeface, char]; amplified: BOOL ~ typeface.class.Amplified[typeface, char]; correction: CorrectionType ~ typeface.class.Correction[typeface, char]; info[code] _ [exists: exists, amplified: amplified, correction: correction]; ENDLOOP; typeface.info _ info; }; DoWithScratchText: PROC[len: NAT, action: PROC[REF TEXT]] ~ { scratch: REF TEXT ~ RefText.ObtainScratch[len]; action[scratch ! UNWIND => RefText.ReleaseScratch[scratch]]; RefText.ReleaseScratch[scratch]; }; MakeNameAtom: PUBLIC PROC [name: ROPE, gmt: BasicTime.GMT] RETURNS [atom: ATOM] ~ { InnterMakeNameAtom: PROC[text: REF TEXT] ~ { text _ RefText.AppendRope[to: text, from: name]; FOR i: NAT IN[0..text.length) DO char: CHAR ~ text[i]; IF char IN['A..'Z] THEN text[i] _ char-'A+'a; -- convert to lower case ENDLOOP; IF gmt#BasicTime.nullGMT THEN { text _ RefText.AppendRope[to: text, from: "/v"]; text _ Convert.AppendCard[to: text, from: LOOPHOLE[gmt]]; }; atom _ Atom.MakeAtomFromRefText[text]; }; DoWithScratchText[100, InnterMakeNameAtom]; }; <> <> <<>> XCGenericCreator: PROC [self: GenericCreator, name: ROPE] RETURNS [typeface: Typeface _ NIL] ~ { IF Rope.Match["xerox/xc*/*", name, FALSE] THEN { tname: ROPE ~ Rope.Translate[name]; -- in case name is really a REF TEXT! vStart: INT ~ Rope.Index[tname, 0, "/"]+1; vEnd: INT ~ Rope.Index[tname, vStart, "/"]; charSetVersion: ROPE ~ Rope.Substr[tname, vStart, vEnd-vStart]; rest: ROPE ~ Rope.Substr[tname, vEnd+1]; charSetMapper: CharSetMapper ~ FindMapping[charSetVersion, rest]; IF charSetMapper # NIL THEN { typeface _ NEW[TypefaceRep _ [ class: charSetMapClass, data: charSetMapper, name: tname ]]; }; }; }; CharSetMapper: TYPE ~ LIST OF CharSetEntry; CharSetEntry: TYPE ~ RECORD [charSet: CARDINAL, newTypeface: Typeface]; In: PROC [charSet: CARDINAL, charSetMapper: CharSetMapper] RETURNS [BOOL] ~ { FOR each: LIST OF CharSetEntry _ charSetMapper, each.rest UNTIL each = NIL DO IF each.first.charSet = charSet THEN RETURN [TRUE] ENDLOOP; RETURN [FALSE] }; InsertInOrder: PROC [charSetEntry: CharSetEntry, charSetMapper: CharSetMapper] RETURNS [CharSetMapper] ~ { IF charSetMapper = NIL OR charSetEntry.charSet < charSetMapper.first.charSet THEN charSetMapper _ CONS[charSetEntry, charSetMapper] ELSE { prev: CharSetMapper _ charSetMapper; UNTIL prev.rest = NIL OR charSetEntry.charSet < prev.rest.first.charSet DO prev _ prev.rest ENDLOOP; prev.rest _ CONS[charSetEntry, prev.rest]; }; RETURN [charSetMapper]; }; CSVersionFromFileName: PROC [fullFName: ROPE] RETURNS [ROPE] ~ { IF NOT Rope.Match["[]<>fonts>xerox>*", fullFName, FALSE] THEN ERROR ELSE { d1: INT ~ Rope.Size["[]<>fonts>xerox>"]; d2: INT ~ Rope.Index[fullFName, d1+1, ">"]; RETURN [Rope.Substr[fullFName, d1, d2-d1]]; }; }; FontNameFromFileName: PROC [fullFName: ROPE] RETURNS [ROPE] ~ { IF NOT Rope.Match["[]<>fonts>*", fullFName, FALSE] THEN ERROR ELSE { d1: INT ~ Rope.Size["[]<>fonts>"]; d2: INT ~ Rope.Index[fullFName, d1+1, "."]; translator: Rope.TranslatorType ~ { new _ IF old = '> THEN '/ ELSE old }; RETURN [Rope.Translate[base: fullFName, start: d1, len: d2-d1, translator: translator]]; }; }; CharSetFromFontName: PROC [fontName: ROPE] RETURNS [CARDINAL] ~ { c: CARDINAL _ 0; b: CARDINAL _ 1; size: INT ~ Rope.Size[fontName]; i: INT _ size-1; ch: CHAR _ 0C; WHILE i > 0 DO ch _ Rope.Fetch[fontName, i]; SELECT ch FROM IN ['0..'8) => {IF b > 255 THEN EXIT; c _ c + b*(ch-'0); b _ b * 8}; ENDCASE => EXIT; i _ i-1; ENDLOOP; IF i = size-1 THEN RETURN [CARDINAL.LAST]; -- no digits IF i < 2 THEN RETURN [CARDINAL.LAST]; -- not enough left for valid name IF NOT (ch='c OR ch='C) THEN RETURN [CARDINAL.LAST]; -- missing "c" IF NOT Rope.Fetch[fontName, i-1] = '- THEN RETURN [CARDINAL.LAST]; -- missing "-" RETURN [c]; }; FindMapping: PROC [charSetVersion: ROPE, shortName: ROPE] RETURNS [CharSetMapper] ~ { <fonts>xerox>xc*>shortName-c#.*, where `xc*' denotes the character set version, shortName is the main part of the font name, with any qualifiers, and # is the character set number.>> charSetMapper: CharSetMapper _ NIL; pattern: ROPE ~ Rope.Cat["///fonts/xerox/xc*/", shortName, "-c*.*"]; matches: LIST OF ROPE _ NIL; matchedVersion: ROPE _ NIL; nameProc: PROC [fullFName: ROPE] RETURNS [continue: BOOL _ TRUE] ~ { csVersion: ROPE ~ CSVersionFromFileName[fullFName]; IF NOT Rope.Equal[csVersion, matchedVersion, FALSE] THEN { IF Rope.Compare[matchedVersion, charSetVersion, FALSE] IN [equal..greater] THEN RETURN [continue: FALSE]; matchedVersion _ csVersion; matches _ NIL; }; matches _ CONS[fullFName, matches]; }; FS.EnumerateForNames[pattern: pattern, proc: nameProc]; FOR each: LIST OF ROPE _ matches, each.rest UNTIL each = NIL DO fontName: ROPE ~ FontNameFromFileName[each.first]; charSet: CARDINAL ~ CharSetFromFontName[fontName]; IF charSet IN [0..255) AND NOT In[charSet, charSetMapper] THEN { newTypeface: Typeface _ NIL; newTypeface _ Find[fontName ! Imager.Error => CONTINUE]; IF newTypeface # NIL THEN charSetMapper _ InsertInOrder[[charSet, newTypeface], charSetMapper]; }; ENDLOOP; RETURN [charSetMapper] }; charSetMapClass: TypefaceClass ~ NEW[TypefaceClassRep _ [ type: $CharSetMapper, Contains: CharSetMapContains, NextChar: CharSetMapNextChar, Width: CharSetMapWidth, Amplified: CharSetMapAmplified, Correction: CharSetMapCorrection, BoundingBox: CharSetMapBoundingBox, FontBoundingBox: CharSetMapFontBoundingBox, Ligature: CharSetMapLigature, Kern: CharSetMapKern, NextKern: CharSetMapNextKern, Mask: CharSetMapMask ]]; MapTypeface: PROC [self: Typeface, char: XChar] RETURNS [Typeface] ~ { charSetMapper: CharSetMapper ~ NARROW[self.data]; FOR each: LIST OF CharSetEntry _ charSetMapper, each.rest UNTIL each = NIL DO IF each.first.charSet = char.set THEN RETURN[each.first.newTypeface]; ENDLOOP; RETURN [NIL] }; CharSetMapContains: PROC [self: Typeface, char: XChar] RETURNS [BOOL] ~ { mapped: Typeface ~ MapTypeface[self, char]; IF mapped = NIL THEN RETURN [FALSE]; RETURN [mapped.class.Contains[mapped, [set: 0, code: char.code]]]; }; CharSetMapNextChar: PROC [self: Typeface, char: XChar] RETURNS [next: XChar] ~ { <> ch: WORD _ LOOPHOLE[char, WORD]+1; UNTIL self.class.Contains[self, LOOPHOLE[ch]] OR ch = WORD.LAST DO ch _ ch + 1; ENDLOOP; next _ LOOPHOLE[ch]; }; CharSetMapWidth: PROC [self: Typeface, char: XChar] RETURNS [VEC] ~ { mapped: Typeface ~ MapTypeface[self, char]; IF mapped = NIL THEN RETURN [[0.5, 0]]; RETURN [mapped.class.Width[mapped, [set: 0, code: char.code]]]; }; CharSetMapAmplified: PROC [self: Typeface, char: XChar] RETURNS [BOOL] ~ { mapped: Typeface ~ MapTypeface[self, char]; IF mapped = NIL THEN RETURN [FALSE]; RETURN [mapped.class.Amplified[mapped, [set: 0, code: char.code]]]; }; CharSetMapCorrection: PROC [self: Typeface, char: XChar] RETURNS [ImagerFont.CorrectionType] ~ { mapped: Typeface ~ MapTypeface[self, char]; IF mapped = NIL THEN RETURN [none]; RETURN [mapped.class.Correction[mapped, [set: 0, code: char.code]]]; }; defaultExtents: Extents ~ [leftExtent: -0.1, rightExtent: 0.4, descent: 0, ascent: 0.7]; CharSetMapBoundingBox: PROC [self: Typeface, char: XChar] RETURNS [Extents] ~ { mapped: Typeface ~ MapTypeface[self, char]; IF mapped = NIL THEN RETURN [defaultExtents]; RETURN [mapped.class.BoundingBox[mapped, [set: 0, code: char.code]]]; }; CharSetMapFontBoundingBox: PROC [self: Typeface] RETURNS [Extents] ~ { charSetMapper: CharSetMapper ~ NARROW[self.data]; box: Imager.Box _ [999999, 999999, -999999, -999999]; BoundPoint: PROC [x, y: REAL] ~ INLINE { IF x < box.xmin THEN box.xmin _ x; IF x > box.xmax THEN box.xmax _ x; IF y < box.ymin THEN box.ymin _ y; IF y > box.ymax THEN box.ymax _ y; }; FOR each: CharSetMapper _ charSetMapper, each.rest UNTIL each = NIL DO mapped: Typeface ~ each.first.newTypeface; e: Extents _ mapped.class.FontBoundingBox[mapped]; bb: Imager.Box _ ImagerBox.BoxFromExtents[e]; BoundPoint[bb.xmin, bb.ymin]; BoundPoint[bb.xmax, bb.ymax]; ENDLOOP; IF box.xmin > box.xmax THEN RETURN [[0,0,0,0]]; RETURN [ImagerBox.ExtentsFromBox[box]] }; CharSetMapLigature: PROC [self: Typeface, char, successor: XChar] RETURNS [XChar] ~ { <> RETURN [nullXChar] }; CharSetMapNextLigature: PROC [self: Typeface, char, successor: XChar] RETURNS [XChar] ~ { RETURN [nullXChar] }; CharSetMapKern: PROC [self: Typeface, char, successor: XChar] RETURNS [VEC] ~ { RETURN [[0, 0]] }; CharSetMapNextKern: PROC [self: Typeface, char, successor: XChar] RETURNS [XChar] ~ { RETURN [nullXChar] }; CharSetMapMask: PROC [self: Typeface, char: XChar, context: Imager.Context] ~ { mapped: Typeface ~ MapTypeface[self, char]; IF mapped = NIL THEN Imager.MaskBox[context, ImagerBox.BoxFromExtents[defaultExtents]] ELSE mapped.class.Mask[mapped, [set: 0, code: char.code], context]; }; RegisterGenericCreator[NEW[GenericCreatorRep _ [data: NIL, proc: XCGenericCreator, priority: 0]]]; END.