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, July 27, 1984 6:15:12 pm PDT
DIRECTORY
Stretch USING [Direction, StretchProc, DoStretch],
CD,
CDObjectProcs USING [StoreFurther],
CDApplications USING [HighPosO],
CDCells USING [CreateEmptyCell],
CDOrient USING [DeMapRect],
CDProperties USING [CopyProps],
Rope USING [ROPE];
StretchCells: CEDAR PROGRAM    
IMPORTS CDCells, CDApplications, CDProperties, CDOrient, CDObjectProcs, Stretch = BEGIN
CellStretchRef: REF Stretch.StretchProc ~ NEW[Stretch.StretchProc ← CellStretch];
CellStretch: Stretch.StretchProc = BEGIN
PROC [obj: CD.ObPtr, 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;
oCell, nCell: CD.CellPtr;
nObj: CD.ObPtr;
appList: CD.ApplicationList ← NIL;
oCell ← NARROW[obj.specificRef];
-- Make lists of changes
FOR a: CD.ApplicationList ← oCell.contents, a.rest WHILE a # NIL DO
ap: CD.ApplicationPtr ← a.first;
urPos: CD.DesignPosition ← CDApplications.HighPosO[a.first];
newAp: CD.ApplicationPtr ← NEW[CD.Application ← a.first^];
newOb: CD.ObPtr;
msg: Rope.ROPE;
newAp.properties ← CDProperties.CopyProps[ap.properties];
SELECT TRUE FROM
-- slide entire object over
Past[dir, place, ap.location] => {
IF dir = $left OR dir = $right THEN
newAp.location.x ← newAp.location.x + amount
ELSE
newAp.location.y ← newAp.location.y + amount;
};
-- stretch object
Past[dir, place, urPos] => {
rect, mapRect: CD.Rect;
lower, upper: INT;
newDir: Stretch.Direction;
newPlace: INT;
-- map a vector down into the object
IF dir = $up OR dir = $right THEN { -- left is left side of stretch mark
lower ← place - 1; upper ← place + 1;
}
ELSE {
lower ← place + 1; upper ← place - 1; -- stretch mark is upside down
};
IF dir = $left OR dir = $right THEN
rect ← [x1: lower, x2: upper, y1: 0, y2: 0]
ELSE
rect ← [x1: 0, x2: 0, y1: lower, y2: upper];
mapRect ← CDOrient.DeMapRect[rect, ap.ob.size, ap.orientation, ap.location];
-- now use the vector to determine location to stretch at
IF mapRect.x1 = mapRect.x2 THEN {
newPlace ← (mapRect.y1 + mapRect.y2) / 2;
IF mapRect.y1 < mapRect.y2 THEN newDir ← $up ELSE newDir ← $down;
}
ELSE {
newPlace ← (mapRect.x1 + mapRect.x2) / 2;
IF mapRect.x1 < mapRect.x2 THEN newDir ← $right ELSE newDir ← $left;
};
[newOb, msg] ← Stretch.DoStretch[ap.ob, newPlace, newDir, amount];
IF newOb = NIL THEN RETURN[NIL, msg];
newAp.ob ← newOb;
};
-- else leave object in same place
ENDCASE;
appList ← CONS[newAp, appList];
ENDLOOP;
nCell ← NEW[CD.CellRecord ← oCell^];
nCell.contents ← appList;
nObj ← NEW[CD.ObjectDefinition ← obj^];
nObj.specificRef ← nCell;
nObj.properties ← CDProperties.CopyProps[obj.properties];
IF dir = $right OR dir = $left THEN
nObj.size.x ← nObj.size.x + amount
ELSE
nObj.size.y ← nObj.size.y + amount;
RETURN[nObj, NIL];
END;
-- Top-level command routines
Init: PROC[] = BEGIN
dummyCell: CD.ObPtr ← CDCells.CreateEmptyCell[];
procs: REF CD.ObjectProcs;
TRUSTED {procs ← LOOPHOLE[dummyCell.p];}; -- make pointer readable
CDObjectProcs.StoreFurther[procs, $StretchProc, CellStretchRef];
END;
-- Main body
Init[];
END.