<> <> <> DIRECTORY Buttons, GGContainer, GGInterfaceTypes, GGUserInput, GGButtons, IO, Labels, Menus, Rope, TiogaButtons, ViewerClasses, ViewerOps, VFonts, ViewerTools; GGButtonsImpl: CEDAR PROGRAM IMPORTS Buttons, GGContainer, GGUserInput, IO, Labels, Menus, Rope, TiogaButtons, VFonts, ViewerOps, ViewerTools EXPORTS GGButtons = BEGIN ButtonLineEntry: TYPE = GGInterfaceTypes.ButtonLineEntry; ButtonList: TYPE = GGInterfaceTypes.ButtonList; ButtonType: TYPE = GGInterfaceTypes.ButtonType; DisplayStyle: TYPE = GGInterfaceTypes.DisplayStyle; GargoyleData: TYPE = GGInterfaceTypes.GargoyleData; GGButtonData: TYPE = REF GGButtonDataObj; GGButtonDataObj: TYPE = GGInterfaceTypes.GGButtonDataObj; MenuEntry: TYPE = GGInterfaceTypes.MenuEntry; PopUpLineEntry: TYPE = GGInterfaceTypes.PopUpLineEntry; ScalarButton: TYPE = GGInterfaceTypes.ScalarButton; ScalarButtonClient: TYPE = REF ScalarButtonClientObj; ScalarButtonClientObj: TYPE = GGInterfaceTypes.ScalarButtonClientObj; StateType: TYPE = GGInterfaceTypes.StateType; StyleChoice: TYPE = GGInterfaceTypes.StyleChoice; TwoState: TYPE = REF TwoStateObj; TwoStateObj: TYPE = GGInterfaceTypes.TwoStateObj; QueuedMenuEntry: TYPE = GGInterfaceTypes.QueuedMenuEntry; Viewer: TYPE = ViewerClasses.Viewer; EnumTypeRef: TYPE = REF EnumTypeRec; EnumTypeRec: TYPE = GGInterfaceTypes.EnumTypeRec; entryHeight: CARDINAL = 15; -- height of a line of items entryVSpace: CARDINAL = 2; -- vertical leading between lines entryHSpace: CARDINAL = 2; -- horizontal space between items on a line column1: CARDINAL = 200; -- horizontal space between margin and column 1; column2: CARDINAL = 250; -- horizontal space between margin and column 2. column3: CARDINAL = 500; -- horizontal space between margin and column 3; <> <<>> BuildMenuLine: PUBLIC PROC [menu: Menus.Menu, line: NAT, clientData: REF ANY, entries: LIST OF MenuEntry] = { guarded: BOOL; FOR entryList: LIST OF MenuEntry _ entries, entryList.rest UNTIL entryList = NIL DO guarded _ entryList.first.confirmProc # NIL; Menus.AppendMenuEntry[ menu: menu, entry: Menus.CreateEntry[ name: entryList.first.name, proc: entryList.first.proc, clientData: clientData, documentation: entryList.first.confirmProc, fork: TRUE, guarded: guarded], line: line ]; ENDLOOP; }; BuildQueuedMenuLine: PUBLIC PROC [menu: Menus.Menu, line: NAT, clientData: REF ANY, entries: LIST OF QueuedMenuEntry] = { guarded: BOOL; buttonData: GGButtonData; FOR entryList: LIST OF QueuedMenuEntry _ entries, entryList.rest UNTIL entryList = NIL DO guarded _ entryList.first.confirmProc # NIL; buttonData _ NEW[GGButtonDataObj _ [clientData, entryList.first.action]]; Menus.AppendMenuEntry[ menu: menu, entry: Menus.CreateEntry[ name: entryList.first.name, proc: GGUserInput.HandleMenuAction, clientData: buttonData, documentation: entryList.first.confirmProc, guarded: guarded], line: line ]; ENDLOOP; }; <<>> <> <<>> <> BuildButtonLine: PUBLIC PROC [container: Viewer, x, y: NAT, clientData: REF ANY, entries: LIST OF ButtonLineEntry] RETURNS [nextX: INTEGER] = { thisButton, prevButton: Buttons.Button; buttonData: GGButtonData; gargoyleData: GargoyleData _ NARROW[clientData]; SELECT entries.first.type FROM button => { buttonData _ NEW[GGButtonDataObj _ [gargoyleData, entries.first.action]]; prevButton _ Buttons.Create[ info: [name: entries.first.name, wx: x, wy: y, wh: entryHeight, parent: container, border: entries.first.border], proc: GGUserInput.HandleMenuAction, clientData: buttonData, fork: TRUE ]; }; label => { prevButton _ Labels.Create[ info: [name: entries.first.name, wx: x, wy: y, wh: entryHeight, parent: container, border: entries.first.border]]; }; text => { prevButton _ ViewerTools.MakeNewTextViewer[[ parent: container, wx: x, wy: y, ww: entries.first.ww, wh: entryHeight, data: entries.first.name, scrollable: FALSE, border: entries.first.border]]; }; ENDCASE => ERROR; IF entries.first.updateProc # NIL THEN entries.first.updateProc[entries.first.name, clientData, prevButton]; nextX _ prevButton.wx + prevButton.ww; FOR entryList: LIST OF ButtonLineEntry _ entries.rest, entryList.rest UNTIL entryList = NIL DO SELECT entryList.first.type FROM button => { buttonData _ NEW[GGButtonDataObj _ [gargoyleData, entryList.first.action]]; thisButton _ Buttons.Create[ info: [name: entryList.first.name, wx: nextX + entryHSpace, wy: y, wh: entryHeight, parent: container, border: entryList.first.border], proc: GGUserInput.HandleMenuAction, clientData: buttonData, fork: TRUE ]; }; label => { thisButton _ Labels.Create[ info: [name: entryList.first.name, wx: nextX + entryHSpace, wy: y, wh: entryHeight, parent: container, border: entryList.first.border]]; }; text => { thisButton _ ViewerTools.MakeNewTextViewer[[ parent: container, wx: nextX + entryHSpace, wy: y, ww: entryList.first.ww, wh: entryHeight, data: entryList.first.name, scrollable: FALSE, border: entryList.first.border]]; }; ENDCASE => ERROR; IF entryList.first.updateProc # NIL THEN entryList.first.updateProc[entryList.first.name, clientData, thisButton]; prevButton _ thisButton; nextX _ prevButton.wx + prevButton.ww; ENDLOOP; }; BuildLineOfPopUps: PUBLIC PROC [container: Viewer, x, y: NAT, clientData: REF ANY, entries: LIST OF PopUpLineEntry] RETURNS [nextX: INTEGER] = { thisButton, prevButton: Buttons.Button; SELECT entries.first.type FROM button => { prevButton _ Buttons.Create[ info: [name: entries.first.name, wx: x, wy: y, wh: entryHeight, parent: container, border: entries.first.border], proc: entries.first.proc, clientData: clientData, fork: TRUE ]; }; label => { prevButton _ Labels.Create[ info: [name: entries.first.name, wx: x, wy: y, wh: entryHeight, parent: container, border: entries.first.border]]; }; text => { prevButton _ ViewerTools.MakeNewTextViewer[[ parent: container, wx: x, wy: y, ww: entries.first.ww, wh: entryHeight, data: entries.first.name, scrollable: FALSE, border: entries.first.border]]; }; ENDCASE => ERROR; IF entries.first.updateProc # NIL THEN entries.first.updateProc[entries.first.name, clientData, prevButton]; nextX _ prevButton.wx + prevButton.ww; FOR entryList: LIST OF PopUpLineEntry _ entries.rest, entryList.rest UNTIL entryList = NIL DO SELECT entryList.first.type FROM button => { thisButton _ Buttons.Create[ info: [name: entryList.first.name, wx: nextX + entryHSpace, wy: y, wh: entryHeight, parent: container, border: entryList.first.border], proc: entryList.first.proc, clientData: clientData, fork: TRUE ]; }; label => { thisButton _ Labels.Create[ info: [name: entryList.first.name, wx: nextX + entryHSpace, wy: y, wh: entryHeight, parent: container, border: entryList.first.border]]; }; text => { thisButton _ ViewerTools.MakeNewTextViewer[[ parent: container, wx: nextX + entryHSpace, wy: y, ww: entryList.first.ww, wh: entryHeight, data: entryList.first.name, scrollable: FALSE, border: entryList.first.border]]; }; ENDCASE => ERROR; IF entryList.first.updateProc # NIL THEN entryList.first.updateProc[entryList.first.name, clientData, thisButton]; prevButton _ thisButton; nextX _ prevButton.wx + prevButton.ww; ENDLOOP; }; BuildTwoStateButton: PUBLIC PROC [viewer: ViewerClasses.Viewer, x,y: INTEGER, name: Rope.ROPE, action: LIST OF REF ANY, clientData: REF ANY, border: BOOL _ TRUE, init: StateType _ off] RETURNS [stateInfo: TwoState, nextX: INTEGER] = { tempButton: Buttons.Button; stateInfo _ NEW[TwoStateObj]; tempButton _ Buttons.Create[ info: [name: name, wx: x, wy: y, <> wh: entryHeight, -- specify rather than defaulting so line is uniform parent: viewer, border: border ], proc: TwoSwitchProc, clientData: stateInfo -- this will be passed to our button proc ]; stateInfo.button _ tempButton; stateInfo.action _ action; stateInfo.clientData _ clientData; SetButtonState[stateInfo, init]; nextX _ tempButton.wx + tempButton.ww + 4; }; SetButtonState: PUBLIC PROC [twoState: TwoState, state: StateType] = { twoState.state _ state; SELECT state FROM on => Buttons.SetDisplayStyle[button: twoState.button, style: $WhiteOnBlack]; off => Buttons.SetDisplayStyle[button: twoState.button, style: $BlackOnWhite]; ENDCASE => ERROR; }; NextState: PROC [state: StateType] RETURNS [StateType] = { IF state = LAST[StateType] THEN RETURN[FIRST[StateType]] ELSE RETURN[SUCC[state]]; }; TwoSwitchProc: Buttons.ButtonProc = { handle: TwoState _ NARROW[clientData]; gargoyleData: GargoyleData _ NARROW[handle.clientData]; GGUserInput.GeneralDispatch[handle.action, gargoyleData]; }; SwitchState: PUBLIC PROC [handle: TwoState] = { nextState: StateType; nextState _ NextState[handle.state]; SetButtonState[handle, nextState]; }; <> <> <> <> <> <<[gargoyleData.hitTest.slopeState[gargoyleData.hitTest.slopeCount], nextX] _ >> <> <> <> <> <> <> <> <> <> <> <> <<};>> <<>> <> <> MakeViewer: PROC [gargoyleData: GargoyleData] RETURNS [viewer: Viewer] = { viewer _ TiogaButtons.CreateViewer[ info: [wy: gargoyleData.height, ww: gargoyleData.outer.ww, wh: entryHeight, parent: gargoyleData.outer, border: FALSE] ]; GGContainer.ChildXBound[gargoyleData.outer, viewer]; }; HeaderButton: PROC [v: Viewer, name: Rope.ROPE, gargoyleData: GargoyleData] RETURNS [button: TiogaButtons.TiogaButton] = { button _ TiogaButtons.CreateButton[ viewer: v, rope: name, format: "", looks: "", proc: NIL, clientData: NIL]; }; AddScalarButton: PUBLIC PROC [prevButton: TiogaButtons.TiogaButton, value: REAL, action: LIST OF REF ANY, on: BOOL, gargoyleData: GargoyleData] RETURNS [button: TiogaButtons.TiogaButton] = { buttonData, prevButtonData: ScalarButtonClient; name: Rope.ROPE; buttonData _ NEW[ScalarButtonClientObj _ [NIL, value, action, on, NIL, gargoyleData]]; name _ IO.PutFR["%6.1f", [real[value]]]; IF Rope.Equal[Rope.Substr[name, Rope.Length[name]-2, 2], ".0"] THEN name _ Rope.Substr[name, 0, Rope.Length[name]-2]; button _ TiogaButtons.AppendToButton[ button: prevButton, rope: Rope.Concat[name, " "], looks: "", proc: ToggleScalar, clientData: buttonData, fork: FALSE]; prevButtonData _ NARROW[prevButton.clientData]; IF prevButtonData # NIL THEN prevButtonData.next _ buttonData; <> buttonData.button _ button; }; ToggleScalar: TiogaButtons.TiogaButtonProc ~ { button: TiogaButtons.TiogaButton _ NARROW[parent]; buttonData: ScalarButtonClient _ NARROW[clientData]; gargoyleData: GargoyleData _ buttonData.gargoyleData; GGUserInput.GeneralDispatch[buttonData.action, gargoyleData]; }; BuildScalarButtons: PUBLIC PROC [clientData: REF ANY, header: Rope.ROPE, scalarButtonList: LIST OF ScalarButton] RETURNS [bigStructure: ScalarButtonClient] = { gargoyleData: GargoyleData _ NARROW[clientData]; prevButton: TiogaButtons.TiogaButton; viewer: Viewer; viewer _ MakeViewer[gargoyleData]; prevButton _ HeaderButton[viewer, header, gargoyleData]; bigStructure _ NIL; FOR list: LIST OF ScalarButton _ scalarButtonList, list.rest UNTIL list = NIL DO prevButton _ AddScalarButton[prevButton, list.first.value, list.first.action, list.first.init = on, gargoyleData]; IF list = scalarButtonList THEN bigStructure _ NARROW[prevButton.clientData]; ENDLOOP; gargoyleData.height _ gargoyleData.height + entryHeight; }; <<>> <> BuildEnumTypeSelection: PUBLIC PROC [viewer: ViewerClasses.Viewer, x, y: CARDINAL, title: Rope.ROPE, buttonNames: ButtonList, default: Rope.ROPE, borderOnButtons: BOOL, atom: ATOM, clientdata: REF ANY, style: StyleChoice, allInOneRow: BOOL, maxWidth: INTEGER] RETURNS [EnumTypeRef] = { foundDefault: BOOL _ FALSE; stateInfo: EnumTypeRef _ NEW[EnumTypeRec]; DefaultFound: PROC[currentName, defaultName: Rope.ROPE] RETURNS [BOOL] = { IF Rope.Equal[currentName, defaultName, FALSE] THEN RETURN [foundDefault _ TRUE] ELSE RETURN [FALSE]; }; BuildMenuSelection: PROC = { border: INTEGER _ 10; startButtons: CARDINAL; startX: INTEGER _ 0; -- keeps a running tally of where the next x position is tempButton: Buttons.Button; eachButton: ButtonList; stateInfo.type _ menuStyle; IF title # NIL THEN { titleLabel: Labels.Label_ Labels.Create[[ name: title, parent: viewer, wx: x, wy: y, wh: entryHeight, border: FALSE ]]; startButtons _ titleLabel.wx + titleLabel.ww + entryHSpace; } ELSE startButtons _ x; startX _ startButtons; FOR eachButton _ buttonNames, eachButton.rest UNTIL eachButton = NIL DO IF ~allInOneRow THEN { IF startX + VFonts.StringWidth[eachButton.first, VFonts.defaultFont] + border >= maxWidth THEN { startX _ startButtons; stateInfo.nexty _ stateInfo.nexty + entryHeight; }; }; tempButton _ Buttons.Create[info: [ name: eachButton.first, wx: startX, wy: stateInfo.nexty, <> wh: entryHeight, -- specify rather than defaulting so line is uniform parent: viewer, border: borderOnButtons ], proc: MenuSelectionProc, clientData: stateInfo ]; ViewerOps.AddProp[tempButton, $ChoiceButtons, stateInfo]; IF DefaultFound[eachButton.first, default] THEN { stateInfo.buttonOn _ tempButton; Buttons.SetDisplayStyle[button: tempButton, style: on]; }; startX _ tempButton.wx + tempButton.ww; ENDLOOP; stateInfo.nextx _ startX; }; BuildFlipThru: PROC = { eachButton: ButtonList; titleButton: Buttons.Button; nextx: INTEGER _ x; IF title # NIL THEN { -- create a title button stateInfo.type _ flipThruWithTitle; titleButton _ Buttons.Create[ info: [name: title, parent: viewer, wx: nextx, wy: y, wh: entryHeight, border: TRUE ], proc: FlipThruButtonProc, clientData: stateInfo ]; nextx _ titleButton.wx + titleButton.ww + 3; } ELSE stateInfo.type _ flipThruNoTitle; FOR eachButton _ buttonNames, eachButton.rest UNTIL (eachButton = NIL) OR DefaultFound[eachButton.first, default] DO -- do nothing ENDLOOP; <> IF title # NIL THEN stateInfo.flipLabel _ Labels.Create[[ name: eachButton.first, wx: nextx, wy: y, ww: MaxNameWidth[buttonNames], -- first find the longest name so we can set up the <> wh: entryHeight, parent: viewer, border: FALSE ]] ELSE stateInfo.flipLabel _ Buttons.Create[ info: [name: eachButton.first, wx: nextx, wy: y, ww: MaxNameWidth[buttonNames], wh: entryHeight, parent: viewer, border: borderOnButtons ], proc: FlipThruButtonProc, clientData: stateInfo ]; stateInfo.nextx _ stateInfo.flipLabel.wx + stateInfo.flipLabel.ww; }; stateInfo.nextx _ x; stateInfo.nexty _ y; stateInfo.atom _ atom; stateInfo.namesOfButtons _ buttonNames; stateInfo.clientdata _ clientdata; IF default = NIL THEN -- set it to be the first name of the list of button names default _ buttonNames.first; SELECT style FROM menuSelection => BuildMenuSelection; flipThru => BuildFlipThru; ENDCASE => ERROR; <> IF ~foundDefault THEN SIGNAL DefaultDoesntExist; stateInfo.nexty _ stateInfo.nexty + entryHeight; RETURN[stateInfo]; }; FlipThruButtonProc: Buttons.ButtonProc = { info: EnumTypeRef _ NARROW[clientData]; gargoyleData: GargoyleData _ NARROW[info.clientdata]; IF mouseButton=red THEN GGUserInput.GeneralDispatch[LIST[info.atom, $FlipForward, info], gargoyleData] ELSE GGUserInput.GeneralDispatch[LIST[info.atom, $FlipBackward, info], gargoyleData]; }; TimeToFlipThru: PUBLIC PROC [event: LIST OF REF ANY] = { info: EnumTypeRef _ NARROW[event.rest.first]; IF event.first = $FlipForward THEN <> ViewerTools.SetContents[viewer: info.flipLabel, contents: GetNextName[info.namesOfButtons, info.flipLabel.name]] ELSE IF event.first = $FlipBackward THEN ViewerTools.SetContents[viewer: info.flipLabel, contents: GetPrevName[info.namesOfButtons, info.flipLabel.name]]; }; UpdateChoiceButtons: PUBLIC PROC [viewer: ViewerClasses.Viewer, enumTypeInfo: EnumTypeRef, newName: Rope.ROPE] = { newButton: Buttons.Button _ NIL; GetDesiredButton: ViewerOps.EnumProc = { IF (Rope.Equal[v.name, newName, FALSE]) AND (ViewerOps.FetchProp[v, $ChoiceButtons] = enumTypeInfo) THEN { newButton _ v; RETURN [FALSE]; }; }; IF enumTypeInfo = NIL THEN SIGNAL ButtonsCannotBeUpdated; SELECT enumTypeInfo.type FROM menuStyle => {ViewerOps.EnumerateChildren[viewer, GetDesiredButton]; IF newButton # NIL THEN { SwitchButtons[enumTypeInfo.buttonOn, newButton]; enumTypeInfo.buttonOn _ newButton; } ELSE SIGNAL ChoiceDoesntExist; }; flipThruWithTitle => Labels.Set[label: enumTypeInfo.flipLabel, value: newName]; flipThruNoTitle => Buttons.ReLabel[button: enumTypeInfo.flipLabel, newName: newName]; ENDCASE => ERROR; }; DefaultDoesntExist: PUBLIC SIGNAL = CODE; ChoiceDoesntExist: PUBLIC SIGNAL = CODE; ButtonsCannotBeUpdated: PUBLIC SIGNAL = CODE; MaxNameWidth: PRIVATE PROC[listOfNames: ButtonList] RETURNS [CARDINAL] = { eachButton: ButtonList _ listOfNames; maxWidth: CARDINAL; IF eachButton # NIL THEN { maxWidth _ VFonts.StringWidth[string: eachButton.first, font: VFonts.defaultFont]; eachButton _ eachButton.rest } ELSE RETURN [0]; WHILE (eachButton # NIL) DO IF VFonts.StringWidth[string: eachButton.first, font: VFonts.defaultFont] > maxWidth THEN maxWidth _ VFonts.StringWidth[string: eachButton.first, font: VFonts.defaultFont]; eachButton _ eachButton.rest; ENDLOOP; maxWidth _ maxWidth + VFonts.CharWidth['M]; -- add on a little extra just to be sure RETURN[maxWidth]; }; MenuSelectionProc: Buttons.ButtonProc = { info: EnumTypeRef _ NARROW[clientData]; viewer: ViewerClasses.Viewer _ NARROW[parent]; SwitchButtons[info.buttonOn, viewer]; -- viewer is the button which was just selected info.buttonOn _ viewer; <> <> }; GetNextName: PRIVATE PROC[listOfNames: ButtonList, currentName: Rope.ROPE] RETURNS [Rope.ROPE] = { eachButton: ButtonList _ listOfNames; WHILE (eachButton # NIL) AND (eachButton.first # currentName) DO eachButton _ eachButton.rest; ENDLOOP; IF eachButton = NIL THEN ERROR; -- This shouldn't happen; we should always be able to <> IF eachButton.rest = NIL THEN <> RETURN [listOfNames.first] ELSE RETURN [(eachButton.rest).first]; }; GetPrevName: PRIVATE PROC[listOfNames: ButtonList, currentName: Rope.ROPE] RETURNS [Rope.ROPE] = { prev: Rope.ROPE _ listOfNames.first; eachName: ButtonList _ listOfNames.rest; WHILE (eachName # NIL) AND ~Rope.Equal[eachName.first, currentName, FALSE] DO prev _ eachName.first; eachName _ eachName.rest; ENDLOOP; RETURN[prev]; }; on: ATOM = $WhiteOnBlack; off: ATOM = $BlackOnWhite; SwitchButtons: PRIVATE PROC[oldButton, newButton: Buttons.Button] = { <> <> Buttons.SetDisplayStyle[button: oldButton, style: off]; <> Buttons.SetDisplayStyle[button: newButton, style: on]; }; END.