GGUtilityImpl.mesa
Last edited by Bier on January 30, 1987 8:33:49 pm PST.
Contents: General Purpose routines for use by Gargoyle.
Pier, February 3, 1987 2:16:44 pm PST
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;
Templates for List Operations
Destructive Delete
DeleteTypeFromList: PUBLIC PROC [entity: Type, entityList: LIST OF Type] RETURNS [smallerList: LIST OF Type] = {
beforeEnt, ent, afterEnt: LIST OF Type;
notFound: BOOL ← FALSE;
[beforeEnt, ent, afterEnt] ← FindTypeAndNeighbors[entity, entityList];
IF notFound THEN RETURN[entityList];
IF beforeEnt = NIL THEN smallerList ← afterEnt
ELSE {
beforeEnt.rest ← afterEnt;
smallerList ← entityList;
};
}; -- end of DeleteTypeFromList
FindTypeAndNeighbors: PROC [entity: Type, entityList: LIST OF Type] RETURNS [beforeEnt, ent, afterEnt: LIST OF Type] = {
lastE: LIST OF Type ← NIL;
eList: LIST OF Type ← entityList;
IF eList = NIL THEN SIGNAL Problem[msg: "msg"];
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: "msg"];
};
Operations on LIST OF FeatureData
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;
};
};
Operations on LIST OF Sequence
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;
Non-destructive (copies the first list).
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;
};
};
Operations on LIST OF REF ANY
Two Finger List Constructor
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;
};
};
Operations on Assorted LIST Types
AppendNATs:
PUBLIC
PROC [list1, list2:
LIST
OF
NAT]
RETURNS [result:
LIST
OF
NAT] = {
pos: LIST OF NAT;
newCell: LIST OF NAT;
Non-destructive (copies the first list).
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;
};
Two Finger List Construction
StartTypeList: PUBLIC PROC [] RETURNS [entityList, ptr: LIST OF Type] = {
ptr ← entityList ← NIL;
};
AddType: PUBLIC PROC [entity: Type, entityList, ptr: LIST OF Type] RETURNS [newList, newPtr: LIST OF Type] = {
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;
};
};
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;
};
};
Modular Arithmetic
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] = {
Example: BreakIntervalMODLen[6, 4, 7] => [0, 3, 6, 1].
BreakIntervalMODLen[2, 5, 7] => [2, 5, -1, -1].
BreakIntervalMODLen[6, 8, 7] => [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]];
};
Operations on Bit Vectors
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];
};
File Names
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"];
};
Font Parsing
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] = {
Used to read in a rope which is data.
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] = {
This routine has the hairy specific knowledge of the formats of font names.
So far: prefix face fontName suffix
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 ??
DOESN'T DO CMR YET
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] = {
Head returns the part of a rope before the last instance of char.
Head returns the entire rope if char is not found
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.