DIRECTORY
Buttons,
Imager USING [black, Color, Context, IntegerMaskRectangle, IntegerSetXY, MakeStipple, SetColor, ShowCharacters, white, XOR],
InputFocus USING [CaptureButtons, ReleaseButtons],
Menus USING [Action, Entry, Trigger, UnGuardRec],
MessageWindow USING [Append],
MessageWindowPrivate USING [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 USING [guardHeight, guardOffset, messageWindowHeight, screenH];

ButtonsImpl: CEDAR MONITOR
LOCKS data USING data: ButtonData
IMPORTS Imager, InputFocus, MessageWindow, MessageWindowPrivate, Process, Rope, TIPUser, VFonts, ViewerOps
EXPORTS Buttons
SHARES 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,
clientData: REF ANY _ NIL
];

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, clientData: REF ANY _ NIL, paint: BOOL _ TRUE] RETURNS [button: Button] = {
data: ButtonData _ NEW[ButtonDataRec _ [proc: proc, font: font, entry: entry, state: IF entry.guarded THEN guarded ELSE armed, clientData: clientData]];
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
{ OPEN MessageWindowPrivate.messageWindow;
ViewerOps.MoveViewer[MessageWindowPrivate.messageWindow, wx, wy, ww-info.ww, wh,
FALSE];
info.wx _ wx + ww;
info.wy _ defaultButtonY;
info.wh _ defaultButtonH;
info.column _ static;
};
info.data _ data;
IF entry.guarded THEN {
FOR n: LIST OF Menus.Action _ 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]];
};

myGrey: Imager.Color = Imager.MakeStipple[001010B];

ButtonsPaint: PRIVATE PaintProc = {
data: ButtonData _ NARROW[self.data];
IF data = NIL THEN RETURN;
IF whatChanged=NIL OR ISTYPE[whatChanged, PaintRectangle] THEN {
borderFudge: INTEGER = IF self.border THEN 0 ELSE 1;
IF ~clear OR data.greyCount # 0 OR data.displayStyle=blackOnGrey THEN {
Imager.SetColor[context, myGrey];
Imager.IntegerMaskRectangle[context, 1, 1, self.cw-2, self.ch-2]}
ELSE IF ~clear OR data.displayStyle=whiteOnBlack THEN {
Imager.SetColor[context, Imager.black];
Imager.IntegerMaskRectangle[context, 1, 1, self.cw-2, self.ch-2]};
Imager.SetColor[context, SELECT data.displayStyle FROM
whiteOnBlack	=> Imager.white,
ENDCASE			=> Imager.black];
Imager.IntegerSetXY[context, leftOffset+borderFudge, bottomOffset+borderFudge];
Imager.ShowCharacters[context, self.name, data.font];
IF data.entry.guarded AND data.state#armed THEN { OPEN ViewerSpecs;
by: INTEGER ~ bottomOffset+borderFudge+guardOffset;
Imager.IntegerMaskRectangle[context, 0, by, self.cw, guardHeight];
};
};

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

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

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

EntryButtonsNotify: ENTRY PROC [self: Viewer, input: LIST OF REF ANY, data: ButtonData] =
{
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 _ FindAction[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 {
data.state_guarded;
ViewerOps.PaintViewer[self, client];
};
ButtonPusher[self, data, TriggerFrom[shift, button], FALSE];
};
ENDCASE => ERROR;
$Mark	=> IF ~data.inverted THEN {
InputFocus.CaptureButtons[ButtonsNotify, buttonsClass.tipTable, self];
ViewerOps.PaintViewer[self, client, FALSE, $Invert];
}
ELSE {
v: Viewer;
c: BOOL;
[v, c] _ ViewerOps.MouseInViewer[mouse];
IF v=self AND c THEN RETURN;
ViewerOps.PaintViewer[self, client, FALSE, $Invert];
InputFocus.ReleaseButtons[];
};
$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;
};

TriggerFrom: PROC[shift: BOOLEAN, button: MouseButton] RETURNS[Menus.Trigger] = {
RETURN[
IF shift THEN SELECT button FROM
red => shiftLeftUp, yellow => shiftMiddleUp, blue => shiftRightUp,
ENDCASE => ERROR
ELSE SELECT button FROM
red => leftUp, yellow => middleUp, blue => rightUp,
ENDCASE => ERROR
];
};

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 {
data.state_guarded;
ViewerOps.PaintViewer[button, client];
}; };

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.Trigger, normalPriority: BOOL] = {
action: Menus.Action;
IF myData = NIL THEN RETURN;
action _ FindAction[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[button, action.input];

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

ButtonsGet: PRIVATE GetProc = {
IF op=NIL THEN RETURN[self.name]
ELSE {
myData: ButtonData = NARROW[self.data];
SELECT op FROM
$ClientData => RETURN[myData.clientData];
ENDCASE	=> ERROR;
};
};

ButtonsSet: PRIVATE SetProc = {
IF op=NIL THEN self.name _ NARROW[data]
ELSE {
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;
};
IF finalise THEN ViewerOps.PaintViewer[self, all];
};

FindAction: PROC[entry: Menus.Entry, trigger: Menus.Trigger] RETURNS [Menus.Action] = {
FOR list: LIST OF Menus.Action _ entry.actions, list.rest UNTIL list=NIL DO
action: Menus.Action = list.first;
IF action.triggers[trigger] THEN RETURN[action];
ENDLOOP;
ERROR;
};

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

buttonsClass: ViewerClasses.ViewerClass _ NEW[ViewerClasses.ViewerClassRec _ [
paint: ButtonsPaint,
get: ButtonsGet,
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
Last Edited by: Wyatt, October 26, 1983 4:36 pm

name is specified via the viewerRec OR entry record, but look at viewer's name first
paint in label (derived from name)
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
ส–

"cedar" style˜Jš
ฯc(™(Jš
-™-J™-J™/J™/J™š
ฯk	˜	J˜Jšœžœkžœ˜|Jšœžœ"˜2Jšœžœ&˜1Jšœžœ
˜Jšœžœ˜+šœžœG˜TJ˜—Jšœžœžœ˜Jšœžœ+˜8Jšœžœžœ˜8J˜šœ
žœ7˜FJ˜—Jšœžœ:˜KJ˜—Jšœ
žœ
ž˜Jšžœžœ˜!Jšžœc˜jJšžœ˜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œžœ
žœYžœ#žœ
žœžœ	žœžœžœ˜า
Jš	œžœ?žœžœ	žœ!˜˜
Jšžœ"žœ˜0Jš
œT™TJšžœ
žœ
žœ˜/JšžœžœC˜TJšžœžœ0˜Aš	žœ
žœ
žœžœž˜3Jšœžœ$˜*š
œP˜PJšžœ˜—J˜J˜J˜J˜Jš
œ˜—J˜šžœžœ˜šžœžœ
žœ&žœžœ
ž˜Dšžœžœ
ž˜&Jšœžœ
žœ5˜@Jšœžœžœ
˜ Jšœžœžœžœ
˜Jšžœ	žœ
œ
˜%—Jšžœ
˜—J˜—Jšžœ/˜5Jš
œ˜J˜—Jš
œ3˜3J˜šœžœ˜#Jšœžœ˜%Jšžœžœ
žœ
žœ
˜šžœ
ž
œžœ˜@Jš
œ"™"Jš
B™BJš	œ
žœžœ
žœžœ˜4šžœžœžœžœ˜GJš
œ!˜!Jš
œA˜A—šžœ
žœžœ žœ˜7Jš
œ'˜'Jš
œB˜B—šœžœž˜6J˜Jšžœ˜—J˜OJ˜5šžœžœžœžœ
˜CJšœžœ(˜3Jš
œB˜BJš
œ˜—Jš
œ˜J˜—šžœžœžœ"˜QJšœ žœ˜%Jš
œ=˜=Jšžœžœ ˜;Jš
œ˜—Jš
œ˜J˜—š
œ˜Jšœžœ˜%J˜&Jš
œ˜J˜—Jšœ
žœ˜*J˜šŸœžœ
žœžœ
žœ
žœ
žœ˜YJš
œ
˜
Jšžœ
žœ ˜-Jš
œ˜Jšœžœžœ
˜J˜Jšœ
žœ
žœ
˜Jšžœžœ
žœ
žœ
˜šžœžœ
žœ
žœ
žœžœžœ
ž˜@šžœžœ
ž˜šœžœžœž˜šœžœžœ
žœž˜4˜J˜Jšœ$žœ˜4J˜Jšžœžœ˜9Jš
œL˜Lšžœ
žœ
žœ
žœ˜-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˜—šŸœžœžœžœ˜Qšžœ
˜šžœžœ
žœž˜ Jš
œB˜BJšžœž˜—šžœ
žœž˜Jš
œ3˜3Jšžœž˜—Jš
œ˜—J˜J˜—šŸ
œžœ
žœ/˜HJš
™Jšžœžœ
žœ
žœ
˜J˜šžœžœ˜J˜J˜&J˜J˜—šžœžœ˜J˜J˜&Jš
œ˜J˜—šŸ
œžœ
žœ2žœ˜TJšœž	œ
˜Jšœžœ4˜KJšžœ˜J˜——šŸœžœNžœ˜iJš
œ˜Jšžœ
žœ
žœ
žœ
˜Jš
œ*˜*J˜Jš
œ(˜(Jšžœ!žœ'˜NJšžœžœ
žœ/˜MJ˜J™LJš
œ"˜"J˜Jšœžœ˜0Jšžœ!žœ'˜NJš
œ˜J˜—šŸ
œžœ˜Jšžœžœ
žœ
žœ˜ šžœ˜Jšœžœ˜'šžœž˜Jšœžœ˜)Jšžœžœ
˜—J˜—Jš
œ˜J˜—šŸ
œžœ˜Jšžœžœ
žœ
žœ˜'šžœ˜Jšœžœ˜'Jšžœ
žœ
žœ
žœ
˜šžœž˜šœžœž˜!˜Jšœžœ˜0Jšžœžœ%˜B—˜Jšœžœ˜0Jšžœžœ%˜B—˜J˜(Jš
œ$˜$—Jšžœžœ
˜—Jš
œ(˜(Jšžœžœ
˜—Jš
œ˜—Jšžœ
žœ"˜2Jš
œ˜J˜—Jš
œ™šŸ
œžœ-žœ˜Wšžœžœ
žœ)žœžœ
ž˜KJ˜"Jšžœžœ
žœ	˜0Jšžœ
˜—Jšžœ
˜J˜J˜—šŸ
œžœžœ
žœ˜+šžœ
žœ
ž˜Jšœžœ#žœ˜<Jšœ
žœ2˜?Jšžœžœ˜'—Jš
œ˜J˜—šœ*žœ!˜NJ˜J˜J˜J˜J˜TJ˜J˜J˜—Jšœ6˜KJ˜Jšžœ
˜J˜J˜—…—$P1}