GGButtonsImpl.mesa
Last edited by Bier on August 11, 1986 11:13:29 pm PDT.
Contents: General Purpose routines for use by Gargoyle.
Pier, December 12, 1986 2:36:03 pm PST
DIRECTORY
Buttons, GGButtons, FileNames, Imager, IO, Labels, Menus, Rope, TiogaButtons, ViewerClasses, ViewerOps, VFonts, ViewerTools;
GGButtonsImpl:
CEDAR
PROGRAM
IMPORTS Buttons, FileNames, IO, Labels, Rope, TiogaButtons, VFonts, ViewerOps, ViewerTools
EXPORTS GGButtons =
BEGIN
ButtonLineEntry: TYPE = GGButtons.ButtonLineEntry;
UnQueuedButtonLineEntry: TYPE = GGButtons.UnQueuedButtonLineEntry;
ButtonList: TYPE = GGButtons.ButtonList;
ButtonType: TYPE = GGButtons.ButtonType;
DisplayStyle: TYPE = GGButtons.DisplayStyle;
ConfirmProc: TYPE = GGButtons.ConfirmProc;
Order: TYPE = GGButtons.Order;
HandleButtonProc: TYPE = GGButtons.HandleButtonProc;
ScalarButton: TYPE = GGButtons.ScalarButton;
ScalarButtonClient: TYPE = REF ScalarButtonClientObj;
ScalarButtonClientObj: TYPE = GGButtons.ScalarButtonClientObj;
ScalarButtonHandle: TYPE = REF ScalarButtonHandleObj;
ScalarButtonHandleObj: TYPE = GGButtons.ScalarButtonHandleObj;
StateType: TYPE = GGButtons.StateType;
StyleChoice: TYPE = GGButtons.StyleChoice;
TwoState: TYPE = REF TwoStateObj;
TwoStateObj: TYPE = GGButtons.TwoStateObj;
UpdateProc: TYPE = GGButtons.UpdateProc;
Viewer: TYPE = ViewerClasses.Viewer;
EnumTypeRef: TYPE = REF EnumTypeRec;
EnumTypeRec: TYPE = GGButtons.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 GGButtons 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: BOOL ← TRUE, 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 [GGButtons.ScalarButtonHandle] = {
sbHandle: GGButtons.ScalarButtonHandle ← NEW[GGButtons.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 GGButtons.ScalarButton;
inserted: BOOL ← FALSE;
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.
ROPE ←
NIL, 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: 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: 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.