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
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]};
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
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 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 {
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𡤊rming;
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] = {
assert: state=arming
IF data = NIL THEN RETURN;
ButtonWait[data, armingTime];
IF data.state = arming
THEN {
data.state𡤊rmed;
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]};
this is where we actually tell the client about the button-invoked function:
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;
routines copied from MenusImpl
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
NOTE! the following line produces a compiler warning that can be safely ignored.
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.