<> <> <> <> DIRECTORY FS, Convert, FileNames, GGBasicTypes, GGError, GGModelTypes, GGParseIn, GGUtility, Imager, ImagerTransformation, Interpress, IO, IPMaster, Real, Rope, ViewerClasses; GGUtilityImpl: CEDAR PROGRAM IMPORTS Convert, FileNames, GGError, GGParseIn, FS, Imager, Interpress, IO, IPMaster, Real, Rope EXPORTS GGUtility = BEGIN ROPE: TYPE = Rope.ROPE; BitVector: TYPE = GGBasicTypes.BitVector; FeatureData: TYPE = GGModelTypes.FeatureData; Outline: TYPE = GGModelTypes.Outline; Sequence: TYPE = GGModelTypes.Sequence; Slice: TYPE = GGModelTypes.Slice; SliceDescriptor: TYPE = GGModelTypes.SliceDescriptor; Traj: TYPE = GGModelTypes.Traj; Viewer: TYPE = ViewerClasses.Viewer; Problem: PUBLIC SIGNAL [msg: Rope.ROPE] = CODE; EntityNotFound: PUBLIC SIGNAL = CODE; <> <<>> <<>> <> <> <> <> <<[beforeEnt, ent, afterEnt] _ Find
TypeAndNeighbors[entity, entityList];>> <> <> <> <> <> <<};>> <<}; -- end of Delete
TypeFromList>> <> <> <> <> <> <> <> <> <> <> <> <<};>> <<>> <> <<>> StartFeatureDataList: PUBLIC PROC [] RETURNS [entityList, ptr: LIST OF FeatureData] = { ptr _ entityList _ NIL; }; AddFeatureData: PUBLIC PROC [entity: FeatureData, entityList, ptr: LIST OF FeatureData] RETURNS [newList, newPtr: LIST OF FeatureData] = { IF ptr = NIL THEN { IF NOT entityList = NIL THEN ERROR; newPtr _ newList _ CONS[entity, NIL]; RETURN; } ELSE { newList _ entityList; ptr.rest _ CONS[entity, NIL]; newPtr _ ptr.rest; }; }; <> DeleteSequenceFromList: PUBLIC PROC [seq: Sequence, seqList: LIST OF Sequence] RETURNS [smallerList: LIST OF Sequence] = { beforeEnt, ent, afterEnt: LIST OF Sequence; notFound: BOOL _ FALSE; [beforeEnt, ent, afterEnt] _ FindSequenceAndNeighbors[seq, seqList]; IF notFound THEN RETURN[seqList]; IF beforeEnt = NIL THEN smallerList _ afterEnt ELSE { beforeEnt.rest _ afterEnt; smallerList _ seqList; }; }; -- end of DeleteSequenceFromList FindSequenceAndNeighbors: PROC [entity: Sequence, entityList: LIST OF Sequence] RETURNS [beforeEnt, ent, afterEnt: LIST OF Sequence] = { lastE: LIST OF Sequence _ NIL; eList: LIST OF Sequence _ entityList; IF eList = NIL THEN ERROR EntityNotFound; UNTIL eList = NIL DO IF eList.first = entity THEN { beforeEnt _ lastE; ent _ eList; afterEnt _ eList.rest; RETURN}; lastE _ eList; eList _ eList.rest; ENDLOOP; SIGNAL Problem[msg: "sequence not found."]; }; AppendSequenceList: PUBLIC PROC [list1, list2: LIST OF Sequence] RETURNS [result: LIST OF Sequence] = { pos: LIST OF Sequence; newCell: LIST OF Sequence; <> IF list1 = NIL THEN RETURN[list2]; result _ CONS[list1.first, NIL]; pos _ result; FOR l: LIST OF Sequence _ list1.rest, l.rest UNTIL l = NIL DO newCell _ CONS[l.first, NIL]; pos.rest _ newCell; pos _ newCell; ENDLOOP; pos.rest _ list2; }; -- end of AppendSequenceList StartSequenceList: PUBLIC PROC [] RETURNS [entityList, ptr: LIST OF Sequence] = { ptr _ entityList _ NIL; }; AddSequence: PUBLIC PROC [entity: Sequence, entityList, ptr: LIST OF Sequence] RETURNS [newList, newPtr: LIST OF Sequence] = { IF ptr = NIL THEN { IF NOT entityList = NIL THEN ERROR; newPtr _ newList _ CONS[entity, NIL]; RETURN; } ELSE { newList _ entityList; ptr.rest _ CONS[entity, NIL]; newPtr _ ptr.rest; }; }; <> <<>> <> StartList: PUBLIC PROC [] RETURNS [entityList, ptr: LIST OF REF ANY] = { ptr _ entityList _ NIL; }; AddEntity: PUBLIC PROC [entity: REF ANY, entityList, ptr: LIST OF REF ANY] RETURNS [newList, newPtr: LIST OF REF ANY] = { IF ptr = NIL THEN { IF NOT entityList = NIL THEN ERROR; newPtr _ newList _ CONS[entity, NIL]; RETURN; } ELSE { newList _ entityList; ptr.rest _ CONS[entity, NIL]; newPtr _ ptr.rest; }; }; <<>> <> <<>> AppendNATs: PUBLIC PROC [list1, list2: LIST OF NAT] RETURNS [result: LIST OF NAT] = { pos: LIST OF NAT; newCell: LIST OF NAT; <> IF list1 = NIL THEN RETURN[list2]; result _ CONS[list1.first, NIL]; pos _ result; FOR l: LIST OF NAT _ list1.rest, l.rest UNTIL l = NIL DO newCell _ CONS[l.first, NIL]; pos.rest _ newCell; pos _ newCell; ENDLOOP; pos.rest _ list2; }; StartNATList: PUBLIC PROC [] RETURNS [entityList, ptr: LIST OF NAT] = { ptr _ entityList _ NIL; }; StartTrajList: PUBLIC PROC [] RETURNS [entityList, ptr: LIST OF Traj] = { ptr _ entityList _ NIL; }; StartSDList: PUBLIC PROC [] RETURNS [entityList, ptr: LIST OF SliceDescriptor] = { ptr _ entityList _ NIL; }; StartOutlineList: PUBLIC PROC [] RETURNS [entityList, ptr: LIST OF Outline] = { ptr _ entityList _ NIL; }; StartSliceList: PUBLIC PROC [] RETURNS [entityList, ptr: LIST OF Slice] = { ptr _ entityList _ NIL; }; <<>> <> <> <> <<};>> <> <> <> <> <> <<}>> <> <> <> <> <<};>> <<};>> AddOutline: PUBLIC PROC [entity: Outline, entityList, ptr: LIST OF Outline] RETURNS [newList, newPtr: LIST OF Outline] = { IF ptr = NIL THEN { IF NOT entityList = NIL THEN ERROR; newPtr _ newList _ CONS[entity, NIL]; RETURN; } ELSE { newList _ entityList; ptr.rest _ CONS[entity, NIL]; newPtr _ ptr.rest; }; }; AddSlice: PUBLIC PROC [entity: Slice, entityList, ptr: LIST OF Slice] RETURNS [newList, newPtr: LIST OF Slice] = { IF ptr = NIL THEN { IF NOT entityList = NIL THEN ERROR; newPtr _ newList _ CONS[entity, NIL]; RETURN; } ELSE { newList _ entityList; ptr.rest _ CONS[entity, NIL]; newPtr _ ptr.rest; }; }; AddNAT: PUBLIC PROC [entity: NAT, entityList, ptr: LIST OF NAT] RETURNS [newList, newPtr: LIST OF NAT] = { IF ptr = NIL THEN { IF NOT entityList = NIL THEN ERROR; newPtr _ newList _ CONS[entity, NIL]; RETURN; } ELSE { newList _ entityList; ptr.rest _ CONS[entity, NIL]; newPtr _ ptr.rest; }; }; AddTraj: PUBLIC PROC [entity: Traj, entityList, ptr: LIST OF Traj] RETURNS [newList, newPtr: LIST OF Traj] = { IF ptr = NIL THEN { IF NOT entityList = NIL THEN ERROR; newPtr _ newList _ CONS[entity, NIL]; RETURN; } ELSE { newList _ entityList; ptr.rest _ CONS[entity, NIL]; newPtr _ ptr.rest; }; }; AddSD: PUBLIC PROC [entity: SliceDescriptor, entityList, ptr: LIST OF SliceDescriptor] RETURNS [newList, newPtr: LIST OF SliceDescriptor] = { IF ptr = NIL THEN { IF NOT entityList = NIL THEN ERROR; newPtr _ newList _ CONS[entity, NIL]; RETURN; } ELSE { newList _ entityList; ptr.rest _ CONS[entity, NIL]; newPtr _ ptr.rest; }; }; <> <<>> BreakIntervalMOD: PUBLIC PROC [start, end, mod: NAT] RETURNS [s1, e1, s2, e2: INT] = { IF start >= mod OR end >= mod THEN ERROR; IF start <= end THEN RETURN[start, end, -1, -1]; RETURN[0, end, start, mod-1]; }; BreakIntervalMODLen: PUBLIC PROC [start, len, mod: NAT] RETURNS [s1, len1, s2, len2: INT] = { < [0, 3, 6, 1].>> < [2, 5, -1, -1].>> < [0, 7, 6, 1]. -- repeats 6 twice>> IF start >= mod OR len > mod + 1 THEN ERROR; IF start + len -1 < mod THEN RETURN[start, len, -1, -1]; RETURN[0, start+len-mod, start, mod-start]; }; InMODRegion: PUBLIC PROC [test: NAT, start, end, mod: NAT] RETURNS [BOOL] = { IF start = end THEN RETURN [test = start]; IF start < end THEN RETURN [test IN [start..end]]; RETURN [test IN [start..mod) OR test IN [0..end]]; }; <> <<>> AllFalse: PUBLIC PROC [bitvec: BitVector] RETURNS [BOOL] = { FOR i: NAT IN [0..bitvec.len) DO IF bitvec[i] = TRUE THEN RETURN[FALSE]; ENDLOOP; RETURN[TRUE]; }; AllTrue: PUBLIC PROC [bitvec: BitVector] RETURNS [BOOL] = { FOR i: NAT IN [0..bitvec.len) DO IF bitvec[i] = FALSE THEN RETURN[FALSE]; ENDLOOP; RETURN[TRUE]; }; <> <<>> GetInterpressFileName: PUBLIC PROC [ipName: Rope.ROPE, currentWDir: Rope.ROPE, feedback: Viewer] RETURNS [fullName: Rope.ROPE _ NIL, success: BOOL _ TRUE] = { cp: FS.ComponentPositions; IF Rope.Length[ipName]=0 OR Rope.Equal[ipName, ""] THEN { GGError.AppendHerald[feedback, "Select an Interpress file name", oneLiner]; GGError.Blink[feedback]; RETURN[NIL, FALSE]; }; [fullName, cp, ] _ FS.ExpandName[ipName, currentWDir ! FS.Error => { GGError.Append[feedback, "... FS Error during name expansion", oneLiner]; GGError.Blink[feedback]; success _ FALSE; CONTINUE; } ]; IF NOT success THEN RETURN; IF Rope.Equal[Rope.Substr[fullName, cp.ext.start, cp.ext.length], "gargoyle", FALSE] THEN { GGError.Append[feedback, " .gargoyle extension for IP files not allowed", oneLiner]; GGError.Blink[feedback]; success _ FALSE; RETURN; }; IF cp.ext.length=0 THEN fullName _ Rope.Concat[fullName, ".IP"]; }; OpenInterpressOrComplain: PUBLIC PROC [feedback: Viewer, fullName: Rope.ROPE] RETURNS [ipMaster: Interpress.Master, success: BOOL] = { success _ TRUE; ipMaster _ Interpress.Open[fileName: fullName, log: NIL ! FS.Error => { GGError.Append[feedback, error.explanation, oneLiner]; GOTO Quit; }; IPMaster.Error => { --ErrorDesc: TYPE = RECORD[code: ATOM, explanation: ROPE] GGError.Append[feedback, Rope.Cat[error.explanation, " for ", fullName], oneLiner]; GOTO Quit; }; Imager.Error => { --ErrorDesc: TYPE = RECORD [code: ATOM, explanation: ROPE] GGError.Append[feedback, Rope.Cat[error.explanation, " for ", fullName], oneLiner]; GOTO Quit; }; IO.Error, IO.EndOfStream => { GGError.Append[feedback, Rope.Cat["IO Stream Error for ", fullName], oneLiner]; GOTO Quit; }; ]; IF ipMaster.pages=0 THEN { GGError.Append[feedback, Rope.Concat["Zero pages in ", fullName], oneLiner]; GOTO Quit; }; EXITS Quit => { GGError.Blink[feedback]; success _ FALSE; }; }; GetGargoyleFileName: PUBLIC PROC [ggName: Rope.ROPE, currentWDir: Rope.ROPE, feedback: Viewer, emergency: BOOL _ FALSE] RETURNS [fullName: Rope.ROPE _ NIL, success: BOOL _ TRUE, versionSpecified: BOOL _ FALSE] = { cp: FS.ComponentPositions; versionSpecified _ Rope.SkipTo[s: ggName, skip: "!"]#Rope.Length[ggName]; IF Rope.Length[ggName]=0 OR Rope.Equal[ggName, ""] THEN { IF NOT emergency THEN { GGError.PutF[feedback, oneLiner, "No filename specified"]; GGError.Blink[feedback]; }; RETURN[NIL, FALSE]; }; [fullName, cp, ] _ FS.ExpandName[ggName, currentWDir ! FS.Error => { success _ FALSE; IF NOT emergency THEN { GGError.PutF[feedback, oneLiner, "FS Error during name expansion of %g", [rope[ggName]]]; GGError.Blink[feedback]; }; CONTINUE; } ]; IF success AND (Rope.Equal[s1: Rope.Substr[base: fullName, start: cp.ext.start, len: cp.ext.length], s2: "IP", case: FALSE] OR Rope.Equal[s1: Rope.Substr[base: fullName, start: cp.ext.start, len: cp.ext.length], s2: "interpress", case: FALSE]) THEN { IF NOT emergency THEN { GGError.Append[feedback, " Interpress extension for Gargoyle files not allowed", oneLiner]; GGError.Blink[feedback]; }; success _ FALSE; }; IF success AND cp.ext.length=0 THEN fullName _ Rope.Concat[fullName, ".gargoyle"]; }; <> ParseFontData: 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" }; ParseLiteralFontData: PUBLIC PROC [inStream: IO.STREAM, nameP, transformP, sizeP: BOOL _ FALSE] RETURNS [fail: BOOL, fontName: Rope.ROPE, transform: ImagerTransformation.Transformation, size: REAL _ 0.0] = { ENABLE IO.Error, IO.EndOfStream, Convert.Error, GGParseIn.SyntaxError => { fail _ TRUE; CONTINUE; }; fail _ FALSE; IF nameP THEN fontName _ IO.GetTokenRope[inStream, IO.IDProc].token; -- "xerox/myfonts/Helvetica-bir" IF transformP THEN transform _ GGParseIn.ReadFactoredTransformation[inStream]; IF sizeP THEN size _ Convert.RealFromRope[IO.GetTokenRope[inStream, IO.IDProc].token]; -- "12" }; FontDataFromUserData: PUBLIC PROC [prefix, family, face: Rope.ROPE, size: REAL, preferredSize: REAL] RETURNS [fontName: Rope.ROPE, fontSize: REAL _ 1.0, fontPreferredSize: REAL, problem: Rope.ROPE] = { <> <> << 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]>> <<>> pressPrefix: Rope.ROPE _ "xerox/pressfonts/"; printPrefix: Rope.ROPE _ "xerox/xc1-2-2/"; screenPrefix: Rope.ROPE _ "xerox/tiogafonts/"; cmrFamily: Rope.ROPE _ "CMR"; faceRope: Rope.ROPE; SELECT TRUE FROM Rope.Equal[prefix, pressPrefix, FALSE] => { faceRope _ SELECT TRUE FROM Rope.Equal[face, "-B", FALSE] => "-brr", Rope.Equal[face, "-I", FALSE] => "-mir", Rope.Equal[face, "-BI", FALSE] => "-bir", Rope.Equal[face, "-IB", FALSE] => "-bir", ENDCASE => IF Rope.Equal[Rope.Substr[base: family, start: 0, len: 3], cmrFamily, FALSE] THEN "" ELSE "-mrr"; }; Rope.Equal[prefix, printPrefix, FALSE] => { faceRope _ SELECT TRUE FROM Rope.Equal[face, "-B", FALSE] => "-bold", Rope.Equal[face, "-I", FALSE] => "-italic", Rope.Equal[face, "-BI", FALSE] => "-bold-italic", Rope.Equal[face, "-IB", FALSE] => "-bold-italic", ENDCASE => ""; }; Rope.Equal[prefix, screenPrefix, FALSE] => { IF Real.Float[Real.Fix[preferredSize]] # preferredSize THEN RETURN[NIL, size, preferredSize, "Preferred size must be an integer."]; faceRope _ SELECT TRUE FROM Rope.Equal[face, "-B", FALSE] => "B", Rope.Equal[face, "-I", FALSE] => "I", Rope.Equal[face, "-BI", FALSE] => "BI", Rope.Equal[face, "-IB", FALSE] => "BI", ENDCASE => ""; faceRope _ Rope.Concat[Convert.RopeFromInt[from: Real.Fix[preferredSize], showRadix: FALSE], faceRope]; }; ENDCASE => RETURN[Rope.Cat[prefix, family, face], size, preferredSize, NIL]; -- may not be the right thing to do RETURN[Rope.Cat[prefix, family, faceRope], size, preferredSize, NIL]; }; UserDataFromFontData: PUBLIC PROC [fontName: Rope.ROPE, fontSize: REAL _ 0.0, fontPreferredSize: REAL _ 0.0] RETURNS [prefix, family, face: Rope.ROPE, size: REAL _ -1.0, preferredSize: REAL _ -1.0, problem: Rope.ROPE] = { isBold, isItalic: BOOL _ FALSE; familyFace: 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"; prefix _ FileNames.Directory[fontName]; -- xerox/foofonts/ SELECT TRUE FROM Rope.Equal[prefix, pressPrefix, FALSE] => { familyFace _ FileNames.GetShortName[fontName]; -- Helvetica-bir or CMR family _ Head[familyFace, '-]; -- Helvetica face _ FileNames.Tail[fontName, '-]; -- -bir face _ SELECT TRUE FROM Rope.Equal[face, "bir", FALSE] => "-BI", Rope.Equal[face, "brr", FALSE] => "-B", Rope.Equal[face, "mir", FALSE] => "-I", Rope.Equal[face, "mrr", FALSE] => "", ENDCASE => ""; -- maybe should be ERROR ?? <> RETURN[prefix, family, face, 1.0, 1.0, NIL]; -- actual size is in client transform, not known here }; Rope.Equal[prefix, printPrefix, FALSE] => { familyFace _ FileNames.GetShortName[fontName]; -- Modern-bold-italic family _ Head[familyFace, '-]; -- Modern isBold _ Rope.Find[familyFace, dashBold, 0, FALSE]#-1; -- has -bold isItalic _ Rope.Find[familyFace, dashItalic, 0, FALSE]#-1; -- has -italic face _ SELECT TRUE FROM isBold AND isItalic => "-BI", isBold => "-B", isItalic => "-I", ENDCASE => ""; RETURN[prefix, family, face, 1.0, 1.0, NIL]; -- actual size is in client transform, not known here }; Rope.Equal[prefix, screenPrefix, FALSE] => { 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]; }; AlphaProc: IO.BreakProc = { SELECT char FROM IO.TAB, IO.CR, IO.SP => RETURN [break]; IN ['a .. 'z], IN ['A .. 'Z] => RETURN [break]; ENDCASE => RETURN [other]; }; endOfName: BOOL; nameStream: IO.STREAM _ IO.RIS[(familyFace _ FileNames.GetShortName[fontName])]; -- Tioga10BI or TERMINAL family _ IO.GetTokenRope[nameStream, DigitProc].token; -- get the leading alpha characters preferredSize _ Convert.RealFromRope[IO.GetTokenRope[nameStream, AlphaProc ! IO.EndOfStream, IO.Error, Convert.Error => {endOfName _ TRUE; CONTINUE;};].token]; -- get any digit characters face _ GGParseIn.ReadBlankAndWord[nameStream]; face _ IF face=NIL THEN "" ELSE Rope.Concat["-", face]; RETURN[prefix, family, face, 1.0, preferredSize, NIL]; }; ENDCASE => RETURN[NIL, NIL, NIL, 0.0, 0.0, "Unknown font"]; }; Head: PROC [s: ROPE, char: CHAR] RETURNS [ROPE] = { <> <> pos: INT _ s.Length[] - 1; IF pos < 0 THEN RETURN[NIL]; DO IF s.Fetch[pos] = char THEN RETURN[s.Substr[0, pos]]; pos _ pos - 1; IF pos < 0 THEN RETURN[s]; ENDLOOP; }; END.