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 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]; 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 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; }; Past[dir, place, urPos] => { rect, mapRect: CD.Rect; lower, upper: INT; newDir: Stretch.Direction; newPlace: INT; 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]; 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; }; 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; 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; Init[]; END. File: StretchCells.mesa Copyright c 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 PROC [obj: CD.ObPtr, place: INT, dir: Direction, amount: INT] RETURNS [CD.ObPtr, Rope.ROPE]; -- Make lists of changes -- slide entire object over -- stretch object -- map a vector down into the object -- now use the vector to determine location to stretch at -- else leave object in same place -- Top-level command routines -- Main body ΚO˜– "Cedar" stylešœ™Jšœ Οmœ1™