DIRECTORY
Buttons USING [Button, ButtonProc],
Imager USING [black, Color, Context, MaskRectangleI, SetColor, SetFont, SetXYI, ShowRope, white],
ImagerOps USING [ColorFromStipple, ImagerFromGraphics, XOR],
InputFocus USING [CaptureButtons, ReleaseButtons],
Menus USING [MouseButton],
MenusPrivate USING [Document],
MessageWindow USING [messageWindow],
Process USING [Detach, InitializeMonitor, Milliseconds, MsecToTicks, priorityNormal,
SetPriority, SetTimeout],
Rope USING [ROPE],
TIPUser USING [InstantiateNewTIPTable, TIPScreenCoords],
VFonts USING [defaultFont, Font, FontHeight, StringWidth],
ViewerClasses USING [GetProc, NotifyProc, PaintProc, PaintRectangle, SetProc, Viewer, ViewerClass, ViewerClassRec, ViewerRec],
ViewerExtras USING [ImagerFont],
ViewerOps USING [CreateViewer, MouseInViewer, MoveViewer, PaintViewer, RegisterViewerClass],
ViewerSpecs USING [messageWindowHeight, screenH];

ButtonsImpl: CEDAR MONITOR LOCKS data USING data: ButtonData

IMPORTS Imager, ImagerOps, InputFocus, MenusPrivate, MessageWindow, Process, TIPUser, VFonts, ViewerExtras, ViewerOps
EXPORTS Buttons
SHARES MessageWindow, ViewerOps =

BEGIN OPEN ViewerClasses, Buttons;

ButtonData: TYPE = REF ButtonDataRec;
ButtonDataRec: TYPE = MONITORED RECORD [
proc: ButtonProc,
font: VFonts.Font,
clientData: REF ANY,
documentation: REF ANY,
greyCount: INTEGER,
displayStyle: DisplayStyle,
inverted: BOOL,
fork: BOOL,
guarded: BOOL,
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: ButtonProc, clientData: REF ANY _ NIL,
fork: BOOL _ FALSE, font: VFonts.Font _ VFonts.defaultFont, documentation: REF ANY _ NIL,
guarded: BOOL _ FALSE, paint: BOOL _ TRUE] RETURNS [button: Button] = BEGIN
data: ButtonData _ NEW[ButtonDataRec _ [, proc, font, clientData, documentation, 0,
blackOnWhite, FALSE, fork, guarded, IF guarded THEN guarded ELSE armed]];
TRUSTED {Process.InitializeMonitor[@data.LOCK]};
IF info.ww=0 THEN info.ww _ VFonts.StringWidth[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 documentation#NIL THEN WITH documentation SELECT FROM
doc: REF TEXT			=> NULL;
doc: REF ButtonProc	=> NULL;
doc: Rope.ROPE			=> NULL;
ENDCASE					=> ERROR;	-- not valid documentation
RETURN[ViewerOps.CreateViewer[$Button, info, paint]];
END;

myGrey: Imager.Color ~ ImagerOps.ColorFromStipple[001010B];
ButtonsPaint: PRIVATE PaintProc = BEGIN
data: ButtonData _ NARROW[self.data];
imager: Imager.Context ~ ImagerOps.ImagerFromGraphics[context];
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 AND data.greyCount=0 AND data.displayStyle=blackOnWhite THEN NULL
ELSE {
IF data.greyCount#0 THEN Imager.SetColor[imager, myGrey]
ELSE SELECT data.displayStyle FROM
blackOnWhite => Imager.SetColor[imager, Imager.white];
whiteOnBlack => Imager.SetColor[imager, Imager.black];
blackOnGrey => Imager.SetColor[imager, myGrey];
ENDCASE => ERROR;
Imager.MaskRectangleI[imager, 1, 1, self.cw-2, self.ch-2];
};
SELECT data.displayStyle FROM
whiteOnBlack => Imager.SetColor[imager, Imager.white];
ENDCASE => Imager.SetColor[imager, Imager.black];
Imager.SetXYI[imager, leftOffset+borderFudge, bottomOffset+borderFudge];
Imager.SetFont[imager, ViewerExtras.ImagerFont[data.font]];
Imager.ShowRope[imager, self.name];
IF data.guarded AND data.state#armed THEN {
by: INTEGER ~ bottomOffset+borderFudge+2;
Imager.MaskRectangleI[imager, 0, by, self.cw, 1];
};
END;
IF whatChanged=$Invert OR data.inverted THEN BEGIN -- invert to indicate highlighting
Imager.SetColor[imager, ImagerOps.XOR];
Imager.MaskRectangleI[imager, 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;

EntryButtonsNotify: ENTRY PROC [self: Viewer, input: LIST OF REF ANY, data: ButtonData] =
BEGIN
ENABLE UNWIND => InputFocus.ReleaseButtons[];
button: Menus.MouseButton _ red;
shift, control: BOOL _ FALSE;
mouse: TIPUser.TIPScreenCoords;
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
$Blue	=> button _ blue;
$Control	=> control _ TRUE;
$Documentation	=> IF data.documentation#NIL THEN
MenusPrivate.Document[data.documentation, self, data.clientData,
button, shift, control];
$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]]};
IF data.documentation#NIL THEN	-- post documentation
MenusPrivate.Document[data.documentation, self, data.clientData,
button, shift, control];
};
arming=> NULL; -- no action
armed=> {
InputFocus.ReleaseButtons[];
ViewerOps.PaintViewer[self, client, FALSE, $Invert];
IF data.guarded THEN BEGIN
data.state_guarded;
ViewerOps.PaintViewer[self, client];
END;
IF data.fork THEN TRUSTED {Process.Detach[FORK ButtonPusher[self,
data, data.proc, data.clientData, button, shift, control, TRUE]]}
ELSE ButtonPusher[self, data, data.proc, data.clientData,
button, shift, control, FALSE]; };
ENDCASE;
$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;
$Shift	=> shift _ TRUE;
$Yellow	=> button _ yellow;
ENDCASE	=> NULL;
z: TIPUser.TIPScreenCoords => mouse _ z;
ENDCASE => ERROR;
ENDLOOP;
END;

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 PROCEDURE[data: ButtonData, ticks: Process.Milliseconds] = TRUSTED {
buttonWaitCondition: CONDITION;
Process.SetTimeout[LONG[@buttonWaitCondition], Process.MsecToTicks[ticks]];
WAIT buttonWaitCondition; };

ButtonPusher: PROC [button: Button, myData: ButtonData, proc: ButtonProc, data: REF ANY,
mouseButton: Menus.MouseButton, shift, control, normalPriority: BOOL] = BEGIN
IF myData = NIL THEN RETURN;
myData.greyCount _ myData.greyCount + 1;
IF myData.displayStyle#blackOnGrey THEN ViewerOps.PaintViewer[button, client];
IF normalPriority THEN TRUSTED {Process.SetPriority[Process.priorityNormal]};
proc[button, data, mouseButton, shift, control ! ABORTED => CONTINUE];
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 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;
END;
IF finalise THEN ViewerOps.PaintViewer[self, all];
END;

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

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

END.



τButtonsImpl.mesa
Copyright c 1984 by Xerox Corporation.  All rights reserved.
McGregor on October 21, 1982 9:46 am
Maxwell, June 7, 1983 2:25 pm
Russ Atkinson, November 18, 1983 1:29 pm
Doug Wyatt, September 4, 1984 11:41:47 am PDT
guardedTexture: GraphicsOps.Texture = [
125252B,052525B,125252B,052525B,125252B,052525B,125252B,052525B,
052525B,125252B,052525B,125252B,052525B,125252B,052525B,125252B
];


borderFudge is so buttons line up whether they have borders or not
assert: state=arming
Κ

–
"Mesa" style˜š
Οc™Jšœ
Οm
œ1™<Jš
$™$J™J™(J™-—J˜š
Οk	˜	JšœŸœ˜#JšœŸœU˜aJšœ
Ÿœ(Ÿœ˜<JšœŸœ"˜2JšœŸœ˜Jšœ
Ÿœ˜JšœŸœ˜$šœŸœG˜TJ˜—JšœŸœŸœ˜JšœŸœ+˜8JšœŸœ.˜:JšœŸœk˜~Jšœ
Ÿœ˜ Jšœ
ŸœM˜\JšœŸœ ˜1J˜—Jšœ
Ÿ
œ
ŸœŸœ˜<J˜JšŸœn˜uJšŸœ˜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šœŸœ˜*JšœŸœ˜J˜JšœŸœ7˜NJšœŸœ#˜:J˜šΟnœŸœ
Ÿœ6Ÿœ
ŸœŸœ
˜WJšœŸœŸœ9Ÿœ
ŸœŸœ
˜YJšœ	ŸœŸœ	ŸœŸœŸœŸ˜KšœŸœ=˜SJš	œŸœŸœ	Ÿœ	Ÿœ	˜I—JšŸœ"Ÿœ˜0JšŸœŸœE˜VJšŸœŸœ0˜Aš	Ÿœ
Ÿœ
ŸœŸœŸ˜3JšŸœ
Ÿœ˜'˜IJšŸœ˜—J˜J˜J˜J˜JšŸœ
˜—J˜šŸœŸœ
Ÿœ
ŸœŸœ
Ÿ˜8JšœŸœ
ŸœŸœ
˜JšœŸœŸœ
˜Jšœ
ŸœŸœ
˜JšŸœŸœ˜0—JšŸœ/˜5JšŸœ
˜J˜—™'J™@J™?J™J™—Jš
œ;˜;J™šœŸœ
Ÿ˜'JšœŸœ˜%J˜?JšŸœŸœ
Ÿœ
Ÿœ
˜JšŸœ
ŸœŸœŸœ
˜>š	Ÿœ
Ÿœ
Ÿœ
Ÿœ
%˜CJš
B™BJš	œ
ŸœŸœ
ŸœŸœ˜4Jš	ŸœŸœŸœ Ÿœ
Ÿ˜JšŸœ˜JšŸœŸœ ˜8šŸœ
ŸœŸ˜"Jš
œ6˜6Jš
œ6˜6Jš
œ/˜/JšŸœŸœ
˜—Jš
œ:˜:J˜—šŸœŸ˜Jš
œ6˜6JšŸœ*˜1—J˜HJ˜;J˜#šŸœŸœŸœ˜+JšœŸœ˜)Jš
œ1˜1J˜—JšŸœ
˜—š	ŸœŸœŸœ
Ÿœ
"˜UJšœ"Ÿœ˜'J˜6JšŸœŸœ ˜;JšŸœ
˜—JšŸœ
˜J˜—šœŸ˜!JšœŸœ˜%J˜&JšŸœ
˜J˜—š œŸœ
ŸœŸœ
Ÿœ
Ÿœ
Ÿœ˜YJš
Ÿ˜JšŸœ
Ÿœ ˜-J˜ JšœŸœŸœ
˜J˜JšŸœŸœ
Ÿœ
Ÿœ
˜šŸœŸœ
Ÿœ
Ÿœ
ŸœŸœŸœ
Ÿ˜@šŸœŸœ
Ÿ˜šœŸœŸœŸ˜J˜JšœŸœ
˜šœŸœŸœ
Ÿ˜0J˜@J˜—šœŸœŸœ
ŸœŸ˜4˜J˜Jšœ$Ÿœ˜4J˜JšŸœŸœ˜9šŸœŸœ
Ÿœ
˜4J˜@J˜—J˜—Jšœ	Ÿœ˜˜	J˜Jšœ$Ÿœ˜4šŸœŸœ
Ÿ˜J˜J˜$JšŸœ
˜—šŸœŸœ
ŸœŸœ˜AJšœ:Ÿœ˜A—šŸœ5˜9JšœŸœ˜"—JšŸœ
˜——šœ	ŸœŸœ
Ÿ˜%J˜FJšœ$Ÿœ˜4Jš
Ÿ˜šŸœ
Ÿ˜
J˜
JšœŸœ
˜J˜(JšŸœŸœŸœ
Ÿœ
˜Jšœ$Ÿœ˜4J˜JšŸœ
˜——J˜JšœŸœ
˜J˜JšŸœŸœ
˜—J˜(JšŸœŸœ
˜—JšŸœ
˜—JšŸœ
˜J˜—š 
œŸœ
Ÿœ/˜HJš
™JšŸœŸœ
Ÿœ
Ÿœ
˜J˜šŸœŸœ˜J˜J˜&J˜J˜—šŸœŸœ
Ÿ˜ J˜J˜&JšŸœ˜J˜—š 
œŸœ
Ÿ	œ2Ÿœ˜YJšœŸ	œ
˜JšœŸœ4˜KJšŸœ˜J˜——š œŸœ>Ÿœ
Ÿœ
˜XJšœ@ŸœŸ˜MJšŸœ
Ÿœ
Ÿœ
Ÿœ
˜Jš
œ(˜(JšŸœ!Ÿœ'˜NJšŸœŸœ
Ÿœ/˜MJšœ1ŸœŸœ˜FJšœŸœ˜0JšŸœ!Ÿœ'˜NJšŸœ
˜J˜—šœŸœŸ˜"JšŸœ˜JšŸœ
˜J˜—šœŸœŸ˜#JšŸœŸœ
Ÿœ
Ÿœ˜'šŸœ
Ÿ˜
JšœŸœ˜'JšŸœ
Ÿœ
Ÿœ
Ÿœ
˜šŸœŸ˜˜JšœŸœ˜0JšŸœŸœ%˜B—˜JšœŸœ˜0JšŸœŸœ%˜B—˜J˜(Jš
œ$˜$—JšŸœŸœ
˜—JšŸœ
˜—JšŸœ
Ÿœ"˜2JšŸœ
˜J˜—šœ*Ÿœ!˜NJ˜J˜J˜J˜J˜7J˜J˜J˜—Jšœ6˜KJ˜JšŸœ
˜J˜J˜—…—"N.L