File: StretchCells.mesa   
Copyright © 1984 by Xerox Corporation. All rights reserved.
Created by: Bob Mayo, June 22, 1984 3:47:45 pm PDT
Last Edited by: Mayo, November 5, 1984 5:06:35 pm PST
DIRECTORY
Stretch USING [Direction, StretchProc, DoStretch],
CD,
CDImportsExtras USING [OneLevelIncludedCopy],
CDDirectory USING [Another],
CDObjectProcs USING [StoreFurther],
CDApplications USING [HighPosO],
CDOrient USING [DeMapRect],
Rope USING [ROPE];
StretchCells: CEDAR PROGRAM    
IMPORTS CD, CDImportsExtras, CDApplications, CDDirectory, CDOrient, CDObjectProcs, Stretch SHARES CDDirectory = BEGIN
CellStretchRef: REF Stretch.StretchProc ~ NEW[Stretch.StretchProc ← CellStretch];
CellStretch: Stretch.StretchProc = BEGIN
PROC [obj: CD.ObPtr, design: CD.Design, place: INT, dir: Direction, amount: INT] RETURNS [CD.ObPtr, Rope.ROPE];
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
ap: CD.ApplicationPtr ← a.first;
urPos: CD.DesignPosition ← CDApplications.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.