DIRECTORY
Buttons USING [Button, ButtonProc, Create, ReLabel, SetDisplayStyle],
ChoiceButtons,
Containers USING [ChildXBound],
Labels USING [Create, Label, Set],
Rope USING [ROPE, Equal],
ViewerClasses USING [Viewer],
ViewerOps USING [AddProp, EnumProc, EnumerateChildren, FetchProp],
ViewerTools USING [MakeNewTextViewer, SetContents, SetSelection],
VFonts USING [CharWidth, Font, FontHeight, StringWidth, defaultFont];

ChoiceButtonsImpl: CEDAR PROGRAM
IMPORTS Buttons, Containers, Labels, Rope, ViewerOps, ViewerTools, VFonts 
EXPORTS ChoiceButtons
= BEGIN OPEN ChoiceButtons;

ROPE: TYPE ~ Rope.ROPE;

entryHeight: CARDINAL = 15; -- how tall to make each line of items
entryHSpace: CARDINAL = 10; -- horizontal space between title and selections
fudge: CARDINAL = 5; -- fudge factor so that the baselines of text viewers are aligned with

on: ATOM = $WhiteOnBlack;
off: ATOM = $BlackOnWhite;

DefaultDoesntExist: PUBLIC SIGNAL = CODE;
ChoiceDoesntExist: PUBLIC SIGNAL = CODE;
ButtonsCannotBeUpdated: PUBLIC SIGNAL = CODE;

BuildEnumTypeSelection: PUBLIC PROC [viewer: ViewerClasses.Viewer, x, y: CARDINAL, title: ROPE, buttonNames: ButtonList, default: ROPE, borderOnButtons: BOOL, notifyClientProc: SelectionNotifierProc, permit: EnumPermissionProc, clientdata: REF ANY, style: StyleChoice, allInOneRow: BOOL, maxWidth: INTEGER] RETURNS [EnumTypeRef] = {
foundDefault: BOOL _ FALSE;
stateInfo: EnumTypeRef _ NEW[EnumTypeRec];
DefaultFound: PROC[currentName, defaultName: 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.proc _ notifyClientProc;
stateInfo.namesOfButtons _ buttonNames;
stateInfo.clientdata _ clientdata;
stateInfo.permission _ permit;
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];
};

MenuSelectionProc: Buttons.ButtonProc = {
info: EnumTypeRef _ NARROW[clientData];
viewer: ViewerClasses.Viewer _ NARROW[parent];
IF info.permission # NIL THEN {
IF info.permission[info] THEN { -- don't do anything without permission first
SwitchButtons[info.buttonOn, viewer]; -- viewer is the button which was just selected
info.buttonOn _ viewer;
IF info.proc # NIL THEN info.proc[viewer.name, info.clientdata];
}}
ELSE {
SwitchButtons[info.buttonOn, viewer]; -- viewer is the button which was just selected
info.buttonOn _ viewer;
IF info.proc # NIL THEN info.proc[viewer.name, info.clientdata];
};
};

SwitchButtons: PRIVATE PROC[oldButton, newButton: Buttons.Button] = {
Buttons.SetDisplayStyle[button: oldButton, style: off];
Buttons.SetDisplayStyle[button: newButton, style: on];
};

FlipThruButtonProc: Buttons.ButtonProc = {
info: EnumTypeRef _ NARROW[clientData];
IF info.permission # NIL THEN {
IF info.permission[info] THEN { -- don't do anything without permission first
IF mouseButton=red THEN 
ViewerTools.SetContents[viewer: info.flipLabel, contents:
GetNextName[info.namesOfButtons, info.flipLabel.name]]
ELSE -- Display the previous name
ViewerTools.SetContents[viewer: info.flipLabel, contents:
GetPrevName[info.namesOfButtons, info.flipLabel.name]];
IF info.proc # NIL THEN info.proc[info.flipLabel.name, info.clientdata];
}}
ELSE {
IF mouseButton=red THEN
ViewerTools.SetContents[viewer: info.flipLabel, contents:
GetNextName[info.namesOfButtons, info.flipLabel.name]]
ELSE -- display the previous name
ViewerTools.SetContents[viewer: info.flipLabel, contents:
GetPrevName[info.namesOfButtons, info.flipLabel.name]];
IF info.proc # NIL THEN info.proc[info.flipLabel.name, info.clientdata];
};
};

UpdateChoiceButtons: PUBLIC PROC [viewer: ViewerClasses.Viewer, enumTypeInfo: EnumTypeRef, newName: 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;
};

GetSelectedButton: PUBLIC PROC [handle: EnumTypeRef] RETURNS [ROPE] = {
IF handle.type = menuStyle THEN {
IF handle.buttonOn = NIL THEN ERROR 
ELSE RETURN [handle.buttonOn.name]
}
ELSE {
IF handle.flipLabel = NIL THEN ERROR
ELSE RETURN[handle.flipLabel.name]
};
};

GetNextName: PRIVATE PROC[listOfNames: ButtonList,  currentName: ROPE] RETURNS
[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] RETURNS
[ROPE] = {
prev: ROPE _ listOfNames.first;
eachName:  ChoiceButtons.ButtonList _ listOfNames.rest;
WHILE (eachName # NIL) AND ~Rope.Equal[eachName.first, currentName, FALSE] DO
prev _ eachName.first;
eachName _ eachName.rest;
ENDLOOP;
RETURN[prev];
};

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];
};

BuildTriStateButton: PUBLIC PROC [viewer: ViewerClasses.Viewer, x,y: INTEGER, name: ROPE] RETURNS [stateInfo: ThreeStateRef, nextX: INTEGER] = {
tempButton: Buttons.Button;
stateInfo _ NEW[ThreeState];
tempButton _ Buttons.Create[
info: [name: name,
wx: x,
wy: y,
wh: entryHeight, -- specify rather than defaulting so line is uniform
parent: viewer, 
border: TRUE
],
proc: TriSwitchProc,
clientData: stateInfo -- this will be passed to our button proc
];
stateInfo.button _ tempButton;
nextX _ tempButton.wx + tempButton.ww + 4;
};

SetButtonState: PUBLIC PROC [buttonSelected:  Buttons.Button, state: StateType] = {
SELECT state FROM 
on => Buttons.SetDisplayStyle[button: buttonSelected, style: $WhiteOnBlack];
off => Buttons.SetDisplayStyle[button: buttonSelected, style: $BlackOnWhite];
default => Buttons.SetDisplayStyle[button: buttonSelected, style: $BlackOnGrey];
ENDCASE => ERROR;
};

NextState: PROC [state: StateType] RETURNS [StateType] = {
IF state = LAST[StateType] THEN RETURN[FIRST[StateType]]
ELSE RETURN[SUCC[state]];
};

TriSwitchProc: Buttons.ButtonProc = {
handle: ThreeStateRef _ NARROW[clientData];
handle.state _ NextState[handle.state];
SetButtonState[handle.button, handle.state];
};

BuildTextPrompt: PUBLIC PROC [viewer: ViewerClasses.Viewer, x,y: CARDINAL, title: ROPE, default: ROPE, font: VFonts.Font, textViewerWidth: INTEGER, clientdata: REF ANY, notify: SelectionNotifierProc, permit: PromptPermissionProc] RETURNS [promptData: PromptDataRef] = {
height: INTEGER _ VFonts.FontHeight[font] + 6;
promptData _ NEW[PromptDataRec];
promptData.promptButton _ Buttons.Create[info: [name: title, wx: x, wy: y, wh: height,
parent: viewer, border: FALSE], font: font, proc: PromptProc, clientData: promptData];
promptData.textViewer _ ViewerTools.MakeNewTextViewer [[
parent: viewer,
wx: promptData.promptButton.wx + promptData.promptButton.ww + entryHSpace,
wy: y + fudge,
ww: textViewerWidth,
wh: height - fudge,
name: title, -- give it the name of the prompt associated with it
data: default,
scrollable: FALSE,
border: FALSE
]];
IF textViewerWidth = LAST[INTEGER] THEN {
Containers.ChildXBound[viewer, promptData.textViewer];
promptData.newx _ LAST[INTEGER];
}
ELSE promptData.newx _ promptData.textViewer.wx + promptData.textViewer.ww;
IF default # NIL THEN ViewerTools.SetContents[promptData.textViewer, default];
promptData.clientdata _ clientdata;
promptData.notify _ notify;
promptData.permission _ permit;
promptData.newy _ y + height;
};

PromptProc: Buttons.ButtonProc = {
handle: PromptDataRef _ NARROW[clientData];
viewer: ViewerClasses.Viewer _ NARROW[parent];
IF handle.permission # NIL THEN {
IF handle.permission[handle] THEN {  -- dont do anything without permission
IF mouseButton=red THEN   -- make pending delete
ViewerTools.SetSelection[handle.textViewer]
ELSE -- notify the client if proc provided.
IF handle.notify # NIL THEN handle.notify[viewer.name, handle.clientdata];
}}
ELSE {
IF mouseButton=red THEN   -- make pending delete
ViewerTools.SetSelection[handle.textViewer]
ELSE -- notify the client if proc provided.
IF handle.notify # NIL THEN handle.notify[viewer.name, handle.clientdata];
} 
};


END.
ChoiceButtonsImpl.mesa
Copyright c 1985 by Xerox Corporation.  All rights reserved.
Written by Linda Gass on August 30, 1982 1:21 pm
Last Edit by McGregor October 5, 1982 12:28 pm
Last Edited by: Maxwell, January 3, 1983 12:35 pm
Doug Wyatt, April 6, 1985 3:23:52 pm PST
their corresponding labels
default the width so that it will be computed for us
now set up the initial button
width properly (unfortunately when re-labeling a button, the width remains the same)
signal that the default didn't exist if necessary
Notify client that change has taken place if the client provided a proc for doing this
Notify client that change has taken place if the client provided a proc for doing this
merely changes the physical appearance of the buttons
Switch off the previously selected button
switch "on" the newly selected button
Display the next name in succession
Notify client that change has taken place if the client provided a proc for doing this
Display the next name in succession
Notify client that change has taken place if the client provided a procedure for doing this
find the current button name in list of button names
we are at the end of our list, cycle around to the beginning
default the width so that it will be computed for us
Indicate which state this button is in.
ΚV˜
codeš
œ™Kšœ
Οm
œ1™<Kš
œ0™0Kš
œ.™.Kš
œ1™1K™(—K˜š
Οk	˜	Kšœžœ8˜EK˜Kšœžœ˜Kšœžœ˜"Kšœžœžœ	˜Kšœžœ
˜Kšœ
žœ3˜BKšœžœ0˜AKšœžœ9˜E—K˜KšΠblœžœ
ž˜ KšžœC˜JKšžœ˜Kšœžœ
žœ˜K˜Kšžœžœžœ
˜K˜Kšœ
žœΟc&˜BKšœ
žœ 0˜Lšœžœ F˜[Kš
œ™K˜—Kšœžœ˜Kšœžœ˜K˜Kšœžœ
žœžœ
˜)Kšœžœ
žœžœ
˜(Kšœžœ
žœžœ
˜-K˜šΟnœžœ
žœ&žœ	žœ$žœžœSžœ
žœ#žœžœžœ˜ΜKšœžœžœ
˜Kšœžœ˜*š
‘œžœžœžœžœ˜Eš
žœ&žœžœ
žœžœ
˜QKšžœ
žœžœ˜——Kš
œ˜š‘œžœ˜Kšœžœ˜Kšœžœ
˜Kšœžœ 8˜MK˜K˜K˜šžœ	žœ
žœ˜˜*K˜
K˜K˜K˜K˜Kšœž˜
K˜—K˜;K˜
—Kšžœ˜K˜˜šžœ+žœžœ
ž˜Gšžœžœ˜KšžœD˜Fšœžœ˜K˜K˜0K˜—K˜—˜#K˜K˜K˜Kš
œ4™4Kšœ 4˜EK˜K˜K˜K˜K˜K˜—K˜9šžœ)žœ˜1K˜ K˜7K˜—K˜'Kšžœ
˜—K˜Kš
œ˜——š‘
œžœ˜K˜K˜Kšœžœ˜šžœ	žœ
žœ ˜.K˜#˜˜K˜K˜
K˜K˜Kšœž˜K˜—K˜K˜K˜—K˜,K˜
—Kšžœ"˜&šžœ+žœžœž˜IKšœ(žœ
 
˜8Kšžœ
˜—Kš
œ™šžœ	žœ
žœ&˜9K˜K˜
K˜Kšœ 3˜RKš
œT™TK˜K˜Kšœž˜
K˜—šžœ&˜*˜K˜
K˜K˜K˜K˜K˜K˜—K˜K˜K˜—K˜BKš
œ˜—K˜K˜K˜"K˜'K˜"K˜šžœžœ
žœ
 :˜PK˜—K˜šžœž˜K˜$K˜Kšžœžœ
˜—K˜Kš
œ1™1Kšžœžœ
žœ˜0K˜K˜1Kšžœ˜Kš
œ˜K˜—š‘œ˜)Kšœžœ
˜'Kšœžœ	˜.šžœžœ
žœ˜šžœžœ -˜MKšœ& /˜UK˜Kš
œV™VKšžœ
žœ
žœ)˜@K˜——šžœ˜Kšœ& /˜UK˜Kš
œV™VKšžœ
žœ
žœ)˜@K˜—Kš
œ˜K˜—š‘
œžœ
žœ*˜EKš
œ5™5Kš
œ)™)K˜7Kš
œ%™%K˜6Kš
œ˜K˜—š‘œ˜*Kšœžœ
˜'šžœžœ
žœ˜šžœžœ -˜MKšžœžœ
˜š
œ#™#˜9K˜6——šžœ
 ˜!˜9K˜7——Kš
œV™VKšžœ
žœ
žœ1˜HK˜——šžœ˜šžœž˜Kš
œ#™#˜9K˜6——šžœ
 ˜!˜9K˜7——Kš
œ[™[Kšžœ
žœ
žœ1˜HK˜—Kš
œ˜K˜—š‘œžœ
žœDžœ˜mKšœžœ
˜ š
œ(˜(šžœžœžœ
˜,Kšœ8žœ˜>K˜Kšžœžœ˜K˜—Kš
œ˜—Kšžœžœ
žœ
žœ˜9šžœž˜˜Ešžœ
žœ
žœ˜K˜0K˜"K˜
—Kšžœ
žœ˜K˜—K˜PK˜VKšžœžœ
˜—Kš
œ˜K˜—š
‘œžœ
žœžœžœ˜Gšžœžœ˜!Kšžœžœ
žœ
žœ
˜$Kšžœ
žœ˜"K˜
—šžœ˜Kšžœžœ
žœ
ž˜$Kšžœ
žœ˜"K˜—K˜K˜—š	‘œžœ
žœ(žœž˜NKšœ
žœ˜
K˜%šžœžœžœ"žœ
˜AK˜Kšžœ
˜—š	žœžœ
žœ
žœ 5˜UKš
œ4™4—šžœžœ
žœ
˜Kš
œ<™<Kšžœ˜—Kšžœ
žœ˜&Kš
œ˜K˜—š	‘œžœ
žœ(žœž˜NKšœ
žœ˜
Kšœžœ˜K˜7š	žœ
žœžœ*žœž˜MK˜K˜Kšžœ
˜—Kšžœ˜
Kš
œ˜K˜—š
‘œžœ
žœžœžœ˜JK˜%Kšœ
žœ
˜šžœžœ
žœ˜K˜RK˜—Kšžœ
žœ˜šžœžœž˜šžœSž˜YK˜S—K˜Kšžœ
˜—Kšœ, (˜TKšžœ˜Kš
œ˜K˜—š‘œžœ
žœ%žœžœžœ#žœ˜
K˜Kšœžœ
˜K˜˜K˜K˜Kš
œ4™4Kšœ 4˜EK˜Kšœž˜K˜K˜Kšœ )˜?K˜—K˜K˜*K˜K˜—š‘œžœ
žœ8˜Sšžœžœ
˜K˜LK˜MK˜PKšžœžœ
˜—Kš
œ˜K˜—š‘	œžœžœ˜:Kš
žœ	žœžœ
žœ
žœ˜8Kšžœ
žœ
žœ	˜Kš
œ˜K˜—š‘
œ˜%Kšœžœ
˜+K˜'Kš
œ'™'K˜,Kš
œ˜K˜—š‘œžœ
žœ%žœ	žœžœ&žœžœ
žœ?žœ ˜Kšœžœ˜.Kšœ
žœ˜ ˜VKšœžœ9˜V—˜8K˜K˜JK˜K˜K˜Kšœ
 4˜AK˜Kšœžœ
˜Kšœž˜
K˜—šžœžœ
žœžœ˜)K˜6Kšœžœ
žœ˜ K˜
—KšžœG˜KKšžœžœ
žœ9˜NK˜#K˜K˜K˜Kš
œ˜K˜—š‘
œ˜"Kšœžœ
˜+Kšœžœ	˜.šžœžœ
žœ˜!šžœžœ &˜Kšžœžœ ˜0K˜+—šžœ
 &˜+Kšžœžœ
žœ/˜J—K˜——šžœ˜šžœžœ ˜0K˜+—šžœ
 &˜+Kšžœžœ
žœ/˜J—K˜—Kš
œ˜K˜—K˜Kšžœ
˜—…—.r?Π