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;

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
									-- their corresponding labels
  
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.ROPE, buttonNames: ButtonList, default: Rope.ROPE, borderOnButtons: BOOLEAN, notifyClientProc: SelectionNotifierProc, permit: EnumPermissionProc, clientdata: REF ANY, style: StyleChoice, allInOneRow: BOOLEAN, maxWidth: INTEGER] RETURNS [EnumTypeRef] = BEGIN
 foundDefault: BOOLEAN _ FALSE;
stateInfo: EnumTypeRef _ NEW[EnumTypeRec];
DefaultFound: PROC[currentName, defaultName: Rope.ROPE] RETURNS [BOOLEAN] = BEGIN
 IF Rope.Equal[currentName, defaultName, FALSE] 	THEN RETURN [foundDefault _ TRUE]
															ELSE RETURN [FALSE];
END;
BuildMenuSelection: PROC = BEGIN
		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,
				-- 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;
		END;
BuildFlipThru: PROCEDURE = BEGIN
		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;
		-- 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;
		END;
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;

-- signal that the default didn't exist if necessary
IF ~foundDefault THEN SIGNAL DefaultDoesntExist;

stateInfo.nexty _ stateInfo.nexty + entryHeight;		
RETURN[stateInfo];
END;
MenuSelectionProc: Buttons.ButtonProc = BEGIN
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;
		-- 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];
		}}
ELSE {
	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];
	};
END;
SwitchButtons: PRIVATE PROCEDURE[oldButton, newButton: Buttons.Button] = BEGIN
-- 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;
FlipThruButtonProc: Buttons.ButtonProc = BEGIN
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 
		-- Display the next name in succession
			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]];
		-- Notify client that change has taken place if the client provided a proc for doing this
		IF info.proc # NIL THEN info.proc[info.flipLabel.name, info.clientdata];
		}}
ELSE {
	IF mouseButton=red THEN
		-- Display the next name in succession
		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]];
	-- Notify client that change has taken place if the client provided a procedure for doing this
	IF info.proc # NIL THEN info.proc[info.flipLabel.name, info.clientdata];
	};
END;
UpdateChoiceButtons: PUBLIC PROCEDURE [viewer: ViewerClasses.Viewer, enumTypeInfo: EnumTypeRef, newName: Rope.ROPE] = BEGIN
newButton: Buttons.Button _ NIL;
GetDesiredButton: ViewerOps.EnumProc = BEGIN
	IF (Rope.Equal[v.name, newName, FALSE]) AND 
					(ViewerOps.FetchProp[v, $ChoiceButtons] = enumTypeInfo) THEN {
		newButton _ v;
		RETURN [FALSE];
		};
	END;
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;
END;
GetSelectedButton: PUBLIC PROC [handle: EnumTypeRef] RETURNS [Rope.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.ROPE] RETURNS
	[Rope.ROPE] = BEGIN
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];
END;

GetPrevName: PRIVATE PROC[listOfNames: ButtonList,  currentName: Rope.ROPE] RETURNS
	[Rope.ROPE] = BEGIN
prev: Rope.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];
END;
MaxNameWidth: PRIVATE PROC[listOfNames: ButtonList] RETURNS [CARDINAL] = BEGIN
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];
END;
BuildTriStateButton: PUBLIC PROCEDURE [viewer: ViewerClasses.Viewer, x,y: INTEGER, name: Rope.ROPE] RETURNS [stateInfo: ThreeStateRef, nextX: INTEGER] = {
 tempButton: Buttons.Button;
stateInfo _ NEW[ThreeState];
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: 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] = BEGIN
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;
END;
NextState:  PROC [state: StateType] RETURNS [StateType] = BEGIN
IF state = LAST[StateType] THEN RETURN[FIRST[StateType]]
ELSE RETURN[SUCC[state]];
END;
TriSwitchProc: Buttons.ButtonProc = BEGIN
handle: ThreeStateRef _ NARROW[clientData];
handle.state _ NextState[handle.state];
-- Indicate which state this button is in.
SetButtonState[handle.button, handle.state];
END;
BuildTextPrompt: PUBLIC PROCEDURE [viewer: ViewerClasses.Viewer, x,y: CARDINAL, title: Rope.ROPE, default: Rope.ROPE, font: VFonts.Font, textViewerWidth: INTEGER, clientdata: REF ANY, notify: SelectionNotifierProc, permit: PromptPermissionProc] RETURNS [promptData: PromptDataRef] = BEGIN
	
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;
END;

PromptProc: Buttons.ButtonProc = BEGIN
 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;
END.



N ChoiceButtonsImpl.mesa
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
 force the selection into the user input field (the text viewer).  Depending on which mouse button this viewer button was selected with, do different things

�Ê�–
"Mesa" style˜IprocšÏcHœ/™wJš
œ1™1š
Ïk	˜	Kšœ	žœSžœžœžœžœžœžœ@žœ8žœ9˜›—Kš/œž
œžœEžœžœ
žœžœ�'œ
žœ�1œžœ�Gœ	�œžœžœ'žœ
žœžœžœ
žœžœžœ
žœžœ
˜ðKš�œ
�œ
�œ
�œ
�œ
�œ
�œ
�˜'šœ
Ïnœžœ
žœ&žœžœ)žœžœSžœ
žœ#žœžœžœž˜áKšœžœžœžœ˜JšŸœžœ žœžœžœž˜QKšœ
žœ&žœžœ
žœžœžœ
žœžœžœ
˜{—Kš4Ÿœžœžœžœžœžœ	�9œYžœ	žœ
žœŽ
žœOžœ0žœ+žœžœ
žœžœžœžœ\žœÔ
�8œ�5œ¶
žœ)žœ™
žœ žœ
˜ñKš4Ÿ
œž	œžœCžœžœ	žœ
žœ�œµ
žœžœ%žœ+žœžœžœ,žœ
�œžœ�!œžœ	žœ
žœ|�4œ�Xœ6žœ	žœÞžœ
˜�Kšœ·
žœžœ
žœ
�;œžœžœDžœžœ�5žœžœ
žœIžœ
žœ
˜À—šœ(ž˜-Kš)œžœ-žœ
žœžœ
žœžœžœ�.œ(�0œ�Zœžœ
žœ
žœ/žœ*�0œ�Zœ
žœ
žœ
žœ.žœ
˜ø—šŸ
œžœ
ž	œ)ž˜NKš�fœ8�)œ7žœ
˜‚—šœ)ž˜.Kš7œžœžœžœ
žœžœžœ�.œžœžœ�'œzžœ
�œ{�Zœžœ
žœ
žœ7žœžœžœ�'œwžœ
�œx�_œ
žœ
žœ
žœ6žœ
˜§	—š	Ÿœžœ
ž	œIžœž˜{Kšœžœ
˜ Kšœ'žœžœžœžœ?žœžœžœ	žœ
˜Ì
Kšžœžœ
žœ
žœžœžœPžœ
žœ
žœxžœ
žœÉ
žœžœžœ
˜ —š
Ÿœžœ
žœžœžœ˜LKšžœžœžœžœ
žœ
žœžœ
žœžœžœžœ
žœ
žœžœ
žœ˜Æ
—š
Ÿœžœ
žœ-žœžœžœž˜hKš&œ&žœžœžœ"žœ"žœžœžœ
žœ
žœ�6œ�8žœžœ
žœ�@œ
žœžœ
žœžœ˜Ò—š
Ÿœžœ
žœ-žœžœžœž˜hKšœžœNžœ
žœžœ*žœžœ5žœžœžœ
˜ú
—šŸœžœ
žœžœžœž˜NKšœ0žœžœžœ
žœwžœ
žœžœžœžœžœSžœwžœ.�)žœžœ
˜»—šŸœžœ
ž	œ%žœ
žœžœ#žœ˜š
Kšœ)žœR�8œ�5œžœ4�*œP˜Ï—šŸœžœ
žœ7ž˜XKš
žœžœò
žœžœžœ
˜™—šŸ	œžœžœž˜?Kšžœ	žœžœ
žœ
žœ
žœ
žœ
žœ
žœ
˜W—šœ$ž˜)Kšœžœ6�+œ-žœ
˜°
—šŸœžœ
ž	œ%žœžœžœ&žœžœ
žœ?žœžœ˜¢Jš#œžœ-žœ�
žœœ�5œžœžœžœžœ
žœžœNžœ
žœžœHžœžœ
žœ¸
žœ˜ó—šœ!ž˜&Kš
��
™�
Kš5œžœ-žœ
žœžœ
žœžœžœ�'œžœžœ�œ1žœ
�'œžœžœ
žœ5žœžœžœ�œ/žœ
�'œžœžœ
žœ5žœ
˜˜—Jšžœ˜—…—5º>˜