<> <> <> <> <> DIRECTORY Stretch USING [Direction, StretchProc, DoStretch], CD, CDImportsExtras USING [OneLevelIncludedCopy], CDBasics USING [AddSize], CDDirectory USING [Another], CDObjectProcs USING [StoreFurther], CDOrient USING [DeMapRect, OrientedSize], Rope USING [ROPE]; StretchCells: CEDAR PROGRAM IMPORTS CD, CDImportsExtras, CDBasics, CDDirectory, CDOrient, CDObjectProcs, Stretch SHARES CDDirectory = BEGIN CellStretchRef: REF Stretch.StretchProc ~ NEW[Stretch.StretchProc _ CellStretch]; CellStretch: Stretch.StretchProc = BEGIN <> Past: PROC [dir: Stretch.Direction, place: INT, line: CD.Position] RETURNS [BOOL] = BEGIN RETURN[(dir = $right AND line.x >= place) OR (dir = $left AND line.x > place) OR (dir = $up AND line.y >= place) OR (dir = $down AND line.y > place)]; END; MapVector: PROC [tail, head: CD.Position, ap: CD.ApplicationPtr] RETURNS [newTail, newHead: CD.Position] = BEGIN [[ , , newTail.x, newTail.y]] _ CDOrient.DeMapRect[[tail.x, tail.y, tail.x, tail.y], ap.ob.size, ap.orientation, [0, 0]]; [[ , , newHead.x, newHead.y]] _ CDOrient.DeMapRect[[head.x, head.y, head.x, head.y], ap.ob.size, ap.orientation, [0, 0]]; END; cell: CD.CellPtr; SELECT obj.p.objectType FROM $Cell => obj _ CDDirectory.Another[obj, design, design]; $Import => obj _ CDImportsExtras.OneLevelIncludedCopy[obj, design]; ENDCASE => ERROR; IF obj.p.objectType # $Cell THEN ERROR; cell _ NARROW[obj.specificRef]; <<-- Stretch cell by moving applications around.>> FOR a: CD.ApplicationList _ cell.contents, a.rest WHILE a # NIL DO <<--hack, included by Ch. Jacobi because no more exported>> HighPosO: PROC [aptr: CD.ApplicationPtr] RETURNS [CD.DesignPosition] = INLINE {RETURN [CDBasics.AddSize[aptr.location, CDOrient.OrientedSize[aptr.ob.size, aptr.orientation]]]}; ap: CD.ApplicationPtr _ a.first; urPos: CD.DesignPosition _ HighPosO[a.first]; newOb: CD.ObPtr; msg: Rope.ROPE; SELECT TRUE FROM <<-- slide entire object over>> Past[dir, place, ap.location] => { IF dir = $left OR dir = $right THEN ap.location.x _ ap.location.x + amount ELSE ap.location.y _ ap.location.y + amount; }; <<-- stretch object >> Past[dir, place, urPos] => { head, tail: CD.Position _ [0, 0]; newHead, newTail: CD.Position; newDir: Stretch.Direction; placeX, placeY: INT; newPlace: INT; <<-- create a vector starting at the stretch place and pointing 1 unit in the stretch direction>> placeX _ place - ap.location.x; placeY _ place - ap.location.y; SELECT dir FROM up => {tail.y _ placeY; head.y _ placeY + 1;}; down => {tail.y _ placeY; head.y _ placeY - 1;}; right => {tail.x _ placeX; head.x _ placeX + 1;}; left => {tail.x _ placeX; head.x _ placeX - 1;}; ENDCASE; [newTail, newHead] _ MapVector[tail, head, ap]; <<-- now use the vector to determine location & direction to stretch>> IF tail.x = 0 THEN newPlace _ newTail.y ELSE newPlace _ newTail.x; SELECT TRUE FROM newHead.x > newTail.x => newDir _ $right; newHead.x < newTail.x => newDir _ $left; newHead.y > newTail.y => newDir _ $up; newHead.y < newTail.y => newDir _ $down; ENDCASE => ERROR; [newOb, msg] _ Stretch.DoStretch[ap.ob, design, newPlace, newDir, amount]; IF newOb = NIL THEN RETURN[NIL, msg]; ap.ob _ newOb; }; <<-- else leave object in same place>> ENDCASE; ENDLOOP; IF dir = $right OR dir = $left THEN obj.size.x _ obj.size.x + amount ELSE obj.size.y _ obj.size.y + amount; RETURN[obj, NIL]; END; <<-- Top-level command routines>> <<>> Init: PROC[] = BEGIN CDObjectProcs.StoreFurther[CD.FetchObjectProcs[$Cell], $StretchProc, CellStretchRef]; CDObjectProcs.StoreFurther[CD.FetchObjectProcs[$Import], $StretchProc, CellStretchRef]; END; <<-- Main body>> <<>> Init[]; END.