<> <> <> <> <<-- 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 <> 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.