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;
};