GGCoreOpsImpl.mesa
Contents: Utility routines extracted from GGUtility and SVUtility and other places.
Copyright © 1986 by Xerox Corporation. All rights reserved.
Bier, January 6, 1992 5:14 pm PST
Pier, October 22, 1987 2:09:53 pm PDT
DIRECTORY
AtomButtons, Basics, Feedback, GGCoreOps, GGCoreTypes, Imager, ImagerColor, ImagerColorPrivate, ImagerTransformation, Rope;
GGCoreOpsImpl:
CEDAR
PROGRAM
IMPORTS Feedback, Imager, ImagerColor, ImagerColorPrivate, ImagerTransformation, Rope
EXPORTS GGCoreOps = BEGIN
Problem: PUBLIC SIGNAL [msg: Rope.ROPE] = Feedback.Problem;
EachEventProc: TYPE = GGCoreOps.EachEventProc;
EachRopeProc: TYPE = PROC [thisRope: Rope.ROPE] RETURNS [done: BOOL ← FALSE];
EventListt: TYPE = REF EventListtObj; -- spelled with two t's to indicate a "List and a Tail pointer"
EventListtObj: TYPE = GGCoreTypes.EventListtObj;
Event: TYPE = GGCoreTypes.Event;
RopeListt: TYPE = REF RopeListtObj;
RopeListtObj: TYPE = GGCoreTypes.RopeListtObj;
ScalarButton: TYPE = AtomButtons.ScalarButton;
NewEventListt:
PUBLIC
PROC []
RETURNS [listt: EventListt] = {
listt ← NEW[EventListtObj ← [NIL, NIL]];
};
FlushEventListt:
PUBLIC
PROC [listt: EventListt] = {
listt.list ← NIL;
listt.tail ← NIL;
};
AppendEvent:
PUBLIC
PROC [event: Event, listt: EventListt] = {
IF listt.tail =
NIL
THEN {
IF NOT listt.list = NIL THEN ERROR;
listt.tail ← listt.list ← LIST[event];
}
ELSE {
listt.tail.rest ← LIST[event];
listt.tail ← listt.tail.rest;
};
};
GetEventList:
PUBLIC
PROC [listt: EventListt]
RETURNS [list:
LIST
OF Event] = {
list ← listt.list;
};
NoEvents:
PUBLIC
PROC [listt: EventListt]
RETURNS [
BOOL] = {
RETURN[listt.list = NIL];
};
ForEachEvent:
PUBLIC
PROC [listt: EventListt, eachEventProc: EachEventProc] = {
done: BOOL ← FALSE;
FOR list:
LIST
OF Event ← listt.list, list.rest
UNTIL list =
NIL
DO
done ← eachEventProc[list.first];
IF done THEN RETURN;
ENDLOOP;
};
NewRopeListt:
PUBLIC
PROC []
RETURNS [listt: RopeListt] = {
listt ← NEW[RopeListtObj ← [NIL, NIL]];
};
FlushRopeListt:
PUBLIC
PROC [listt: RopeListt] = {
listt.list ← NIL;
listt.tail ← NIL;
};
AppendRope:
PUBLIC
PROC [rope: Rope.
ROPE, listt: RopeListt] = {
IF listt.tail =
NIL
THEN {
IF NOT listt.list = NIL THEN ERROR;
listt.tail ← listt.list ← LIST[rope];
}
ELSE {
listt.tail.rest ← LIST[rope];
listt.tail ← listt.tail.rest;
};
};
NoRopes:
PUBLIC
PROC [listt: RopeListt]
RETURNS [
BOOL] = {
RETURN[listt.list = NIL];
};
ForEachRope:
PUBLIC
PROC [listt: RopeListt, eachRopeProc: EachRopeProc] = {
done: BOOL ← FALSE;
FOR list:
LIST
OF Rope.
ROPE ← listt.list, list.rest
UNTIL list =
NIL
DO
done ← eachRopeProc[list.first];
IF done THEN RETURN;
ENDLOOP;
};
Operations on LIST OF REF ANY
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;
};
};
List:
PUBLIC PROC [ref1, ref2, ref3:
REF
ANY ←
NIL]
RETURNS [
LIST
OF
REF
ANY] = {
RETURN[
SELECT
TRUE
FROM
ref2=NIL => LIST[ref1],
ref3=NIL => LIST[ref1, ref2],
ENDCASE => LIST[ref1, ref2, ref3]
];
};
Operations on LIST OF REAL
StartRealList:
PUBLIC
PROC []
RETURNS [entityList, ptr:
LIST
OF
REAL] = {
ptr ← entityList ← NIL;
};
AddReal:
PUBLIC
PROC [entity:
REAL, entityList, ptr:
LIST
OF
REAL]
RETURNS [newList, newPtr:
LIST
OF
REAL] = {
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;
};
};
AppendRealList:
PUBLIC
PROC [list1, list2:
LIST
OF
REAL]
RETURNS [result:
LIST
OF
REAL] = {
pos: LIST OF REAL;
newCell: LIST OF REAL;
Non-destructive (copies the first list).
IF list1 = NIL THEN RETURN[list2];
result ← CONS[list1.first, NIL];
pos ← result;
FOR l:
LIST
OF
REAL ← list1.rest, l.rest
UNTIL l =
NIL
DO
newCell ← CONS[l.first, NIL];
pos.rest ← newCell;
pos ← newCell;
ENDLOOP;
pos.rest ← list2;
};
RealCompareProc: TYPE = PROC[r1: REAL, r2: REAL] RETURNS [Basics.Comparison];
SortRealList:
PUBLIC
PROC [list:
LIST
OF
REAL, ascending:
BOOL ←
TRUE]
RETURNS [sortedList:
LIST
OF
REAL] = {
Sorts the list of REAL using the MergeSort algorithm from ListImpl.
CompareAscending: RealCompareProc = {
IF r1 < r2 THEN RETURN[less];
IF r1 > r2 THEN RETURN[greater]
ELSE RETURN[equal];
};
CompareDescending: RealCompareProc = {
IF r1 > r2 THEN RETURN[less];
IF r1 < r2 THEN RETURN[greater]
ELSE RETURN[equal];
};
IF ascending THEN sortedList ← UniqueSortRealList[list, CompareAscending]
ELSE sortedList ← UniqueSortRealList[list, CompareDescending];
};
SortRealListAux:
PUBLIC PROC [list:
LIST
OF
REAL, compareProc: RealCompareProc]
RETURNS [
LIST
OF
REAL] = {
... destructively sorts the given list in increasing order according to compareProc. The sort is not stable, so order of equal elements is not preserved.
InnerSort:
PROC [head:
LIST
OF
REAL, max:
NAT]
RETURNS [new, next:
LIST
OF
REAL] = {
mid: LIST OF REAL ← (new ← head).rest;
IF mid = NIL THEN RETURN;
next ← mid.rest;
IF compareProc[new.first, mid.first] = greater
THEN {
swap them, leaving mid pointing at the greater.
mid.rest ← new; new ← mid; mid ← head;
};
mid.rest ← NIL;
IF next = NIL THEN RETURN;
Second, grab the second pair of elements off the list. There is at least one.
next ← (mid ← next).rest;
IF next #
NIL
THEN {
There are two elements for the second pair, so we need to put them in order.
temp: LIST OF REAL ← next;
next ← temp.rest;
temp.rest ← NIL;
IF compareProc[mid.first, temp.first] = greater
THEN {
The first two nodes are in the wrong order, so swap them.
mid.rest ← NIL; temp.rest ← mid; mid ← temp}
};
Third, merge the two lead lists. If this exhausts the original list, then return.
new ← MergeRealList[new, mid, compareProc];
IF next = NIL THEN RETURN;
Finally, build up the tree by progressively building small lists and merging them into larger lists. The size doubles at each level. We start with new holding onto a list of 4 elements, and next holding onto the remainder of the list.
FOR depth:
NAT
IN [2..max)
DO
[mid, next] ← InnerSort[next, depth];
new ← MergeRealList[new, mid, compareProc];
IF next = NIL THEN RETURN;
ENDLOOP;
};
IF list = NIL OR list.rest = NIL THEN RETURN [list];
RETURN [InnerSort[list, 32].new];
};
MergeRealList:
PUBLIC
PROC [x,y:
LIST
OF
REAL, compareProc: RealCompareProc]
RETURNS [new:
LIST
OF
REAL] = {
... destructively merges two lists according to compareProc. If the input lists are sorted in increasing order, then the output list will be sorted in increasing order.
Implementation notes:
RC assignments are limited by preserving runs of elements in order.
tail: LIST OF REAL ← NIL;
Test for empty lists
IF x = NIL THEN RETURN [y];
IF y = NIL THEN RETURN [x];
new ← x;
IF compareProc[x.first, y.first] = greater
THEN {new ← y; y ← x; x ← new};
Start from y, which we do by swapping x and y.
DO
We first assume that we have just appended from x, but need to advance x to the next element and check for emptiness. Once this is done we try to stay within x as long as the predicate allows. By doing this we reduce the amount of RC assignments of the form "tail.rest ← ...", which speeds things up considerably.
DO
tail ← x; x ← x.rest;
IF x = NIL THEN {tail.rest ← y; RETURN};
IF compareProc[x.first, y.first] = greater THEN EXIT;
ENDLOOP;
tail.rest ← y;
We have just appended from y, so append to the list from y as long as reasonable.
DO
tail ← y; y ← y.rest;
IF y = NIL THEN {tail.rest ← x; RETURN};
IF compareProc[x.first, y.first] = less THEN EXIT;
ENDLOOP;
tail.rest ← x;
ENDLOOP;
};
UniqueSortRealList:
PUBLIC
PROC [list:
LIST
OF
REAL, compareProc: RealCompareProc]
RETURNS[
LIST
OF
REAL] = {
lag: LIST OF REAL ← list ← SortRealListAux[list, compareProc];
WHILE lag #
NIL
DO
rest: LIST OF REAL ← lag.rest;
IF rest = NIL THEN EXIT;
IF compareProc[lag.first, rest.first] = equal THEN lag.rest ← rest.rest ELSE lag ← rest;
ENDLOOP;
RETURN[list];
};
Operations on LIST OF BOOL
StartBoolList:
PUBLIC
PROC []
RETURNS [entityList, ptr:
LIST
OF
BOOL] = {
ptr ← entityList ← NIL;
};
AddBool:
PUBLIC
PROC [entity:
BOOL, entityList, ptr:
LIST
OF
BOOL]
RETURNS [newList, newPtr:
LIST
OF
BOOL] = {
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;
};
};
AppendBoolList:
PUBLIC
PROC [list1, list2:
LIST
OF
BOOL]
RETURNS [result:
LIST
OF
BOOL] = {
pos: LIST OF BOOL;
newCell: LIST OF BOOL;
Non-destructive (copies the first list).
IF list1 = NIL THEN RETURN[list2];
result ← CONS[list1.first, NIL];
pos ← result;
FOR l:
LIST
OF
BOOL ← list1.rest, l.rest
UNTIL l =
NIL
DO
newCell ← CONS[l.first, NIL];
pos.rest ← newCell;
pos ← newCell;
ENDLOOP;
pos.rest ← list2;
};
Operations on LIST OF NAT
StartNATList:
PUBLIC
PROC []
RETURNS [entityList, ptr:
LIST
OF
NAT] = {
ptr ← entityList ← NIL;
};
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;
};
};
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;
};
Operations on LIST OF ScalarButton
StartScalarButtonList:
PUBLIC
PROC []
RETURNS [entityList, ptr:
LIST
OF ScalarButton] = {
ptr ← entityList ← NIL;
};
AddScalarButton:
PUBLIC
PROC [entity: ScalarButton, entityList, ptr:
LIST
OF ScalarButton]
RETURNS [newList, newPtr:
LIST
OF ScalarButton] = {
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;
};
};
AppendScalarButtons:
PUBLIC
PROC [list1, list2:
LIST
OF ScalarButton]
RETURNS [result:
LIST
OF ScalarButton] = {
pos: LIST OF ScalarButton;
newCell: LIST OF ScalarButton;
Non-destructive (copies the first list).
IF list1 = NIL THEN RETURN[list2];
result ← CONS[list1.first, NIL];
pos ← result;
FOR l:
LIST
OF ScalarButton ← list1.rest, l.rest
UNTIL l =
NIL
DO
newCell ← CONS[l.first, NIL];
pos.rest ← newCell;
pos ← newCell;
ENDLOOP;
pos.rest ← list2;
};
PUChoiceList:
PUBLIC PROC [r0, r1, r2, r3, r4, r5, r6, r7, r8, r9, r10, r11, r12, r13, r14, r15, r16, r17, r18, r19: AtomButtons.PopUpChoice ← [] ]
RETURNS [list: AtomButtons.PopUpChoices] = {
OPEN AtomButtons;
InnerCons: PROC[r: PopUpChoice] = {rList ← CONS[r, rList]; };
rList: PopUpChoices;
IF r0.action#NIL THEN InnerCons[r0];
IF r1.action#NIL THEN InnerCons[r1];
IF r2.action#NIL THEN InnerCons[r2];
IF r3.action#NIL THEN InnerCons[r3];
IF r4.action#NIL THEN InnerCons[r4];
IF r5.action#NIL THEN InnerCons[r5];
IF r6.action#NIL THEN InnerCons[r6];
IF r7.action#NIL THEN InnerCons[r7];
IF r8.action#NIL THEN InnerCons[r8];
IF r9.action#NIL THEN InnerCons[r9];
IF r10.action#NIL THEN InnerCons[r10];
IF r11.action#NIL THEN InnerCons[r11];
IF r12.action#NIL THEN InnerCons[r12];
IF r13.action#NIL THEN InnerCons[r13];
IF r14.action#NIL THEN InnerCons[r14];
IF r15.action#NIL THEN InnerCons[r15];
IF r16.action#NIL THEN InnerCons[r16];
IF r17.action#NIL THEN InnerCons[r17];
IF r18.action#NIL THEN InnerCons[r18];
IF r19.action#NIL THEN InnerCons[r19];
FOR dummy: PopUpChoices ← rList, dummy.rest
UNTIL dummy=
NIL
DO
list ← CONS[dummy.first, list];
ENDLOOP;
};
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]];
};
ExtractRGB:
PUBLIC
PROC [color: ImagerColor.ConstantColor]
RETURNS [r,g,b:
REAL] = {
rgb: ImagerColor.RGB;
IF color=NIL THEN ERROR Problem["NIL color for ExtractRGB"];
rgb ← ImagerColorPrivate.RGBFromColor[color];
r ← rgb.R; g ← rgb.G; b ← rgb.B;
};
EquivalentColors:
PUBLIC
PROC [color1, color2: Imager.Color]
RETURNS [equal:
BOOL ←
FALSE] = {
Does not yet work properly for sampled colors.
r1, g1, b1, r2, g2, b2: REAL;
epsilon: REAL ← 1.0E-2;
success: BOOL ← TRUE;
IF color1=color2 THEN RETURN[TRUE];
IF color1=NIL OR color2=NIL THEN RETURN[FALSE];
WITH color1
SELECT
FROM
color1Constant: ImagerColor.ConstantColor => {
WITH color2
SELECT
FROM
color2Constant: ImagerColor.ConstantColor => {
[r1, g1, b1] ← ExtractRGB[color1Constant];
[r2, g2, b2] ← ExtractRGB[color2Constant];
equal ← (r1=r2
AND g1=g2
AND b1=b2)
OR
(ABS[r1-r2]<epsilon AND ABS[g1-g2]<epsilon AND ABS[b1-b2]<epsilon);
};
ENDCASE => equal ← FALSE;
};
color1SampledBlack: ImagerColor.SampledBlack => {
WITH color2
SELECT
FROM
color2SampledBlack: ImagerColor.SampledBlack => {
equal ← color1SampledBlack.pa = color2SampledBlack.pa
AND
color1SampledBlack.clear = color2SampledBlack.clear
Ignores transformation for now (must be ignored for Imager.Object caching).
};
ENDCASE => equal ← FALSE;
};
color1SampledColor: ImagerColor.SampledColor => {
WITH color2
SELECT
FROM
color2SampledColor: ImagerColor.SampledColor => {
equal ← color1SampledColor.pa = color2SampledColor.pa
AND
color1SampledColor.colorOperator = color2SampledColor.colorOperator
Ignores transformation for now (must be ignored for Imager.Object caching).
};
ENDCASE => equal ← FALSE;
};
ENDCASE => equal ← FALSE;
};
SetColor:
PUBLIC
PROC [dc: Imager.Context, color: Imager.Color, m: Imager.Transformation ←
NIL] = {
Calls Imager.SetColor, Imager.SetSampledColor, or Imager.SetSampledBlack as appropriate. Gargoyle stores the transformation colorView in the sampled color (instead of colorDevice as the Imager would). m is considered to be a transformation from View to View.
IF color = NIL THEN RETURN;
WITH color
SELECT
FROM
sampledBlack: ImagerColor.SampledBlack => {
IF m # NIL
THEN Imager.SetSampledBlack[dc, sampledBlack.pa,
ImagerTransformation.Concat[sampledBlack.um, m], sampledBlack.clear]
ELSE Imager.SetSampledBlack[dc, sampledBlack.pa, sampledBlack.um, sampledBlack.clear];
};
sampledColor: ImagerColor.SampledColor => {
IF m # NIL
THEN Imager.SetSampledColor[dc, sampledColor.pa,
ImagerTransformation.Concat[sampledColor.um, m], sampledColor.colorOperator]
ELSE Imager.SetSampledColor[dc, sampledColor.pa, sampledColor.um, sampledColor.colorOperator];
}
ENDCASE => Imager.SetColor[dc, color];
};
TransformColor:
PUBLIC PROC [color: Imager.Color, view
View: ImagerTransformation.Transformation]
RETURNS [newColor: Imager.Color] = {
um in a transformation is a colorView transformation.
WITH color
SELECT
FROM
sampledBlack: ImagerColor.SampledBlack => {
sampledBlack.um ← ImagerTransformation.Concat[sampledBlack.um, viewView];
};
sampledColor: ImagerColor.SampledColor => {
sampledColor.um ← ImagerTransformation.Concat[sampledColor.um, viewView];
}
ENDCASE => {};
newColor ← color;
};
CopyColor:
PUBLIC PROC [color: Imager.Color]
RETURNS [copy: Imager.Color] = {
WITH color
SELECT
FROM
sampledBlack: ImagerColor.SampledBlack => {
copy ← ImagerColor.MakeSampledBlack[sampledBlack.pa, ImagerTransformation.Copy[sampledBlack.um], sampledBlack.clear];
};
sampledColor: ImagerColor.SampledColor => {
copy ← ImagerColor.MakeSampledColor[sampledColor.pa, ImagerTransformation.Copy[sampledColor.um], sampledColor.colorOperator];
}
ENDCASE => copy ← color;
};
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;
};
END.