ImagerTypefaceImpl.mesa
Copyright © 1984, 1985, 1986 by Xerox Corporation. All rights reserved.
Doug Wyatt, May 7, 1986 4:42:18 pm PDT
Michael Plass, March 6, 1986 1:39:51 pm PST
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, GenericCreator, InfoTable, InfoTableRep, Typeface, XChar],
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
~ 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: BOOLTRUE] ~ {
someKey: ROPENIL;
epa: PROC [key: ROPE, val: REF] RETURNS [quit: BOOLTRUE] ~ {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: ROPENIL;
cp: FS.ComponentPositions;
nameStart, nameStop: INT ← 0;
fontName, extension: ROPENIL;
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.