DIRECTORY Convert, Cursors, Imager, ImagerBackdoor, InputFocus, ScreenBoundingBox, MessageWindow, Real, TIPUser, ViewerClasses, ViewerPrivate, ViewersWorld, ViewersWorldInstance; ScreenBoundingBoxImpl: CEDAR MONITOR IMPORTS Convert, Cursors, InputFocus, Imager, ImagerBackdoor, MessageWindow, Real, TIPUser, ViewerPrivate, ViewersWorld, ViewersWorldInstance EXPORTS ScreenBoundingBox ~ BEGIN PaintOp: TYPE = {paint, remove, change}; ready: CONDITION; mode: ATOM; -- state of box ($Done or $Abort) p0, p1, origin: Imager.VEC; -- the min and max (x,y) points rect, prev: Imager.Rectangle; -- current, previous bounders x0, x1, y0, y1, all: BOOL; -- corner, edge, or all picked? messageWindowShow: BOOL ฌ TRUE; grey: CARDINAL ฌ 122645B; xorStipple: Imager.Color ฌ ImagerBackdoor.MakeStipple[stipple: grey, xor: TRUE]; AbortAdjust: PUBLIC SIGNAL ~ CODE; GetArea: PUBLIC ENTRY PROC RETURNS [x, y, w, h: NAT] = { ENABLE UNWIND => NULL; p0 ฌ p1 ฌ origin ฌ [0.0, 0.0]; rect ฌ prev ฌ [0, 0, 0, 0]; x0 ฌ x1 ฌ y0 ฌ y1 ฌ all ฌ FALSE; mode ฌ $Waiting; InputFocus.CaptureButtons[BoxAdjustNotify, vaTIP]; Cursors.SetCursor[crossHairsCircle]; UNTIL mode = $Done OR mode = $Abort DO WAIT ready ENDLOOP; IF mode = $Abort THEN SIGNAL AbortAdjust; RETURN[ Real.Round[rect.x], Real.Round[rect.y], Real.Round[rect.w], Real.Round[rect.h]]; }; Clip: PROC [position: TIPUser.TIPScreenCoords] RETURNS [x, y: INTEGER] = BEGIN xn, yn: NAT; [xn, yn] ฌ ViewersWorld.GetDeviceSize[ViewersWorldInstance.GetWorld[]]; x ฌ MIN[MAX[position.mouseX, 0], xn]; y ฌ MIN[MAX[position.mouseY, 0], yn]; IF messageWindowShow THEN { MessageWindow.Append[" ", TRUE]; MessageWindow.Append[Convert.RopeFromInt[x], FALSE]; MessageWindow.Append[", ", FALSE]; MessageWindow.Append[Convert.RopeFromInt[y], FALSE]; }; END; BoxAdjustNotify: ENTRY ViewerClasses.NotifyProc ~ { ENABLE UNWIND => EndAdjust[$Abort]; NewMouse: PROC ~ { IF all THEN { dif: Imager.VEC ฌ [mouseX-origin.x, mouseY-origin.y]; p0 ฌ [p0.x+dif.x, p0.y+dif.y]; p1 ฌ [p1.x+dif.x, p1.y+dif.y]; origin ฌ [mouseX, mouseY]; } ELSE { IF x0 THEN p0.x ฌ mouseX ELSE IF x1 THEN p1.x ฌ mouseX; IF y0 THEN p0.y ฌ mouseY ELSE IF y1 THEN p1.y ฌ mouseY; }; rect ฌ MakeRectangle[p0.x, p0.y, p1.x, p1.y]; Feedback[change]; prev ฌ rect; }; mouseX, mouseY: REAL ฌ 0.0; FOR list: LIST OF REF ANY ฌ input, list.rest UNTIL list = NIL DO WITH list.first SELECT FROM x: ATOM => SELECT x FROM $Abort => { EndAdjust[$Abort]; NOTIFY ready; }; $Down => { centerX: BOOL ฌ FALSE; wOver4, hOver4: REAL; [] ฌ InputFocus.SetInputFocus[]; x0 ฌ x1 ฌ y0 ฌ y1 ฌ all ฌ FALSE; IF mode = $Waiting THEN { -- intialize things x1 ฌ y1 ฌ TRUE; p0 ฌ p1 ฌ [mouseX, mouseY]; mode ฌ $Active; } ELSE { -- determine user interaction (corner, edge, or center?) IF p0.x > p1.x THEN {t: REAL ฌ p0.x; p0.x ฌ p1.x; p1.x ฌ t}; IF p0.y > p1.y THEN {t: REAL ฌ p0.y; p0.y ฌ p1.y; p1.y ฌ t}; wOver4 ฌ (p1.x-p0.x)/4; hOver4 ฌ (p1.y-p0.y)/4; SELECT mouseX FROM < p0.x+wOver4 => x0 ฌ TRUE; > p1.x-wOver4 => x1 ฌ TRUE; ENDCASE => centerX ฌ TRUE; SELECT mouseY FROM < p0.y+hOver4 => y0 ฌ TRUE; > p1.y-hOver4 => y1 ฌ TRUE; ENDCASE => IF centerX THEN { all ฌ TRUE; origin ฌ [mouseX, mouseY]; }; }; NewMouse[]; }; $Move => NewMouse[]; $End => IF mode # $Waiting THEN { EndAdjust[$Done]; NOTIFY ready; }; ENDCASE => NULL; z: TIPUser.TIPScreenCoords => [mouseX, mouseY] ฌ Clip[z]; ENDCASE => ERROR; ENDLOOP; }; MakeRectangle: PROC [x0, y0, x1, y1: REAL] RETURNS [r: Imager.Rectangle] ~ { IF x0 > x1 THEN {t: REAL ฌ x0; x0 ฌ x1; x1 ฌ t}; IF y0 > y1 THEN {t: REAL ฌ y0; y0 ฌ y1; y1 ฌ t}; r ฌ [x0, y0, x1-x0, y1-y0]; }; EndAdjust: PROC [a: ATOM] = BEGIN mode ฌ a; Feedback[remove]; InputFocus.ReleaseButtons[]; END; Feedback: PROC [op: PaintOp ฌ paint] ~ { Action: PROC [context: Imager.Context] ~ { -- this context in viewer coords Show: PROC [r: Imager.Rectangle] ~ { Imager.MaskRectangle[context, [r.x-5.0, r.y-5.0, 5.0, r.h+10.0]]; -- left side Imager.MaskRectangle[context, [r.x+r.w, r.y-5.0, 5.0, r.h+10.0]]; -- right side Imager.MaskRectangle[context, [r.x, r.y-5.0, r.w, 5.0]]; -- top side Imager.MaskRectangle[context, [r.x, r.y+r.h, r.w, 5.0]]; -- bottom side }; IF prev = rect AND op = change THEN RETURN; -- no change Imager.SetColor[context, xorStipple]; SELECT op FROM paint => Show[rect]; remove => { IF prev # [0.0, 0.0, 0.0, 0.0] THEN Show[prev]; -- remove old box prev ฌ [0.0, 0.0, 0.0, 0.0]; }; change => { IF prev # [0., 0., 0., 0.] THEN Show[prev]; -- remove old box Show[rect]; -- show new box }; ENDCASE => ERROR; }; ViewerPrivate.PaintScreen[main, Action, FALSE]; }; vaTIP: TIPUser.TIPTable ฌ TIPUser.InstantiateNewTIPTable["BoundingBox.tip"]; END. ฎ ScreenBoundingBoxImpl.mesa Copyright ำ 1985, 1991, 1992 by Xerox Corporation. All rights reserved. Michael Plass, April 25, 1985 9:59:49 am PST Beach, April 11, 1984 9:54:18 am PST Russ Atkinson (RRA) March 14, 1985 0:22:04 am PST Bloomenthal, February 7, 1989 9:48:09 pm PST Kenneth A. Pier, May 29, 1991 5:57 pm PDT Willie-s, June 5, 1992 12:44 pm PDT We'd hoped this would capture CTRL up after RED up, but it doesn't: สฒ•NewlineDelimiter –(cedarcode) style™code™Kšœ ฯeœ=™HK™,K™$K™1K™,K™)K™#—K˜šฯk ˜ K˜จK˜—šœžœž˜$Kšžœ†˜Kšžœ˜—šœž˜K˜šœžœ˜(K˜—šœž œ˜K˜—Kšœžœฯc!˜-KšœžœŸ˜;KšœŸ˜