AtomButtonsImpl.mesa
Last edited by Bier on January 28, 1987 2:36:40 pm PST.
Contents: General Purpose routines for use by Gargoyle.
Pier, December 12, 1986 2:36:03 pm PST
DIRECTORY
Buttons, AtomButtons, FileNames, Imager, IO, Labels, Menus, Rope, TiogaButtons, ViewerClasses, ViewerOps, VFonts, ViewerTools;
AtomButtonsImpl: CEDAR PROGRAM
IMPORTS Buttons, FileNames, IO, Labels, Rope, TiogaButtons, VFonts, ViewerOps, ViewerTools
EXPORTS AtomButtons =
BEGIN
ButtonLineEntry: TYPE = AtomButtons.ButtonLineEntry;
UnQueuedButtonLineEntry: TYPE = AtomButtons.UnQueuedButtonLineEntry;
ButtonList: TYPE = AtomButtons.ButtonList;
ButtonType: TYPE = AtomButtons.ButtonType;
DisplayStyle: TYPE = AtomButtons.DisplayStyle;
ConfirmProc: TYPE = AtomButtons.ConfirmProc;
Order: TYPE = AtomButtons.Order;
HandleButtonProc: TYPE = AtomButtons.HandleButtonProc;
ScalarButton: TYPE = AtomButtons.ScalarButton;
ScalarButtonClient: TYPE = REF ScalarButtonClientObj;
ScalarButtonClientObj: TYPE = AtomButtons.ScalarButtonClientObj;
ScalarButtonHandle: TYPE = REF ScalarButtonHandleObj;
ScalarButtonHandleObj: TYPE = AtomButtons.ScalarButtonHandleObj;
StateType: TYPE = AtomButtons.StateType;
StyleChoice: TYPE = AtomButtons.StyleChoice;
TwoState: TYPE = REF TwoStateObj;
TwoStateObj: TYPE = AtomButtons.TwoStateObj;
UpdateProc: TYPE = AtomButtons.UpdateProc;
Viewer: TYPE = ViewerClasses.Viewer;
EnumTypeRef: TYPE = REF EnumTypeRec;
EnumTypeRec: TYPE = AtomButtons.EnumTypeRec;
entryHeight: CARDINAL = 15; -- height of a line of items
entryHSpace: CARDINAL = 2; -- horizontal space between items on a line
It should be possible to set these values through the AtomButtons interface.
Button Lines
GGButtonData: TYPE = REF GGButtonDataObj;
GGButtonDataObj: TYPE = RECORD [
clientData: REF ANY, -- compilation dependencies again
leftAction: LIST OF REF ANY,
rightAction: LIST OF REF ANY,
handleProc: HandleButtonProc,
confirmProc: ConfirmProc
];
BuildButtonLine: PUBLIC PROC [container: Viewer, x, y: NAT,
clientData: REF ANY,
handleProc: HandleButtonProc,
entries: LIST OF ButtonLineEntry] RETURNS [nextX: INTEGER] = {
thisButton, prevButton: Buttons.Button;
prevButton ← BuildButton[container, x, y, clientData, handleProc, entries.first.type, entries.first.leftAction, entries.first.rightAction, entries.first.name, entries.first.border, entries.first.ww, entries.first.updateProc, entries.first.confirmProc, entries.first.font];
nextX ← prevButton.wx + prevButton.ww;
FOR entryList: LIST OF ButtonLineEntry ← entries.rest, entryList.rest UNTIL entryList = NIL DO
thisButton ← BuildButton[container, nextX + entryHSpace, y, clientData, handleProc, entryList.first.type, entryList.first.leftAction, entryList.first.rightAction, entryList.first.name, entryList.first.border, entryList.first.ww, entryList.first.updateProc, entryList.first.confirmProc, entryList.first.font];
prevButton ← thisButton;
nextX ← prevButton.wx + prevButton.ww;
ENDLOOP;
};
BuildButton: PROC [container: Viewer, x, y: NAT, clientData: REF ANY,
A line of regular Buttons, Labels, and TextViewers.
handleProc: HandleButtonProc,
type: ButtonType,
leftAction: LIST OF REF ANY,
rightAction: LIST OF REF ANY,
name: Rope.ROPE,
border: BOOL,
ww: NAT,
updateProc: UpdateProc,
confirmProc: ConfirmProc,
font: Imager.Font] RETURNS [button: Buttons.Button] = {
SELECT type FROM
button => {
buttonData: GGButtonData;
buttonData ← NEW[GGButtonDataObj ← [clientData, leftAction, rightAction, handleProc, confirmProc]];
button ← Buttons.Create[
info: [name: name, wx: x, wy: y, wh: entryHeight,
parent: container, border: border],
proc: HandleButton,
clientData: buttonData,
documentation: handleConfirm,
fork: FALSE,
guarded: confirmProc # NIL,
font: font
];
};
label => {
button ← Labels.Create[
info: [name: name, wx: x, wy: y, wh: entryHeight,
parent: container, border: border]];
};
text => {
button ← ViewerTools.MakeNewTextViewer[[
parent: container,
wx: x,
wy: y,
ww: ww,
wh: entryHeight,
data: name,
scrollable: FALSE, border: border]];
};
ENDCASE => ERROR;
IF updateProc # NIL THEN updateProc[name, clientData, button];
};
HandleButton: Menus.ClickProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
buttonData: GGButtonData ← NARROW[clientData];
IF buttonData.rightAction#NIL AND mouseButton = blue THEN
buttonData.handleProc[buttonData.clientData, buttonData.rightAction]
ELSE buttonData.handleProc[buttonData.clientData, buttonData.leftAction];
buttonData.handleProc usually puts the action on the slack queue.
};
handleConfirm: REF Menus.ClickProc ← NEW[Menus.ClickProc ← HandleConfirm];
HandleConfirm: Menus.ClickProc = {
buttonData: GGButtonData ← NARROW[clientData];
buttonData.confirmProc[buttonData.clientData];
};
UnQueued Buttons Lines
GGUnQueuedButtonData: TYPE = REF GGUnQueuedButtonDataObj;
GGUnQueuedButtonDataObj: TYPE = RECORD [
clientData: REF ANY,
clickProc: Menus.ClickProc,
confirmProc: ConfirmProc
];
BuildUnQueuedButtonLine: PUBLIC PROC [container: Viewer, x, y: NAT,
clientData: REF ANY,
entries: LIST OF UnQueuedButtonLineEntry] RETURNS [nextX: INTEGER] = {
thisButton, prevButton: Buttons.Button;
prevButton ← BuildUnQueuedButton[container, x, y, clientData, entries.first.type, entries.first.clickProc, entries.first.name, entries.first.border, entries.first.ww, entries.first.updateProc, entries.first.confirmProc, entries.first.font];
nextX ← prevButton.wx + prevButton.ww;
FOR entryList: LIST OF UnQueuedButtonLineEntry ← entries.rest, entryList.rest UNTIL entryList = NIL DO
thisButton ← BuildUnQueuedButton[container, nextX + entryHSpace, y, clientData, entryList.first.type, entryList.first.clickProc, entryList.first.name, entryList.first.border, entryList.first.ww, entryList.first.updateProc, entryList.first.confirmProc, entryList.first.font];
prevButton ← thisButton;
nextX ← prevButton.wx + prevButton.ww;
ENDLOOP;
};
BuildUnQueuedButton: PROC [container: Viewer, x, y: NAT, clientData: REF ANY,
type: ButtonType,
clickProc: Menus.ClickProc,
name: Rope.ROPE,
border: BOOL,
ww: NAT,
updateProc: UpdateProc,
confirmProc: ConfirmProc,
font: Imager.Font] RETURNS [button: Buttons.Button] = {
An unqueued button calls the clickProc indicated by the client. It forks a process.
Like BuildButton except that action: LIST OF REF ANY is replaced with clickProc: Menus.ClickProc. This only affects buttons (not labels or text viewers).
SELECT type FROM
button => {
buttonData: GGUnQueuedButtonData;
buttonData ← NEW[GGUnQueuedButtonDataObj ← [clientData, clickProc, confirmProc]];
button ← Buttons.Create[
info: [name: name, wx: x, wy: y, wh: entryHeight,
parent: container, border: border],
proc: HandleUnQueuedButton,
clientData: buttonData,
documentation: handleUnQueuedConfirm,
fork: TRUE,
guarded: confirmProc # NIL,
font: font
];
};
label => {
button ← Labels.Create[
info: [name: name, wx: x, wy: y, wh: entryHeight,
parent: container, border: border]];
};
text => {
button ← ViewerTools.MakeNewTextViewer[[
parent: container,
wx: x,
wy: y,
ww: ww,
wh: entryHeight,
data: name,
scrollable: FALSE, border: border]];
};
ENDCASE => ERROR;
IF updateProc # NIL THEN updateProc[name, clientData, button];
};
HandleUnQueuedButton: Menus.ClickProc = {
buttonData: GGUnQueuedButtonData ← NARROW[clientData];
buttonData.clickProc[NIL, buttonData.clientData, mouseButton, shift, control];
};
handleUnQueuedConfirm: REF Menus.ClickProc ← NEW[Menus.ClickProc ← HandleUnQueuedConfirm];
HandleUnQueuedConfirm: Menus.ClickProc = {
buttonData: GGUnQueuedButtonData ← NARROW[clientData];
buttonData.confirmProc[buttonData.clientData];
};
Two State Buttons
BuildTwoStateButton: PUBLIC PROC [viewer: ViewerClasses.Viewer, x, y: NAT,
clientData: REF ANY,
handleProc: HandleButtonProc,
name: Rope.ROPE,
border: BOOLTRUE, init: StateType ← off,
action: LIST OF REF ANY] RETURNS [stateInfo: TwoState, nextX: INTEGER] = {
tempButton: Buttons.Button;
stateInfo ← NEW[TwoStateObj];
tempButton ← Buttons.Create[
info: [name: name,
wx: x,
wy: y,
default the width so that it will be computed for us
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;
stateInfo.handleProc ← handleProc;
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;
};
GetButtonState: PUBLIC PROC [twoState: TwoState] RETURNS [state: StateType] = {
state ← twoState.state;
};
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];
handle.handleProc[handle.clientData, handle.action];
};
SwitchState: PUBLIC PROC [handle: TwoState] = {
nextState: StateType;
nextState ← NextState[handle.state];
SetButtonState[handle, nextState];
};
Scalar Buttons
A line of Tioga Buttons, but built for the new User Interface Architecture (see comment below).
Makes a TiogaButtons viewer and fills it with buttons. Each button names the action atoms to give to the slack process when the button is pressed. The rest is somewhat convoluted. The client must figure out which button has been pressed, update his data structures and call an appropriate procedure to change the appearance of the button, if desired. Hence, the client must have a data structure which points to the appropriate button. This procedure builds such a data structure.
CreateScalarButtonViewer: PUBLIC PROC [container: Viewer, x, y: NAT] RETURNS [AtomButtons.ScalarButtonHandle] = {
sbHandle: AtomButtons.ScalarButtonHandle ← NEW[AtomButtons.ScalarButtonHandleObj];
sbHandle.viewer ← MakeViewer[container, x, y];
sbHandle.headerButton ← NewHeaderButton[sbHandle.viewer, NIL];
RETURN[sbHandle];
};
BuildScalarButtons: PUBLIC PROC [handle: ScalarButtonHandle, clientData: REF ANY, handleProc: HandleButtonProc, header: Rope.ROPE, scalarButtonList: LIST OF ScalarButton] = {
buttons: ScalarButtonClient;
prevButton: TiogaButtons.TiogaButton;
oldScalarButtons: ScalarButtonClient ← handle.scalarButtons;
clear out the existing buttons, which TiogaOps doesn't seem able to do !!
FOR thisButton: ScalarButtonClient ← oldScalarButtons, thisButton.next UNTIL thisButton=NIL DO
TiogaButtons.DeleteButton[thisButton.button];
ENDLOOP;
add the new buttons
prevButton ← handle.headerButton;
FOR list: LIST OF ScalarButton ← scalarButtonList, list.rest UNTIL list = NIL DO
prevButton ← AppendScalarButton[prevButton, clientData, handleProc, list.first.name, list.first.value, list.first.init = on, list.first.action];
IF list = scalarButtonList THEN buttons ← NARROW[prevButton.clientData];
ENDLOOP;
handle.scalarButtons ← buttons;
handle.handleProc ← handleProc;
};
StartScalarButtonList: PROC [] RETURNS [entityList, ptr: LIST OF ScalarButton] = {
ptr ← entityList ← NIL;
};
AddScalarButton: PROC [entity: ScalarButton, entityList, ptr: LIST OF ScalarButton] RETURNS [newList, newPtr: LIST OF ScalarButton] = {
IF ptr = NIL THEN {
IF NOT entityList = NIL THEN ERROR;
newPtr ← newList ← CONS[entity, NIL];
RETURN;
}
ELSE {
newList ← entityList;
ptr.rest ← CONS[entity, NIL];
newPtr ← ptr.rest;
};
};
AddValueSorted: PUBLIC PROC [clientData: REF ANY, scalarButtonHandle: ScalarButtonHandle, value: ScalarButton, order: Order ← incr] RETURNS [oldFoundButton: ScalarButtonClient ← NIL] = {
Adds a new scalar button to the list, sort in increasing order or decreasing order as requested. If it is already there, it is not added. Turns on the new button.
epsilon: REAL = 0.001;
list, finger: LIST OF AtomButtons.ScalarButton;
inserted: BOOLFALSE;
oldScalarButtons: ScalarButtonClient ← scalarButtonHandle.scalarButtons;
[list, finger] ← StartScalarButtonList[];
FOR thisButton: ScalarButtonClient ← oldScalarButtons, thisButton.next UNTIL thisButton=NIL DO
search the current list for duplicate OR for proper insertion point, build new list along the way
IF ABS[thisButton.value-value.value] < epsilon THEN {
thisButton.on ← value.init = on;
IF thisButton.on THEN TiogaButtons.ChangeButtonLooks[thisButton.button, "b", ""]
ELSE TiogaButtons.ChangeButtonLooks[thisButton.button, "", "b"];
RETURN[thisButton];
};
IF NOT inserted AND order=decr AND thisButton.value<value.value THEN { -- insert new value behind thisButton
[list, finger] ← AddScalarButton[value, list, finger];
inserted ← TRUE;
}
ELSE IF NOT inserted AND order=incr AND thisButton.value>value.value THEN { -- insert new value behind thisButton
[list, finger] ← AddScalarButton[value, list, finger];
inserted ← TRUE;
};
[list, finger] ← AddScalarButton[[thisButton.name, thisButton.value, thisButton.action, IF thisButton.on THEN on ELSE off], list, finger];
ENDLOOP;
IF NOT inserted THEN { -- tack new slope onto proper end of the list
[list, finger] ← AddScalarButton[value, list, finger];
};
Now clear out the existing buttons, which TiogaOps doesn't seem able to do !!
FOR thisButton: ScalarButtonClient ← oldScalarButtons, thisButton.next UNTIL thisButton=NIL DO
TiogaButtons.DeleteButton[thisButton.button];
ENDLOOP;
scalarButtonHandle.scalarButtons ← RebuildScalarButtons[viewer: scalarButtonHandle.viewer, headerButton: scalarButtonHandle.headerButton, clientData: clientData, handleProc: scalarButtonHandle.handleProc, scalarButtonList: list];
FOR thisButton: ScalarButtonClient ← scalarButtonHandle.scalarButtons, thisButton.next UNTIL thisButton=NIL DO
IF thisButton.on THEN TiogaButtons.ChangeButtonLooks[thisButton.button, "b", ""]
ELSE TiogaButtons.ChangeButtonLooks[thisButton.button, "", "b"];
ENDLOOP;
};
RebuildScalarButtons: PUBLIC PROC [viewer: Viewer, headerButton: TiogaButtons.TiogaButton, clientData: REF ANY, handleProc: HandleButtonProc, scalarButtonList: LIST OF ScalarButton] RETURNS [buttons: ScalarButtonClient ← NIL] = {
this routine builds a new set of Tioga buttons into the given viewer
the client must have cleaned out old buttons before calling herein.
prevButton: TiogaButtons.TiogaButton ← headerButton;
FOR list: LIST OF ScalarButton ← scalarButtonList, list.rest UNTIL list = NIL DO
prevButton ← AppendScalarButton[prevButton, clientData, handleProc, list.first.name, list.first.value, list.first.init = on, list.first.action];
IF list = scalarButtonList THEN buttons ← NARROW[prevButton.clientData];
ENDLOOP;
};
AppendScalarButton: PROC [prevButton: TiogaButtons.TiogaButton, clientData: REF ANY, handleProc: HandleButtonProc, name: Rope.ROPENIL, value: REAL, on: BOOL, action: LIST OF REF ANY] RETURNS [button: TiogaButtons.TiogaButton] = {
creates a new button and appends it to the viewer in which prevButton exists. DOES NOT APPEND TO prevButton, as one might hope !!
buttonData, prevButtonData: ScalarButtonClient;
IF name = NIL THEN {
space: CHAR = ' ;
name ← IO.PutFR["%1.2f", [real[value]]];
IF Rope.Equal[Rope.Substr[name, Rope.Length[name]-5, 5], ".0000"] THEN
name ← Rope.Substr[name, 0, Rope.Length[name]-5];
name ← FileNames.Tail[name, space]; -- strip off leading spaces
strip off trailing zeroes
UNTIL Rope.Fetch[base: name, index: Rope.Length[name]-1]# '0 DO name ← Rope.Substr[base: name, start: 0, len: Rope.Length[name]-1]; ENDLOOP;
};
buttonData ← NEW[ScalarButtonClientObj ← [NIL, name, value, action, on, NIL, clientData, handleProc]];
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;
prevButtonData will be NIL after the Header button.
buttonData.button ← button;
};
ToggleScalar: TiogaButtons.TiogaButtonProc ~ {
button: TiogaButtons.TiogaButton ← NARROW[parent];
buttonData: ScalarButtonClient ← NARROW[clientData];
buttonData.handleProc[buttonData.clientData, buttonData.action];
};
MakeViewer: PROC [container: Viewer, x, y: NAT] RETURNS [viewer: Viewer] = {
viewer ← TiogaButtons.CreateViewer[
info:
[wx: x,
wy: y,
ww: container.ww,
wh: entryHeight,
parent: container,
border: FALSE]
];
Containers.ChildXBound[container, viewer];
container.class.set[self: container, data: viewer, op: $XBound];
};
NewHeaderButton: PROC [v: Viewer, name: Rope.ROPE] RETURNS [button: TiogaButtons.TiogaButton] = {
button ← TiogaButtons.CreateButton[
viewer: v,
rope: name,
format: "",
looks: "",
proc: NIL,
clientData: NIL];
};
Enumerated Types Buttons
(like Choice Buttons, but built for the new User Interface Architecture (queues atoms onto the slack process queue and waits for them to return before acting. Thus, the buttons can be "pushed" from the TIP Table as well as with the mouse.
BuildEnumTypeSelection: PUBLIC PROC [
viewer: ViewerClasses.Viewer, x, y: NAT, maxWidth: NAT,
clientData: REF ANY,
handleProc: HandleButtonProc,
title: Rope.ROPE, default: Rope.ROPE,
borderOnButtons: BOOL, style: StyleChoice, allInOneRow: BOOL,
buttonNames: ButtonList, atom: ATOM] RETURNS [EnumTypeRef] = {
foundDefault: BOOLFALSE;
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: NAT;
startX: NAT ← 0; -- keeps a running tally of where the next x position is
tempButton: Buttons.Button;
eachButton: ButtonList;
stateInfo.type ← menuStyle;
stateInfo.handleProc ← handleProc;
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,
default the width so that it will be computed for us
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;
stateInfo.handleProc ← handleProc;
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;
now set up the initial button
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
width properly (unfortunately when re-labeling a button, the width remains the same)
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;
signal that the default didn't exist if necessary
IF ~foundDefault THEN SIGNAL DefaultDoesntExist;
stateInfo.nexty ← stateInfo.nexty + entryHeight;
RETURN[stateInfo];
};
FlipThruButtonProc: Buttons.ButtonProc = {
info: EnumTypeRef ← NARROW[clientData];
IF mouseButton=red THEN
info.handleProc[info.clientData, LIST[info.atom, $FlipForward--, info--]]
ELSE info.handleProc[info.clientData, LIST[info.atom, $FlipBackward--, info--]];
};
TimeToFlipThru: PUBLIC PROC [event: LIST OF REF ANY] = {
info: EnumTypeRef ← NARROW[event.rest.first];
IF event.first = $FlipForward THEN
Display the next name in succession
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: 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;
Notify client that change has taken place if the client provided a proc for doing this
IF info.proc # NIL THEN info.proc[viewer.name, info.clientdata];
};
GetNextName: 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
find the current button name in list of button names
IF eachButton.rest = NIL THEN
we are at the end of our list, cycle around to the beginning
RETURN [listOfNames.first]
ELSE RETURN [(eachButton.rest).first];
};
GetPrevName: 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: PROC[oldButton, newButton: Buttons.Button] = {
merely changes the physical appearance of the buttons
Switch off the previously selected button
Buttons.SetDisplayStyle[button: oldButton, style: off];
switch "on" the newly selected button
Buttons.SetDisplayStyle[button: newButton, style: on];
};
END.