--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)
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_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, 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] = {
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: 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.

^borderFudge is so buttons line up whether they have borders or not
assert: state=arming
�Ê\˜J˜J˜8J˜š
Ïk	˜	Jš
œ˜J˜šœ	�œ+˜9J˜H—Jšœ�œ˜-Jšœ�œ"˜2Jšœ�œ˜Jšœ
�œ˜)Jšœ�œ˜$šœ�œG˜TJ˜—Jšœ�œ�œ˜(Jšœ�œ+˜8Jšœ�œK˜WJ˜šœ
�œ7˜FJ˜—J˜—J˜Jšœ�
œ
�œ�œ˜DJš�œj˜qJš�œ˜Jš�œ˜!J˜Jš�œ
�œ˜%J˜J˜J˜Jšœ�œ�œ˜-šœ�œ�	œ
�œ˜,Jš
œ˜Jš
œ˜Jšœ�œ
�œ
˜Jšœ�œ
�œ
˜Jšœ�œ
˜J˜Jšœ
�œ
˜Jšœ�œ
˜Jšœ	�œ
˜J˜J˜J˜—˜J˜A—˜J˜B—˜J˜3J˜—Jšœ(Ïc˜>Jšœ(ž˜>J˜Jšœ�œ˜.J˜Jšœ�œ.˜@J˜Jšœ�œž˜*Jšœ�œ˜J˜Jšœ�œ7˜NJšœ�œ#˜:J˜šÏnœ�œ
�œ˜*Jš
œ˜Jšœ�œ
�œ�œ
˜Jšœ�œ�œ˜Jšœ�œ
�œ�œ
˜Jš
œ˜Jšœ	�œ�œ
˜Jšœ�œ�œ˜š�œ˜š
�˜Jš
œ˜Jš
œ˜Jš
œ˜Jš
œ>˜>Jš
œ)˜)šœ�œ=˜GJšœ�œ˜'Jšœ
�œ	�œ	�œ˜)—Jš�œ"�œ˜0Jš�œ�œF˜WJš�œ�œ1˜Bš	�œ
�œ
�œ�œ�˜3Jš�œ
�œ˜'˜IJš�œ˜—J˜J˜J˜J˜Jš�œ
˜—J˜š�œ�œ
�œ
�œ�œ
�˜8Jšœ�œ
�œ�œ
˜Jšœ�œ�œ
˜$Jšœ
�œ�œ
˜Jš�œ�œž˜0—Jšœ	�
˜Jšœ�˜(Jš�	œ/�
˜9J˜Jš�œ
�œ˜Jš�œ
˜——J˜—šœ<�œ˜S˜š
œ˜Jš
œ;˜;Jš
œA˜Aš
œ1˜1Jš
œ+˜+Jš
œ˜Jš
œ˜—J˜—š
œ%˜%Jš
œ#˜#—Jš
œ˜J˜J˜——˜'J˜@J˜?J˜—J˜˜+˜J˜.˜&J˜
—J˜9J˜—J˜—˜,˜J˜.˜&J˜
—˜:J˜F—J˜—J˜—šœ�œ
�œ
�œ
˜9Jšœ�œ˜)Jšœ�œ˜Jš�œ�œ
�œ
�œ
˜Jš�œ
�œ�œ�œ
˜>š	�œ
�œ
�œ
�œ
ž%˜CJš
žB™B˜Jš	œ
�œ�œ
�œ�œ˜4š�œ�œ�œ�œ˜GJš
œ˜Jš
œ/˜/—š�œ
�œ�œ �œ˜7Jš
œ˜Jš
œ0˜0—šœ�œ�˜/J˜Jš�œ
˜—J˜A˜˜2J˜0—˜3J˜/—J˜—˜-J˜2—š�œ�œ�œ
�˜/š�œ�œ
�˜$JšœDž˜PJ˜Zšœ�œ�˜/J˜Jš�œ
˜—J˜(J˜OJš
�˜—š�œ
�˜
Jšœ�œ˜)J˜)Jš�œ
˜—Jš�œ
˜—Jš�œ
˜—Jš�œ
˜J˜—š	�œ�œ�œ
�œ
ž"˜UJ˜#J˜%Jš�œ�œ ˜;Jš�œ
˜—Jš�œ
˜J˜—šœ�˜!Jšœ�œ˜)J˜&Jš�œ
˜J˜—šŸœ�œ
�œ�œ
�œ
�œ
�œ˜]Jš
�˜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š
œI˜IJšœ$�œ˜4Jš
�˜š�œ
�˜
J˜
Jšœ�œ
˜J˜(Jš�œ�œ�œ
�œ
˜Jšœ$�œ˜4J˜Jš�œ
˜——J˜Jšœ�œ
˜J˜Jš�œ�œ
˜—J˜(Jš�œ�œ
˜—Jš�œ
˜—Jš�œ
˜J˜—šŸ
œ�œ
�œ.˜GJš
ž™Jš�œ�œ
�œ
�œ
˜J˜š�œ�œ˜J˜J˜&J˜J˜—š�œ�œ
�˜ J˜J˜&Jš�œ˜J˜—šŸ
œ�œ
�	œ6�œ˜]Jšœ�	œ
˜Jšœ�œ4˜KJš�œ˜J˜——šŸœ�œM�œ
�œ
˜gJšœ@�œ�˜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˜—šœ-�œ!˜QJ˜J˜J˜J˜J˜7J˜J˜J˜—Jšœ<ž˜QJ˜Jš�œ
˜J˜—…—+ 6Ú