Constrainers (Abutters facsimiles)
badEdge: ARRAY EdgeType OF BOOL ~ [left: FALSE, right: TRUE, top: FALSE, bottom: TRUE];
horzEdge: ARRAY EdgeType OF BOOL ~ [left: TRUE, right: TRUE, top: FALSE, bottom: FALSE];
null: SeriesElement ~ [NIL, 0];
RegisterClass:
PUBLIC PROC [viewerFlavor:
ATOM, class: ConstrainerClassRep]
RETURNS [same:
ATOM] ~ {
mjsClass: MJSContainers.MJSContainerClass =
NEW [MJSContainers.MJSContainerClassRep ← [
paint: Paint,
destroy: class.destroy,
copy: class.copy,
set: class.set,
get: class.get,
init: Init,
save: class.save,
caption: class.caption,
adjust: NoteSizeChanged,
childAdjust: NoteConstrainerChildSize,
menu: class.menu,
icon: class.icon]];
MJSContainers.RegisterClass[same ← viewerFlavor, mjsClass];
Atom.PutProp[atom: viewerFlavor, prop: classProp, val: NEW [ConstrainerClassRep ← class]];
};
Position: TYPE = RECORD [ww, wh: INTEGER ← 0];
ConstrainerData:
PUBLIC TYPE =
RECORD [
class: ConstrainerClass,
tracked: Position ← [],
clientData: REF ANY
];
Paint: ViewerClasses.PaintProc = {
[self: ViewerClasses.Viewer, context: Imager.Context, whatChanged: REF ANY, clear: BOOL] RETURNS [quit: BOOL ← FALSE]
cData: REF ConstrainerData ~ NARROW[MJSContainers.GetClientData[self]];
IF self.ww#cData.tracked.ww
THEN {
ViewerConstraints.Suspect[e: [self, right]];
cData.tracked.ww ← self.ww;
quit ← TRUE;
};
IF self.wh#cData.tracked.wh
THEN {
ViewerConstraints.Suspect[e: [self, bottom]];
cData.tracked.wh ← self.wh;
quit ← TRUE;
};
IF quit THEN ViewerConstraints.PaintConstraintSystem[self];
};
Init: ViewerClasses.InitProc = {
[self: ViewerClasses.Viewer]
cData: REF ConstrainerData ~ NARROW[MJSContainers.GetClientData[self]];
IF cData.class.init#NIL THEN cData.class.init[self];
};
NoteSizeChanged: ViewerClasses.AdjustProc = {
[self: ViewerClasses.Viewer] RETURNS [adjusted: BOOL ← FALSE]
cData: REF ConstrainerData ~ NARROW[MJSContainers.GetClientData[self]];
needToPaint: BOOL ← FALSE;
IF self.ww#cData.tracked.ww
THEN {
ViewerConstraints.Suspect[e: [self, right]];
cData.tracked.ww ← self.ww;
needToPaint ← TRUE;
};
IF self.wh#cData.tracked.wh
THEN {
ViewerConstraints.Suspect[e: [self, bottom]];
cData.tracked.wh ← self.wh;
needToPaint ← TRUE;
};
IF needToPaint THEN ViewerConstraints.PaintConstraintSystem[self];
};
NoteConstrainerChildSize: MJSContainers.ChildAdjustProc = {
[parent: ViewerClasses.Viewer, child: ViewerClasses.Viewer] RETURNS [viewerToPaint: ViewerClasses.Viewer ← NIL, paintColumn: BOOL ← FALSE]
Body
};
classProp: ATOM ← Atom.MakeAtom["Eric Nickell @ April 27, 1958 03:40:33 pm EST"];
vanilla:
PUBLIC ATOM ← RegisterClass[
$VanillaConstrainer,
[save: Save]];
Save: ViewerClasses.SaveProc = {
[self: ViewerClasses.Viewer, force: BOOL ← FALSE]
cData: REF ConstrainerData ~ NARROW[MJSContainers.GetClientData[self]];
FOR v: Viewer ← self.child, v.sibling
UNTIL v=
NIL DO
IF force
THEN -- Copied from part of ViewerOpsImplB.SaveAllEdits-- {
IF (v.newVersion
OR v.newFile)
AND v.class.save #
NIL THEN
v.class.save[v, force ! ANY => CONTINUE];
v.newVersion ← v.newFile ← FALSE;
IF v.icon=dirtyDocument THEN v.icon ← document;
IF v.link#
NIL THEN FOR t: Viewer ← v.link, t.link
UNTIL t=v
DO
t.newVersion ← t.newFile ← FALSE;
ENDLOOP;
}
ELSE {
ViewerOps.SaveViewer[v];
};
ENDLOOP;
};
GetClass:
PUBLIC PROC [viewerFlavor:
ATOM]
RETURNS [class: ConstrainerClass] = {
class ← NARROW[Atom.GetProp[viewerFlavor, classProp]];
};
Create:
PUBLIC PROC [viewerFlavor:
ATOM, info: ViewerClasses.ViewerRec ← [], paint:
BOOL ←
TRUE]
RETURNS [c: Constrainer] ~ {
cData: REF ConstrainerData;
realFlavor: ATOM = IF viewerFlavor # NIL THEN viewerFlavor ELSE vanilla;
class: ConstrainerClass = GetClass[realFlavor];
info.data ← cData ← NEW [ConstrainerData ← [class: class, clientData: info.data]];
c ← MJSContainers.Create[viewerFlavor: realFlavor, info: info, paint: paint];
};
ViewerIsConstrainer:
PUBLIC PROC [v: Viewer]
RETURNS [b:
BOOL] ~ {
data: REF ANY;
IF NOT MJSContainers.IsMJSContainer[v] THEN RETURN[FALSE];
data ← MJSContainers.GetClientData[v];
b ← data # NIL AND ISTYPE[data, REF ConstrainerData]
};
GetClientData:
PUBLIC PROC [c: Constrainer]
RETURNS [cd:
REF ANY] ~ {
cd ← NARROW[c.data, REF ConstrainerData].clientData;
};
ScrollOffset:
PUBLIC PROC [c: Constrainer]
RETURNS [offTop:
INTEGER] ~ {
offTop ← MJSContainers.ScrollOffset[c];
};
HScrollOffset:
PUBLIC PROC [c: Constrainer]
RETURNS [offLeft:
INTEGER] ~ {
offLeft ← MJSContainersExtras.HScrollOffset[c];
};
Abut:
PUBLIC PROC [c: Constrainer, child1, child2: Viewer, edge: EdgeType, space:
INTEGER ← 0, stretch:
BOOL ←
FALSE, paint:
BOOL ←
TRUE] ~ {
IF child2.parent#c OR (child1#parentSide AND child1.parent#c) THEN ERROR VC.Error[invalidConstraint, "Supposed child not a child of the constrainer."];
[] ← DoAbut[
fromE: IF child1=parentSide THEN [c, edge] ELSE [child1, opposite[edge]],
toE: [child2, edge],
offset: IF badEdge[edge] THEN -space ELSE space,
preserveToEVSize: ~stretch
];
};
parentSide: PUBLIC Viewer ← NEW [ViewerClasses.ViewerRec];
SetLayout:
PUBLIC PROC [c: Constrainer, rules: Rules, paint, eliminateOldConstraints:
BOOL ←
TRUE] ~ {
cl: LIST OF Constraint ← NIL;
setW: LIST OF EdgeOffset ← NIL;
setH: LIST OF EdgeOffset ← NIL;
IF eliminateOldConstraints
THEN {
cl: LIST OF Constraint ~ NARROW[ViewerOps.FetchProp[viewer: c, prop: $ConstraintsEstablishedBySetLayout]];
FOR each:
LIST OF Constraint ← cl, each.rest
UNTIL each=
NIL DO
ViewerConstraints.BreakConstraint[constraint: each.first];
ENDLOOP;
ViewerOps.AddProp[viewer: c, prop: $ConstraintsEstablishedBySetLayout, val: NIL];
};
FOR k: EdgeType
IN EdgeType
DO
settingParent: LIST OF EdgeOffset ← NIL;
BuildConstraints:
PROC [series: Series, se1:
Edge] ~ {
se1 is the edge from which we ought to start hanging this series.
Basically, we wish to construct a constraint from se1 to the the 1st element in series.rigid, from the 1st in series.rigid to the 2nd, etc, and then from the last in series.rigid to either nothing, or possibly to a list of other series (i.e. a series really represents a tree), or possibly to a parent.
FOR each:
LIST OF SeriesElement ← series.rigid, each.rest
UNTIL each=
NIL DO
se2: Edge ~ [each.first.viewer, k];
IF se2.v.parent#c THEN ERROR VC.Error[invalidConstraint, "Supposed child not a child of the constrainer."];
cl ← CONS[DoAbut[fromE: se1, toE: se2, offset: IF badEdge[k] THEN -each.first.spaceBefore ELSE each.first.spaceBefore, preserveToEVSize: each.first.keepSizeFixed], cl];
se1 ← [se2.v, opposite[k]];
ENDLOOP;
WITH series
SELECT FROM
n: Series.none => IF n.setParentSize THEN settingParent ← CONS[[se1, n.spaceAfter], settingParent];
p: Series.parallel => {
FOR each:
LIST OF Series ← p.p, each.rest
UNTIL each=
NIL DO
BuildConstraints[each.first, se1];
ENDLOOP;
};
s: Series.stretch => {
cl ← CONS[DoAbut[fromE: se1, toE: [s.se.viewer, k], offset: IF badEdge[k] THEN -s.se.spaceBefore ELSE s.se.spaceBefore, preserveToEVSize: FALSE], cl];
};
ENDCASE => ERROR;
};
BuildConstraints[rules[k], [c, k]];
SELECT TRUE FROM
settingParent#NIL AND badEdge[k] => ERROR VC.Error[invalidConstraint, "Cannot set parent size from the bottom or right."];
settingParent#
NIL => {
cl ← CONS[ConstrainToMax[fromEO: settingParent, to: [c, opposite[k]]], cl];
};
ENDCASE;
ENDLOOP;
};
EdgeOffset: TYPE ~ RECORD [edge: Edge, offset: INTEGER];
MaxData: TYPE ~ RECORD [SEQUENCE n: NAT OF INTEGER];
ConstrainToMax:
PROC [fromEO:
LIST OF EdgeOffset, to:
Edge]
RETURNS [c:
VC.Constraint] ~ {
Init: ViewerConstraints.InitProc = {
[i: NAT, from: BOOL] RETURNS [e: Edge]
this: LIST OF EdgeOffset ← fromEO;
THROUGH [0..i) DO this ← this.rest ENDLOOP;
maxData[i] ← this.first.offset;
RETURN [this.first.edge];
};
Count:
PROC [from:
LIST OF EdgeOffset]
RETURNS [n:
NAT ← 0] ~ {
FOR each:
LIST OF EdgeOffset ← from, each.rest UNTIL each=NIL
DO
n ← n+1;
ENDLOOP;
};
n: NAT ← Count[fromEO];
class: VC.ConstraintClass ~ ViewerConstraints.CreateConstraintClass[enforce: EnforceMax, nFrom: n, nTo: 1];
maxData: REF MaxData ~ NEW[MaxData[n]];
c ← ViewerConstraints.EstablishConstraint[class: class, fetch: Init, instanceData: maxData];
};
EnforceMax: ViewerConstraints.EnforceProc = {
[from: ViewerConstraints.Values, to: ViewerConstraints.Values, classData: REF ANY, instanceData: REF ANY]
maxData: REF MaxData ~ NARROW[instanceData];
max: INTEGER ← INTEGER.FIRST;
FOR k:
NAT IN [0..from.n)
DO
max ← MAX[max, from[k]+maxData[k]];
ENDLOOP;
to[0] ← max;
};
DoAbut:
PROC [fromE, toE: Edge, offset:
INTEGER, preserveToEVSize:
BOOL]
RETURNS [c: Constraint] ~ {
Init:
VC.InitProc = {
[i: NAT, from: BOOL] RETURNS [e: Edge]
e ←
SELECT TRUE FROM
from AND i=0 => fromE,
~from AND i=0 => toE,
~from AND i=1 => [toE.v, opposite[toE.et]],
ENDCASE => ERROR;
};
IF horzEdge[fromE.et]#horzEdge[toE.et] THEN ERROR;
c ← VC.EstablishConstraint[class: IF preserveToEVSize THEN fixedAbut ELSE stretchyAbut, fetch: Init, instanceData: NEW[AbutData ← [horz: horzEdge[fromE.et], offset: offset]]];
};
fixedAbut: VC.ConstraintClass ~ VC.CreateConstraintClass[enforce: AbutEnforce, nFrom: 1, nTo: 2];
stretchyAbut: VC.ConstraintClass ~ VC.CreateConstraintClass[enforce: AbutEnforce, nFrom: 1, nTo: 1];
AbutData: TYPE ~ RECORD [horz: BOOL, offset: INTEGER];
AbutEnforce:
VC.EnforceProc = {
[from: ViewerConstraints.Values, to: ViewerConstraints.Values, classData: REF ANY, instanceData: REF ANY]
data: REF AbutData ~ NARROW[instanceData];
IF to.n>1
THEN {
--Rigid
size: INTEGER ~ to[1]-to[0]; --And we wish to maintain this invariant
to[0] ← from[0]+data.offset;
to[1] ← size+to[0];
}
ELSE to[0] ← from[0]+data.offset; --Stretchy
};
Constrainers (Additional capabilities)
centerClass: ViewerConstraints.ConstraintClass ~ ViewerConstraints.CreateConstraintClass[enforce: CenterEnforce, nFrom: 2, nTo: 2];
CenterEnforce: ViewerConstraints.EnforceProc = {
[from: ViewerConstraints.Values, to: ViewerConstraints.Values, classData: REF ANY, instanceData: REF ANY]
outerSize: INTEGER ~ from[1]-from[0];
innerSize: INTEGER ~ to[1]-to[0];
to[0] ← (outerSize-innerSize)/2;
to[1] ← to[0]+innerSize;
};
Center:
PUBLIC PROC [parent, child: Viewer, margin:
INTEGER ← 0, horz:
BOOL ←
TRUE] ~ {
edgeType: ARRAY [0..2) OF EdgeType ~ IF horz THEN [left, right] ELSE [top, bottom];
Init: ViewerConstraints.InitProc = {
[i: NAT, from: BOOL] RETURNS [e: ViewerConstraints.Edge]
Type: TYPE ~ RECORD [horz, from: BOOL, i: NAT];
this: Type ~ [horz, from, i];
RETURN [[v: IF from THEN parent ELSE child, et: edgeType[i]]];
};
[] ← ViewerConstraints.EstablishConstraint[class: centerClass, fetch: Init];
};
wrapClass: ViewerConstraints.ConstraintClass ~ ViewerConstraints.CreateConstraintClass[enforce: WrapEnforce, nFrom: 6, nTo: 4];
WrapEnforce: ViewerConstraints.EnforceProc = {
[from: ViewerConstraints.Values, to: ViewerConstraints.Values, classData: REF ANY, instanceData: REF ANY]
width: INTEGER ~ to[1]-to[0];
height: INTEGER ~ to[3]-to[2];
margin: REF INTEGER ~ NARROW[instanceData];
IF from[5]+2*margin^+width>from[2]
THEN {
--Need to wrap
to[0] ← margin^;
to[2] ← from[4]+margin^;
}
ELSE {
--Can stay on the same line
to[0] ← from[5]+margin^;
to[2] ← from[3];
};
to[1] ← to[0]+width;
to[3] ← to[2]+height;
};
Wrap:
PUBLIC PROC [parent: Viewer, children:
LIST OF Viewer, margin:
INTEGER ← 0] ~ {
instanceData: REF INTEGER ~ NEW[INTEGER ← margin];
FOR each:
LIST OF Viewer ← children, each.rest
UNTIL each.rest=
NIL DO
Init: ViewerConstraints.InitProc = {
[i: NAT, from: BOOL] RETURNS [e: ViewerConstraints.Edge]
Type: TYPE ~ RECORD [i: NAT, from: BOOL];
this: Type ~ [i, from];
e ←
SELECT this
FROM
[0, TRUE] => [parent, top],
[1, TRUE] => [parent, left],
[2, TRUE] => [parent, right],
[3, TRUE] => [fromV, top],
[4, TRUE] => [fromV, bottom],
[5, TRUE] => [fromV, right],
[0, FALSE] => [toV, left],
[1, FALSE] => [toV, right],
[2, FALSE] => [toV, top],
[3, FALSE] => [toV, bottom],
ENDCASE => ERROR;
};
fromV: Viewer ~ each.first;
toV: Viewer ~ each.rest.first;
[] ← ViewerConstraints.EstablishConstraint[class: wrapClass, fetch: Init, instanceData: instanceData];
ENDLOOP;
};