<> <> <> <> <<>> DIRECTORY Convert, FileNames, GGFont, GGParseIn, Imager, ImagerFont, ImagerTransformation, IO, Real, Rope; GGFontImpl: CEDAR --MONITOR-- PROGRAM IMPORTS Convert, FileNames, GGParseIn, Imager, ImagerFont, ImagerTransformation, IO, Real, Rope EXPORTS GGFont = BEGIN ROPE: TYPE = Rope.ROPE; FontData: TYPE = GGFont.FontData; FontDataRec: TYPE = GGFont.FontDataRec; ParseError: PUBLIC ERROR[explanation: ROPE] = CODE; boldList: LIST OF ROPE _ LIST["-B", "-BI"]; italicList: LIST OF ROPE _ LIST["-I", "-BI"]; endList: LIST OF ROPE _ LIST["mrr", "mir", "brr", "bir", "bold", "italic"]; DigitProc: IO.BreakProc = { SELECT char FROM IO.TAB, IO.CR, IO.SP => RETURN [break]; '0, '1, '2, '3, '4, '5, '6, '7, '8, '9 => RETURN [break]; ENDCASE => RETURN [other]; }; NonDigitProc: IO.BreakProc = { SELECT char FROM '0, '1, '2, '3, '4, '5, '6, '7, '8, '9 => RETURN [other]; ENDCASE => RETURN [break]; }; DefaultDefaultFontData: PUBLIC PROC RETURNS [data: FontData] = { data _ CopyFontData[defaultFontData]; }; CreateFontData: PUBLIC PROC RETURNS [data: FontData] = { data _ NEW[FontDataRec _ []]; }; InitFontData: PUBLIC PROC [data: FontData] RETURNS [newData: FontData] = { newData _ data; IF newData#NIL THEN newData^ _ []; -- fill in from definition defaults }; CopyFontData: PUBLIC PROC [data: FontData, oldCopy: FontData _ NIL] RETURNS [newCopy: FontData] = { newCopy _ IF oldCopy#NIL THEN oldCopy ELSE CreateFontData[]; IF data#NIL THEN newCopy^ _ data^; IF newCopy.transform#NIL THEN newCopy.transform _ ImagerTransformation.Copy[newCopy.transform]; }; scratchData: FontData _ NEW[FontDataRec _ []]; ParseFontData: PUBLIC --ENTRY-- PROC [data: FontData _ NIL, inStream: IO.STREAM, literalP, prefixP, familyP, faceP, transformP, scaleP, storedSizeP, designSizeP: BOOL _ FALSE] RETURNS [newData: FontData] = { <> <> Inner: PROC = { DisallowedEnding: PROC [s: Rope.ROPE] RETURNS [BOOL] = { tail: Rope.ROPE _ FileNames.Tail[s, '-]; FOR endRope: LIST OF ROPE _ endList, endRope.rest UNTIL endRope=NIL DO IF Rope.Find[s, endRope.first, 0, FALSE]#-1 THEN RETURN[TRUE]; ENDLOOP; RETURN[FALSE]; }; IF literalP THEN { scratchData.literal _ IO.GetTokenRope[inStream, IO.IDProc].token; -- "xerox/myFonts/FooBarFont" scratchData.prefix _ FileNames.Directory[scratchData.literal]; -- "xerox/myFonts/" scratchData.literalFSF _ FileNames.Tail[scratchData.literal, '/]; -- "FooBarFont" } ELSE { lit: ROPE _ IO.GetTokenRope[inStream, IO.IDProc].token; -- "xerox/xc1-2-2/Modern-BI" IF prefixP THEN { scratchData.prefix _ FileNames.Directory[lit]; -- "xerox/xc1-2-2/" lit _ FileNames.Tail[lit, '/]; -- "Modern-BI" }; IF familyP THEN { IF DisallowedEnding[lit] THEN ParseError["Literal font name not allowed here"]; scratchData.userFSF _ lit; -- "Modern-BI" scratchData.family _ Before[lit, '-]; -- "Modern }; IF faceP THEN { -- means figure out the faces from the userFSF faceRope: ROPE; faceS: IO.STREAM _ IO.RIS[scratchData.userFSF]; -- "Modern-BI" [] _ IO.GetTokenRope[faceS, IO.TokenProc]; -- read and discard family name "Modern" faceRope _ IO.GetTokenRope[faceS, IO.IDProc ! IO.EndOfStream => CONTINUE;].token; -- "-BI or SP in other cases FOR boldRope: LIST OF ROPE _ boldList, boldRope.rest UNTIL boldRope=NIL DO IF scratchData.bold THEN EXIT; scratchData.bold _ Rope.Find[faceRope, boldRope.first, 0, FALSE]#-1; ENDLOOP; FOR italicRope: LIST OF ROPE _ italicList, italicRope.rest UNTIL italicRope=NIL DO IF scratchData.italic THEN EXIT; scratchData.italic _ Rope.Find[faceRope, italicRope.first, 0, FALSE]#-1; ENDLOOP; scratchData.faceKnown _ TRUE; }; scratchData.comfortable _ TRUE; }; <> IF transformP THEN scratchData.transform _ GGParseIn.ReadFactoredTransformationVEC[inStream]; IF scaleP THEN scratchData.scale _ Convert.RealFromRope[IO.GetTokenRope[inStream, IO.IDProc].token]; -- "12 or 20.123 or ..." IF storedSizeP THEN scratchData.storedSize _ Convert.RealFromRope[IO.GetTokenRope[inStream, IO.IDProc].token]; -- "12 or 20.123 or ..." IF designSizeP THEN scratchData.designSize _ Convert.RealFromRope[IO.GetTokenRope[inStream, IO.IDProc].token]; -- "12 or 20.123 or ..." IF literalP THEN UserDataFromFontData[scratchData] ELSE LiteralDataFromFontData[scratchData]; }; -- Inner errorRope: Rope.ROPE; BEGIN newData _ IF data=NIL THEN CreateFontData[] ELSE data; -- prepare newData scratchData^ _ newData^; -- operate on scratch copy in case failure happens while parsing Inner[ ! IO.Error => {errorRope _ "FontName IO Error"; GOTO Error}; IO.EndOfStream => {errorRope _ "FontName EndOfStream"; GOTO Error}; Convert.Error => {errorRope _ "FontName Convert Error"; GOTO Error}; GGParseIn.SyntaxError => {errorRope _ "FontName SyntaxError"; GOTO Error}; ]; <> newData^ _ scratchData^; EXITS Error => ParseError[Rope.Concat[errorRope, ": See GGFontSampler.tioga for syntax"]]; END; }; LiteralDataFromFontData: PUBLIC --ENTRY-- PROC [data: FontData] = { <> <> <> <> << xerox/xc1-2-2/ -B -bold>> << xerox/xc1-2-2/ -I -italic>> << xerox/xc1-2-2/ -BI -bold-italic>> << xerox/xc1-2-2/ -IB -bold-italic>> << xerox/xc1-2-2/ none none>> <<>> << xerox/pressfonts/ -B -brr>> << xerox/pressfonts/ -I -mir>> << xerox/pressfonts/ -BI -bir>> << xerox/pressfonts/ -IB -bir>> << xerox/pressfonts/ none -mrr (unless CMR font)>> <<>> << xerox/tiogafonts/ -B Fix[size]B>> << xerox/tiogafonts/ -I Fix[size]I>> << xerox/tiogafonts/ -BI Fix[size]BI>> << xerox/tiogafonts/ -IB Fix[size]BI>> << xerox/tiogafonts/ none Fix[size]>> <<>> Inner: PROC = { HasEndDigits: PROC RETURNS [yep: BOOL _ FALSE] = { <> ENABLE IO.Error, IO.EndOfStream, Convert.Error => { yep _ FALSE; CONTINUE; }; nameStream: IO.STREAM _ IO.RIS[scratchData.family]; -- Helvetica or cmbbi66 [] _ IO.GetTokenRope[nameStream, DigitProc]; -- toss the leading alpha characters yep _ Convert.IntFromRope[IO.GetTokenRope[nameStream, NonDigitProc].token]>0; -- get any digit characters. Assume font names indicate positive values. }; pressPrefix: Rope.ROPE _ "xerox/pressfonts/"; printPrefix: Rope.ROPE _ "xerox/xc1-2-2/"; screenPrefix: Rope.ROPE _ "xerox/tiogafonts/"; faceRope: Rope.ROPE; SELECT TRUE FROM Rope.Equal[scratchData.prefix, pressPrefix, FALSE] AND scratchData.faceKnown => { faceRope _ SELECT TRUE FROM scratchData.bold AND scratchData.italic => "-bir", scratchData.bold => "-brr", scratchData.italic => "-mir", ENDCASE => IF HasEndDigits[] THEN "" ELSE "-mrr"; }; Rope.Equal[scratchData.prefix, printPrefix, FALSE] AND scratchData.faceKnown => { faceRope _ SELECT TRUE FROM scratchData.bold AND scratchData.italic => "-bold-italic", scratchData.bold => "-bold", scratchData.italic => "-italic", ENDCASE => ""; }; Rope.Equal[scratchData.prefix, screenPrefix, FALSE] => { -- derive storedSize from the font name <> storedSize: REAL _ 1.5; nameStream: IO.STREAM _ IO.RIS[scratchData.userFSF]; -- Tioga10-BI or TERMINAL [] _ IO.GetTokenRope[nameStream, DigitProc]; -- get the leading alpha characters storedSize _ Convert.RealFromRope[IO.GetTokenRope[nameStream, NonDigitProc].token]; -- get any digit characters IF Real.Float[Real.Fix[storedSize]] # storedSize THEN ParseError["StoredSize must be an integer for screen fonts"]; scratchData.storedSize _ storedSize; -- so things come out the right size faceRope _ SELECT TRUE FROM scratchData.bold AND scratchData.italic => "BI", scratchData.bold => "B", scratchData.italic => "I", ENDCASE => ""; }; ENDCASE => NULL; scratchData.literalFSF _ Rope.Concat[scratchData.family, faceRope]; scratchData.literal _ Rope.Concat[scratchData.prefix, scratchData.literalFSF]; }; errorRope: Rope.ROPE; BEGIN IF data=NIL THEN ParseError["NIL Font Data cannot be parsed"]; scratchData^ _ data^; -- operate on scratch copy in case failure happens while parsing Inner[ ! IO.Error => {errorRope _ "FontName IO Error"; GOTO Error}; IO.EndOfStream => {errorRope _ "FontName EndOfStream"; GOTO Error}; Convert.Error => {errorRope _ "FontName Convert Error"; GOTO Error}; GGParseIn.SyntaxError => {errorRope _ "FontName SyntaxError"; GOTO Error}; ]; <> data^ _ scratchData^; EXITS Error => ParseError[Rope.Concat[errorRope, ": (example: Helvetica-BI 18 for SetPressFont)"]]; END; }; UserDataFromFontData: PUBLIC --ENTRY-- PROC [data: FontData] = { <> <> Inner: PROC = { isBold, isItalic: BOOL _ FALSE; userFace, literalFace: Rope.ROPE; pressPrefix: Rope.ROPE _ "xerox/pressfonts/"; printPrefix: Rope.ROPE _ "xerox/xc1-2-2/"; screenPrefix: Rope.ROPE _ "xerox/tiogafonts/"; cmrFamily: Rope.ROPE _ "CMR"; dashBold: Rope.ROPE _ "-bold"; dashItalic: Rope.ROPE _ "-italic"; IF data.literal=NIL OR data.literalFSF=NIL THEN ERROR; data.prefix _ FileNames.Directory[data.literal]; -- xerox/... SELECT TRUE FROM Rope.Equal[data.prefix, pressPrefix, FALSE] => { <> data.family _ Before[data.literalFSF, '-]; -- Helvetica or CMR literalFace _ FileNames.Tail[data.literalFSF, '-]; -- bir or NIL data.bold _ Rope.Equal[literalFace, "bir", FALSE] OR Rope.Equal[literalFace, "brr", FALSE]; data.italic _ Rope.Equal[literalFace, "bir", FALSE] OR Rope.Equal[literalFace, "mir", FALSE]; data.faceKnown _ TRUE; data.comfortable _ TRUE; userFace _ SELECT TRUE FROM Rope.Equal[literalFace, "bir", FALSE] => "-BI", Rope.Equal[literalFace, "brr", FALSE] => "-B", Rope.Equal[literalFace, "mir", FALSE] => "-I", Rope.Equal[literalFace, "mrr", FALSE] => "", ENDCASE => ""; data.userFSF _ Rope.Concat[data.family, userFace]; }; Rope.Equal[data.prefix, printPrefix, FALSE] => { <> data.family _ Before[data.literalFSF, '-]; -- Modern data.bold _ Rope.Find[data.literalFSF, dashBold, 0, FALSE]#-1; -- has -bold data.italic _ Rope.Find[data.literalFSF, dashItalic, 0, FALSE]#-1; -- has -italic data.faceKnown _ TRUE; data.comfortable _ TRUE; userFace _ SELECT TRUE FROM isBold AND isItalic => "-BI", isBold => "-B", isItalic => "-I", ENDCASE => ""; data.userFSF _ Rope.Concat[data.family, userFace]; }; Rope.Equal[data.prefix, screenPrefix, FALSE] => { --Tioga10BI or TERMINAL alphaRope, faceRope, storedSizeRope: Rope.ROPE; storedSize: REAL _ 1.5; --, non integer default used below nameStream: IO.STREAM _ IO.RIS[data.literalFSF]; -- Tioga10BI or TERMINAL alphaRope _ IO.GetTokenRope[nameStream, DigitProc].token; -- get the leading alpha characters storedSizeRope _ IO.GetTokenRope[nameStream, NonDigitProc ! IO.EndOfStream, IO.Error => CONTINUE;].token; -- get any digit characters faceRope _ GGParseIn.ReadBlankAndWord[nameStream]; -- like BI or NIL storedSize _ Convert.RealFromRope[storedSizeRope ! Convert.Error => CONTINUE;]; -- get any digit characters IF Real.Float[Real.Fix[storedSize]] # storedSize THEN ParseError["StoredSize must be an integer for screen fonts"]; data.family _ Rope.Concat[alphaRope, storedSizeRope]; -- concat alpha and numeric parts data.scale _ data.storedSize _ storedSize; -- so things come out the right size. Note that this overides the user input during SetFontLiteral. The rule we use is that if you use a TiogaFont with a size in the name, like Tioga10, we derive the storedSize and scale from the name. IF faceRope#NIL THEN faceRope _ Rope.Concat["-", faceRope]; data.userFSF _ Rope.Concat[data.family, faceRope]; data.faceKnown _ TRUE; data.comfortable _ TRUE; FOR boldRope: LIST OF ROPE _ boldList, boldRope.rest UNTIL boldRope=NIL DO IF data.bold THEN EXIT; data.bold _ Rope.Find[faceRope, boldRope.first, 0, FALSE]#-1; ENDLOOP; FOR italicRope: LIST OF ROPE _ italicList, italicRope.rest UNTIL italicRope=NIL DO IF data.italic THEN EXIT; data.italic _ Rope.Find[faceRope, italicRope.first, 0, FALSE]#-1; ENDLOOP; }; ENDCASE => NULL; }; errorRope: Rope.ROPE; BEGIN Inner[ ! IO.Error => {errorRope _ "IO.Error during font parse"; GOTO Error}; IO.EndOfStream => {errorRope _ "IO.EndOfStream during font parse"; GOTO Error}; Convert.Error => {errorRope _ "Convert.Error during font parse"; GOTO Error}; GGParseIn.SyntaxError => {errorRope _ "GGParseIn.SyntaxError during font parse"; GOTO Error}; ]; EXITS Error => ParseError[errorRope]; END; }; AlternateFont: PUBLIC PROC [data: FontData, font: ImagerFont.Font, op: ATOM] RETURNS [alternate: ImagerFont.Font] = { <> <> IF font=NIL THEN RETURN[NIL]; IF op#$visible THEN RETURN[font]; <> IF Rope.Find[data.prefix, "pressfont", 0, FALSE]#-1 OR Rope.Find[data.prefix, "xc1", 0, FALSE]#-1 THEN { dashIndex: INT _ Rope.Index[data.userFSF, 0, "-"]; -- is there a dash in the userFSF ?? altName: Rope.ROPE _ IF dashIndex=-1 THEN Rope.Cat["xerox/tiogafonts/", data.userFSF, "10"] ELSE Rope.Cat["xerox/tiogafonts/", Rope.Replace[data.userFSF, dashIndex, 1, "10"] ]; alternate _ ImagerFont.Scale[ImagerFont.Find[altName, substituteWithWarning ! Imager.Error, Imager.Warning => {alternate _ font; CONTINUE;}; ], 0.10]; } ELSE alternate _ font; }; Before: PROC [s: Rope.ROPE, char: CHAR] RETURNS [Rope.ROPE] = { <> <> pos: INT _ 0; len: INT _ s.Length[]; IF s=NIL THEN RETURN[NIL]; DO IF s.Fetch[pos] = char THEN RETURN[s.Substr[0, pos]]; pos _ pos + 1; IF pos = len THEN RETURN[s]; ENDLOOP; }; OldParseFontData: PUBLIC PROC [inStream: IO.STREAM, prefixP, familyP, faceP, transformP, sizeP: BOOL _ FALSE] RETURNS [fail: BOOL, prefix, family, face: Rope.ROPE, transform: ImagerTransformation.Transformation, size: REAL _ 0.0] = { ENABLE IO.Error, IO.EndOfStream, Convert.Error, GGParseIn.SyntaxError => { fail _ TRUE; CONTINUE; }; ReadWord: PROC [f: IO.STREAM] RETURNS [word: Rope.ROPE] = { <> WordBreakProc: SAFE PROC [char: CHAR] RETURNS [IO.CharClass] = CHECKED { SELECT char FROM IO.TAB => RETURN [break]; IO.CR =>RETURN [break]; IO.SP => RETURN [break]; ', => RETURN [break]; '] => RETURN [break]; ') => RETURN [break]; ENDCASE => RETURN [other]; }; [word, ----] _ IO.GetTokenRope[f, WordBreakProc !IO.EndOfStream => {word _ NIL; CONTINUE}]; }; nameStream: IO.STREAM; fail _ FALSE; IF prefixP THEN prefix _ IO.GetTokenRope[inStream, IO.IDProc].token; -- "xerox/myfonts/" nameStream _ IO.RIS[IO.GetTokenRope[inStream, IO.IDProc].token]; -- "fontOne-BI" IF familyP THEN family _ IO.GetTokenRope[nameStream, IO.TokenProc].token; -- "fontOne" IF faceP THEN face _ ReadWord[nameStream]; -- "-BI" (or SP) IF transformP THEN transform _ GGParseIn.ReadFactoredTransformation[inStream]; IF sizeP THEN size _ Convert.RealFromRope[IO.GetTokenRope[inStream, IO.IDProc].token]; -- "12" }; defaultFontData: FontData _ NIL; Init: PROC [] = { defaultFontData _ CreateFontData[]; defaultFontData^ _ ["xerox/pressfonts/helvetica-mrr", "xerox/pressfonts/", "helvetica-mrr", "helvetica", "helvetica", ImagerTransformation.Scale[10.0], 1.0,1.0,1.0, TRUE, FALSE, FALSE, TRUE]; }; Init[]; END.