File: StretchLinesImpl.mesa   
Copyright © 1984 by Xerox Corporation. All rights reserved.
Created by: September 4, 1984 3:32:31 pm PDT PDT
Last Edited by: September 4, 1984 3:30:46 pm PDT PDT
Last Edited by: Mayo, November 5, 1984 8:54:40 pm PST
Last Edited by: Jacobi, December 19, 1984 4:38:49 pm PST
DIRECTORY
Stretch USING [StretchProc],
StretchLines,
CDMenus USING [CreateEntry],
TerminalIO USING [WriteRope, WriteInt, RequestRope, UserSaysYes],
CDSequencer USING [Command, ImplementCommand],
CD, CDPanel USING [FetchDefaultLevel],
TokenIO, CDBasics,
CDIO USING [ReadLevel, WriteLevel],
CDOps USING [IncludeApplication],
CDCallSpecific USING [CallProc, Register],
CDApplications USING [NewApplicationI],
CDOrient, Rope USING [ROPE, Cat, Equal],
CDObjectProcs USING [StoreFurther],
Atom, Graphics;
StretchLinesImpl: CEDAR PROGRAM    
IMPORTS Atom, CDMenus, CD, TerminalIO, CDOps, CDBasics, CDCallSpecific, Rope, CDSequencer, TokenIO, CDIO, CDOrient, CDPanel, CDApplications, CDObjectProcs, Graphics EXPORTS StretchLines =  
BEGIN OPEN StretchLines;
StretchObj: TYPE = REF StretchObjRec;  -- an object that can be put in a cell or design
-- Stretch line objects are always horizontal, with the left end at 0 and the right end at a positive coordinate. The line is a certain amount above the bottom side of the object, as indicated by 'baseline'. Different orientations of stretch lines are had by rotating and flipping this basic object.
StretchObjRec: TYPE = RECORD [
label: Rope.ROPE,
type: LineTypes,
level: CD.Level,  -- for blunt lines, the level to be stretched.
baseline: INT ← 3
];
versionNumber: INT ~ 2;  -- version of file format for stretch lines
-- Format version changes are recorded near the proceedure WriteStretchLine.
objAtom: PUBLIC ATOM ← $StretchLine;
objsProcs: REF CD.ObjectProcs;
myLevel: CD.Level;
objHeightAboveBaseline: INT = 9;
defaultObjWidth: INT = 45;
minObjWidth: INT = 2 * CD.lambda;
 
-- Utilities
-- Given a ChipNDale application that points to a stretch mark, return its label.
FindLabel: PUBLIC PROC [aptr: CD.ApplicationPtr] RETURNS [Rope.ROPE, LineTypes] = BEGIN
st: StretchObj ← NARROW[aptr.ob.specificRef, StretchObj];
RETURN[st.label, st.type];
END;
-- find the origin of a stretch line relative to the containing cell's origin
AptrToLine: PUBLIC PROC [aptr: CD.ApplicationPtr] RETURNS [REF LineData] = BEGIN
markObj: StretchObj = NARROW[aptr.ob.specificRef];
line: REF LineData ← NEW[LineData];
orient: CD.Orientation ← aptr.orientation;
IF aptr.ob.p.objectType # objAtom THEN RETURN[NIL];
IF CDOrient.IncludesMirrorX[orient] THEN {
orient ← CDOrient.MirrorX[orient]; -- compiler can't nest these calls!!!
orient ← CDOrient.Rotate90[orient];
orient ← CDOrient.Rotate90[orient];
};
line.point ← CDBasics.BaseOfAnyRect[CDOrient.MapRect[
itemInCell: [x1: 0, y1: markObj.baseline, x2: aptr.ob.size.x, y2: markObj.baseline],
cellSize: aptr.ob.size, cellInstOrient: aptr.orientation, cellInstPos: aptr.location]];
line.length ← aptr.ob.size.x;
SELECT orient FROM
CDOrient.original => line.direction ← up;
CDOrient.rotate90 => line.direction ← left;
CDOrient.rotate180 => line.direction ← down;
CDOrient.rotate270 => line.direction ← right;
ENDCASE => ERROR;
line.type ← markObj.type;
line.label ← markObj.label;
line.level ← markObj.level;
RETURN[line];
END;
-- check a command for wierdness as it is possible to screw up the TIP table.
OKCommand: PROC [comm: CDSequencer.Command] RETURNS[BOOL] = BEGIN
IF comm.pos.x > 10000 OR comm.pos.y > 10000 OR comm.pos.x < -10000 OR comm.pos.y < -10000 THEN BEGIN
TerminalIO.WriteRope["Warning: Huge position passed to AlignmentMarks from ChipNDale, maybe the TIP table is screwed up?\n"];
TerminalIO.WriteRope["comm.pos.x ="]; TerminalIO.WriteInt[comm.pos.x];
TerminalIO.WriteRope[" comm.pos.y ="]; TerminalIO.WriteInt[comm.pos.y];
[] ← TerminalIO.RequestRope["\nOperation will be aborted, type return ......"];
RETURN[FALSE];
END;
RETURN[TRUE];
END;
-- routines for interactive editing of stretch line
-- Place mark. Given point is the left (or lower) endpoint of the mark.r
Place: PUBLIC PROC [into: CD.Design, line: LineData, shift: BOOL ← TRUE] = BEGIN
aptr: CD.ApplicationPtr;
IF line.level = CD.combined AND line.type = blunt THEN
line.level ← CDPanel.FetchDefaultLevel[into];
aptr ← MakeLineAptr[line, shift];
IF aptr = NIL THEN ERROR; -- should never happen
CDOps.IncludeApplication[into, aptr];
END;
-- Make a mark application. If shift = TRUE then shift the object so that the line is at the point specified, if FALSE the lower left corner of the object (not the line) goes at the point specified. Returns NIL if an error occured (such as no level specified for a blunt line).
MakeLineAptr: PUBLIC PROC [line: LineData, shift: BOOL ← TRUE] RETURNS [CD.ApplicationPtr] = BEGIN
orient: CD.Orientation;
obj: CD.ObPtr ← NEW[CD.ObjectDefinition];
p: CD.Position ← [line.point.x, line.point.y];
len: INT ← MAX[minObjWidth, line.length];
markObj: StretchObj ← NEW[StretchObjRec];
markObj.label ← line.label;
markObj.type ← line.type;
obj.p ← objsProcs;
SELECT line.direction FROM
up => {
orient ← CDOrient.original;
IF shift THEN p.y ← p.y - markObj.baseline;
};
down => {
orient ← CDOrient.rotate180;
IF shift THEN p.y ← p.y - objHeightAboveBaseline;
};
left => {
orient ← CDOrient.rotate90;
IF shift THEN p.x ← p.x - objHeightAboveBaseline;
};
right => {
orient ← CDOrient.rotate270;
IF shift THEN p.x ← p.x - markObj.baseline;
};
ENDCASE => ERROR;
IF line.type = blunt THEN {
IF line.level = CD.combined THEN RETURN [NIL]; -- level must be specified
markObj.level ← line.level;
}
ELSE
markObj.level ← CD.combined;
obj.level ← myLevel;
obj.size ← [len, markObj.baseline + objHeightAboveBaseline];
obj.specificRef ← markObj;
RETURN[CDApplications.NewApplicationI[obj, p, orient]];
END;
FindList: PUBLIC PROC [ob: CD.ObPtr] RETURNS [LIST OF LineData] = BEGIN
list: CD.ApplicationList;
lines: LIST OF LineData ← NIL;
SELECT ob.p.objectType FROM
$Cell => list ← NARROW[ob.specificRef, CD.CellPtr].contents;
ENDCASE => RETURN[NIL];
FOR a: CD.ApplicationList ← list, a.rest WHILE a # NIL DO
IF a.first.ob.p.objectType = objAtom THEN {
lines ← CONS[AptrToLine[a.first]^, lines];
};
ENDLOOP;
RETURN[lines];
END;
Find: PUBLIC PROC [ob: CD.ObPtr, label: Rope.ROPE] RETURNS [REF LineData] = BEGIN
FOR a: LIST OF LineData ← FindList[ob], a.rest WHILE a # NIL DO
IF Rope.Equal[a.first.label, label] THEN {
RETURN[NEW[LineData ← a.first]];
};
ENDLOOP;
RETURN[NIL];
END;
DrawStretchMark: CD.DrawProc = BEGIN
-- PROC [aptr: ApplicationPtr, pos: DesignPosition, orient: Orientation, pr: REF DrawInformation];
markObj: StretchObj = NARROW[aptr.ob.specificRef];
-- move to a specified point, with or without drawing a line
MoveTo: PROC [x, y: INT, draw: BOOL, aptr: CD.ApplicationPtr, pos: CD.DesignPosition, orient: CD.Orientation, context: Graphics.Context] = BEGIN
p: CD.Position;
p ← CDBasics.AddPoints[CDOrient.MapPoint[
pointInCell: [x: x, y: y],
cellSize: aptr.ob.size, cellInstOrient: orient], pos];
IF draw THEN
Graphics.DrawTo[context, p.x, p.y]
ELSE
Graphics.SetCP[context, p.x, p.y];
END;
Color: PROC [context: Graphics.Context] = BEGIN
MapToReal: PROC[x, y: INT] RETURNS [REAL, REAL] = INLINE BEGIN
MapPoint: PROC [p: CD.Position, cellSize: CD.Position, orient: CD.Orientation] RETURNS [CD.Position] = INLINE BEGIN
RETURN[CDOrient.MapPoint[
pointInCell: [x: p.x, y: p.y],
cellSize: cellSize, cellInstOrient: orient]];
END;
orig: CD.Position;
orig ← CDBasics.AddPoints[MapPoint[[x, y], aptr.ob.size, orient], pos];
RETURN[orig.x, orig.y];
END;
mid: INT ← aptr.ob.size.x / 2;
x, y: REAL;
path: Graphics.Path ← Graphics.NewPath[size: 8];
IF context = NIL THEN RETURN;
[] ← Graphics.SetFat[context, FALSE];
-- fill in the arrow, a hack since we can't do color except in rectangles
[x, y] ← MapToReal[mid - 2, markObj.baseline + 0];
Graphics.MoveTo[path, x, y, TRUE];
[x, y] ← MapToReal[mid - 2, markObj.baseline + 4];
Graphics.LineTo[path, x, y];
[x, y] ← MapToReal[mid - 4, markObj.baseline + 4];
Graphics.LineTo[path, x, y];
[x, y] ← MapToReal[mid - 0, markObj.baseline + 8];
Graphics.LineTo[path, x, y];
[x, y] ← MapToReal[mid + 4, markObj.baseline + 4];
Graphics.LineTo[path, x, y];
[x, y] ← MapToReal[mid + 2, markObj.baseline + 4];
Graphics.LineTo[path, x, y];
[x, y] ← MapToReal[mid + 2, markObj.baseline + 0];
Graphics.LineTo[path, x, y];
Graphics.DrawArea[self: context, path: path];
rect ← CDBasics.MoveRect[CDOrient.MapRect[
itemInCell: [x1: mid - 1, y1: markObj.baseline + 4, x2: mid + 1, y2: markObj.baseline + 7],
cellSize: aptr.ob.size, cellInstOrient: orient], pos];
pr.drawRect[rect, aptr.ob.level, pr];
rect ← CDBasics.MoveRect[CDOrient.MapRect[
itemInCell: [x1: mid - 2, y1: markObj.baseline, x2: mid + 2, y2: markObj.baseline + 6],
cellSize: aptr.ob.size, cellInstOrient: orient], pos];
pr.drawRect[rect, aptr.ob.level, pr];
rect ← CDBasics.MoveRect[CDOrient.MapRect[
itemInCell: [x1: mid - 3, y1: markObj.baseline + 4, x2: mid + 3, y2: markObj.baseline + 5],
cellSize: aptr.ob.size, cellInstOrient: orient], pos];
pr.drawRect[rect, aptr.ob.level, pr];
END;
Outline: PROC [context: Graphics.Context] = BEGIN
right: INT ← aptr.ob.size.x;
left: INT ← 0;
mid: INT ← aptr.ob.size.x / 2;
IF context = NIL THEN RETURN;
[] ← Graphics.SetFat[context, FALSE];
-- draw the stretch line
MoveTo[left, markObj.baseline, FALSE, aptr, pos, orient, context];
MoveTo[right, markObj.baseline, TRUE, aptr, pos, orient, context];
{ -- use our `Fetch' procedure so we know that it works the same as drawing
line: LineData ← Fetch[aptr];
pos1, pos2: CD.Position;
pos1 ← pos2 ← line.point;
IF line.direction = up OR line.direction = down THEN
pos2.x ← pos1.x + line.length
ELSE
pos2.y ← pos1.y + line.length;
Graphics.SetCP[context, pos1.x, pos1.y];
Graphics.DrawTo[context, pos2.x, pos2.y];
};
-- draw direction arrow
MoveTo[mid - 2, markObj.baseline + 0, FALSE, aptr, pos, orient, context];
MoveTo[mid - 2, markObj.baseline + 4, TRUE, aptr, pos, orient, context];
MoveTo[mid - 4, markObj.baseline + 4, TRUE, aptr, pos, orient, context];
MoveTo[mid - 0, markObj.baseline + 8, TRUE, aptr, pos, orient, context];
MoveTo[mid + 4, markObj.baseline + 4, TRUE, aptr, pos, orient, context];
MoveTo[mid + 2, markObj.baseline + 4, TRUE, aptr, pos, orient, context];
MoveTo[mid + 2, markObj.baseline + 0, TRUE, aptr, pos, orient, context];
IF NARROW[aptr.ob.specificRef, StretchObj].type = pointed THEN {
-- draw arrowheads
MoveTo[left + 2, markObj.baseline + 2, FALSE, aptr, pos, orient, context];
MoveTo[left + 0, markObj.baseline + 0, TRUE, aptr, pos, orient, context];
MoveTo[left + 2, markObj.baseline - 2, TRUE, aptr, pos, orient, context];
MoveTo[right - 2, markObj.baseline + 2, FALSE, aptr, pos, orient, context];
MoveTo[right - 0, markObj.baseline + 0, TRUE, aptr, pos, orient, context];
MoveTo[right - 2, markObj.baseline - 2, TRUE, aptr, pos, orient, context];
}
ELSE {
-- draw square ends
MoveTo[left + 1, markObj.baseline + 2, FALSE, aptr, pos, orient, context];
MoveTo[left + 0, markObj.baseline + 2, TRUE, aptr, pos, orient, context];
MoveTo[left + 0, markObj.baseline - 2, TRUE, aptr, pos, orient, context];
MoveTo[left + 1, markObj.baseline - 2, TRUE, aptr, pos, orient, context];
MoveTo[right - 1, markObj.baseline + 2, FALSE, aptr, pos, orient, context];
MoveTo[right - 0, markObj.baseline + 2, TRUE, aptr, pos, orient, context];
MoveTo[right - 0, markObj.baseline - 2, TRUE, aptr, pos, orient, context];
MoveTo[right - 1, markObj.baseline - 2, TRUE, aptr, pos, orient, context];
};
END;
CD.DrawToContext[pr, Color, markObj.level];
CD.DrawToContext[pr, Outline, aptr.ob.level];
END;
AddStretchLine: PROC [comm: CDSequencer.Command] = BEGIN
line: LineData;
IF ~OKCommand[comm] THEN RETURN[];
line.label ← TerminalIO.RequestRope["Enter label for new stretch line: "];
IF TerminalIO.UserSaysYes["Pointed?", "Make this a pointed stretch line?", TRUE] THEN
line.type ← pointed
ELSE
line.type ← blunt;
line.point ← comm.pos;
line.length ← defaultObjWidth;
Place[comm.design, line, FALSE];
END;
AddCellLine: PROC [comm: CDSequencer.Command] = BEGIN
line: LineData;
IF ~OKCommand[comm] THEN RETURN[];
line.label ← TerminalIO.RequestRope["Enter label for new cell stretch line: "];
line.type ← pointed;
line.point ← comm.pos;
line.length ← defaultObjWidth;
Place[comm.design, line, FALSE];
END;
AddLayerLine: PROC [comm: CDSequencer.Command] = BEGIN
line: LineData;
line.level ← CDPanel.FetchDefaultLevel[comm.design];
line.type ← blunt;
IF ~OKCommand[comm] THEN RETURN[];
line.label ← TerminalIO.RequestRope[Rope.Cat["Enter label for new '", Atom.GetPName[CD.LevelKey[line.level]], "' stretch line: "]];
line.type ← blunt;
line.point ← comm.pos;
line.length ← defaultObjWidth;
Place[comm.design, line, FALSE];
END;
-- FILE FORMATS
Version1:
INT -- version number (1)
ROPE -- label
ROPE -- "P" for pointed line, "B" for blunt line
INT -- x dimension of line
LEVEL -- level that the line refers to
Version 2:
Added field at end: BASELINE -- the location of the line above the bottom of the object.
WriteStretchLine: CD.InternalWriteProc -- PROC [me: ObPtr] -- = BEGIN
markObj: StretchObj = NARROW[me.specificRef];
TokenIO.WriteInt[versionNumber];
TokenIO.WriteRope[markObj.label];
IF markObj.type = pointed THEN
TokenIO.WriteRope["P"]
ELSE
TokenIO.WriteRope["B"];
TokenIO.WriteInt[me.size.x];
CDIO.WriteLevel[markObj.level];
TokenIO.WriteInt[markObj.baseline];
END;
ReadStretchLine: CD.InternalReadProc -- PROC [] RETURNS [ObPtr] -- = BEGIN
obj: CD.ObPtr ← NEW[CD.ObjectDefinition];
vers: INT;
markObj: StretchObj ← NEW[StretchObjRec];
vers ← TokenIO.ReadInt[];
obj.p ← objsProcs;
obj.specificRef ← markObj;
markObj.label ← TokenIO.ReadRope[];
IF Rope.Equal[TokenIO.ReadRope[], "P"] THEN
markObj.type ← pointed
ELSE
markObj.type ← blunt;
obj.size.x ← TokenIO.ReadInt[];
markObj.level ← CDIO.ReadLevel[];
IF vers > 1 THEN
markObj.baseline ← TokenIO.ReadInt[];
obj.level ← myLevel;
obj.size.y ← markObj.baseline + objHeightAboveBaseline;
RETURN[obj];
END;
DescribeStretchLine: CD.DescribeProc -- PROC [me: ObPtr] RETURNS [Rope.ROPE] -- = BEGIN
markObj: StretchObj = NARROW[me.specificRef];
IF markObj.type = pointed THEN
RETURN[Rope.Cat["Cell stretch line labeled '", markObj.label, "'"]]
ELSE
RETURN[Rope.Cat["Layer '", Atom.GetPName[CD.LevelKey[markObj.level]], "' stretch line labeled '", markObj.label, "'"]];
END;
SetSize: CDCallSpecific.CallProc = BEGIN
newLength: CD.DesignNumber ← NARROW[x, REF CD.DesignNumber]^;
aptr.ob.size.x ← MAX[minObjWidth, newLength];
repaintMe ← TRUE;
END;
AdjustSize: CDCallSpecific.CallProc = BEGIN
amount: INT;
IF x=NIL THEN
amount ← CD.lambda
ELSE IF ISTYPE [x, REF CD.DesignPosition] THEN {
p: CD.DesignPosition ← NARROW[x, REF CD.DesignPosition]^;
IF p.x = 0 THEN
amount ← p.y
ELSE
amount ← p.x;
}
ELSE {
done←FALSE;
RETURN;
};
aptr.ob.size.x ← MAX[minObjWidth, MAX[CD.lambda, aptr.ob.size.x + amount]];
repaintMe ← TRUE;
END;
-- Routines to stretch stretch lines themselves
StretchStretchRef: REF Stretch.StretchProc ~ NEW[Stretch.StretchProc ← StretchStretch];
StretchStretch: Stretch.StretchProc = BEGIN
PROC [obj: CD.ObPtr, design: CD.Design, place: INT, dir: Direction, amount: INT] RETURNS [CD.ObPtr, Rope.ROPE];
nObj: CD.ObPtr ← NEW[CD.ObjectDefinition];
markObj: REF StretchObjRec ← NEW[StretchObjRec ← NARROW[obj.specificRef, REF StretchObjRec]^];
nObj.specificRef ← markObj;
nObj.p ← objsProcs;
IF (dir = $up AND place < markObj.baseline) OR (dir = $down AND place <= markObj.baseline) THEN {
markObj.baseline ← markObj.baseline + amount;
} ELSE {
IF dir = $right OR dir = $left THEN nObj.size.x ← nObj.size.x + amount;
};
RETURN[nObj, NIL];
END;
-- Top-level command routines
Init: PROC[] = BEGIN
error: BOOL ← FALSE;
tmp: REF CD.ObjectProcs;
error ← FALSE;
tmp ← CD.RegisterObjectType[objAtom ! CD.Error => {error ← TRUE; CONTINUE}];
IF tmp = NIL THEN error ← TRUE;
IF ~error THEN {
myLevel ← CD.NewLevel[NIL, $StretchLineLevel];
objsProcs ← tmp;
}
ELSE {
error ← FALSE;
objsProcs ← CD.FetchObjectProcs[objAtom! CD.Error => {error ← TRUE; CONTINUE}];
myLevel ← CD.FetchLevel[NIL, $StretchLineLevel ! CD.Error => {error ← TRUE; CONTINUE}];
IF error THEN objsProcs ← NIL;
};
IF objsProcs = NIL THEN {
TerminalIO.WriteRope["Error: Can't register stretch-line object procs.\n"];
RETURN;
};
objsProcs.drawMe ← DrawStretchMark;
objsProcs.internalWrite ← WriteStretchLine;
objsProcs.internalRead ← ReadStretchLine;
objsProcs.describe ← DescribeStretchLine;
objsProcs.inDirectory ← FALSE;
objsProcs.wireTyped ← FALSE;
CDObjectProcs.StoreFurther[objsProcs, $StretchProc, StretchStretchRef];
CDCallSpecific.Register[$Lengthen, objsProcs, AdjustSize];
CDCallSpecific.Register[$Widen, objsProcs, AdjustSize];
CDCallSpecific.Register[$SetLength, objsProcs, SetSize];
CDCallSpecific.Register[$SetWidth, objsProcs, SetSize];
CDSequencer.ImplementCommand[$AddStretchLine, AddStretchLine];
CDSequencer.ImplementCommand[$AddCellLine, AddCellLine];
CDSequencer.ImplementCommand[$AddLayerLine, AddLayerLine];
CDMenus.CreateEntry[menu: $ModuleMenu, entry: "Add Cell Stretch Line", key: $AddCellLine];
CDMenus.CreateEntry[menu: $ModuleMenu, entry: "Add Layer Stretch Line", key: $AddLayerLine];
END;
-- Main body
Init[];
END.