
<<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>>
<<>>
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]};
<<name is specified via the viewerRec OR entry record, but look at viewer's name first>>
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 {
<<paint in label (derived from name)>>
<<borderFudge is so buttons line up whether they have borders or not>>
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] = {
<<assert: state=arming>>
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]};

<<this is where we actually tell the client about the button-invoked function:>>
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];
};

<<routines copied from MenusImpl>>
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.