DIRECTORY
ViewerConstraints, ViewerConstraintsPrivate,
Process USING [Detach],
RefTab USING [Create, Fetch, Ref, Store],
ViewerEvents USING [EventProc, RegisterEventProc],
ViewerOps USING [AddProp, EstablishViewerPosition, FetchProp, PaintViewer];



ViewerConstraintsImpl: CEDAR MONITOR
IMPORTS Process, RefTab, ViewerEvents, ViewerOps
EXPORTS ViewerConstraints
~ BEGIN
OPEN ViewerConstraints, ViewerConstraintsPrivate;

ConstraintClass: PUBLIC TYPE ~ ViewerConstraintsPrivate.ConstraintClass;
ConstraintClassRep: PUBLIC TYPE ~ ViewerConstraintsPrivate.ConstraintClassRep;
Constraint: PUBLIC TYPE ~ ViewerConstraintsPrivate.Constraint;
ConstraintRep: PUBLIC TYPE ~ ViewerConstraintsPrivate.ConstraintRep;

Error: PUBLIC ERROR [type: ErrorType, reason: ROPE] ~ CODE;

CreateConstraintClass: PUBLIC PROC [enforce: EnforceProc, nFrom, nTo: NAT, classData: REF _ NIL] RETURNS [class: ConstraintClass] ~ {
IF nTo=0 THEN ERROR Error[invalidConstraintClass, "Must have output edges being constrained."];
class _ NEW[ConstraintClassRep _ [
nFrom: nFrom,
nTo: nTo,
enforce: enforce,
classData: classData
]];
};
constraintProp: ARRAY EdgeType OF ATOM ~ [$LeftAffectsConstraints, $RightAffectsConstraints, $TopAffectsConstraints, $BottomAffectsConstraints];
edgeControlledByProp: ARRAY EdgeType OF ATOM ~ [$LeftControlledBy, $RightControlledBy, $TopControlledBy, $BottomControlledBy];
EstablishConstraint: PUBLIC PROC [class: ConstraintClass, fetch: InitProc, instanceData: REF _ NIL] RETURNS [constraint: Constraint] ~ {
ancestor: Viewer;
c: Constraint ~ NEW[ConstraintRep _ [
class: class,
from: NEW[ValuesRep[class.nFrom]],
to: NEW[ValuesRep[class.nTo]],
eFrom: NEW[EdgeSequenceRep[class.nFrom]],
eTo: NEW[EdgeSequenceRep[class.nTo]],
instanceData: instanceData
]];
FOR i: NAT IN [0..class.nTo) DO
c.eTo[i] _ fetch[i: i, from: FALSE];
IF i=0 THEN ancestor _ Ancestor[c.eTo[0].v];
IF Ancestor[c.eTo[i].v]#ancestor THEN ERROR Error[invalidConstraint, "All edges must belong to viewers with a common ancestor."];
ViewerOps.AddProp[viewer: c.eTo[i].v, prop: edgeControlledByProp[c.eTo[i].et], val: c];
ENDLOOP;
FOR i: NAT IN [0..class.nFrom) DO
constraintList: LIST OF Constraint;
c.eFrom[i] _ fetch[i: i, from: TRUE];
IF Ancestor[c.eFrom[i].v]#ancestor THEN ERROR Error[invalidConstraint, "All edges must belong to viewers with a common ancestor."];
constraintList _ CONS[c, NARROW[ViewerOps.FetchProp[viewer: c.eFrom[i].v, prop: constraintProp[c.eFrom[i].et]]]];
ViewerOps.AddProp[viewer: c.eFrom[i].v, prop: constraintProp[c.eFrom[i].et], val: constraintList];
ENDLOOP;
{
cl: LIST OF Constraint _ NARROW[ViewerOps.FetchProp[viewer: ancestor, prop: $ConstraintSystem]];
OrderConstraints[cl _ CONS[c, cl]];
ViewerOps.AddProp[viewer: ancestor, prop: $ConstraintSystem, val: cl];
};
RETURN [c];
};
BreakConstraint: PUBLIC PROC [constraint: Constraint] ~ {
ancestor: Viewer ~ Ancestor[constraint.eTo[0].v];
cl: LIST OF Constraint ~ NARROW[ViewerOps.FetchProp[viewer: ancestor, prop: $ConstraintSystem]];
SELECT TRUE FROM
cl=NIL => ERROR;
cl.first=constraint => ViewerOps.AddProp[viewer: ancestor, prop: $ConstraintSystem, val: cl.rest];
ENDCASE => FOR each: LIST OF Constraint _ cl, each.rest UNTIL each.rest=NIL DO
IF each.rest.first=constraint THEN each.rest _ each.rest.rest;
ENDLOOP;
FOR k: NAT IN [0..constraint.eTo.n) DO
ViewerOps.AddProp[viewer: constraint.eTo[k].v, prop: edgeControlledByProp[constraint.eTo[k].et], val: NIL];	--It's safe to simply remove the property from the propList, since it could only have been controlled by one constraint anyhow.
ENDLOOP;
FOR k: NAT IN [0..constraint.eFrom.n) DO
cl: LIST OF Constraint _ NARROW[ViewerOps.FetchProp[viewer: constraint.eTo[k].v, prop: constraintProp[constraint.eTo[k].et]]];
SELECT TRUE FROM
cl=NIL => {};
cl.first=constraint => ViewerOps.AddProp[viewer: constraint.eTo[k].v, prop: constraintProp[constraint.eTo[k].et], val: cl.rest];
ENDCASE => {	--Don't need to reset the property ... just eliminate the offending party from the list
FOR each: LIST OF Constraint _ cl, each.rest UNTIL each.rest=NIL DO
IF each.rest.first=constraint THEN each.rest _ each.rest.rest;
ENDLOOP;
};
ENDLOOP;
};
BreakConstraintsToEdge: PUBLIC PROC [e: Edge] ~ {
c: Constraint ~ NARROW[ViewerOps.FetchProp[viewer: e.v, prop: edgeControlledByProp[e.et]]];
cl: LIST OF Constraint ~ NARROW[ViewerOps.FetchProp[viewer: e.v, prop: constraintProp[e.et]]];
IF c#NIL THEN BreakConstraint[c];
FOR each: LIST OF Constraint _ cl, each.rest UNTIL each=NIL DO
BreakConstraint[each.first];
ENDLOOP;
};
Suspect: PUBLIC PROC [e: Edge] ~ {
constraintList: LIST OF Constraint _ NARROW[ViewerOps.FetchProp[viewer: e.v, prop: constraintProp[e.et]]];
FOR each: LIST OF Constraint _ constraintList, each.rest UNTIL each=NIL DO
each.first.check _ TRUE;
ENDLOOP;
{	--Note that we need to paint the edge's viewer's parent
ancestor: Viewer ~ Ancestor[e.v];
parent: Viewer ~ IF e.v.parent=NIL THEN e.v ELSE e.v.parent;
toPaint: RefTab.Ref _ NARROW[ViewerOps.FetchProp[viewer: ancestor, prop: $ConstraintToPaint]];
IF toPaint=NIL THEN ViewerOps.AddProp[viewer: ancestor, prop: $ConstraintToPaint, val: toPaint _ RefTab.Create[]];
[] _ RefTab.Store[x: toPaint, key: parent, val: NIL];
};
};
WhatNeedsPainting: PUBLIC PROC [v: Viewer, clear: BOOL _ TRUE] RETURNS [l: LIST OF Viewer _ NIL] ~ {
Check: PROC [viewer: Viewer] ~ {
IF RefTab.Fetch[toPaint, viewer].found THEN l _ CONS[viewer, l]
ELSE FOR each: Viewer _ viewer.child, each.sibling UNTIL each=NIL DO
Check[each];
ENDLOOP;
};
ancestor: Viewer ~ Ancestor[v];
toPaint: RefTab.Ref ~ NARROW[ViewerOps.FetchProp[viewer: ancestor, prop: $ConstraintToPaint]];
IF toPaint=NIL THEN RETURN[NIL];
Check[ancestor];
};
PaintConstraintSystem: PUBLIC ENTRY PROC [v: Viewer, fork: BOOL _ TRUE] ~ {
ENABLE UNWIND => {};
IF fork THEN TRUSTED {
Process.Detach[FORK PaintConstraintSystem[v, FALSE]];
}
ELSE {
EnforceConstraintSystem[v];
FOR each: LIST OF Viewer _ WhatNeedsPainting[v], each.rest UNTIL each=NIL DO
ViewerOps.PaintViewer[viewer: each.first, hint: all];
ENDLOOP;
};
};
EnforceConstraintSystem: PUBLIC PROC [v: Viewer] ~ {
cl: LIST OF Constraint ~ NARROW[ViewerOps.FetchProp[viewer: Ancestor[v], prop: $ConstraintSystem]];
EnforceConstraints[cl];
};
EnforceConstraints: PROC [cl: LIST OF Constraint] ~ {
FOR each: LIST OF Constraint _ cl, each.rest UNTIL each=NIL DO
c: Constraint ~ each.first;
IF c.check THEN {
ToChange: TYPE ~ RECORD [v: Viewer, vals: ARRAY EdgeType OF INTEGER];
toChange: LIST OF ToChange _ NIL;
oldToValues: Values ~ c.to;
c.to _ NEW[ValuesRep[oldToValues.n]];
FOR k: NAT IN [0..c.from.n) DO		--Set up the `from' values
v: Viewer ~ c.eFrom[k].v;
c.from[k] _ SELECT c.eFrom[k].et FROM
left => v.wx,
right => v.wx+v.ww,
top => v.wy,
bottom => v.wy+v.wh,
ENDCASE => ERROR;
ENDLOOP;
FOR k: NAT IN [0..c.to.n) DO		--Set up the `to' values
v: Viewer ~ c.eTo[k].v;
c.to[k] _ SELECT c.eTo[k].et FROM
left => v.wx,
right => v.wx+v.ww,
top => v.wy,
bottom => v.wy+v.wh,
ENDCASE => ERROR;
ENDLOOP;
c.class.enforce[c.from, c.to, c.class.classData, c.instanceData];	--Call the EnforceProc
FOR k: NAT IN [0..c.to.n) DO		--Decode the `to' values
IF c.to[k]#oldToValues[k] THEN {
Set: PROC [e: Edge, val: INTEGER] ~ {
Find: PROC RETURNS [first: LIST OF ToChange] ~ {
FOR each: LIST OF ToChange _ toChange, each.rest UNTIL each=NIL DO
IF each.first.v=e.v THEN RETURN [each];
ENDLOOP;
RETURN [toChange _ CONS[[e.v, [left: e.v.wx, right: e.v.wx+e.v.ww, top: e.v.wy, bottom: e.v.wy+e.v.wh]], toChange]];
};
first: LIST OF ToChange ~ Find[];
first.first.vals[e.et] _ val;
};
e: Edge ~ c.eTo[k];
Suspect[e];
Set[e, c.to[k]]
};
ENDLOOP;
FOR each: LIST OF ToChange _ toChange, each.rest UNTIL each=NIL DO
tc: ToChange ~ each.first;
ViewerOps.EstablishViewerPosition[viewer: tc.v, x: tc.vals[left], y: tc.vals[top], w: tc.vals[right]-tc.vals[left], h: tc.vals[bottom]-tc.vals[top] ];
ENDLOOP;
c.check _ FALSE;
};
ENDLOOP;
};
EdgesControlled: TYPE ~ ARRAY EdgeType OF BOOL;
OrderConstraints: PROC [c: LIST OF Constraint] ~ {
dirty: RefTab.Ref ~ RefTab.Create[mod: 53];
FOR each: LIST OF Constraint _ c, each.rest UNTIL each=NIL DO
FOR k: NAT IN [0..each.first.eTo.n) DO
flags: REF EdgesControlled _ NARROW[RefTab.Fetch[x: dirty, key: each.first.eTo[k].v].val];
IF flags=NIL THEN {
flags _ NEW[EdgesControlled _ ALL[FALSE]];
[] _ RefTab.Store[x: dirty, key: each.first.eTo[k].v, val: flags];
};
IF flags[each.first.eTo[k].et] THEN Error[constraintConflict, "More than one constraint controlling an edge."];
flags[each.first.eTo[k].et] _ TRUE;
ENDLOOP;
ENDLOOP;

{
unsorted: LIST OF Constraint _ c;
progressed: BOOL _ TRUE;
UNTIL unsorted=NIL OR ~progressed DO
progressed _ FALSE;
FOR each: LIST OF Constraint _ unsorted, each.rest UNTIL each=NIL DO {
constraint: Constraint ~ each.first;
FOR k: NAT IN [0..constraint.eFrom.n) DO
flags: REF ARRAY EdgeType OF BOOL _ NARROW[RefTab.Fetch[x: dirty, key: constraint.eFrom[k].v].val];
IF flags=NIL THEN {
flags _ NEW[EdgesControlled _ ALL[FALSE]];
[] _ RefTab.Store[x: dirty, key: each.first.eTo[k].v, val: flags];
};
IF flags[constraint.eFrom[k].et] THEN GOTO ThisOneStillDirty;
ENDLOOP;
{
progressed _ TRUE;
FOR k: NAT IN [0..constraint.eTo.n) DO
flags: REF ARRAY EdgeType OF BOOL _ NARROW[RefTab.Fetch[x: dirty, key: constraint.eTo[k].v].val];
flags[constraint.eTo[k].et] _ FALSE;
ENDLOOP;
each.first _ unsorted.first;
unsorted.first _ constraint;
unsorted _ unsorted.rest;
};
EXITS ThisOneStillDirty => {};
} ENDLOOP;
ENDLOOP;
IF unsorted#NIL THEN Error[constraintConflict, "Constraints are circular."];
};
};
Ancestor: PROC [v: Viewer] RETURNS [a: Viewer] ~ {
a _ v;
UNTIL a.parent=NIL DO a _ a.parent ENDLOOP;
};
ViewerDeleted: ViewerEvents.EventProc = {
FOR et: EdgeType IN EdgeType DO
BreakConstraintsToEdge[[viewer, et]];
ENDLOOP;
};
[] _ ViewerEvents.RegisterEventProc[proc: ViewerDeleted, event: destroy, before: FALSE];

END.

”ViewerConstraintsImpl.mesa
Copyright c 1986 by Xerox Corporation.  All rights reserved.
Eric Nickell, October 17, 1986 4:07:33 pm PDT

Utilities
Check to see if this constraint has no dirty inputs
Here, we know that this constraint can be put in the sorted pile.
Watch for deleted Viewers
[viewer: ViewerClasses.Viewer, event: ViewerEvents.ViewerEvent, before: BOOL] RETURNS [abort: BOOL _ FALSE]
Κ˜™Icodešœ
Οm
œ1™<K™-K™—š
Οk	˜	Kš
œ,˜,Kšœžœ
˜Kšœžœ˜)Kšœ
žœ ˜2Kšœ
žœ<˜KK˜—K˜K˜KšΠlnœž
˜$Kšžœ)˜0Kšžœ˜Kšœž˜šžœ-˜1K˜Kšœžœ
žœ,˜HKšœžœ
žœ/˜NKšœžœ
žœ'˜>Kšœžœ
žœ*˜DK˜Kš
Οnœžœ
žœžœžœ
˜;K˜š œžœ$žœ
žœžœžœ˜…
Kšžœžœ
žœL˜_šœžœ˜"Kš
œ
˜
K˜	K˜K˜Kš
œ˜—K˜—Kšœžœ
žœ
žœj˜
Kšœžœ
žœ
žœR˜~š
 œžœ9žœžœžœ˜ˆ
Kš
œ˜šœžœ˜%K˜
Kšœžœ˜"Kšœžœ˜Kšœžœ˜)Kšœžœ˜%K˜Kš
œ˜—šžœžœ
žœž˜Kšœžœ˜$K•StartOfExpansion[v1: 
Graphs.Vertex, v2: 
Graphs.Vertex, direction: 
Graphs.Direction, label: 
Graphs.Label, other: 
Asserting.Assertions]šžœžœ!˜,Kšžœžœ
žœV˜
Kš
œW˜WKšžœ
˜—šžœžœ
žœž˜!Kšœžœ
žœ˜#Kšœžœ˜%Kšžœ!žœ
žœV˜ƒ
KšœžœžœR˜qKš
œb˜bKšžœ
˜—š
œ
˜
K–.[viewer: 
ViewerClasses.Viewer, prop: 
ATOM]šœžœ
žœžœA˜`Kšœžœ	˜#K–>[viewer: 
ViewerClasses.Viewer, prop: 
ATOM, val: 
REF ANY]š
œF˜FKš
œ˜—Kšžœ˜K˜—š œžœ
žœ˜9K–.[viewer: 
ViewerClasses.Viewer, prop: 
ATOM]š
œ1˜1Kšœžœ
žœžœA˜`šžœ
žœ
ž˜Kšœžœžœ
˜K–>[viewer: 
ViewerClasses.Viewer, prop: 
ATOM, val: 
REF ANY]š
œb˜bš
žœžœžœ
žœžœžœ
ž˜NKšžœžœ˜>Kšžœ
˜——šžœžœ
žœž˜&K–>[viewer: 
ViewerClasses.Viewer, prop: 
ATOM, val: 
REF ANY]šœfžœΟc˜λ
Kšžœ
˜—šžœžœ
žœž˜(K–.[viewer: 
ViewerClasses.Viewer, prop: 
ATOM]šœžœ
žœžœ_˜~–>[viewer: 
ViewerClasses.Viewer, prop: 
ATOM, val: 
REF ANY]šžœ
žœ
ž˜Kšœžœ˜
Kš
œ€
˜€
šžœ‘W˜dšžœžœ
žœžœžœ
ž˜CKšžœžœ˜>Kšžœ
˜—Kš
œ˜——Kšžœ
˜—K˜—š œžœ˜1K–.[viewer: 
ViewerClasses.Viewer, prop: 
ATOM]šœžœE˜[K–.[viewer: 
ViewerClasses.Viewer, prop: 
ATOM]šœžœ
žœžœ?˜^Kšžœžœ
žœ˜!šžœžœ
žœžœžœ
ž˜>K˜Kšžœ
˜—K˜—š œžœ˜"Kšœžœ
žœžœ?˜jšžœžœ
žœ(žœžœ
ž˜JKšœžœ
˜Kšžœ
˜—šœ‘7˜9K˜!Kš	œžœžœ
žœžœ˜<K–.[viewer: 
ViewerClasses.Viewer, prop: 
ATOM]šœžœB˜^Kšžœ	žœ
žœ_˜rK–7[x: 
RefTab.Ref, key: 
RefTab.Key, val: 
RefTab.Val]šœ0žœ˜5Kš
œ˜—K˜—š œžœ
žœžœžœžœžœ
žœ
žœ˜d–.[viewer: 
ViewerClasses.Viewer, prop: 
ATOM]š œžœ˜ Kšžœ%žœžœ˜?š	žœ
žœ+žœžœ
ž˜DK˜Kšžœ
˜—K˜—Kš
œ˜KšœžœB˜^Kš
žœ	žœ
žœ
žœ
žœ˜ K˜K˜—š œžœ
žœ
žœžœžœ˜KKšžœ
žœ˜šžœžœ
žœ˜Kšœžœžœ˜5Kš
œ
˜
—šžœ˜K˜šžœžœ
žœ*žœžœ
ž˜LK–w[viewer: 
ViewerClasses.Viewer, hint: 
ViewerOps.PaintHint, clearClient: 
BOOL _ TRUE, whatChanged: 
REF ANY _ NIL]˜5Kšžœ
˜—Kš
œ˜—K˜—š œžœ˜4K–.[viewer: 
ViewerClasses.Viewer, prop: 
ATOM]šœžœ
žœžœD˜cK˜K˜——
head™	š œžœžœ
žœ˜5šžœžœ
žœžœžœ
ž˜>K˜šžœžœ˜Kšœ
žœžœžœ
žœ
žœ˜EKšœ
žœ
žœžœ
˜!K˜Kšœžœ˜%š	žœžœ
žœžœ‘˜:K˜šœžœž˜%K˜
K˜K˜K˜Kšžœžœ
˜—Kšžœ
˜—š	žœžœ
žœ
žœ‘˜6K˜šœ
žœ
ž˜!K˜
K˜K˜K˜Kšžœžœ
˜—Kšžœ
˜—KšœB‘˜Xš	žœžœ
žœ
žœ‘˜6šžœžœ˜ š œžœžœ˜%š
 œžœ
žœ	žœ
žœ˜0šžœžœ
žœ žœžœ
ž˜BKšžœžœ
žœ˜'Kšžœ
˜—Kšžœ
žœ]˜tK˜—Kšœžœ
žœ˜!K˜K˜—K˜K˜K˜Kš
œ˜—Kšžœ
˜—šžœžœ
žœ žœžœ
ž˜BK–X[viewer: 
ViewerClasses.Viewer, x: 
INTEGER, y: 
INTEGER, w: 
INTEGER, h: 
INTEGER]˜K˜–
Kšžœ
˜—Kšœ
žœ
˜Kš
œ˜—Kšžœ
˜—K˜—Kš	œžœžœ
žœ
žœ
˜/š œžœžœ
žœ˜2K–#[mod: 
RefTab.SeqIndex _ 21B (17)]˜+šžœžœ
žœžœžœ
ž˜=šžœžœ
žœž˜&K–$[x: 
RefTab.Ref, key: 
RefTab.Key]šœžœžœ7˜Zšžœžœ
žœ˜Kšœžœžœ
žœ˜*K–7[x: 
RefTab.Ref, key: 
RefTab.Key, val: 
RefTab.Val]˜BK˜—KšžœžœL˜oKšœžœ
˜#Kšžœ
˜—Kšžœ
˜—K˜š
œ
˜
Kšœ
žœ
žœ˜!Kšœžœžœ
˜šžœ
žœ
žœ
ž˜$Kšœ
žœ
˜šžœžœ
žœ"žœžœ
žœ˜FK™3K˜$šžœžœ
žœž˜(Kšœžœ
žœ
žœ
žœžœ9˜cšžœžœ
žœ˜Kšœžœžœ
žœ˜*K–7[x: 
RefTab.Ref, key: 
RefTab.Key, val: 
RefTab.Val]˜BK˜—Kšžœžœ
žœ˜=Kšžœ
˜—K™Aš
œ
˜
Kšœ
žœ
˜šžœžœ
žœž˜&K–$[x: 
RefTab.Ref, key: 
RefTab.Key]šœžœ
žœ
žœ
žœžœ7˜aKšœžœ
˜$Kšžœ
˜—K˜K˜K˜Kš
œ˜—Kšžœ˜Kšœžœ
˜
—Kšžœ
˜—Kšžœ
žœ8˜LKš
œ˜—K˜—š œžœ
žœ˜2K˜Kšžœ
žœ
žœžœ
˜+K˜——™
code2–o -- [viewer: ViewerClasses.Viewer, event: ViewerEvents.ViewerEvent, before: BOOL] RETURNS [abort: BOOL _ FALSE]˜)Mš
Πckk™kšžœžœ
ž˜K˜%Kšžœ
˜—M˜—MšœQžœ˜X—K˜Kšžœ
˜—…—&f9