<> <> <> <<>> DIRECTORY Constrainers, Atom, MJSContainers, MJSContainersExtras, ViewerClasses, ViewerConstraints, ViewerOps; ConstrainersImpl: CEDAR PROGRAM IMPORTS Atom, MJSContainers, MJSContainersExtras, ViewerConstraints, ViewerOps EXPORTS Constrainers ~ BEGIN OPEN Constrainers, VC: ViewerConstraints; Edge: TYPE ~ VC.Edge; opposite: ARRAY EdgeType OF EdgeType ~ [left: right, right: left, top: bottom, bottom: top]; catercorner: ARRAY EdgeType OF EdgeType ~ [left: top, right: bottom, top: left, bottom: right]; <> EnforceSquare: ViewerConstraints.EnforceProc = { <<[from: ViewerConstraints.Values, to: ViewerConstraints.Values, classData: REF ANY, instanceData: REF ANY]>> to[0] _ (from[1]-from[0]) + from[2]; }; keepSquare: ViewerConstraints.ConstraintClass ~ ViewerConstraints.CreateConstraintClass[enforce: EnforceSquare, nFrom: 3, nTo: 1, classData: NIL]; KeepSquare: PUBLIC PROC [v: Viewer, adjustEdge: EdgeType] RETURNS [constraint: ViewerConstraints.Constraint] ~ { Fetch: ViewerConstraints.InitProc ~ { Type: TYPE ~ RECORD [from: BOOL, i: [0..3)]; foo: Type ~ [from, i]; e _ SELECT foo FROM [TRUE, 0] => [v, opposite[catercorner[adjustEdge]]], [TRUE, 1] => [v, catercorner[adjustEdge]], [TRUE, 2] => [v, opposite[adjustEdge]], [FALSE, 0] => [v, adjustEdge], ENDCASE => ERROR; }; constraint _ ViewerConstraints.EstablishConstraint[class: keepSquare, fetch: Fetch]; }; <> 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]; <> 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] ~ { <> <> 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 }; <> 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; }; END.