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, November 14, 1983 12:52 pm
DIRECTORY
Buttons,
Imager USING [black, Color, Context, IntegerMaskRectangle, IntegerSetXY, MakeStipple, SetColor, ShowCharacters, white, XOR],
InputFocus USING [CaptureButtons, ReleaseButtons],
Menus USING [Action, Entry],
MenusPrivate USING [armedTime, armingTime, ChooseAction, EntryInfo, GuardResponse, MakeEntry, Trigger],
MessageWindowPrivate USING [messageWindow],
Process
USING [Detach, Milliseconds, MsecToTicks, priorityNormal,
SetPriority, SetTimeout],
TIPUser USING [InstantiateNewTIPTable, TIPScreenCoords],
VFonts USING [defaultFont, FONT, FontHeight, RopeWidth],
ViewerClasses,
ViewerOps
USING [CreateViewer, MouseInViewer, MoveViewer, NotifyViewer, PaintViewer,
RegisterViewerClass],
ViewerSpecs USING [guardHeight, guardOffset];
ButtonsImpl: CEDAR MONITOR LOCKS data USING data: ButtonData
IMPORTS Imager, InputFocus, MenusPrivate, MessageWindowPrivate, Process, TIPUser, VFonts, ViewerOps
EXPORTS Buttons
SHARES ViewerOps
= BEGIN OPEN ViewerClasses, Buttons;
EntryInfo: TYPE = MenusPrivate.EntryInfo;
ButtonData: TYPE = REF ButtonDataRec;
ButtonDataRec:
TYPE =
MONITORED
RECORD[
entry: EntryInfo,
font: VFonts.FONT,
displayStyle: DisplayStyle ← blackOnWhite,
inverted: BOOL ← FALSE
];
DisplayStyle: TYPE = {blackOnWhite, whiteOnBlack, blackOnGrey} ;
bottomOffset: INTEGER = 3; -- for painting
leftOffset: INTEGER = 3;
Create:
PUBLIC
PROC [info: ViewerRec ← [], entry: Menus.Entry,
font: VFonts.FONT ← VFonts.defaultFont, paint: BOOL ← TRUE] RETURNS [button: Button] = {
data: ButtonData ← NEW[ButtonDataRec ← [entry: MenusPrivate.MakeEntry[entry], font: font]];
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 ELSE data.entry.name ← info.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 {
mw: Viewer = MessageWindowPrivate.messageWindow;
ViewerOps.MoveViewer[mw, mw.wx, mw.wy, mw.ww-info.ww, mw.wh, FALSE];
info.wx ← mw.wx + mw.ww;
info.wy ← mw.wy;
info.wh ← mw.wh;
info.column ← static;
};
info.data ← data;
RETURN[ViewerOps.CreateViewer[$Button, info, paint]];
};
myGrey: Imager.Color = Imager.MakeStipple[001010B];
ButtonPaint:
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.entry.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;
};
};
ButtonNotify: NotifyProc = {
data: ButtonData ← NARROW[self.data];
EntryButtonNotify[self, input, data];
};
MouseButton: TYPE = { red, yellow, blue };
EntryButtonNotify:
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;
entry: EntryInfo;
IF data = NIL THEN RETURN;
entry ← data.entry;
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 entry.state
FROM
guarded => {
entry.state ← arming;
ViewerOps.PaintViewer[self, client, FALSE, $Invert];
InputFocus.ReleaseButtons[];
TRUSTED {Process.Detach[FORK ArmButtonProc[data, self]]};
TRUSTED {Process.Detach[
FORK MenusPrivate.GuardResponse[self.parent,
MenusPrivate.ChooseAction[entry, TriggerFrom[shift, button]]]]};
};
arming=> NULL; -- no action
armed=> {
InputFocus.ReleaseButtons[];
ViewerOps.PaintViewer[self, client, FALSE, $Invert];
IF entry.guarded
THEN {
entry.state ← guarded;
ViewerOps.PaintViewer[self, client];
};
ButtonPusher[self, data, TriggerFrom[shift, button], FALSE];
};
ENDCASE => ERROR;
};
$Mark => {
IF ~data.inverted
THEN {
InputFocus.CaptureButtons[ButtonNotify, buttonClass.tipTable, self];
ViewerOps.PaintViewer[self, client, FALSE, $Invert];
}
ELSE {
v: Viewer; c: BOOL;
[v, c] ← ViewerOps.MouseInViewer[mouse];
IF
NOT(v=self
AND c)
THEN {
-- mouse moved out of the button
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[MenusPrivate.Trigger] = {
RETURN[(
SELECT button
FROM red => 0, yellow => 1, blue => 2,
ENDCASE =>
ERROR)
+ (IF shift THEN 3 ELSE 0)];
};
ButtonWait:
INTERNAL
PROC[data: ButtonData, ticks: Process.Milliseconds] =
TRUSTED {
buttonWaitCondition: CONDITION;
Process.SetTimeout[LONG[@buttonWaitCondition], Process.MsecToTicks[ticks]];
WAIT buttonWaitCondition;
};
ArmButtonProc:
ENTRY
PROC[data: ButtonData, button: Buttons.Button] = {
assert: state=arming
entry: EntryInfo;
IF data = NIL THEN RETURN;
entry ← data.entry;
ButtonWait[data, MenusPrivate.armingTime];
IF entry.state=arming
THEN {
entry.state ← armed;
ViewerOps.PaintViewer[button, client];
ButtonWait[data, MenusPrivate.armedTime];
};
IF entry.state#guarded
THEN {
entry.state ← guarded;
ViewerOps.PaintViewer[button, client];
};
ButtonPusher:
PROC[button: Button, data: ButtonData, trigger: MenusPrivate.Trigger,
normalPriority: BOOL] = {
entry: EntryInfo;
action: Menus.Action;
IF data = NIL THEN RETURN;
entry ← data.entry;
action ← MenusPrivate.ChooseAction[entry,trigger];
entry.greyCount ← entry.greyCount + 1;
IF data.displayStyle#blackOnGrey THEN ViewerOps.PaintViewer[button, client];
IF normalPriority THEN TRUSTED {Process.SetPriority[Process.priorityNormal]};
ViewerOps.NotifyViewer[button.parent, action.input];
entry.greyCount ← MAX[entry.greyCount - 1, 0];
IF data.displayStyle#blackOnGrey THEN ViewerOps.PaintViewer[button, client];
};
ButtonGet:
PRIVATE GetProc = {
IF op=NIL THEN RETURN[self.name]
ELSE RETURN[NIL];
};
ButtonSet:
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;
ENDCASE => ERROR;
};
IF finalise THEN ViewerOps.PaintViewer[self, all];
};
buttonClass: ViewerClasses.ViewerClass ←
NEW[ViewerClasses.ViewerClassRec ← [
paint: ButtonPaint,
get: ButtonGet,
set: ButtonSet,
notify: ButtonNotify,
tipTable: TIPUser.InstantiateNewTIPTable["Button.tip"],
cursor: bullseye
]];
ViewerOps.RegisterViewerClass[$Button, buttonClass]; -- plug in to Viewers
END.