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]]; 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 { 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] = { 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. ¾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 name is specified via the viewerRec OR entry record, but look at viewer's name first paint in label (derived from name) borderFudge is so buttons line up whether they have borders or not assert: state=arming Êü– "cedar" style˜JšÏc(™(Jš-™-J™-J™/J™1J™šÏk ˜ J˜Jšœžœkžœ˜|Jšœžœ"˜2Jšœžœ˜Jšœ žœU˜gJšœžœ˜+šœžœ4˜AJ˜—Jšœžœ+˜8Jšœžœžœ˜8J˜šœ žœE˜TJ˜—Jšœžœ˜-J˜—Jš œ žœžœžœžœ˜Jš œ žœžœžœžœ˜XJšœžœE˜[JšœT™TJšžœžœžœžœ˜NJšžœžœC˜TJšžœžœ0˜Aš žœ žœžœžœžœ˜5Jšœ0˜0Jšœ=žœ˜DJ˜J˜J˜J˜Jšœ˜—J˜Jšžœ/˜5Jšœ˜J˜—Jšœ3˜3J˜šœ žœ˜"Jšœžœ˜%Jšžœžœžœžœ˜šžœ ž œžœ˜@Jšœ"™"JšB™BJš œ žœžœ žœžœ˜4šžœžœžœžœ˜MJšœ!˜!JšœA˜A—šžœžœžœ žœ˜7Jšœ'˜'JšœB˜B—šœžœž˜6J˜Jšžœ˜—J˜OJ˜5šžœžœžœžœ ˜CJšœžœ(˜3JšœB˜BJšœ˜—Jšœ˜J˜—šžœžœžœ"˜QJšœ žœ˜%Jšœ=˜=Jšžœžœ ˜;Jšœ˜—Jšœ˜J˜—šœ˜Jšœžœ˜%J˜%Jšœ˜J˜—Jšœ žœ˜*J˜šŸœžœžœžœžœžœžœ˜YJšžœžœ ˜-Jšœ˜Jšœžœžœ˜J˜J˜Jšžœžœžœžœ˜J˜šžœžœžœžœžœžœžœž˜@šžœžœž˜šœžœžœž˜šœ ˜ šžœžœžœ ž˜-˜J˜Jšœ$žœ˜4J˜Jšžœžœ˜9šžœžœ(˜DJšœ@˜@—J˜—Jšœ žœ˜˜ J˜Jšœ$žœ˜4šžœžœ˜Jšœ˜J˜$Jšœ˜—Jšœ5žœ˜