LFBoundingBoxImpl.mesa
Copyright © 1985 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
DIRECTORY
Convert USING [RopeFromInt],
Cursors USING [SetCursor],
Imager USING [Color, Context, MaskRectangleI, SetColor],
ImagerBackdoor USING [MakeStipple],
InputFocus USING [CaptureButtons, ReleaseButtons],
LFBoundingBox USING [],
MessageWindow USING [Append],
Terminal USING [Current, Virtual],
TIPUser USING [InstantiateNewTIPTable, TIPScreenCoords, TIPTable],
ViewerClasses USING [NotifyProc],
ViewerPrivate USING [PaintScreen];
LFBoundingBoxImpl:
CEDAR
MONITOR
IMPORTS Convert, Cursors, InputFocus, Imager, ImagerBackdoor, MessageWindow, Terminal, TIPUser, ViewerPrivate
EXPORTS LFBoundingBox
~
BEGIN
lastX, lastY: INTEGER ← LAST[INTEGER];
topY, leftX, sourceBottom, sourceHeight, sourceLeft, sourceWidth: INTEGER;
mode: {waitingForFirstPoint, waitingForSecondPoint, done, abort} ← done;
ready: CONDITION;
messageWindowFeedback: BOOLEAN ← FALSE;
AbortAdjust:
PUBLIC
SIGNAL ~
CODE;
grey: CARDINAL ← 122645B;
xorStipple: Imager.Color ←
NIL;
GetArea:
PUBLIC
ENTRY
PROC
RETURNS [x, y, w, h:
NAT] = {
ENABLE UNWIND => NULL;
xorStipple ← ImagerBackdoor.MakeStipple[stipple: grey, xor: TRUE];
mode ← waitingForFirstPoint;
InputFocus.CaptureButtons[BoxAdjustNotify, vaTIP];
Cursors.SetCursor[crossHairsCircle];
lastX ← lastY ← LAST[INTEGER];
UNTIL mode = done OR mode = abort DO WAIT ready ENDLOOP;
IF mode = abort THEN SIGNAL AbortAdjust;
x ← sourceLeft;
y ← sourceBottom;
w ← sourceWidth;
h ← sourceHeight;
xorStipple ← NIL;
};
Clip:
PROC [position: TIPUser.TIPScreenCoords]
RETURNS [x, y:
INTEGER] =
BEGIN
vt: Terminal.Virtual ← Terminal.Current[];
x ← MIN[MAX[position.mouseX, 0], vt.bwWidth];
y ← MIN[MAX[position.mouseY, 0], vt.bwHeight];
IF messageWindowFeedback
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[];
mouseX, mouseY: INTEGER ← 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 =>
BEGIN
EndAdjust[];
mode ← abort;
NOTIFY ready;
END;
$Move =>
BEGIN
IF mode = waitingForFirstPoint
THEN {
mode ← waitingForSecondPoint;
topY ← mouseY;
leftX ← mouseX;
};
Feedback[mouseX, mouseY];
END;
$End =>
BEGIN
Feedback[mouseX, mouseY];
IF mode = waitingForSecondPoint
THEN {
mode ← done;
EndAdjust[];
IF topY < mouseY THEN {t: NAT ← topY; topY ← mouseY; mouseY ← t};
IF leftX > mouseX THEN {t: NAT ← leftX; leftX ← mouseX; mouseX ← t};
sourceBottom ← mouseY;
sourceHeight ← topY - mouseY + 1;
sourceLeft ← leftX;
sourceWidth ← mouseX - leftX + 1;
NOTIFY ready;
};
END;
ENDCASE => NULL;
z: TIPUser.TIPScreenCoords => [mouseX, mouseY] ← Clip[z];
ENDCASE => ERROR;
ENDLOOP;
};
EndAdjust:
PROC =
BEGIN
Feedback[LAST[INTEGER], LAST[INTEGER], TRUE];
InputFocus.ReleaseButtons[];
END;
Feedback:
PROC [x, y:
INTEGER, remove:
BOOL ←
FALSE] =
BEGIN
action:
PROC [context: Imager.Context] ~ {
Show:
PROC [x1, y1:
INTEGER] =
BEGIN
x2: INTEGER ← leftX;
y2: INTEGER ← topY;
IF x1 > x2 THEN {t: INTEGER ← x2; x2 ← x1; x1 ← t};
IF y1 > y2 THEN {t: INTEGER ← y2; y2 ← y1; y1 ← t};
x2 ← x2 + 1;
y2 ← y2 + 1;
Imager.MaskRectangleI[context, x1-5, y1-5, 5, y2-y1+10]; -- left side
Imager.MaskRectangleI[context, x2, y1-5, 5, y2-y1+10]; -- right side
Imager.MaskRectangleI[context, x1, y1-5, x2-x1, 5]; -- top side
Imager.MaskRectangleI[context, x1, y2, x2-x1, 5]; -- bottom side
END;
IF lastX=x AND lastY=y THEN RETURN; -- no change
Imager.SetColor[context, xorStipple];
IF lastX#LAST[INTEGER] THEN Show[lastX, lastY]; -- to remove the old box
IF remove
THEN
lastX ← lastY ← LAST[INTEGER]
ELSE {
Show[x, y]; -- to show the new box
lastX ← x; lastY ← y;
};
};
ViewerPrivate.PaintScreen[bw, action, FALSE];
END;
vaTIP: TIPUser.TIPTable ←
TIPUser.InstantiateNewTIPTable["BoundingBox.tip"];