SVUtilityImpl.mesa
Copyright © 1986 by Xerox Corporation. All rights reserved.
Last edited by Bier on February 5, 1987
Contents: Some helpful Solidviews routines that don't fit anywhere in particular.
DIRECTORY
AtomButtonsTypes, CodeTimer, ColorTool, Feedback, FS, Imager, ImagerColor, ImagerColorMap, ImagerDitherContext, Real, RealFns, Rope, SVSceneTypes, SVUtility, Terminal, ViewerClasses, ViewerOps;
SVUtilityImpl:
CEDAR
PROGRAM
IMPORTS CodeTimer, ColorTool, Feedback, FS, ImagerColor, ImagerColorMap, ImagerDitherContext, Real, RealFns, Rope, Terminal, ViewerOps
EXPORTS SVUtility =
BEGIN
FeatureData: TYPE = SVSceneTypes.FeatureData;
FeedbackData: TYPE = AtomButtonsTypes.FeedbackData;
MasterObject: TYPE = SVSceneTypes.MasterObject;
MasterObjectList: TYPE = SVSceneTypes.MasterObjectList;
Slice: TYPE = SVSceneTypes.Slice;
SliceList: TYPE = SVSceneTypes.SliceList;
SliceDescriptor: TYPE = SVSceneTypes.SliceDescriptor;
Viewer: TYPE = ViewerClasses.Viewer;
Problem: PUBLIC SIGNAL [msg: Rope.ROPE] = Feedback.Problem;
EntityNotFound: PUBLIC SIGNAL = CODE;
Algebraic Math
LinearFormula:
PROC [a, b:
REAL]
RETURNS [root:
REAL, rootCount:
NAT] = {
The solution to the equation "ax + b = 0".
IF a = 0
THEN {
IF b = 0 THEN {root ← 0.0; rootCount ← 0; RETURN}
ELSE {root ← 0.0; rootCount ← 0; RETURN} -- inconsistent case
}
ELSE {
IF b = 0 THEN {root ← 0.0; rootCount ← 1; RETURN}
ELSE {root ← -b/a; rootCount ← 1; RETURN};
};
};
QuadraticFormula:
PUBLIC
PROC [a, b, c:
REAL]
RETURNS [roots:
ARRAY [1..2]
OF
REAL, rootCount:
NAT] = {
The solution to the equation "ax2+bx+c=0". If a=0 this is just a linear equation. If
c = 0, one root is zero and we solve a linear equation. Otherwise, we use the
quadratic formula in either the form [-b+-(b2-4ac)1/2]/2a or (2c)/[-b-+(b2-4ac)1/2]
depending on the sign of b. We will arrange the roots so that roots[1] < roots[2].
discriminant, temp: REAL;
IF a = 0
THEN {
[roots[1], rootCount] ← LinearFormula [b, c];
RETURN;
};
IF c = 0
THEN {
roots[1] ← 0.0;
[roots[2], rootCount] ← LinearFormula[a, b];
rootCount ← rootCount + 1;
IF roots[1] > roots[2]
THEN {
-- swap them
temp ← roots[1];
roots[1] ← roots[2];
roots[2] ← temp;
};
RETURN};
discriminant ← b*b - 4*a*c; -- 3 mult, 1 add
SELECT discriminant FROM
=0 => {rootCount ← 1;
roots[1] ← -b/(2*a);
RETURN}; -- 1 mult, 1 div (4 mult, 1 div, 1 add total)
<0 => {rootCount ← 0;
RETURN}; -- (3 mult, 1 add total)
>0 => {
sqrtRadical: REAL ← RealFns.SqRt[discriminant];
term: REAL;
rootCount ← 2;
term ← IF b < 0 THEN sqrtRadical - b ELSE -sqrtRadical - b;
roots[1] ← term/(2.0*a);
roots[2] ← (2.0*c)/term;
IF roots[1] > roots[2]
THEN {
-- swap them
temp ← roots[1];
roots[1] ← roots[2];
roots[2] ← temp;
};
RETURN}; -- 1 SqRt, 2 mult, 2 div, 2 add (1 SqRt, 5 mult, 2 div, 3 add total)
ENDCASE => ERROR;
}; -- end of QuadraticFormula
Operations on LIST OF MasterObject
AppendToMasterObjects:
PUBLIC
PROC [mo: MasterObject, list: MasterObjectList]
RETURNS [MasterObjectList] = {
A copy of List.Nconc1 for MasterObjectList instead of LIST OF REF ANY
z: MasterObjectList ← list;
IF z = NIL THEN RETURN[CONS[mo,NIL]];
UNTIL z.rest = NIL DO z ← z.rest; ENDLOOP;
z.rest ← CONS[mo,NIL];
RETURN[list];
};
AppendToAssemblyList:
PUBLIC PROC [assembly: Slice, list: SliceList]
RETURNS [SliceList] = {
A copy of List.Nconc1 for LIST OF Slice instead of LIST OF REF ANY
z: LIST OF Slice ← list.list;
IF z = NIL THEN {list.list ← CONS[assembly, NIL]; RETURN[list]};
UNTIL z.rest = NIL DO z ← z.rest; ENDLOOP;
z.rest ← CONS[assembly,NIL];
RETURN[list];
};
Operations on LIST OF Slice
StartSliceList:
PUBLIC
PROC []
RETURNS [entityList, ptr:
LIST
OF Slice] = {
ptr ← entityList ← NIL;
};
AddSlice:
PUBLIC
PROC [slice: 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[slice, NIL];
RETURN;
}
ELSE {
newList ← entityList;
ptr.rest ← CONS[slice, NIL];
newPtr ← ptr.rest;
};
};
Operations on LIST OF REF ANY (should use List.mesa)
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 LIST OF SliceDescriptor
StartSliceDescriptorList:
PUBLIC
PROC []
RETURNS [entityList, ptr:
LIST
OF SliceDescriptor] = {
ptr ← entityList ← NIL;
};
AddSliceDescriptor:
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;
};
};
AppendSliceDescriptorList:
PUBLIC
PROC [list1, list2:
LIST
OF SliceDescriptor]
RETURNS [result:
LIST
OF SliceDescriptor] = {
pos: LIST OF SliceDescriptor;
newCell: LIST OF SliceDescriptor;
Non-destructive (copies the first list).
IF list1 = NIL THEN RETURN[list2];
result ← CONS[list1.first, NIL];
pos ← result;
FOR l:
LIST
OF SliceDescriptor ← list1.rest, l.rest
UNTIL l =
NIL
DO
newCell ← CONS[l.first, NIL];
pos.rest ← newCell;
pos ← newCell;
ENDLOOP;
pos.rest ← list2;
};
DeleteSliceDescriptorFromList:
PUBLIC
PROC [sliceD: SliceDescriptor, sliceDList:
LIST
OF SliceDescriptor]
RETURNS [smallerList:
LIST
OF SliceDescriptor] = {
beforeEnt, ent, afterEnt: LIST OF SliceDescriptor;
found: BOOL ← FALSE;
[beforeEnt, ent, afterEnt, found] ← FindSliceDescriptorAndNeighbors[sliceD, sliceDList];
IF NOT found THEN RETURN[sliceDList];
IF beforeEnt = NIL THEN smallerList ← afterEnt
ELSE {
beforeEnt.rest ← afterEnt;
smallerList ← sliceDList;
};
};
FindSliceDescriptorAndNeighbors:
PROC [sliceD: SliceDescriptor, sliceDList:
LIST
OF SliceDescriptor]
RETURNS [beforeEnt, ent, afterEnt:
LIST
OF SliceDescriptor, found:
BOOL ←
FALSE] = {
lastE: LIST OF SliceDescriptor ← NIL;
eList: LIST OF SliceDescriptor ← sliceDList;
IF eList = NIL THEN ERROR EntityNotFound;
UNTIL eList =
NIL
DO
IF eList.first = sliceD
THEN {
beforeEnt ← lastE;
ent ← eList;
afterEnt ← eList.rest;
found ← TRUE;
RETURN;
};
lastE ← eList;
eList ← eList.rest;
ENDLOOP;
};
Operations on LIST OF FeatureData
CopyFeatureList:
PUBLIC
PROC [features:
LIST
OF FeatureData]
RETURNS [copyList:
LIST
OF FeatureData] = {
z: LIST OF FeatureData ← NIL;
IF features = NIL THEN RETURN[NIL];
copyList ← CONS[features.first, NIL];
z ← copyList;
UNTIL (features ← features.rest) =
NIL
DO
z.rest ← CONS[features.first, NIL];
z ← z.rest;
ENDLOOP;
};
FeatureDataNconc:
PUBLIC
PROC [l1, l2:
LIST
OF FeatureData]
RETURNS [bigList:
LIST
OF FeatureData] = {
z: LIST OF FeatureData ← l1;
IF z = NIL THEN RETURN[l2];
UNTIL z.rest = NIL DO z ← z.rest; ENDLOOP;
z.rest ← l2;
RETURN[l1];
};
Filename Operations (factor out as GGFiles in GGCore)
GetInterpressFileName:
PUBLIC
PROC [shortName: Rope.
ROPE, workingDir: Rope.
ROPE, feedback: FeedbackData]
RETURNS [fullName: Rope.
ROPE ←
NIL, success:
BOOL ←
TRUE] = {
[fullName, success, ----] ← GetGenericFileName[shortName, workingDir, "IP", LIST["pic", "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", "pic"], feedback];
};
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];
};
Colors
GetSpecialColor:
PUBLIC
PROC
RETURNS [color: Imager.Color] = {
zeroByte: Terminal.ColorValue = 0;
channel: Terminal.ChannelValue ← 129;
mapEntry: REF ImagerColorMap.MapEntry;
tool: ViewerClasses.Viewer ← ViewerOps.FindViewer["ColorTool"];
IF tool=NIL THEN RETURN[NIL];
mapEntry ← NEW[ImagerColorMap.MapEntry ← [channel, zeroByte, zeroByte, zeroByte] ];
ImagerColorMap.LoadEntries[vt: Terminal.Current[], mapEntries: LIST[mapEntry^], shared: FALSE];
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];
};
Init:
PROC [] = {
[] ← CodeTimer.CreateTable[$Solidviews];
};
Init[];
END.