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 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; 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; Init[]; END.  File: StretchRects.mesa Copyright c 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. PROC [obj: CD.ObPtr, place: INT, dir: Direction, amount: INT] RETURNS [CD.ObPtr, Rope.ROPE]; -- Top-level command routines -- Main body ΚY˜– "Cedar" stylešœ™Jšœ Οmœ1™