<> <> <> <> <<>> DIRECTORY Xl, XTk, XTkCollections, XTkContainers, XTkFriends; XTkContainersImpl: CEDAR MONITOR IMPORTS XTk, XTkCollections, XTkFriends EXPORTS XTkContainers = BEGIN OPEN XTkContainers; exceptWidth: XTk.GeometryRequest = [TRUE, TRUE, FALSE, TRUE, TRUE]; exceptHeight: XTk.GeometryRequest = [TRUE, TRUE, TRUE, FALSE, TRUE]; yStack: PUBLIC XTk.Class ¬ XTkFriends.CreateClass[[super: XTkCollections.collectionClass, key: $yStack, removeChildLR: XTkCollections.RemoveChildAndSqueezeLR, preferredSizeLR: YPreferredSizeLR, configureLR: YConfigureLR]]; xStack: PUBLIC XTk.Class ¬ XTkFriends.CreateClass[[super: XTkCollections.collectionClass, key: $xStack, removeChildLR: XTkCollections.RemoveChildAndSqueezeLR, preferredSizeLR: XPreferredSizeLR, configureLR: XConfigureLR]]; container: PUBLIC XTk.Class ¬ XTkFriends.CreateClass[[super: XTkCollections.collectionClass, key: $container, removeChildLR: XTkCollections.RemoveChildAndSqueezeLR, preferredSizeLR: ContPreferredSizeLR, configureLR: ContConfigureLR]]; CreateContainer: PUBLIC PROC [widgetSpec: WidgetSpec ¬ [], children: LIST OF Widget ¬ NIL] RETURNS [widget: Widget] = { widgetSpec.class ¬ XTkFriends.InitClassField[widgetSpec.class, container]; widget ¬ XTkCollections.Create[widgetSpec, children]; }; RemoveChild: PUBLIC PROC [container: ContainerWidget, child: Widget, destroyChild: BOOL ¬ TRUE, startReconfigure: BOOL ¬ TRUE] = { XTkCollections.RemoveChild[container, child, startReconfigure, ~destroyChild] }; AppendChild: PUBLIC PROC [container: Widget, child: Widget, startReconfigure: BOOL ¬ TRUE] = { XTkCollections.AddChild[container, child, NIL, startReconfigure] }; AppendChildren: PUBLIC PROC [container: Widget, children: LIST OF Widget, startReconfigure: BOOL] = { XTkCollections.AddChildren[container, children, startReconfigure]; }; SetForce: PUBLIC PROC [container: ContainerWidget, force: INT] = { ip: XTkCollections.CollectionInstPart ~ XTkCollections.GetCollectionInstPart[container]; IF force#-1 THEN ip.reserved ¬ NEW[INT¬force] ELSE ip.reserved ¬ NIL; }; CreateXStack: PUBLIC PROC [widgetSpec: WidgetSpec, stack: LIST OF Widget ¬ NIL, force: INT ¬ -1] RETURNS [widget: Widget] = { widgetSpec.class ¬ XTkFriends.InitClassField[widgetSpec.class, xStack]; widget ¬ XTkCollections.Create[widgetSpec, stack]; SetForce[widget, force]; }; CreateYStack: PUBLIC PROC [widgetSpec: WidgetSpec, stack: LIST OF Widget ¬ NIL, force: INT ¬ -1] RETURNS [widget: Widget] = { widgetSpec.class ¬ XTkFriends.InitClassField[widgetSpec.class, yStack]; widget ¬ XTkCollections.Create[widgetSpec, stack]; SetForce[widget, force]; }; CreateAbut: PUBLIC PROC [widgetSpec: WidgetSpec ¬ [], children: LIST OF Widget ¬ NIL, orient: Orientation, force: INT ¬ -1] RETURNS [widget: ContainerWidget] = { SELECT orient FROM inX => {widgetSpec.class ¬ XTkFriends.InitClassField[widgetSpec.class, xStack]}; inY => {widgetSpec.class ¬ XTkFriends.InitClassField[widgetSpec.class, yStack]}; ENDCASE => ERROR; widget ¬ XTkCollections.Create[widgetSpec, children]; SetForce[widget, force]; }; DefineBorders: PROC [widget: XTk.Widget] = { EachChild: XTkCollections.EachChildProc = { <<--forget dynamic borders; its not worth the troubles-->> IF child.actual.borderWidth<0 THEN child.actual.borderWidth ¬ widget.actual.borderWidth; }; IF widget.actual.borderWidth<0 THEN { IF widget.parent#NIL THEN widget.actual.borderWidth ¬ widget.parent.actual.borderWidth; IF widget.actual.borderWidth<0 THEN widget.actual.borderWidth ¬ 0; }; XTkCollections.BasicEnumerateChildren[widget, EachChild]; }; GetForce: PROC [widget: Widget] RETURNS [INT¬-1] = { ip: XTkCollections.CollectionInstPart ~ XTkCollections.GetCollectionInstPart[widget]; WITH ip.reserved SELECT FROM ri: REF INT => RETURN [ri­]; ENDCASE => {}; }; AddPos: PROC [gr: XTk.GeometryRequest] RETURNS [XTk.GeometryRequest] = { gr[x] ¬ TRUE; gr[y] ¬ TRUE; RETURN [gr] }; YPreferredSizeLR: XTk.PreferredSizeProc = { force: INT ¬ -1; EachChild: XTkCollections.EachChildProc = { b: INT ¬ XTk.BorderWidth[child]; g: Xl.Geometry ¬ child.s.geometry; IF child.s.mapping=unmapped THEN RETURN; g.borderWidth ¬ b; g.size.width ¬ proposed.size.width; g ¬ XTkFriends.PreferredSizeLR[widget: child, proposed: g, maySkip: maySkip]; IF force>0 THEN g.size.height ¬ MAX[force-2*b, 1]; IF g.size.height<=0 THEN g.size.height ¬ 20; preferred.size.width ¬ MAX[preferred.size.width, g.size.width]; preferred.size.height ¬ preferred.size.height + g.size.height + 2*b; }; IF widget.s.geometry.size.width>0 THEN maySkip[w] ¬ TRUE; IF widget.s.geometry.size.height>0 THEN maySkip[h] ¬ TRUE; IF maySkip[w] AND maySkip[h] THEN RETURN [widget.s.geometry]; preferred ¬ [ size: [0, 0], pos: widget.s.geometry.pos, borderWidth: widget.s.geometry.borderWidth ]; force ¬ GetForce[widget]; maySkip ¬ AddPos[maySkip]; XTkCollections.BasicEnumerateChildren[widget, EachChild]; IF widget.s.geometry.size.width>0 THEN preferred.size.width ¬ widget.s.geometry.size.width; IF widget.s.geometry.size.height>0 THEN preferred.size.height ¬ widget.s.geometry.size.height; }; XPreferredSizeLR: XTk.PreferredSizeProc = { force: INT ¬ -1; EachChild: XTkCollections.EachChildProc = { b: INT ¬ XTk.BorderWidth[child]; g: Xl.Geometry ¬ child.s.geometry; IF child.s.mapping=unmapped THEN RETURN; g.borderWidth ¬ b; g.size.height ¬ proposed.size.height; g ¬ XTkFriends.PreferredSizeLR[widget: child, proposed: g, maySkip: maySkip]; IF force>0 THEN g.size.width ¬ MAX[force-2*b, 1]; IF g.size.width<=0 THEN g.size.width ¬ 20; preferred.size.height ¬ MAX[preferred.size.height, g.size.height]; preferred.size.width ¬ preferred.size.width + g.size.width + 2*b; }; IF widget.s.geometry.size.width>0 THEN maySkip[h] ¬ TRUE; IF widget.s.geometry.size.height>0 THEN maySkip[w] ¬ TRUE; IF maySkip[w] AND maySkip[h] THEN RETURN [widget.s.geometry]; preferred ¬ [ size: [0, 0], pos: widget.s.geometry.pos, borderWidth: widget.s.geometry.borderWidth ]; force ¬ GetForce[widget]; maySkip ¬ AddPos[maySkip]; XTkCollections.BasicEnumerateChildren[widget, EachChild]; IF widget.s.geometry.size.width>0 THEN preferred.size.width ¬ widget.s.geometry.size.width; IF widget.s.geometry.size.height>0 THEN preferred.size.height ¬ widget.s.geometry.size.height; }; ContPreferredSizeLR: XTk.PreferredSizeProc = { EachChild: XTkCollections.EachChildProc = { b: INT ¬ XTk.BorderWidth[child]; g: Xl.Geometry ¬ [size: proposed.size, pos: child.actual.pos, borderWidth: b]; IF child.s.mapping=unmapped THEN RETURN; g ¬ XTkFriends.PreferredSizeLR[widget: child, proposed: g, maySkip: maySkip]; IF g.size.width<=0 THEN g.size.width ¬ 1; IF g.size.height<=0 THEN g.size.height ¬ 1; IF g.pos.x=XTk.dontUse THEN g.pos.x ¬ child.actual.pos.x; IF g.pos.y=XTk.dontUse THEN g.pos.y ¬ child.actual.pos.y; preferred.size.width ¬ MAX[preferred.size.width, g.pos.x + g.size.width + b*2]; preferred.size.height ¬ MAX[preferred.size.height, g.pos.y + g.size.height + b*2]; }; IF widget.s.geometry.size.width>0 THEN maySkip[w] ¬ TRUE; IF widget.s.geometry.size.height>0 THEN maySkip[h] ¬ TRUE; IF maySkip[w] AND maySkip[h] THEN RETURN [widget.s.geometry]; preferred ¬ [ size: [0, 0], pos: widget.s.geometry.pos, borderWidth: widget.s.geometry.borderWidth ]; XTkCollections.BasicEnumerateChildren[widget, EachChild]; IF widget.s.geometry.size.width>0 THEN preferred.size.width ¬ widget.s.geometry.size.width; IF widget.s.geometry.size.height>0 THEN preferred.size.height ¬ widget.s.geometry.size.height; }; YConfigureLR: XTk.ConfigureProc = { existW: BOOL ¬ widget.actualMapping> EachChild: XTkCollections.EachChildProc = { IF child.state#realized AND ~reConsiderChildren THEN RETURN; IF child.s.mapping#unmapped THEN {mapCount ¬ mapCount+1; lastChild ¬ child}; considerCount ¬ considerCount+1; }; XTkCollections.BasicEnumerateChildren[widget, EachChild]; }; <> <> <> <> <> <> <> <> AND ~reConsiderChildren THEN RETURN;>> <> <> <> <> <> <> <<};>> <0 THEN g.size.height ¬ MAX[1, force - g.borderWidth*2];>> <> <> <> <> <> <<};>> <<};>> <> <> <<};>> <> <<[count, lastChild] ¬ MyCount[widget];>> <0 AND force=0 THEN {>> <> <<};>> <> <<};>> <<>> YSizingLR: PROC [widget: Widget, reConsiderChildren: BOOL] = { cd: REF MyConfigureData ¬ NIL; force: INT ¬ GetForce[widget]; mapCount: INT; allCount: INT; index: INT ¬ 0; varyingCount: INT ¬ 0; lastChild: Widget; pos: Xl.Point ¬ [0, 0]; fixCommon: BOOL = TRUE; FirstPassPerChild: XTkCollections.EachChildProc = { <<--used in first pass to get ideal geometry>> g: Xl.Geometry ¬ child.actual; IF child.state#realized AND ~reConsiderChildren THEN RETURN; IF child.s.mapping=dontUse THEN child.s.mapping ¬ mapped; cd[index].child ¬ child; cd[index].mapping ¬ child.s.mapping; IF child.s.mapping=mapped THEN { IF Varying[child] THEN varyingCount ¬ varyingCount+1; g ¬ XTkFriends.PreferredSizeLR[widget: child, proposed: child.actual, maySkip: exceptHeight]; g.pos ¬ pos; IF g.borderWidth<0 THEN g.borderWidth ¬ 0; IF fixCommon OR g.size.width<=0 THEN { g.size.width ¬ widget.actual.size.width - g.borderWidth*2; }; IF force>0 THEN g.size.height ¬ MAX[1, force - g.borderWidth*2]; IF g.size.height<=0 THEN g.size.height ¬ 20; IF g.size.width<=0 THEN g.size.width ¬ 1; IF child=lastChild AND varyingCount=0 THEN { g.size.height ¬ MAX[widget.actual.size.height-pos.y-g.borderWidth*2, 1]; }; pos.y ¬ pos.y+g.size.height+2*g.borderWidth; }; cd[index].g ¬ g; index ¬ MIN[allCount, index+1]; }; IF reConsiderChildren THEN XTk.SetWidgetFlag[widget, XTk.mustReConsiderChildren, FALSE]; [mapCount, allCount, lastChild] ¬ XCount[widget, reConsiderChildren]; --zero'th path: count IF mapCount>0 AND force=0 THEN { force ¬ MAX[1, widget.actual.size.height / mapCount]; }; cd ¬ NEW[MyConfigureData[allCount]]; XTkCollections.BasicEnumerateChildren[widget, FirstPassPerChild]; -- first real pass: get ideal geometry IF varyingCount>0 THEN { offset: INT ¬ 0; wrong: INT ¬ widget.actual.size.height-pos.y; IF wrong#0 THEN { FOR i: INT IN [0..allCount) DO -- second pass: fix geometry evenly child: XTk.Widget ¬ cd[i].child; cd[i].g.pos.y ¬ cd[i].g.pos.y + offset; IF Varying[child] THEN { correction: INT ¬ wrong/varyingCount; varyingCount ¬ varyingCount-1; IF (cd[i].g.size.height+correction)<1 THEN { correction ¬ 1-cd[i].g.size.height; }; wrong ¬ wrong-correction; cd[i].g.size.height ¬ cd[i].g.size.height + correction; offset ¬ offset + correction; }; ENDLOOP; }; }; FOR i: INT IN [0..allCount) DO-- last pass: now really set the fixed geometry child: XTk.Widget ¬ cd[i].child; XTkFriends.ConfigureLR[child, cd[i].g, cd[i].mapping, reConsiderChildren]; ENDLOOP; }; <> <> <> <> <> <> <> <> AND ~reConsiderChildren THEN RETURN;>> <> <> <> <> <> <> <<};>> <0 THEN g.size.width ¬ MAX[1, force - g.borderWidth*2];>> <> <> <> <> <> <<};>> <<};>> <> <> <<};>> <> <<[count, lastChild] ¬ MyCount[widget];>> <0 AND force=0 THEN {>> <> <<};>> <> <<};>> <<>> MyConfigureData: TYPE = RECORD [ d: SEQUENCE count: NAT OF MyConfigureRec ]; MyConfigureRec: TYPE = RECORD [ child: XTk.Widget, g: Xl.Geometry ¬ [], mapping: XTk.Mapping ¬ dontUse ]; varyingFlag: XTk.WidgetFlagKey ~ wf6; SetVaryingSize: PUBLIC PROC [childOfStack: XTk.Widget, varyingSize: BOOL ¬ TRUE] = { XTk.SetWidgetFlag[childOfStack, varyingFlag, varyingSize] }; Varying: PROC [widget: Widget] RETURNS [BOOL] = { RETURN [XTk.GetWidgetFlag[widget, varyingFlag]] }; XSizingLR: PROC [widget: Widget, reConsiderChildren: BOOL] = { cd: REF MyConfigureData ¬ NIL; force: INT ¬ GetForce[widget]; mapCount: INT; allCount: INT; index: INT ¬ 0; varyingCount: INT ¬ 0; lastChild: Widget; pos: Xl.Point ¬ [0, 0]; fixCommon: BOOL = TRUE; FirstPassPerChild: XTkCollections.EachChildProc = { <<--used in first pass to get ideal geometry>> g: Xl.Geometry ¬ child.actual; IF child.state#realized AND ~reConsiderChildren THEN RETURN; IF child.s.mapping=dontUse THEN child.s.mapping ¬ mapped; cd[index].child ¬ child; cd[index].mapping ¬ child.s.mapping; IF child.s.mapping=mapped THEN { IF Varying[child] THEN varyingCount ¬ varyingCount+1; g ¬ XTkFriends.PreferredSizeLR[widget: child, proposed: child.actual, maySkip: exceptWidth]; g.pos ¬ pos; IF g.borderWidth<0 THEN g.borderWidth ¬ 0; IF fixCommon OR g.size.height<=0 THEN { g.size.height ¬ widget.actual.size.height - g.borderWidth*2; }; IF force>0 THEN g.size.width ¬ MAX[1, force - g.borderWidth*2]; IF g.size.width<=0 THEN g.size.width ¬ 40; IF g.size.height<=0 THEN g.size.height ¬ 1; IF child=lastChild AND varyingCount=0 THEN { g.size.width ¬ MAX[widget.actual.size.width-pos.x-g.borderWidth*2, 1]; }; pos.x ¬ pos.x + g.size.width + 2*g.borderWidth; }; cd[index].g ¬ g; index ¬ MIN[allCount, index+1]; }; IF reConsiderChildren THEN XTk.SetWidgetFlag[widget, XTk.mustReConsiderChildren, FALSE]; [mapCount, allCount, lastChild] ¬ XCount[widget, reConsiderChildren]; --zero'th path: count IF mapCount>0 AND force=0 THEN { force ¬ MAX[1, widget.actual.size.width / mapCount]; }; cd ¬ NEW[MyConfigureData[allCount]]; XTkCollections.BasicEnumerateChildren[widget, FirstPassPerChild]; -- first real pass: get ideal geometry IF varyingCount>0 THEN { offset: INT ¬ 0; wrong: INT ¬ widget.actual.size.width-pos.x; IF wrong#0 THEN { FOR i: INT IN [0..allCount) DO -- second pass: fix geometry evenly child: XTk.Widget ¬ cd[i].child; cd[i].g.pos.x ¬ cd[i].g.pos.x + offset; IF Varying[child] THEN { correction: INT ¬ wrong/varyingCount; varyingCount ¬ varyingCount-1; IF (cd[i].g.size.width+correction)<1 THEN { correction ¬ 1-cd[i].g.size.width; }; wrong ¬ wrong-correction; cd[i].g.size.width ¬ cd[i].g.size.width + correction; offset ¬ offset + correction; }; ENDLOOP; }; }; FOR i: INT IN [0..allCount) DO-- last pass: now really set the fixed geometry child: XTk.Widget ¬ cd[i].child; XTkFriends.ConfigureLR[child, cd[i].g, cd[i].mapping, reConsiderChildren]; ENDLOOP; }; skipNone: XTk.GeometryRequest = [FALSE, FALSE, FALSE, FALSE, FALSE]; ContSizingLR: PROC [widget: Widget, reConsiderChildren: BOOL] = { pos: Xl.Point ¬ [0, 0]; EachChild: XTkCollections.EachChildProc = { g: Xl.Geometry ¬ []; IF child.state#realized<> AND ~reConsiderChildren THEN RETURN; IF child.s.mapping=mapped THEN { g ¬ XTkFriends.PreferredSizeLR[widget: child, proposed: child.actual, maySkip: skipNone]; IF g.size.width<=0 THEN g.size.width ¬ 1; IF g.size.height<=0 THEN g.size.height ¬ 1; IF g.borderWidth<0 THEN g.borderWidth ¬ 0; }; XTkFriends.ConfigureLR[child, g, child.s.mapping, reConsiderChildren]; }; IF reConsiderChildren THEN XTk.SetWidgetFlag[widget, XTk.mustReConsiderChildren, FALSE]; XTkCollections.BasicEnumerateChildren[widget, EachChild]; }; END.