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]}; 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: 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_arming; 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] = { 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 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]}; 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; 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 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. &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 name is specified via the viewerRec OR entry record, but look at viewer's name first borderFudge is so buttons line up whether they have borders or not assert: state=arming this is where we actually tell the client about the button-invoked function: routines copied from MenusImpl NOTE! the following line produces a compiler warning that can be safely ignored. Κ – "cedar" style˜JšΟc(™(Jš-™-J™-J™/šΟk ˜ J˜JšœžœV˜bJšœ žœ"˜2Jšœžœ:˜EJšœžœ˜,šœžœG˜TJ˜—Jšœžœžœ˜Jšœžœ+˜8Jšœžœ,˜8J˜šœ žœ7˜FJ˜—J˜ J˜—Jš œ žœžœžœžœ˜Jšœ(˜>J˜Jšœ žœ˜.J˜Jšœžœ.˜@J˜Jšœžœ˜*Jšœ žœ˜J˜Jšœžœ7˜NJšœžœ#˜:J˜š Οnœžœžœ{žœžœžœž˜»Jš œžœ?žœžœ žœ ˜€Jšžœ"žœ˜0JšœT™TJšžœ žœžœ˜/Jšžœ žœC˜TJšžœ žœ0˜Aš žœ žœžœ žœ ž˜3Jšžœžœ˜'˜IJšžœ˜—J˜J˜J˜J˜Jšžœ˜—J˜šžœžœ˜š žœžœžœ1žœžœž˜Ošžœžœž˜&Jšœžœžœ5˜@Jšœžœžœ˜ Jšœžœžœžœ˜Jšžœ žœ œ˜%—Jšžœ˜—J˜—Jšžœ/˜5Jšžœ˜J˜—Jš œžœžœžœžœ ˜/J˜šœžœ žœžœ˜4Jšœžœ ˜%Jšžœžœžœžœ˜Jšžœžœžœžœ˜>š žœ žœžœžœ%˜CJšB™BJš œ žœžœ žœžœ˜4šžœžœžœžœ˜GJšœ˜Jšœ8˜8—šžœžœžœ žœ˜7Jšœ˜Jšœ9˜9—šœžœž˜/J˜Jšžœ ˜—J˜FJ˜.šžœžœžœž˜5Jšœžœ˜)Jšœ/˜/Jšžœ˜—Jšžœ˜J˜—š žœžœžœžœ"˜UJ˜Jšœ4˜4Jšžœžœ ˜;Jšžœ˜—Jšžœ˜J˜—šœž˜!Jšœžœ ˜%J˜&Jšžœ˜J˜—J˜*J˜šŸœžœžœžœžœžœžœ˜YJšž˜Jšžœžœ ˜-Jšœ˜Jšœžœžœ˜J˜Jšœ žœžœ˜Jšžœžœžœžœ˜šžœžœžœžœžœžœžœž˜@šžœ žœž˜šœžœžœž˜šœžœžœžœ ž˜4˜ J˜Jšœ$žœ ˜4J˜Jšžœžœ˜9JšœR˜Ršžœ žœžœžœ˜-Jšžœ˜ —J˜—Jšœ žœ ˜˜ J˜Jšœ$žœ ˜4šžœžœž˜ J˜J˜$Jšžœ˜—Jšœ5žœ˜