AtomButtonsImpl.mesa
Copyright Ó 1987, 1989, 1992 by Xerox Corporation. All rights reserved.
Pier, November 11, 1987 0:56:14 am PST
Last tweaked by Mike Spreitzer on September 9, 1987 7:54:01 pm PDT
Bier, February 7, 1991 4:07 pm PST
Doug Wyatt, September 20, 1989 4:56:40 pm PDT
Contents: Routines for creating, with very short procedure calls, a coordinated set of buttons, including popup buttons, labels, and text viewers, that make an application control panel.
Michael Plass, March 25, 1992 10:59 am PST
DIRECTORY
Atom, AtomButtons, AtomButtonsTypes, Buttons, CodeTimer, FileNames, Imager, IO, Labels, MachineDependentPopping, Menus, PopUpButtons, Rope, TiogaButtons, VFonts, ViewerClasses, ViewerOps, ViewerTools;
AtomButtonsImpl: CEDAR PROGRAM
IMPORTS Atom, Buttons, CodeTimer, FileNames, IO, Labels, MachineDependentPopping, PopUpButtons, Rope, TiogaButtons, VFonts, ViewerOps, ViewerTools
EXPORTS AtomButtons =
BEGIN
ButtonLineEntry: TYPE = AtomButtons.ButtonLineEntry;
ButtonList: TYPE = AtomButtons.ButtonList;
ButtonType: TYPE = AtomButtons.ButtonType;
CompareProc: TYPE = AtomButtons.CompareProc;
ConfirmProc: TYPE = AtomButtonsTypes.ConfirmProc;
DisplayStyle: TYPE = AtomButtons.DisplayStyle;
EnumTypeRec: TYPE = AtomButtonsTypes.EnumTypeRec;
EnumTypeRef: TYPE = REF EnumTypeRec;
Event: TYPE = AtomButtons.Event;
FindProc: TYPE = AtomButtons.FindProc;
HandleButtonProc: TYPE = AtomButtons.HandleButtonProc;
InitButtonProc: TYPE = AtomButtonsTypes.InitButtonProc;
InitTwoStateProc: TYPE = AtomButtonsTypes.InitTwoStateProc;
Order: TYPE = AtomButtons.Order;
PopUpChoice: TYPE = AtomButtons.PopUpChoice;
ReadSortedProc: TYPE = AtomButtons.ReadSortedProc;
WriteSortedProc: TYPE = AtomButtons.WriteSortedProc;
ScalarButton: TYPE = AtomButtons.ScalarButton;
SortedButtonClient: TYPE = REF SortedButtonClientObj;
SortedButtonClientObj: TYPE = AtomButtonsTypes.SortedButtonClientObj;
SortedButtonHandle: TYPE = REF SortedButtonHandleObj;
SortedButtonHandleObj: TYPE = AtomButtonsTypes.SortedButtonHandleObj;
SortedButtonEntry: TYPE = AtomButtons.SortedButtonEntry;
StyleChoice: TYPE = AtomButtons.StyleChoice;
TwoState: TYPE = REF TwoStateObj;
TwoStateObj: TYPE = AtomButtonsTypes.TwoStateObj;
UnQueuedButtonLineEntry: TYPE = AtomButtons.UnQueuedButtonLineEntry;
UpdateProc: TYPE = AtomButtons.UpdateProc;
Viewer: TYPE = ViewerClasses.Viewer;
NotYetImplemented: PUBLIC SIGNAL = CODE;
epsilon: REAL = 0.001;
Button Lines
GGButtonData: TYPE = REF GGButtonDataObj;
GGButtonDataObj: TYPE = RECORD [
clientData: REF ANY,
events: LIST OF Event,
handleProc: HandleButtonProc,
confirmProc: ConfirmProc
];
Buttons, PopUpButtons, Labels, and Text Viewers.
BuildButtonLine: PUBLIC PROC [container: Viewer, x, y: NAT, clientData: REF ANY, handleProc: HandleButtonProc, entries: LIST OF ButtonLineEntry, horizontalSpace: INTEGER ¬ 2, lineHeight: INTEGER ¬ 15] RETURNS [nextX: INTEGER] = {
thisButton, prevButton, firstButton: Buttons.Button;
wxRelative: INTEGER ¬ -1;
clientPackageName: Rope.ROPE ~ PopUpButtons.GuessPackageName[
MachineDependentPopping.GetCaller2sGlobalFrame[]];
firstButton ¬ prevButton ¬ BuildButton[container, x, y, clientData, handleProc, entries.first, horizontalSpace, lineHeight, clientPackageName];
FOR entryList: LIST OF ButtonLineEntry ¬ entries.rest, entryList.rest UNTIL entryList = NIL DO
WITH entryList.first SELECT FROM
a: ButtonLineEntry.button => wxRelative ¬ a.wxRelative;
b: ButtonLineEntry.popUpButton => wxRelative ¬ b.wxRelative;
c: ButtonLineEntry.label => wxRelative ¬ c.wxRelative;
d: ButtonLineEntry.text => wxRelative ¬ d.wxRelative;
e: ButtonLineEntry.twoState => wxRelative ¬ e.wxRelative;
ENDCASE => ERROR;
nextX ¬ IF wxRelative < 0
THEN prevButton.wx + prevButton.ww + horizontalSpace
ELSE wxRelative;
thisButton ¬ BuildButton[container, nextX, y, clientData, handleProc, entryList.first, horizontalSpace, lineHeight, clientPackageName];
prevButton ¬ thisButton;
ENDLOOP;
nextX ¬ prevButton.wx + prevButton.ww;
};
BuildButton: PROC [container: Viewer, x, y: NAT, clientData: REF ANY, handleProc: HandleButtonProc, entry: ButtonLineEntry, horizontalSpace: INTEGER, lineHeight: INTEGER, clientPackageName: Rope.ROPE] RETURNS [button: Buttons.Button] = {
WITH entry SELECT FROM
a: ButtonLineEntry.button => button ¬ BuildOldButton[container, x, y, clientData, handleProc, a.name, a.events, a.border, a.font, a.confirmProc, a.initProc, a.ww, lineHeight];
b: ButtonLineEntry.popUpButton => button ¬ BuildPopUpButton[container, x, y, clientData, handleProc, b.name, b.choices, b.border, b.font, b.help, b.disableDecoding, b.headMenu, b.confirmProc, b.initProc, b.ww, lineHeight, clientPackageName];
c: ButtonLineEntry.label => button ¬ BuildLabel[container, x, y, clientData, c.name, c.initProc, c.ww, c.border, c.font, lineHeight];
d: ButtonLineEntry.text => button ¬ BuildTextViewer[container, x, y, clientData, handleProc, d.name, d.initProc, d.ww, d.border, d.font, lineHeight];
e: ButtonLineEntry.twoState => button ¬ BuildTwoState[container, x, y, clientData, handleProc, e.name, e.event, e.on, e.initProc, e.ww, e.border, e.font, lineHeight];
ENDCASE => ERROR;
};
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 mouseButton = red THEN buttonData.handleProc[buttonData.clientData, buttonData.events.first]
ELSE IF mouseButton = yellow THEN {
IF buttonData.events.rest # NIL AND buttonData.events.rest.first # NIL
THEN buttonData.handleProc[buttonData.clientData, buttonData.events.rest.first]
ELSE buttonData.handleProc[buttonData.clientData, buttonData.events.first];
}
ELSE {
IF buttonData.events.rest # NIL AND buttonData.events.rest.rest # NIL AND buttonData.events.rest.rest.first # NIL
THEN buttonData.handleProc[buttonData.clientData, buttonData.events.rest.rest.first]
ELSE buttonData.handleProc[buttonData.clientData, buttonData.events.first];
};
buttonData.handleProc might put the event on the slack queue.
};
BuildLabel: PROC [container: Viewer, x, y: NAT, clientData: REF ANY, name: Rope.ROPE, initProc: InitButtonProc, ww: NAT, border: BOOL ¬ FALSE, font: Imager.Font, lineHeight: INTEGER] RETURNS [button: Buttons.Button] = {
button ¬ Labels.Create[
info: [
parent: container,
wx: x, wy: y, ww: ww, wh: lineHeight,
name: name,
border: border],
font: font];
IF initProc # NIL THEN initProc[name, clientData, button];
};
BuildTwoState: PROC [container: ViewerClasses.Viewer, x, y: NAT, clientData: REF ANY, handleProc: HandleButtonProc, name: Rope.ROPE, event: LIST OF REF ANY, state: BOOL ¬ FALSE, initProc: InitTwoStateProc, ww: NAT, border: BOOL ¬ FALSE, font: Imager.Font, lineHeight: INTEGER ¬ 15] RETURNS [button: Buttons.Button] = {
stateInfo: TwoState ¬ NEW[TwoStateObj];
button ¬ Buttons.Create[
info: [
name: name,
parent: container,
wx: x, wy: y, ww: ww, wh: lineHeight,
border: border],
proc: TwoSwitchProc,
clientData: stateInfo -- this will be passed to our button proc
];
stateInfo.button ¬ button;
stateInfo.event ¬ event;
stateInfo.clientData ¬ clientData;
stateInfo.handleProc ¬ handleProc;
SetBinaryState[stateInfo, state];
IF initProc # NIL THEN initProc[name, clientData, stateInfo];
};
BuildOldButton: PROC [container: Viewer, x, y: NAT, clientData: REF ANY, handleProc: HandleButtonProc, name: Rope.ROPE, events: LIST OF Event, border: BOOL ¬ FALSE, font: Imager.Font, confirmProc: ConfirmProc, initProc: InitButtonProc, ww: NAT, lineHeight: INTEGER] RETURNS [button: Buttons.Button] = {
buttonData: GGButtonData;
buttonData ¬ NEW[GGButtonDataObj ¬ [clientData, events, handleProc, confirmProc]];
button ¬ Buttons.Create[
info: [name: name, wx: x, wy: y, wh: lineHeight,
parent: container, border: border],
proc: HandleButton,
clientData: buttonData,
documentation: handleConfirm,
fork: FALSE,
guarded: confirmProc # NIL,
font: font
];
IF initProc # NIL THEN initProc[name, clientData, button];
};
PopUpButtonData: TYPE = REF PopUpButtonDataObj;
PopUpButtonDataObj: TYPE = RECORD [
handleProc: HandleButtonProc
];
PopUpData: TYPE = REF PopUpDataObj;
PopUpDataObj: TYPE = RECORD [
handleProc: HandlePopUpProc
];
BuildPopUpButton: PROC [container: Viewer, x, y: NAT, clientData: REF ANY, handleProc: HandleButtonProc, name: Rope.ROPE, choices: LIST OF PopUpChoice, border: BOOL ¬ FALSE, font: Imager.Font, help: PopUpButtons.Help, disableDecoding: BOOL ¬ FALSE, headMenu: BOOL ¬ FALSE, confirmProc: ConfirmProc, initProc: InitButtonProc, ww: NAT, lineHeight: INTEGER, clientPackageName: Rope.ROPE] RETURNS [button: Buttons.Button] = {
popUpClassSpec: PopUpButtons.ClassSpec;
popUpClass: PopUpButtons.Class;
choiceList, ptr: LIST OF PopUpButtons.Choice;
image: PopUpButtons.Image;
instanceData: PopUpButtonData;
[choiceList, ptr] ¬ StartChoiceList[];
FOR list: LIST OF PopUpChoice ¬ choices, list.rest UNTIL list = NIL DO
IF list.first.actionImage = NIL THEN image ¬ PopUpButtons.ImageForRope[Atom.GetPName[NARROW[list.first.action.first]], NIL, list.first.font]
ELSE image ¬ PopUpButtons.ImageForRope[list.first.actionImage, NIL, list.first.font];
[choiceList, ptr] ¬ AddChoice[[key: list.first.action, doc: list.first.doc, image: image], choiceList, ptr];
ENDLOOP;
IF help=NIL THEN help ¬ PopUpButtons.DeduceHelp[buttonName: name, clientPackageName: clientPackageName];
popUpClassSpec ¬ [
classData: clientData,
proc: HandlePopUpButton,
choices: choiceList,
fork: FALSE,
disableDecoding: disableDecoding,
headMenu: headMenu,
image: PopUpButtons.ImageForRope[name, NIL, font, PopUpButtons.center],
help: help
];
popUpClass ¬ PopUpButtons.MakeClass[popUpClassSpec];
instanceData ¬ NEW[PopUpButtonDataObj ¬ [handleProc]];
button ¬ PopUpButtons.Instantiate[
class: popUpClass,
viewerInfo: [name: name, wx: x, wy: y, ww: ww, wh: lineHeight,
parent: container, border: border],
instanceData: instanceData,
image: PopUpButtons.ImageForRope[name, NIL, font]
];
IF initProc # NIL THEN initProc[name, clientData, button];
};
HandlePopUpProc: TYPE = AtomButtons.HandlePopUpProc;
BuildPopUp: PUBLIC PROC [clientData: REF, handleProc: HandlePopUpProc, paint: PopUpButtons.PaintProc, inButton: PopUpButtons.InTestProc, entry: ButtonLineEntry, clientPackageName: Rope.ROPE] RETURNS [instance: REF] = {
CodeTimer.StartInt[$AtomButtonsBuildPopUp, $EmbeddedButtons];
WITH entry SELECT FROM
b: ButtonLineEntry.popUpButton => instance ¬ BuildPopUpAux[clientData, handleProc, b.name, b.choices, b.font, b.help, b.disableDecoding, b.headMenu, b.confirmProc, b.initProc, paint, inButton, clientPackageName];
ENDCASE => ERROR;
CodeTimer.StopInt[$AtomButtonsBuildPopUp, $EmbeddedButtons];
};
BuildPopUpAux: PROC [clientData: REF, handleProc: HandlePopUpProc, name: Rope.ROPE, choices: AtomButtons.PopUpChoices, font: Imager.Font, help: PopUpButtons.Help, disableDecoding: BOOL, headMenu: BOOL, confirmProc: ConfirmProc, initProc: InitButtonProc, paint: PopUpButtons.PaintProc, inButton: PopUpButtons.InTestProc, clientPackageName: Rope.ROPE] RETURNS [instance: REF] = {
popUpClassSpec: PopUpButtons.ClassSpec;
popUpClass: PopUpButtons.Class;
choiceList, ptr: LIST OF PopUpButtons.Choice;
image: PopUpButtons.Image;
instanceData: PopUpData;
[choiceList, ptr] ¬ StartChoiceList[];
FOR list: LIST OF PopUpChoice ¬ choices, list.rest UNTIL list = NIL DO
IF list.first.actionImage = NIL THEN image ¬ PopUpButtons.ImageForRope[Atom.GetPName[NARROW[list.first.action.first]], NIL, IF list.first.font = NIL THEN font ELSE list.first.font]
ELSE image ¬ PopUpButtons.ImageForRope[list.first.actionImage, NIL, IF list.first.font = NIL THEN font ELSE list.first.font];
[choiceList, ptr] ¬ AddChoice[[key: list.first.action, doc: list.first.doc, image: image], choiceList, ptr];
ENDLOOP;
IF help=NIL THEN help ¬ PopUpButtons.DeduceHelp[buttonName: name, clientPackageName: clientPackageName];
popUpClassSpec ¬ [
classData: clientData,
proc: HandlePopUp,
choices: choiceList,
fork: FALSE,
disableDecoding: disableDecoding,
headMenu: headMenu,
image: PopUpButtons.ImageForRope[name, NIL, font, PopUpButtons.center],
help: help
];
popUpClass ¬ PopUpButtons.MakeClass[popUpClassSpec];
instanceData ¬ NEW[PopUpDataObj ¬ [handleProc]];
instance ¬ PopUpButtons.GeneralInstantiate[
class: popUpClass,
Paint: paint,
InTest: inButton,
instanceData: instanceData,
image: PopUpButtons.ImageForRope[name, NIL, font],
help: NIL
];
};
HandlePopUpButton: PROC [view: PopUpButtons.View, instanceData, classData, key: REF ANY] = {
event: LIST OF REF ANY ¬ NARROW[key];
popUpButtonData: PopUpButtonData ¬ NARROW[instanceData];
popUpButtonData.handleProc[classData, event];
};
HandlePopUp: PROC [view: PopUpButtons.View, instanceData, classData, key: REF ANY] = {
event: LIST OF REF ANY ¬ NARROW[key];
popUpData: PopUpData ¬ NARROW[instanceData];
popUpData.handleProc[view, classData, event];
};
StartChoiceList: PUBLIC PROC [] RETURNS [entityList, ptr: LIST OF PopUpButtons.Choice] = {
ptr ¬ entityList ¬ NIL;
};
AddChoice: PUBLIC PROC [entity: PopUpButtons.Choice, entityList, ptr: LIST OF PopUpButtons.Choice] RETURNS [newList, newPtr: LIST OF PopUpButtons.Choice] = {
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;
};
};
BuildTextViewer: PROC [container: Viewer, x, y: NAT, clientData: REF ANY, handleProc: HandleButtonProc, name: Rope.ROPE, initProc: InitButtonProc, ww: NAT, border: BOOL ¬ FALSE, font: Imager.Font, lineHeight: INTEGER] RETURNS [button: Buttons.Button] = {
button ¬ ViewerTools.MakeNewTextViewer[[
parent: container,
wx: x, wy: y, ww: ww, wh: lineHeight,
data: name,
scrollable: FALSE, border: border]];
IF initProc # NIL THEN initProc[name, clientData, button];
};
handleConfirm: REF Menus.ClickProc ¬ NEW[Menus.ClickProc ¬ HandleConfirm];
HandleConfirm: Menus.ClickProc = {
buttonData: GGButtonData ¬ NARROW[clientData];
buttonData.confirmProc[buttonData.clientData];
};
Binary (on/off) Buttons.
SetBinaryState: PUBLIC PROC [twoState: TwoState, on: BOOL ¬ FALSE] = {
twoState.on ¬ on;
SELECT on FROM
TRUE => Buttons.SetDisplayStyle[button: twoState.button, style: $WhiteOnBlack];
FALSE => Buttons.SetDisplayStyle[button: twoState.button, style: $BlackOnWhite];
ENDCASE => ERROR;
};
GetBinaryState: PUBLIC PROC [twoState: TwoState] RETURNS [on: BOOL ¬ FALSE] = {
on ¬ twoState.on;
};
NextState: PROC [on: BOOL ¬ FALSE] RETURNS [BOOL ¬ FALSE] = {
IF on = LAST[BOOL] THEN RETURN[FIRST[BOOL]]
ELSE RETURN[SUCC[on]];
};
TwoSwitchProc: Buttons.ButtonProc = {
handle: TwoState ¬ NARROW[clientData];
handle.handleProc[handle.clientData, handle.event];
};
SwitchBinaryState: PUBLIC PROC [handle: TwoState] = {
nextState: BOOL ¬ FALSE;
nextState ¬ NextState[handle.on];
SetBinaryState[handle, nextState];
};
Extensible Sorted Button List
CreateSortedButtonViewer: PUBLIC PROC [container: Viewer, x, y: NAT, lineHeight: INTEGER ¬ 15] RETURNS [SortedButtonHandle] = {
sbHandle: AtomButtons.SortedButtonHandle ¬ NEW[SortedButtonHandleObj];
sbHandle.viewer ¬ MakeViewer[container, x, y, lineHeight];
sbHandle.headerButton ¬ NewHeaderButton[sbHandle.viewer, NIL];
RETURN[sbHandle];
};
BuildSortedButtons: PUBLIC PROC [handle: SortedButtonHandle, clientData: REF ANY, handleProc: HandleButtonProc, header: Rope.ROPE, sortedButtonList: LIST OF SortedButtonEntry] = {
buttons: SortedButtonClient;
prevButton: TiogaButtons.TiogaButton;
oldSortedButtons: SortedButtonClient ¬ NARROW[handle.sortedButtons];
Clear out the existing buttons.
FOR thisButton: SortedButtonClient ¬ oldSortedButtons, thisButton.next UNTIL thisButton=NIL DO
thisButton.button.clientData ¬ NIL;
thisButton.clientData ¬ NIL;
TiogaButtons.DeleteButton[thisButton.button];
ENDLOOP;
Add the new buttons
prevButton ¬ handle.headerButton;
FOR list: LIST OF SortedButtonEntry ¬ sortedButtonList, list.rest UNTIL list = NIL DO
prevButton ¬ AppendSortedButton[prevButton, clientData, handleProc, list.first.name, list.first.value, list.first.events, list.first.on];
IF list = sortedButtonList THEN buttons ¬ NARROW[prevButton.clientData];
ENDLOOP;
handle.sortedButtons ¬ buttons;
handle.handleProc ¬ handleProc;
};
AppendSortedButton: PROC [prevButton: TiogaButtons.TiogaButton, clientData: REF ANY, handleProc: HandleButtonProc, name: Rope.ROPE ¬ NIL, value: REF ANY, events: LIST OF Event, on: BOOL ¬ FALSE] 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 !!
buttonClient, prevButtonData: SortedButtonClient;
buttonClient ¬ NEW[SortedButtonClientObj ¬ [NIL, name, value, events, on, NIL, clientData, handleProc]];
button ¬ TiogaButtons.AppendToButton[
button: prevButton,
rope: Rope.Concat[name, " "],
looks: "",
proc: PressSorted,
clientData: buttonClient,
fork: FALSE];
prevButtonData ¬ NARROW[prevButton.clientData];
IF prevButtonData # NIL THEN prevButtonData.next ¬ buttonClient;
prevButtonData will be NIL after the Header button.
buttonClient.button ¬ button;
AdjustAppearance[buttonClient];
};
PressSorted: TiogaButtons.TiogaButtonProc ~ {
buttonData: SortedButtonClient ¬ NARROW[clientData];
events: LIST OF Event ¬ buttonData.events;
IF mouseButton = red THEN buttonData.handleProc[buttonData.clientData, events.first]
ELSE IF mouseButton = yellow THEN {
IF events.rest # NIL AND events.rest.first # NIL
THEN buttonData.handleProc[buttonData.clientData, events.rest.first]
ELSE buttonData.handleProc[buttonData.clientData, events.first];
}
ELSE { -- mouseButton = blue
IF events.rest # NIL AND events.rest.rest # NIL AND events.rest.rest.first # NIL
THEN buttonData.handleProc[buttonData.clientData, events.rest.rest.first]
ELSE buttonData.handleProc[buttonData.clientData, events.first];
};
};
ReadSortedButtons: PUBLIC PROC [handle: SortedButtonHandle, readProc: ReadSortedProc, clientData: REF ANY ¬ NIL] = {
buttonData: SortedButtonClient ¬ NARROW[handle.sortedButtons];
FOR thisButton: SortedButtonClient ¬ buttonData, thisButton.next UNTIL thisButton=NIL DO
IF readProc[thisButton.on, thisButton.name, thisButton.value, clientData] THEN EXIT;
ENDLOOP;
};
AdjustAppearance: PROC [client: SortedButtonClient] = {
IF client.on THEN TiogaButtons.ChangeButtonLooks[client.button, "b", ""]
ELSE TiogaButtons.ChangeButtonLooks[client.button, "", "b"];
};
WriteSortedButtons: PUBLIC PROC [handle: SortedButtonHandle, writeProc: WriteSortedProc, clientData: REF ANY ¬ NIL] = {
buttonData: SortedButtonClient ¬ NARROW[handle.sortedButtons];
done, newState: BOOL ¬ FALSE;
newName: Rope.ROPE;
newValue: REF ANY;
FOR thisClient: SortedButtonClient ¬ buttonData, thisClient.next UNTIL thisClient=NIL DO
[newState, newName, newValue, done] ¬ writeProc[thisClient.on, thisClient.name, thisClient.value, clientData];
thisClient.on ¬ newState;
thisClient.name ¬ IF newName = NIL THEN thisClient.name ELSE newName;
thisClient.value ¬ newValue;
AdjustAppearance[thisClient];
IF done THEN EXIT;
ENDLOOP;
};
AddSortedButton: PUBLIC PROC [clientData: REF ANY, handle: SortedButtonHandle, entry: SortedButtonEntry, compareProc: CompareProc] RETURNS [oldFoundButton: SortedButtonClient ¬ 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 (but not the old) button.
list, finger: LIST OF AtomButtons.SortedButtonEntry;
inserted: BOOL ¬ FALSE;
oldScalarButtons: SortedButtonClient ¬ NARROW[handle.sortedButtons];
[list, finger] ¬ StartSortedButtonEntryList[];
FOR thisClient: SortedButtonClient ¬ oldScalarButtons, thisClient.next UNTIL thisClient=NIL DO
IF NOT inserted THEN {
SELECT compareProc[entry.name, entry.value, thisClient.name, thisClient.value] FROM
equal => {
thisClient.on ¬ entry.on;
AdjustAppearance[thisClient];
RETURN[thisClient];
};
less => {
[list, finger] ¬ AddSortedButtonEntry[entry, list, finger];
inserted ¬ TRUE;
};
ENDCASE => NULL;
};
[list, finger] ¬ AddSortedButtonEntry[
[thisClient.name, thisClient.value, thisClient.events, thisClient.on],
list, finger];
ENDLOOP;
IF NOT inserted THEN { -- tack new slope onto right end of the list
[list, finger] ¬ AddSortedButtonEntry[entry, list, finger];
};
Clear out the existing buttons, which TiogaOps doesn't seem able to do !!
FOR thisClient: SortedButtonClient ¬ oldScalarButtons, thisClient.next UNTIL thisClient=NIL DO
thisClient.button.clientData ¬ NIL;
thisClient.clientData ¬ NIL;
TiogaButtons.DeleteButton[thisClient.button];
ENDLOOP;
handle.sortedButtons ¬ RebuildSortedButtons[handle.viewer, handle.headerButton, clientData, handle.handleProc, list];
FOR thisClient: SortedButtonClient ¬ NARROW[handle.sortedButtons], thisClient.next UNTIL thisClient=NIL DO
AdjustAppearance[thisClient];
ENDLOOP;
};
DeleteSortedButtons: PUBLIC PROC [clientData: REF ANY, handle: SortedButtonHandle, findProc: FindProc] = {
oldScalarButtons: SortedButtonClient ¬ NARROW[handle.sortedButtons];
list, finger: LIST OF AtomButtons.SortedButtonEntry;
found, done: BOOL ¬ FALSE;
[list, finger] ¬ StartSortedButtonEntryList[];
FOR thisClient: SortedButtonClient ¬ oldScalarButtons, thisClient.next UNTIL thisClient=NIL DO
IF NOT done THEN {
[found, done] ¬ findProc[thisClient.on, thisClient.name, thisClient.value, thisClient.clientData];
}
ELSE found ¬ FALSE;
IF NOT found THEN {
[list, finger] ¬ AddSortedButtonEntry[
[thisClient.name, thisClient.value, thisClient.events, thisClient.on],
list, finger];
};
ENDLOOP;
FOR thisClient: SortedButtonClient ¬ oldScalarButtons, thisClient.next UNTIL thisClient=NIL DO
thisClient.button.clientData ¬ NIL;
thisClient.clientData ¬ NIL;
TiogaButtons.DeleteButton[thisClient.button];
ENDLOOP;
handle.sortedButtons ¬ RebuildSortedButtons[handle.viewer, handle.headerButton, clientData, handle.handleProc, list];
FOR thisClient: SortedButtonClient ¬ NARROW[handle.sortedButtons], thisClient.next UNTIL thisClient=NIL DO
AdjustAppearance[thisClient];
ENDLOOP;
};
RebuildSortedButtons: PROC [viewer: Viewer, headerButton: TiogaButtons.TiogaButton, clientData: REF ANY, handleProc: HandleButtonProc, sortedButtonList: LIST OF SortedButtonEntry] RETURNS [buttons: SortedButtonClient ¬ 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 SortedButtonEntry ¬ sortedButtonList, list.rest UNTIL list = NIL DO
prevButton ¬ AppendSortedButton[prevButton, clientData, handleProc, list.first.name, list.first.value, list.first.events, list.first.on];
IF list = sortedButtonList THEN buttons ¬ NARROW[prevButton.clientData];
ENDLOOP;
};
StartSortedButtonEntryList: PROC [] RETURNS [entityList, ptr: LIST OF SortedButtonEntry] = {
ptr ¬ entityList ¬ NIL;
};
AddSortedButtonEntry: PROC [entity: SortedButtonEntry, entityList, ptr: LIST OF SortedButtonEntry] RETURNS [newList, newPtr: LIST OF SortedButtonEntry] = {
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;
};
};
Extensible Scalar (REAL valued) Button List
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 event 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.
BuildScalarButtons: PUBLIC PROC [handle: SortedButtonHandle, clientData: REF ANY, handleProc: HandleButtonProc, header: Rope.ROPE, scalarButtonList: LIST OF ScalarButton] = {
sortedList, ptr: LIST OF SortedButtonEntry;
value: REF ANY;
[sortedList, ptr] ¬ StartSortedButtonEntryList[];
FOR list: LIST OF ScalarButton ¬ scalarButtonList, list.rest UNTIL list = NIL DO
value ¬ NEW[REAL ¬ list.first.value];
[sortedList, ptr] ¬ AddSortedButtonEntry[[list.first.name, value, list.first.events, list.first.on], sortedList, ptr];
ENDLOOP;
BuildSortedButtons[handle, clientData, handleProc, header, sortedList];
};
SetAllScalarStates: PUBLIC PROC [clientData: REF ANY, handle: SortedButtonHandle, on: BOOL ¬ FALSE] = {
SetAll: PROC [state: BOOL ¬ FALSE, name: Rope.ROPE, value: REF ANY, clientData: REF ANY] RETURNS [newState: BOOL ¬ FALSE, newName: Rope.ROPE ¬ NIL, newValue: REF ANY, done: BOOL ¬ FALSE] = {
newState ¬ on;
newValue ¬ value;
};
WriteSortedButtons[handle, SetAll, clientData];
};
SetScalarState: PUBLIC PROC [clientData: REF ANY, handle: SortedButtonHandle, scalar: REAL, on: BOOL ¬ FALSE, epsilon: REAL ¬ 0.001] = {
SetOneState: PROC [state: BOOL ¬ FALSE, name: Rope.ROPE, value: REF ANY, clientData: REF ANY] RETURNS [newState: BOOL ¬ FALSE, newName: Rope.ROPE ¬ NIL, newValue: REF ANY, done: BOOL ¬ FALSE] = {
real: REAL ¬ NARROW[value, REF REAL]­;
IF ABS[real-scalar] < epsilon THEN {newState ¬ on; done ¬ TRUE}
ELSE newState ¬ state;
newValue ¬ value;
};
WriteSortedButtons[handle, SetOneState, clientData];
};
GetScalarState: PUBLIC PROC [clientData: REF ANY, handle: SortedButtonHandle, scalar: REAL, epsilon: REAL ¬ 0.001] RETURNS [on: BOOL ¬ FALSE] = {
GetOneState: PROC [state: BOOL ¬ FALSE, name: Rope.ROPE, value: REF ANY, clientData: REF ANY] RETURNS [done: BOOL ¬ FALSE] = {
real: REAL ¬ NARROW[value, REF REAL]­;
IF ABS[real-scalar] < epsilon THEN {on ¬ state; done ¬ TRUE; success ¬ TRUE};
};
success: BOOL ¬ FALSE;
ReadSortedButtons[handle, GetOneState, clientData];
IF NOT success THEN ERROR;
};
ToggleScalarState: PUBLIC PROC [clientData: REF ANY, handle: SortedButtonHandle, scalar: REAL, epsilon: REAL ¬ 0.001] RETURNS [newState: BOOL ¬ FALSE] = {
SetOneState: PROC [state: BOOL ¬ FALSE, name: Rope.ROPE, value: REF ANY, clientData: REF ANY] RETURNS [newState: BOOL ¬ FALSE, newName: Rope.ROPE ¬ NIL, newValue: REF ANY, done: BOOL ¬ FALSE] = {
real: REAL ¬ NARROW[value, REF REAL]­;
IF ABS[real-scalar] < epsilon THEN {newState ¬ NOT state; done ¬ TRUE}
ELSE newState ¬ state;
newValue ¬ value;
};
WriteSortedButtons[handle, SetOneState, clientData];
};
AppendScalarButton: PROC [prevButton: TiogaButtons.TiogaButton, clientData: REF ANY, handleProc: HandleButtonProc, name: Rope.ROPE ¬ NIL, value: REAL, on: BOOL ¬ FALSE, events: LIST OF Event] RETURNS [button: TiogaButtons.TiogaButton] = {
refValue: REF ANY;
IF name = NIL THEN {
space: CHAR = ' ;
name ¬ IO.PutFR1["%1.2f", [real[value]]];
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;
Strip off trailing decimal point
IF Rope.Fetch[base: name, index: Rope.Length[name]-1] = '. THEN name ¬ Rope.Substr[base: name, start: 0, len: Rope.Length[name]-1];
};
refValue ¬ NEW[REAL ¬ value];
button ¬ AppendSortedButton[prevButton, clientData, handleProc, name, refValue, events, on];
};
AddScalarSorted: PUBLIC PROC [clientData: REF ANY, handle: SortedButtonHandle, button: ScalarButton, order: Order ¬ incr] RETURNS [oldFoundButton: SortedButtonClient ¬ 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.
list, finger: LIST OF AtomButtons.ScalarButton;
inserted: BOOL ¬ FALSE;
oldScalarButtons: SortedButtonClient ¬ NARROW[handle.sortedButtons];
[list, finger] ¬ StartScalarButtonList[];
FOR thisClient: SortedButtonClient ¬ oldScalarButtons, thisClient.next UNTIL thisClient=NIL DO
search the current list for duplicate OR for proper insertion point, build new list along the way
thisScalar: REAL ¬ NARROW[thisClient.value, REF REAL]­;
IF ABS[thisScalar-button.value] < epsilon THEN {
thisClient.on ¬ button.on;
AdjustAppearance[thisClient];
RETURN[thisClient];
};
IF NOT inserted AND order=decr AND thisScalar<button.value THEN { -- insert new button behind thisClient
[list, finger] ¬ AddScalarButton[button, list, finger];
inserted ¬ TRUE;
}
ELSE IF NOT inserted AND order=incr AND thisScalar>button.value THEN { -- insert new button behind thisClient
[list, finger] ¬ AddScalarButton[button, list, finger];
inserted ¬ TRUE;
};
[list, finger] ¬ AddScalarButton[
[thisClient.name, thisScalar, thisClient.events, thisClient.on],
list, finger];
ENDLOOP;
IF NOT inserted THEN { -- tack new slope onto proper end of the list
[list, finger] ¬ AddScalarButton[button, list, finger];
};
Now clear out the existing buttons, which TiogaOps doesn't seem able to do !!
FOR thisClient: SortedButtonClient ¬ oldScalarButtons, thisClient.next UNTIL thisClient=NIL DO
thisClient.button.clientData ¬ NIL;
thisClient.clientData ¬ NIL;
TiogaButtons.DeleteButton[thisClient.button];
ENDLOOP;
handle.sortedButtons ¬ RebuildScalarButtons[viewer: handle.viewer, headerButton: handle.headerButton, clientData: clientData, handleProc: handle.handleProc, scalarButtonList: list];
FOR thisClient: SortedButtonClient ¬ NARROW[handle.sortedButtons], thisClient.next UNTIL thisClient=NIL DO
AdjustAppearance[thisClient];
ENDLOOP;
};
RebuildScalarButtons: PUBLIC PROC [viewer: Viewer, headerButton: TiogaButtons.TiogaButton, clientData: REF ANY, handleProc: HandleButtonProc, scalarButtonList: LIST OF ScalarButton] RETURNS [buttons: SortedButtonClient ¬ 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.on, list.first.events];
IF list = scalarButtonList THEN buttons ¬ NARROW[prevButton.clientData];
ENDLOOP;
};
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;
};
};
MakeViewer: PROC [container: Viewer, x, y: NAT, lineHeight: INTEGER] RETURNS [viewer: Viewer] = {
viewer ¬ TiogaButtons.CreateViewer[
info: [
wx: x, wy: y, ww: container.ww, wh: lineHeight,
parent: container,
border: FALSE]
];
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 Type (Cycling) Button
(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 ¬ FALSE, style: StyleChoice, allInOneRow: BOOL ¬ FALSE, buttonNames: ButtonList, atom: ATOM, horizontalSpace: INTEGER ¬ 2, lineHeight: INTEGER ¬ 15] RETURNS [EnumTypeRef] = {
foundDefault: BOOL ¬ FALSE;
stateInfo: EnumTypeRef ¬ NEW[EnumTypeRec];
DefaultFound: PROC[currentName, defaultName: Rope.ROPE] RETURNS [BOOL ¬ FALSE] = {
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: lineHeight,
border: FALSE
]];
startButtons ¬ titleLabel.wx + titleLabel.ww + horizontalSpace;
}
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 + lineHeight;
};
};
tempButton ¬ Buttons.Create[info: [
name: eachButton.first,
wx: startX,
wy: stateInfo.nexty,
default the width so that it will be computed for us
wh: lineHeight, -- 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: lineHeight,
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: lineHeight,
parent: viewer,
border: FALSE
]]
ELSE stateInfo.flipLabel ¬ Buttons.Create[
info: [name: eachButton.first,
wx: nextx,
wy: y,
ww: MaxNameWidth[buttonNames],
wh: lineHeight,
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 + lineHeight;
RETURN[stateInfo];
}; -- end of BuildEnumTypeSelection
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];
};
Old-fashioned callback proc buttons. Use is discouraged.
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, horizontalSpace: INTEGER ¬ 2, lineHeight: INTEGER ¬ 15] RETURNS [nextX: INTEGER] = {
thisButton, prevButton: Buttons.Button;
entry: UnQueuedButtonLineEntry;
entry ¬ entries.first;
prevButton ¬ BuildUnQueuedButton[container, x, y, clientData, entry.type, entry.clickProc, entry.name, entry.border, entry.ww, entry.updateProc, entry.confirmProc, entry.font, horizontalSpace, lineHeight];
nextX ¬ prevButton.wx + prevButton.ww;
FOR entryList: LIST OF UnQueuedButtonLineEntry ¬ entries.rest, entryList.rest UNTIL entryList = NIL DO
entry ¬ entryList.first;
thisButton ¬ BuildUnQueuedButton[container, nextX + horizontalSpace, y, clientData, entry.type, entry.clickProc, entry.name, entry.border, entry.ww, entry.updateProc, entry.confirmProc, entry.font, horizontalSpace, lineHeight];
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 ¬ FALSE, ww: NAT, updateProc: UpdateProc, confirmProc: ConfirmProc, font: Imager.Font, horizontalSpace: INTEGER, lineHeight: INTEGER] RETURNS [button: Buttons.Button] = {
An unqueued button calls the clickProc indicated by the client. It forks a process.
Like BuildButton except that event: 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: lineHeight,
parent: container, border: border],
proc: HandleUnQueuedButton,
clientData: buttonData,
documentation: handleUnQueuedConfirm,
fork: TRUE,
guarded: confirmProc # NIL,
font: font
];
};
label => {
button ¬ Labels.Create[
info: [
parent: container,
name: name,
wx: x, wy: y, ww: ww, wh: lineHeight,
border: border]];
};
text => {
button ¬ ViewerTools.MakeNewTextViewer[[
parent: container,
wx: x, wy: y, ww: ww, wh: lineHeight,
data: name,
scrollable: FALSE, border: border]];
};
popUpButton => SIGNAL NotYetImplemented; -- not yet implemented
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];
};
END.