--File: NutButtonsImpl.mesa
-- Last Edited by: Butler, July 27, 1984 10:44:33 am PDT
DIRECTORY
Buttons USING [ButtonProc],
NutButtons,
Graphics
USING [black, Color, Context, DrawBox, DrawRope,
GetBounds, PaintMode, SetColor, SetCP, SetPaintMode, SetStipple, white],
GraphicsOps USING [DrawTexturedBox, Texture],
InputFocus USING [CaptureButtons, ReleaseButtons],
Menus USING [MouseButton],
MenusPrivate USING [Document, greyGuard],
MessageWindow USING [messageWindow],
Process
USING [Detach, InitializeMonitor, Milliseconds, MsecToTicks, priorityNormal,
SetPriority, SetTimeout],
Rope USING [ROPE, Substr, Length, Find],
TIPUser USING [InstantiateNewTIPTable, TIPScreenCoords],
VFonts USING [defaultFont, Font, FontHeight, GraphicsFont, StringWidth, EstablishFont],
ViewerClasses,
ViewerOps
USING [CreateViewer, MouseInViewer, MoveViewer, PaintViewer,
RegisterViewerClass],
ViewerSpecs;
NutButtonsImpl: CEDAR MONITOR LOCKS data USING data: NutButtonsData
IMPORTS Graphics, GraphicsOps, InputFocus, MenusPrivate, MessageWindow, Process, TIPUser, VFonts, ViewerOps, Rope
EXPORTS NutButtons
SHARES MessageWindow, ViewerOps =
BEGIN OPEN ViewerClasses, NutButtons;
ROPE: TYPE = Rope.ROPE;
NutButtonsData: TYPE = REF NutButtonsDataRec;
NutButtonsDataRec:
TYPE =
MONITORED
RECORD [
proc: Buttons.ButtonProc,
font: ButtonFontInfo,
clientData: REF ANY,
documentation: REF ANY,
greyCount: INTEGER,
displayStyle: DisplayStyle,
inverted: BOOL,
fork: BOOL,
guarded: BOOL,
state: GuardState
];
attributeFont: VFonts.Font
← VFonts.EstablishFont[family: "Tioga", size: 10, italic: TRUE];
relationFont: VFonts.Font
← VFonts.EstablishFont[family: "Helvetica", size: 8, bold: TRUE];
valueFont: VFonts.Font
← VFonts.EstablishFont[family: "Cream", size: 12];
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: Buttons.ButtonProc,
clientData: REF ANY ← NIL,
fork: BOOL ← FALSE,
documentation: REF ANY ← NIL,
font: ButtonFontInfo ← NIL,
guarded: BOOL ← FALSE,
paint: BOOL ← TRUE]
RETURNS [button: NutButton] =
BEGIN
nfont: VFonts.Font;
data: NutButtonsData;
savedName: Rope.ROPE;
IF font = NIL THEN font ← NEW[ButtonFontInfoRec ← [FALSE,,,]];
nfont ← InitializeFonts[font, info.name];
data ←
NEW[NutButtonsDataRec← [, 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, nfont]+leftOffset+leftOffset;
IF info.wh=0 THEN info.wh ← VFonts.FontHeight[nfont]+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 Buttons.ButtonProc => NULL;
doc: Rope.ROPE => NULL;
ENDCASE => ERROR; -- not valid documentation
savedName ← info.name;
IF NOT info.visible THEN info.name ← "";
button ← ViewerOps.CreateViewer[$NutButton, info, paint];
info.name ← savedName;
RETURN[button];
END;
InitializeFonts: PROC[fontInfo: ButtonFontInfo, word: ROPE]
RETURNS [VFonts.Font] =
BEGIN
IF fontInfo.twoFont THEN BEGIN
IF fontInfo.valFont=NIL THEN fontInfo.valFont ← valueFont;
IF fontInfo.attrFont=NIL THEN fontInfo.attrFont ← attributeFont;
IF VFonts.StringWidth[word, fontInfo.valFont] >=
VFonts.StringWidth[word, fontInfo.attrFont]
THEN RETURN[fontInfo.valFont]
ELSE RETURN[fontInfo.attrFont];
END
ELSE IF fontInfo.singleFont=NIL THEN
fontInfo.singleFont ← relationFont;
RETURN[fontInfo.singleFont];
END;
guardedTexture: GraphicsOps.Texture = [
125252B,052525B,125252B,052525B,125252B,052525B,125252B,052525B,
052525B,125252B,052525B,125252B,052525B,125252B,052525B,125252B
];
PreColon: PROC[label: ROPE] RETURNS[ROPE] =
BEGIN
colonPos: INT ← Rope.Find[s1: label, s2: ":"];
IF colonPos = -1 THEN --Not a label
RETURN[label]
ELSE RETURN[ Rope.Substr[base: label, len: colonPos+1] ];
END;
PostColon: PROC[label: ROPE] RETURNS[ROPE] =
BEGIN
colonPos: INT ← Rope.Find[s1: label, s2: ":"];
IF colonPos = -1 THEN --Not a label
RETURN[label]
ELSE RETURN[ Rope.Substr[base: label, start: (colonPos+1),
len: (Rope.Length[label] - colonPos)] ];
END;
NutButtonsPaint:
PRIVATE PaintProc =
BEGIN
OPEN Graphics;
data: NutButtonsData ← NARROW[self.data];
myGrey: CARDINAL = 001010B;
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
IF self.visible THEN BEGIN
borderFudge: INTEGER = IF self.border THEN 0 ELSE 1;
IF ~clear
OR data.greyCount # 0
OR data.displayStyle=blackOnGrey
THEN {
SetStipple[context, myGrey];
DrawBox[context, [1, 1, self.cw-1, self.ch-1]]}
ELSE
IF ~clear
OR data.displayStyle=whiteOnBlack
THEN {
SetColor[context, black];
DrawBox[context, [1, 1, self.cw-1, self.ch-1]]};
SetColor[context,
SELECT data.displayStyle
FROM
whiteOnBlack => white,
ENDCASE => black];
SetCP[context, leftOffset+borderFudge, bottomOffset+borderFudge];
IF data.font.twoFont THEN BEGIN
DrawRope[self: context, rope: PreColon[self.name],
font: VFonts.GraphicsFont[data.font.attrFont]];
DrawRope[self: context, rope: PostColon[self.name],
font: VFonts.GraphicsFont[data.font.valFont]];
END
ELSE DrawRope[self: context, rope: self.name,
font: VFonts.GraphicsFont[data.font.singleFont]];
IF data.guarded
AND data.state#armed
THEN
BEGIN
IF MenusPrivate.greyGuard
THEN
BEGIN
SetCP[context, leftOffset+borderFudge+1, bottomOffset+borderFudge]; -- fake bold
DrawRope[self: context, rope: self.name, font: VFonts.GraphicsFont[data.font.singleFont]];
SetColor[context,
SELECT data.displayStyle
FROM
whiteOnBlack => black,
ENDCASE => white];
[] ← SetPaintMode[context, transparent];
GraphicsOps.DrawTexturedBox[context, [0, 0, self.cw, self.ch], guardedTexture];
END
ELSE
BEGIN
by: INTEGER ~ bottomOffset+borderFudge+2;
DrawBox[context, [0, by, self.cw, by+1]];
END;
END;
END;
END;
IF whatChanged=$Invert
OR data.inverted
THEN
BEGIN
-- invert to indicate highlighting
[] ← SetPaintMode[context, invert];
DrawBox[context, GetBounds[context]];
IF whatChanged=$Invert THEN data.inverted ← ~data.inverted;
END;
END;
ButtonsNotify: NotifyProc =
BEGIN
data: NutButtonsData ← NARROW[self.data];
EntryButtonsNotify[self, input, data];
END;
EntryButtonsNotify:
ENTRY
PROC [self: Viewer, input:
LIST
OF
REF
ANY, data: NutButtonsData] =
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𡤊rming;
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, nutButtonsClass.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: NutButtonsData, button: NutButton] = {
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
PROCEDURE[data: NutButtonsData, ticks: Process.Milliseconds] =
TRUSTED {
buttonWaitCondition: CONDITION;
Process.SetTimeout[LONG[@buttonWaitCondition], Process.MsecToTicks[ticks]];
WAIT buttonWaitCondition; };
ButtonPusher:
PROC [button: NutButton, myData: NutButtonsData, proc: Buttons.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: NutButtonsData ← 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;
nutButtonsClass: ViewerClasses.ViewerClass ←
NEW[ViewerClasses.ViewerClassRec ← [
paint: NutButtonsPaint,
get: ButtonGet,
set: ButtonsSet,
notify: ButtonsNotify,
tipTable: TIPUser.InstantiateNewTIPTable["Button.tip"],
cursor: bullseye
]];
ViewerOps.RegisterViewerClass[$NutButton, nutButtonsClass]; -- plug in to Viewers
END.