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
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;
We'd hoped this would capture CTRL up after RED up, but it doesn't:
[] ¬ 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.