File: StretchRects.mesa   
Copyright © 1984 by Xerox Corporation. All rights reserved.
Created by: Bob Mayo, July 2, 1984 2:53:37 pm PDT
Last Edited by: Mayo, July 27, 1984 6:16:02 pm PDT
-- provide stretching capability for rectangles by registering a 'further' proc.
DIRECTORY
Stretch USING [Direction, StretchProc],
CD USING [ObPtr, DesignPosition, ObjectProcs],
CDRects USING [CreateBareRect, CreateSaveRect],
CDObjectProcs USING [StoreFurther],
CDProperties USING [CopyProps],
Rope USING [ROPE];
StretchRects: CEDAR PROGRAM    
IMPORTS CDProperties, CDRects, CDObjectProcs = BEGIN
RectStretchRef: REF Stretch.StretchProc ~ NEW[Stretch.StretchProc ← RectStretch];
RectStretch: Stretch.StretchProc = BEGIN
PROC [obj: CD.ObPtr, place: INT, dir: Direction, amount: INT] RETURNS [CD.ObPtr, Rope.ROPE];
nObj: CD.ObPtr;
nSize: CD.DesignPosition ← obj.size;
IF dir = $right OR dir = $left THEN {
IF place > nSize.x OR place < 0 THEN RETURN[NIL, "Program tried to stretch a rectangle ouside of its boundaries"];
nSize.x ← nSize.x + amount;
}
ELSE {
IF place > nSize.y OR place < 0 THEN RETURN[NIL, "Program tried to stretch a rectangle ouside of its boundaries"];
nSize.y ← nSize.y + amount;
};
SELECT obj.p.objectType FROM
$Rect => nObj ← CDRects.CreateBareRect[nSize, obj.level];
$SaveRect => nObj ← CDRects.CreateSaveRect[nSize, obj.level];
ENDCASE => RETURN[NIL, "Program called StretchRect to stretch something other than a rectangle"];
nObj.properties ← CDProperties.CopyProps[obj.properties];
RETURN[nObj, NIL];
END;
-- Top-level command routines
Init: PROC[] = BEGIN
rect: CD.ObPtr;
procs: REF CD.ObjectProcs;
size: CD.DesignPosition ← [1, 1];
rect ← CDRects.CreateBareRect[size, 1];
TRUSTED {procs ← LOOPHOLE[rect.p];}; -- make pointer readable
CDObjectProcs.StoreFurther[procs, $StretchProc, RectStretchRef];
rect ← CDRects.CreateSaveRect[size, 1];
TRUSTED {procs ← LOOPHOLE[rect.p];}; -- make pointer readable
CDObjectProcs.StoreFurther[procs, $StretchProc, RectStretchRef];
END;
-- Main body
Init[];
END.