<> <> <> <> <> <> 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]; <> <> <> <> <> <> <> <> <> <> <> <> 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>> <> <> <> <> <> <> <> <> <> <<};>> <<-- 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>> <> <> <> <> <> <> <> <> <<>> 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 <> 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.