DIRECTORY
Buttons,
Imager USING [black, Color, Context, MaskIntRectangle, MaskCharacters, SetColor, SetIntCP, white],
InputFocus USING [CaptureButtons, ReleaseButtons],
Menus USING [Entry, EntryNotifyRecord, MenuEntryTrigger, UnGuardRec],
MessageWindow USING [Append, messageWindow],
Process USING [Detach, InitializeMonitor, Milliseconds, MsecToTicks, priorityNormal,
SetPriority, SetTimeout],
Rope USING [FromRefText, ROPE],
TIPUser USING [InstantiateNewTIPTable, TIPScreenCoords],
VFonts USING [defaultFont, Font, FontHeight, RopeWidth],
ViewerClasses,
ViewerOps USING [CreateViewer, MouseInViewer, MoveViewer, PaintViewer,
RegisterViewerClass],
ViewerSpecs;

ButtonsImpl: CEDAR MONITOR LOCKS data USING data: ButtonData

IMPORTS Imager, InputFocus, MessageWindow, Process, Rope, TIPUser, VFonts, ViewerOps
EXPORTS Buttons
SHARES MessageWindow, ViewerOps =

BEGIN OPEN ViewerClasses, Buttons;

ButtonData: TYPE = REF ButtonDataRec;
ButtonDataRec: TYPE = MONITORED RECORD [
proc: ViewerClasses.NotifyProc,
font: VFonts.Font,
entry: Menus.Entry,
greyCount: INTEGER _ 0,
displayStyle: DisplayStyle _ blackOnWhite,
inverted: BOOL _ FALSE,
state: GuardState
];

armingTime: Process.Milliseconds _ 100; -- cover removal time.
armedTime: Process.Milliseconds _ 5000; -- unguarded interval.

GuardState: TYPE = { guarded, arming, armed };

DisplayStyle: TYPE = {blackOnWhite, whiteOnBlack, blackOnGrey} ;

bottomOffset: INTEGER = 3;	-- for painting
leftOffset: INTEGER = 3;

defaultButtonY: INTEGER = ViewerSpecs.screenH-ViewerSpecs.messageWindowHeight;
defaultButtonH: INTEGER = ViewerSpecs.messageWindowHeight;

Create: PUBLIC PROC [info: ViewerRec _ [], proc: ViewerClasses.NotifyProc, entry: Menus.Entry, font: VFonts.Font _ VFonts.defaultFont, paint: BOOL _ TRUE] RETURNS [button: Button] = BEGIN
data: ButtonData _ NEW[ButtonDataRec _ [proc: proc, font: font, entry: entry, state: IF entry.guarded THEN guarded ELSE armed]];
TRUSTED {Process.InitializeMonitor[@data.LOCK]};
IF info.name = NIL THEN info.name _ entry.name;
IF info.ww=0 THEN info.ww _ VFonts.RopeWidth[info.name, font]+leftOffset+leftOffset;
IF info.wh=0 THEN info.wh _ VFonts.FontHeight[font]+bottomOffset;
IF info.parent=NIL AND info.wx=0 AND info.wy=0 THEN
BEGIN OPEN MessageWindow.messageWindow;
ViewerOps.MoveViewer[MessageWindow.messageWindow, wx, wy, ww-info.ww, wh,
FALSE];
info.wx _ wx + ww;
info.wy _ defaultButtonY;
info.wh _ defaultButtonH;
info.column _ static;
END;
info.data _ data;
IF entry.guarded THEN {
FOR n: LIST OF Menus.EntryNotifyRecord _ entry.actions, n.rest UNTIL n = NIL DO
WITH n.first.guardResponse SELECT FROM
r: REF TEXT 					=> n.first.guardResponse _ Rope.FromRefText[r];
r: REF Menus.UnGuardRec => NULL;
r: REF Rope.ROPE 			=> NULL;
ENDCASE						=> ERROR;	-- not valid  
ENDLOOP;
};
RETURN[ViewerOps.CreateViewer[$Button, info, paint]];
END;

myGrey: REF CARDINAL = NEW[CARDINAL _ 001010B];

ButtonsPaint: PRIVATE PaintProc = BEGIN OPEN Imager;
data: ButtonData _ NARROW[self.data];
IF data = NIL THEN RETURN;
IF ISTYPE[whatChanged, PaintRectangle] THEN whatChanged _ NIL;
IF whatChanged=NIL THEN BEGIN	-- paint in label (derived from name)
borderFudge: INTEGER = IF self.border THEN 0 ELSE 1;
IF ~clear OR data.greyCount # 0 OR data.displayStyle=blackOnGrey THEN {
SetColor[context, myGrey];
MaskIntRectangle[context, [1, 1, self.cw-2, self.ch-2]]}
ELSE IF ~clear OR data.displayStyle=whiteOnBlack THEN {
SetColor[context, black];
MaskIntRectangle[context, [1, 1, self.cw-2, self.ch-2]]};
SetColor[context, SELECT data.displayStyle FROM
whiteOnBlack	=> white,
ENDCASE			=> black];
SetIntCP[context, [leftOffset+borderFudge, bottomOffset+borderFudge]];
MaskCharacters[context, data.font, self.name];
IF data.entry.guarded AND data.state#armed THEN BEGIN
by: INTEGER ~ bottomOffset+borderFudge+2;
MaskIntRectangle[context, [0, by, self.cw, 1]];
END;
END;

IF whatChanged=$Invert OR data.inverted THEN BEGIN	-- invert to indicate highlighting
SetColor[context, $XOR];
MaskIntRectangle[context, [0, 0, self.cw, self.ch]];
IF whatChanged=$Invert THEN data.inverted _ ~data.inverted;
END;
END;

ButtonsNotify: NotifyProc = BEGIN
data: ButtonData _ NARROW[self.data];
EntryButtonsNotify[self, input, data];
END;

MouseButton: TYPE = { red, yellow, blue };

EntryButtonsNotify: ENTRY PROC [self: Viewer, input: LIST OF REF ANY, data: ButtonData] =
BEGIN
ENABLE UNWIND => InputFocus.ReleaseButtons[];
button: MouseButton _ red;
shift, control: BOOL _ FALSE;
mouse: TIPUser.TIPScreenCoords;
response: REF ANY;
IF data = NIL THEN RETURN;
FOR list: LIST OF REF ANY _ input, list.rest UNTIL list = NIL DO
WITH list.first SELECT FROM
x: ATOM	=> SELECT x FROM
$Hit	=> IF data.inverted THEN SELECT data.state FROM
guarded => {
data.state_arming;
ViewerOps.PaintViewer[self, client, FALSE, $Invert];
InputFocus.ReleaseButtons[];
TRUSTED {Process.Detach[FORK ArmButtonProc[data, self]]};
response _ FindNotifyRecord[data.entry, TriggerFrom[shift, button]].guardResponse;
IF response#NIL THEN TRUSTED {Process.Detach[
FORK GuardResponse[response] ]};
};
arming=> NULL; -- no action
armed=> {
InputFocus.ReleaseButtons[];
ViewerOps.PaintViewer[self, client, FALSE, $Invert];
IF data.entry.guarded THEN BEGIN
data.state_guarded;
ViewerOps.PaintViewer[self, client];
END;
ButtonPusher[self, data, TriggerFrom[shift, button], FALSE];
};
ENDCASE => ERROR;
$Mark	=> IF ~data.inverted THEN BEGIN
InputFocus.CaptureButtons[ButtonsNotify, buttonsClass.tipTable, self];
ViewerOps.PaintViewer[self, client, FALSE, $Invert];
END
ELSE BEGIN
v: Viewer;
c: BOOL;
[v, c] _ ViewerOps.MouseInViewer[mouse];
IF v=self AND c THEN RETURN;
ViewerOps.PaintViewer[self, client, FALSE, $Invert];
InputFocus.ReleaseButtons[];
END;
$Red	=> button _ red;
$Yellow	=> button _ yellow;
$Blue	=> button _ blue;
$Shift	=> shift _ TRUE;
$Control	=> control _ TRUE;
ENDCASE	=> NULL;
z: TIPUser.TIPScreenCoords => mouse _ z;
ENDCASE => ERROR;
ENDLOOP;
END;

TriggerFrom: PROC [shift: BOOLEAN, button: MouseButton] RETURNS [answer: Menus.MenuEntryTrigger] = {
SELECT TRUE FROM
(button = red)     AND NOT shift => answer _ leftup;
(button = red)     AND       shift => answer _ shiftleftup;
(button = yellow) AND NOT shift => answer _ middleup;
(button = yellow) AND       shift => answer _ shiftmiddleup;
(button = blue)   AND NOT shift => answer _ rightup;
(button = blue)   AND       shift => answer _ shiftrightup;
ENDCASE => ERROR;
RETURN[answer];
};
ArmButtonProc: ENTRY PROC [data: ButtonData, button: Buttons.Button] = {
IF data = NIL THEN RETURN;
ButtonWait[data, armingTime];
IF data.state = arming THEN {
data.state_armed;
ViewerOps.PaintViewer[button, client];
ButtonWait[data, armedTime];
};
IF data.state#guarded THEN BEGIN
data.state_guarded;
ViewerOps.PaintViewer[button, client];
END; };

ButtonWait: INTERNAL PROC[data: ButtonData, ticks: Process.Milliseconds] = TRUSTED {
buttonWaitCondition: CONDITION;
Process.SetTimeout[LONG[@buttonWaitCondition], Process.MsecToTicks[ticks]];
WAIT buttonWaitCondition; };

ButtonPusher: PROC [button: Button, myData: ButtonData, trigger: Menus.MenuEntryTrigger, normalPriority: BOOL] = BEGIN
notifyRecord: Menus.EntryNotifyRecord;
IF myData = NIL THEN RETURN;
notifyRecord _ FindNotifyRecord[myData.entry,trigger];

myData.greyCount _ myData.greyCount + 1;
IF myData.displayStyle#blackOnGrey THEN ViewerOps.PaintViewer[button, client];
IF normalPriority THEN TRUSTED {Process.SetPriority[Process.priorityNormal]};

myData.proc[NIL, notifyRecord.notifyData];

myData.greyCount _ MAX[myData.greyCount - 1, 0];
IF myData.displayStyle#blackOnGrey THEN ViewerOps.PaintViewer[button, client];
END;

ButtonGet: PRIVATE GetProc = BEGIN
RETURN[self.name];
END;

ButtonsSet: PRIVATE SetProc = BEGIN
IF op=NIL THEN self.name _ NARROW[data]
ELSE BEGIN
myData: ButtonData _ NARROW[self.data];
IF myData = NIL THEN RETURN;
SELECT op FROM
$DisplayStyle =>
SELECT data FROM
$BlackOnWhite	=> {
myData.greyCount _ MAX[myData.greyCount - 1, 0];
IF myData.greyCount <= 0 THEN myData.displayStyle _ blackOnWhite};
$WhiteOnBlack	=> {
myData.greyCount _ MAX[myData.greyCount - 1, 0];
IF myData.greyCount <= 0 THEN myData.displayStyle _ whiteOnBlack};
$BlackOnGrey, $BlackOnGray	=> {
myData.greyCount _ myData.greyCount + 1;
myData.displayStyle _ blackOnWhite};
ENDCASE			=> ERROR;
-- $ClientData	=> myData.clientData _ data;
ENDCASE	=> ERROR;
END;
IF finalise THEN ViewerOps.PaintViewer[self, all];
END;

FindNotifyRecord: PROC [entry: Menus.Entry, trigger: Menus.MenuEntryTrigger] RETURNS [answer: Menus.EntryNotifyRecord] = {
FOR l: LIST OF Menus.EntryNotifyRecord _ entry.actions, l.rest UNTIL l = NIL DO
FOR t: LIST OF Menus.MenuEntryTrigger _ l.first.trigger, t.rest UNTIL t = NIL DO
IF t.first = trigger OR t.first = all THEN RETURN[l.first];
ENDLOOP;
ENDLOOP;
ERROR;
};

GuardResponse: PROC [response: REF ANY] = BEGIN
WITH response SELECT FROM
response: Rope.ROPE						=> MessageWindow.Append[response, TRUE];
response: REF Menus.UnGuardRec	=> response.proc[response.data];
ENDCASE									=> ERROR;	-- not valid response
END;		


buttonsClass: ViewerClasses.ViewerClass _ NEW[ViewerClasses.ViewerClassRec _ [
paint: ButtonsPaint,
get: ButtonGet,
set: ButtonsSet,
notify: ButtonsNotify,
tipTable: TIPUser.InstantiateNewTIPTable["/Indigo/CedarViewers/Viewers/Button.tip"],
cursor: bullseye
]];

ViewerOps.RegisterViewerClass[$Button, buttonsClass];	-- plug in to Viewers

END.


&ButtonsImpl.mesa; Written by S. McGregor
Edited by McGregor on August 4, 1983 10:49 am
Last Edited by: Maxwell, June 7, 1983 2:25 pm
Last Edited by: Pausch, August 26, 1983 1:51 pm
name is specified via the viewerRec OR entry record, but look at viewer's name first
borderFudge is so buttons line up whether they have borders or not
assert: state=arming
this is where we actually tell the client about the button-invoked function:
routines copied from MenusImpl
NOTE! the following line produces a compiler warning that can be safely ignored.
Κ–

"cedar" style˜Jš
Οc(™(Jš
-™-J™-J™/š
Οk	˜	J˜JšœžœV˜bJšœžœ"˜2Jšœžœ:˜EJšœžœ˜,šœžœG˜TJ˜—Jšœžœžœ˜Jšœžœ+˜8Jšœžœ,˜8J˜šœ
žœ7˜FJ˜—J˜J˜—Jš	œ
žœ
žœ
žœžœ˜<J˜JšžœM˜TJšžœ˜Jšžœ˜!J˜Jšžœ
žœ˜"J˜Jšœžœžœ˜%šœžœž	œ
žœ˜(J˜J˜J˜Jšœžœ˜Jš
œ*˜*Jšœ
žœžœ
˜J˜J˜J˜—Jšœ(˜>Jšœ(˜>J˜Jšœžœ˜.J˜Jšœžœ.˜@J˜Jšœžœ˜*Jšœžœ˜J˜Jšœžœ7˜NJšœžœ#˜:J˜š
Οnœžœ
žœ{žœžœžœž˜»
Jš	œžœ?žœžœ	žœ	˜€
Jšžœ"žœ˜0Jš
œT™TJšžœ
žœ
žœ˜/JšžœžœC˜TJšžœžœ0˜Aš	žœ
žœ
žœžœž˜3Jšžœ
žœ˜'˜IJšžœ˜—J˜J˜J˜J˜Jšžœ
˜—J˜šžœžœ˜šžœžœ
žœ1žœžœ
ž˜Ošžœžœ
ž˜&Jšœžœ
žœ5˜@Jšœžœžœ
˜ Jšœžœžœžœ
˜Jšžœ	žœ
œ
˜%—Jšžœ
˜—J˜—Jšžœ/˜5Jšžœ
˜J˜—Jš	œžœ
žœžœ
žœ˜/J˜šœžœ
žœ
žœ˜4Jšœžœ˜%Jšžœžœ
žœ
žœ
˜Jšžœ
žœžœžœ
˜>š	žœ
žœ
žœ
žœ
%˜CJš
B™BJš	œ
žœžœ
žœžœ˜4šžœžœžœžœ˜GJš
œ˜Jš
œ8˜8—šžœ
žœžœ žœ˜7Jš
œ˜Jš
œ9˜9—šœžœž˜/J˜Jšžœ
˜—J˜FJ˜.šžœžœžœ
ž˜5Jšœžœ˜)Jš
œ/˜/Jšžœ
˜—Jšžœ
˜J˜—š	žœžœžœ
žœ
"˜UJ˜Jš
œ4˜4Jšžœžœ ˜;Jšžœ
˜—Jšžœ
˜J˜—šœž˜!Jšœžœ˜%J˜&Jšžœ
˜J˜—J˜*J˜šŸœžœ
žœžœ
žœ
žœ
žœ˜YJš
ž˜Jšžœ
žœ ˜-Jš
œ˜Jšœžœžœ
˜J˜Jšœ
žœ
žœ
˜Jšžœžœ
žœ
žœ
˜šžœžœ
žœ
žœ
žœžœžœ
ž˜@šžœžœ
ž˜šœžœžœž˜šœžœžœ
žœž˜4˜J˜Jšœ$žœ˜4J˜Jšžœžœ˜9Jš
œR˜Ršžœ
žœ
žœ
žœ˜-Jšžœ˜ —J˜—Jšœ	žœ˜˜	J˜Jšœ$žœ˜4šžœžœ
ž˜ J˜J˜$Jšžœ
˜—Jšœ5žœ˜<J˜—Jšžœžœ
˜—šœ	žœžœ
ž˜%J˜FJšœ$žœ˜4Jš
ž˜šžœ
ž˜
J˜
Jšœžœ
˜J˜(Jšžœžœžœ
žœ
˜Jšœ$žœ˜4J˜Jšžœ
˜——J˜J˜J˜Jšœžœ
˜Jšœžœ
˜Jšžœžœ
˜—J˜(Jšžœžœ
˜—Jšžœ
˜—Jšžœ
˜J˜—šŸœžœ	žœžœ%˜dšžœ
žœ
ž˜Jšœžœ
žœ˜4Jšœžœ%˜;Jšœžœ
žœ˜5Jšœžœ'˜<Jšœžœ
žœ˜4Jšœžœ&˜;Jšžœžœ
˜—Jšžœ	˜J˜—šŸ
œžœ
žœ/˜HJš
™Jšžœžœ
žœ
žœ
˜J˜šžœžœ˜J˜J˜&J˜J˜—šžœžœ
ž˜ J˜J˜&Jšžœ˜J˜—šŸ
œžœ
žœ2žœ˜TJšœž	œ
˜Jšœžœ4˜KJšžœ˜J˜——šŸœžœWžœž˜vJš
œ&˜&Jšžœ
žœ
žœ
žœ
˜Jš
œ6˜6J˜Jš
œ(˜(Jšžœ!žœ'˜NJšžœžœ
žœ/˜MJ˜J™LJšœžœ˜*J˜Jšœžœ˜0Jšžœ!žœ'˜NJšžœ
˜J˜—šœžœž˜"Jšžœ˜Jšžœ
˜J˜—šœžœž˜#Jšžœžœ
žœ
žœ˜'šžœ
ž˜
Jšœžœ˜'Jšžœ
žœ
žœ
žœ
˜šžœž˜š
œ˜šžœž˜˜Jšœžœ˜0Jšžœžœ%˜B—˜Jšœžœ˜0Jšžœžœ%˜B—˜J˜(Jš
œ$˜$—Jšžœžœ
˜—Jš
œ+˜+—Jšžœžœ
˜—Jšžœ
˜—Jšžœ
žœ"˜2Jšžœ
˜J˜—Jš
œ™šŸœžœ7žœ&˜zšžœžœ
žœ1žœžœ
ž˜Ošžœžœ
žœ2žœžœ
ž˜PJš
œP™PJšžœžœžœ
žœ
˜;Jšžœ
˜—Jšžœ
˜—Jšžœ
˜J˜J˜—š	Ÿ
œžœžœ
žœž˜/šžœ
žœ
ž˜Jšœžœ(žœ˜AJšœ
žœ2˜?Jšžœžœ˜/—Jšžœ˜J˜—J˜šœ*žœ!˜NJ˜J˜J˜J˜J˜TJ˜J˜J˜—Jšœ6˜KJ˜Jšžœ
˜J˜J˜—…—$–1Π