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 USING [Error], ImagerTypeface USING [BYTE, CorrectionType, CreateProc, InfoTable, InfoTableRep, Typeface, XChar], ImagerTypefaceExtras USING [GenericCreator], ImagerTypefaceExtrasExtras, IO USING [PutFR1, rope], RefText USING [AppendRope, ObtainScratch, ReleaseScratch], Rope USING [Cat, Concat, Equal, FromRefText, Length, ROPE, Substr, Translate, TranslatorType], SymTab USING [Create, Delete, Fetch, Insert, Pairs, Ref, Store]; ImagerTypefaceImpl: CEDAR MONITOR IMPORTS Atom, Convert, FS, Imager, IO, RefText, Rope, SymTab EXPORTS ImagerTypeface, ImagerTypefaceExtras, ImagerTypefaceExtrasExtras ~ BEGIN OPEN ImagerTypeface; ROPE: TYPE ~ Rope.ROPE; 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; GenericCreator: TYPE ~ ImagerTypefaceExtras.GenericCreator; 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]; }; END. ΆImagerTypefaceImpl.mesa Copyright c 1984, 1985 by Xerox Corporation. All rights reserved. Doug Wyatt, May 27, 1985 1:47:52 pm PDT Michael Plass, March 6, 1986 1:39:51 pm PST Κ¬˜codešœ™Kšœ Οmœ7™BK™'K™+—K™šΟk ˜ Kšœžœ˜!Kšœ žœžœ ˜Kšœžœ˜Kšžœžœ˜‰Kšœžœ ˜KšœžœžœH˜bKšœžœ˜,Kšœ˜Kšžœžœ˜Kšœžœ-˜:Kšœžœ+žœ%˜^Kšœžœ4˜@—K˜KšΠblœžœž˜!Kšžœžœ žœ˜