GGUtilityImpl.mesa
Last edited by Bier on April 9, 1987 11:33:45 pm PDT.
Pier, May 1, 1987 3:04:41 pm PDT
Contents: General Purpose routines for use by Gargoyle.
DIRECTORY
AtomButtonsTypes, CodeTimer, ColorTool, Feedback, FS, GGBasicTypes, GGModelTypes, GGUtility, Imager, ImagerColor, ImagerColorMap, ImagerColorPrivate, ImagerDitherContext, ImagerTransformation, Interpress, IO, --IPMaster,-- Real, Rope, Terminal, ViewerClasses, ViewerOps;
GGUtilityImpl:
CEDAR
PROGRAM
IMPORTS CodeTimer, ColorTool, Feedback, FS, Imager, ImagerColor, ImagerColorMap, ImagerColorPrivate, ImagerDitherContext, Interpress, IO, --IPMaster, --Real, Rope, Terminal, ViewerOps
EXPORTS GGUtility = BEGIN
ROPE: TYPE = Rope.ROPE;
BitVector: TYPE = GGBasicTypes.BitVector;
FeatureData: TYPE = GGModelTypes.FeatureData;
FeedbackData: TYPE = AtomButtonsTypes.FeedbackData;
Outline: TYPE = GGModelTypes.Outline;
Sequence: TYPE = GGModelTypes.Sequence;
SequenceOfReal: TYPE = GGBasicTypes.SequenceOfReal;
SequenceOfRealObj: TYPE = GGBasicTypes.SequenceOfRealObj;
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;
found: BOOL ← FALSE;
[beforeEnt, ent, afterEnt, found] ← FindSequenceAndNeighbors[seq, seqList];
IF NOT found 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, found:
BOOL ←
FALSE] = {
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;
found ← TRUE;
RETURN;
};
lastE ← eList;
eList ← eList.rest;
ENDLOOP;
};
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];
};
GetGenericFileName:
PROC [fileName, wDir, defaultExt: Rope.
ROPE, illegalExts:
LIST
OF Rope.
ROPE, feedback: FeedbackData, emergency:
BOOL ←
FALSE]
RETURNS [fullName: Rope.
ROPE ←
NIL, success:
BOOL ←
TRUE, versionSpecified:
BOOL ←
FALSE] = {
cp: FS.ComponentPositions;
extRope: Rope.ROPE;
versionSpecified ← Rope.SkipTo[s: fileName, skip: "!"]#Rope.Length[fileName];
IF Rope.Length[fileName]=0
OR Rope.Equal[fileName, ""]
THEN {
IF
NOT emergency
THEN {
Feedback.PutF[feedback, oneLiner, "No filename specified"];
Feedback.Blink[feedback];
};
RETURN[NIL, FALSE];
};
[fullName, cp, ] ←
FS.ExpandName[fileName, wDir !
FS.Error => {
success ← FALSE;
IF
NOT emergency
THEN {
Feedback.PutF[feedback, oneLiner, "FS Error during name expansion of %g", [rope[fileName]]];
Feedback.Blink[feedback];
};
CONTINUE;
}
];
IF NOT success THEN RETURN;
extRope ← Rope.Substr[base: fullName, start: cp.ext.start, len: cp.ext.length];
FOR ropeList:
LIST
OF Rope.
ROPE ← illegalExts, ropeList.rest
UNTIL ropeList=
NIL
DO
IF Rope.Equal[ropeList.first, extRope,
FALSE]
THEN {
IF
NOT emergency
THEN {
Feedback.PutF[feedback, oneLiner, "%g extension for %g files not allowed", [rope[extRope]], [rope[defaultExt]] ];
Feedback.Blink[feedback];
};
success ← FALSE; RETURN;
};
ENDLOOP;
IF cp.ext.length=0 THEN fullName ← Rope.Cat[fullName, ".", defaultExt];
};
GetGargoyleFileName:
PUBLIC
PROC [ggName: Rope.
ROPE, currentWDir: Rope.
ROPE, feedback: FeedbackData, emergency:
BOOL ←
FALSE]
RETURNS [fullName: Rope.
ROPE ←
NIL, success:
BOOL ←
TRUE, versionSpecified:
BOOL ←
FALSE] = {
[fullName, success, versionSpecified] ← GetGenericFileName[ggName, currentWDir, "gargoyle", LIST["IP", "interpress", "script", "mesa", "tioga"], feedback, emergency];
};
GetInterpressFileName:
PUBLIC
PROC [ipName: Rope.
ROPE, currentWDir: Rope.
ROPE, feedback: FeedbackData]
RETURNS [fullName: Rope.
ROPE ←
NIL, success:
BOOL ←
TRUE] = {
[fullName, success, ----] ← GetGenericFileName[ipName, currentWDir, "IP", LIST["gargoyle", "script", "mesa", "tioga"], feedback];
};
GetScriptFileName:
PUBLIC
PROC [scriptName: Rope.
ROPE, currentWDir: Rope.
ROPE, feedback: FeedbackData]
RETURNS [fullName: Rope.
ROPE ←
NIL, success:
BOOL ←
TRUE] = {
[fullName, success, ----] ← GetGenericFileName[scriptName, currentWDir, "script", LIST["gargoyle", "IP", "interpress", "mesa", "tioga"], feedback];
};
OpenInterpressOrComplain:
PUBLIC
PROC [feedback: FeedbackData, fullName: Rope.
ROPE]
RETURNS [ipMaster: Interpress.Master, success:
BOOL] = {
LogIt: Interpress.LogProc = {
Feedback.Append[feedback, explanation, oneLiner];
};
success ← TRUE;
ipMaster ← Interpress.Open[fileName: fullName, log: LogIt !
FS.Error => {
Feedback.Append[feedback, error.explanation, oneLiner];
GOTO Quit;
};
IPMaster.Error => { --ErrorDesc: TYPE = RECORD[code: ATOM, explanation: ROPE]
Feedback.Append[feedback, Rope.Cat[error.explanation, " for ", fullName], oneLiner];
GOTO Quit;
};
Imager.Error => {
--ErrorDesc: TYPE = RECORD [code: ATOM, explanation: ROPE]
Feedback.Append[feedback, Rope.Cat[error.explanation, " for ", fullName], oneLiner];
GOTO Quit;
};
IO.Error,
IO.EndOfStream => {
Feedback.Append[feedback, Rope.Cat["IO Stream Error for ", fullName], oneLiner];
GOTO Quit;
};
];
IF ipMaster.pages=0
THEN {
Feedback.Append[feedback, Rope.Concat["Zero pages in ", fullName], oneLiner];
GOTO Quit;
};
EXITS
Quit => {
Feedback.Blink[feedback];
success ← FALSE;
};
};
CopyPattern:
PUBLIC PROC [pattern: SequenceOfReal]
RETURNS [new: SequenceOfReal] = {
IF pattern=NIL THEN RETURN[NIL];
new ← NEW[SequenceOfRealObj[pattern.len]];
FOR index:
NAT
IN [0..pattern.len)
DO
new[index] ← pattern[index];
ENDLOOP;
};
ExtractRGB:
PUBLIC
PROC [color: Imager.Color]
RETURNS [r,g,b:
REAL] = {
rgb: ImagerColor.RGB;
rgb ← ImagerColorPrivate.RGBFromColor[NARROW[color]];
r ← rgb.R; g ← rgb.G; b ← rgb.B;
};
EquivalentColors:
PUBLIC
PROC [color1, color2: Imager.Color]
RETURNS [
BOOL] = {
r1, g1, b1, r2, g2, b2: REAL;
epsilon: REAL ← 1.0E-2;
IF color1=color2 THEN RETURN[TRUE];
[r1, g1, b1] ← ExtractRGB[color1];
[r2, g2, b2] ← ExtractRGB[color2];
RETURN[(r1=r2 AND g1=g2 AND b1=b2) OR (ABS[r1-r2]<epsilon AND ABS[g1-g2]<epsilon AND ABS[b1-b2]<epsilon ) ];
};
GetSpecialColor:
PUBLIC PROC
RETURNS [color: Imager.Color] = {
zeroByte: Terminal.ColorValue = 0;
channel: Terminal.ChannelValue ← 102;
mapEntry: REF ImagerColorMap.MapEntry;
tool: ViewerClasses.Viewer ← ViewerOps.FindViewer["ColorTool"];
IF tool=NIL THEN RETURN[NIL];
mapEntry ← NEW[ImagerColorMap.MapEntry ← [channel, zeroByte, zeroByte, zeroByte] ];
color ← ImagerDitherContext.MakeSpecialColor[ specialPixel: [value: mapEntry.mapIndex, dstFunc: null], ordinaryColor: ImagerColor.ColorFromRGB[ColorTool.GetRGBValue[tool]]];
ColorTool.RegisterNotifyProc[$GG, TrackPatch, mapEntry, tool];
};
TrackPatch:
PROC[rgb: ImagerColor.
RGB, clientData:
REF] = {
-- ColorTool.NotifyProc
ToByte: PROC[v: REAL] RETURNS[Terminal.ColorValue] = { RETURN[Real.Round[v*255]] };
mapEntry: REF ImagerColorMap.MapEntry ← NARROW[clientData];
mapEntry.red ← ToByte[rgb.R];
mapEntry.green ← ToByte[rgb.G];
mapEntry.blue ← ToByte[rgb.B];
ImagerColorMap.LoadEntries[vt: Terminal.Current[],
mapEntries: LIST[mapEntry^], shared: FALSE];
};
Conversions
BoolToRope:
PUBLIC
PROC [bool:
BOOL]
RETURNS [rope: Rope.
ROPE] = {
Returns "T" or "F".
rope ← IF bool THEN "T" ELSE "F";
};
RopeToBool:
PUBLIC
PROC [rope: Rope.
ROPE]
RETURNS [bool:
BOOL] = {
Takes "T" or "F". Raises an Error if rope is anything else.
SELECT
TRUE
FROM
Rope.Equal[rope, "F", FALSE] => bool ← FALSE;
Rope.Equal[rope, "T", FALSE] => bool ← TRUE;
ENDCASE => ERROR;
};
Init:
PROC [] = {
[] ← CodeTimer.CreateTable[$Gargoyle];
};
Init[];
END.