<> <> <> <> DIRECTORY CD, CDInstances, CDBasics, CDLayers USING [MakeAbstract], CDLRUCache, CDImports, CDIOExtras, CDOps, CDOrient, CDSymbolicObjects, CDPrivate, CDProperties, CDRects, Imager, ImagerPath, Rope; CDSymbolicObjectsImpl: CEDAR MONITOR IMPORTS CD, CDInstances, CDBasics, CDLayers, CDLRUCache, CDIOExtras, CDOps, CDOrient, CDPrivate, CDProperties, CDRects, Imager, ImagerPath, Rope EXPORTS CDSymbolicObjects SHARES CDLayers = BEGIN <<--for historical reasons symbolic rectangles are called pins and symbolic points are called alignment marks. >> symNameProp: ATOM = $SignalName; symLayerProp: ATOM = $layerOfPin; symOwnerProp: ATOM = $ownerOfPin; markOb: CD.Object; markLayer: CD.Layer _ CD.combined; markPath: ImagerPath.Trajectory = CreateMarkPath[]; PinSpecific: TYPE = REF PinRec; PinRec: TYPE = RECORD [dummy: INT _ 17]; dummyPinSpecific: PinSpecific = NEW[PinRec]; pinLayer: CD.Layer _ CD.NewLayer[NIL, $pinRepresentation]; segmentLayer: CD.Layer _ CD.NewLayer[NIL, $segmentRepresentation]; pinCache: CDLRUCache.LRUCache = CDLRUCache.Create[size: 17, newProc: NewPin]; segmentCache: CDLRUCache.LRUCache = CDLRUCache.Create[size: 17, newProc: NewPin]; NewPin: PROC [] RETURNS [CD.Object] = { ob: CD.Object _ NEW[CD.ObjectRep]; ob.specificRef _ dummyPinSpecific; ob.layer _ pinLayer; ob.class _ symbolicRectsClass; RETURN [ob] }; NewSegment: PROC [] RETURNS [CD.Object] = { ob: CD.Object _ NEW[CD.ObjectRep]; ob.specificRef _ dummyPinSpecific; ob.layer _ segmentLayer; ob.class _ symbolicLineClass; RETURN [ob] }; Init: PROC [] = BEGIN <<--rects>> CDLayers.MakeAbstract[pinLayer]; symbolicRectsClass.drawMe _ symbolicRectsClass.quickDrawMe _ DrawPin; symbolicRectsClass.showMeSelected _ ShowSelectedPin; symbolicRectsClass.internalRead _ ReadPin; symbolicRectsClass.internalWrite _ WritePin; symbolicRectsClass.wireTyped _ TRUE; symbolicRectsClass.symbolic _ TRUE; symbolicRectsClass.description _ "pin"; symbolicRectsClass.describeInst _ DescribeInstance; CDRects.UseAsCreateRect[pinLayer, RCreatePinOb, symbolicRectsClass]; <<--lines>> CDLayers.MakeAbstract[segmentLayer]; symbolicLineClass.drawMe _ symbolicRectsClass.quickDrawMe _ DrawSegment; symbolicLineClass.showMeSelected _ ShowSelectedPin; symbolicLineClass.internalRead _ ReadSegment; symbolicLineClass.internalWrite _ WritePin; symbolicLineClass.wireTyped _ TRUE; symbolicLineClass.symbolic _ TRUE; symbolicLineClass.description _ "segment"; symbolicLineClass.describeInst _ DescribeInstance; CDRects.UseAsCreateRect[segmentLayer, RCreateLineOb, symbolicLineClass]; <<--points>> symbolicPointClass.drawMe _ DrawMark; symbolicPointClass.internalWrite _ WriteMark; symbolicPointClass.internalRead _ ReadMark; symbolicPointClass.description _ "mark"; symbolicPointClass.symbolic _ TRUE; markOb _ NEW[CD.ObjectRep _ [ class: symbolicPointClass, size: [4, 4], layer: markLayer, specificRef: $AlignmentMarkOb ]]; <<--common>> [] _ CDProperties.RegisterProperty[symLayerProp, $layer]; [] _ CDProperties.RegisterProperty[symOwnerProp, $atom]; CDProperties.InstallProcs[prop: symOwnerProp, new: [makeCopy: CDProperties.CopyVal]]; CDProperties.InstallProcs[prop: symLayerProp, new: [makeCopy: CDProperties.CopyVal]]; END; DescribeInstance: PROC[i: CD.Instance] RETURNS [Rope.ROPE] = BEGIN RETURN [Rope.Cat[CDOps.LayerName[GetLayer[i]], " ", i.ob.class.description]]; END; CreatePointOb: PUBLIC PROC [dummySize: CD.Number_0] RETURNS [CD.Object] = BEGIN RETURN [markOb] END; CreateLineOb: PUBLIC PROC [length: CD.Number, dummyWidth: CD.Number_0] RETURNS [CD.Object] = BEGIN ob: CD.Object = segmentCache.UnusedOrNew[]; size: CD.Position; IF dummyWidth<=0 THEN dummyWidth _ 8; size _ [dummyWidth, length]; ob.size _ CDBasics.MaxPoint[size, [1, 1]]; RETURN [segmentCache.ReplaceByAequivalent[ob]]; END; CreateRectOb: PUBLIC PROC [size: CD.Position] RETURNS [CD.Object] = BEGIN ob: CD.Object = pinCache.UnusedOrNew[]; ob.size _ CDBasics.MaxPoint[size, [1, 1]]; RETURN [pinCache.ReplaceByAequivalent[ob]]; END; RCreatePinOb: PROC [size: CD.Position, l: CD.Layer] RETURNS [CD.Object] = BEGIN RETURN [CreateRectOb[size]] END; RCreateLineOb: PROC [size: CD.Position, l: CD.Layer] RETURNS [CD.Object] = BEGIN RETURN [CreateLineOb[size.y, size.x]] END; IsSymbolicOb: PUBLIC PROC [ob: CD.Object] RETURNS [BOOL] = { RETURN [ob.class=symbolicPointClass OR ob.class=symbolicLineClass OR ob.class=symbolicRectsClass] }; IsPointOb: PUBLIC PROC [ob: CD.Object] RETURNS [BOOL] = { RETURN [ob.class=symbolicPointClass] }; IsLineOb: PUBLIC PROC [ob: CD.Object] RETURNS [BOOL] = { RETURN [ob.class=symbolicLineClass] }; IsRectOb: PUBLIC PROC [ob: CD.Object] RETURNS [BOOL] = { RETURN [ob.class=symbolicRectsClass] }; SymbolicKind: PUBLIC PROC [ob: CD.Object] RETURNS [k: CDSymbolicObjects.Kind] = { SELECT TRUE FROM ob.class=symbolicRectsClass => k _ rect; ob.class=symbolicLineClass => k _ line; ob.class=symbolicPointClass => k _ point; ENDCASE => k _ notSymbolic }; SetOwner: PUBLIC PROC [symInst: CD.Instance, owner: ATOM_NIL] = BEGIN IF IsSymbolicOb[symInst.ob] THEN CDProperties.PutPropOnInstance[symInst, symOwnerProp, owner] END; GetOwner: PUBLIC PROC [symInst: CD.Instance] RETURNS [at: ATOM] = BEGIN WITH CDProperties.GetPropFromInstance[symInst, symOwnerProp] SELECT FROM a: ATOM => at _ a ENDCASE => at _ NIL END; SetName: PUBLIC PROC [symInst: CD.Instance, name: Rope.ROPE] = BEGIN IF IsSymbolicOb[symInst.ob] THEN CDProperties.PutPropOnInstance[symInst, symNameProp, name] END; GetName: PUBLIC PROC [symInst: CD.Instance] RETURNS [r: Rope.ROPE _ NIL] = BEGIN IF IsSymbolicOb[symInst.ob] THEN { WITH CDProperties.GetPropFromInstance[symInst, symNameProp] SELECT FROM n: Rope.ROPE => r _ n; rt: REF READONLY TEXT => r _ Rope.FromRefText[rt]; ENDCASE => NULL; } END; SetLayer: PUBLIC PROC [symInst: CD.Instance, layer: CD.Layer] = BEGIN IF IsSymbolicOb[symInst.ob] THEN CDProperties.PutPropOnInstance[symInst, symLayerProp, CDPrivate.layers[layer]] END; GetLayer: PUBLIC PROC [symInst: CD.Instance] RETURNS [layer: CD.Layer] = BEGIN WITH CDProperties.GetPropFromInstance[symInst, symLayerProp] SELECT FROM lp: CDPrivate.LayerRef => layer _ lp^.number ENDCASE => layer _ CD.combined END; DirectionFromOrient: PUBLIC PROC [o: CD.Orientation] RETURNS [dir: CDSymbolicObjects.Direction] = BEGIN SELECT o FROM CDOrient.original, CDOrient.rotate180X => dir _ west; CDOrient.rotate90, CDOrient.rotate90X => dir _ south; CDOrient.rotate180, CDOrient.mirrorX => dir _ east; CDOrient.rotate270, CDOrient.rotate270X => dir _ north; ENDCASE => ERROR; END; OrientFromDirection: PUBLIC PROC [dir: CDSymbolicObjects.Direction] RETURNS [o: CD.Orientation] = BEGIN SELECT dir FROM west => o _ CDOrient.original; south => o _ CDOrient.rotate90; east => o _ CDOrient.rotate180; north => o _ CDOrient.rotate270; ENDCASE => ERROR; END; CreateSymInst: PUBLIC PROC [name: Rope.ROPE_NIL, denotes: CD.Rect, dummySize: CD.Number, layer: CD.Layer, owner: ATOM, approachFrom: CDSymbolicObjects.Direction] RETURNS [symInst: CD.Instance] = BEGIN symOb: CD.Object; orient: CD.Orientation _ OrientFromDirection[approachFrom]; loc: CD.Position; denotes _ CDBasics.NormalizeRect[denotes]; IF denotes.x1#denotes.x2 AND denotes.y1#denotes.y2 THEN { <<--rect>> loc _ CDBasics.BaseOfRect[denotes]; symOb _ CreateRectOb[CDOrient.OrientedSize[CDBasics.SizeOfRect[denotes], orient]]; } ELSE IF denotes.x1=denotes.x2 AND denotes.y1=denotes.y2 THEN { <<--point>> p: CD.Position; symOb _ CreatePointOb[dummySize]; p _ CDOrient.MapPoint[ pointInCell: [0, 0], cellSize: symOb.size, cellInstOrient: orient, cellInstPos: [0, 0] ]; loc _ [x: denotes.x1-p.x, y: denotes.y1-p.y]; } ELSE { <<--segment>> l: CD.Number; IF denotes.x1=denotes.x2 THEN { l _ denotes.y2-denotes.y1; IF approachFrom=south OR approachFrom=north THEN { <<-- erroneous parameters..>> approachFrom _ west; orient _ OrientFromDirection[approachFrom]; } } ELSE { l _ denotes.x2-denotes.x1; IF approachFrom=west OR approachFrom=east THEN { <<-- erroneous parameters..>> approachFrom _ south; orient _ OrientFromDirection[approachFrom]; } }; symOb _ CreateLineOb[length: l, dummyWidth: dummySize]; loc _ CDBasics.BaseOfRect[denotes]; SELECT approachFrom FROM west, south => NULL; east => loc.x _ loc.x-symOb.size.x; north => loc.y _ loc.y-symOb.size.y; ENDCASE => ERROR; }; symInst _ CDInstances.NewInstance[ob: symOb, location: loc, orientation: orient]; IF name#NIL THEN SetName[symInst, name]; IF layer#CD.combined THEN SetLayer[symInst, layer]; IF owner#NIL THEN SetOwner[symInst, owner]; END; Denotes: PUBLIC PROC [symInst: CD.Instance] RETURNS [CD.Rect] = BEGIN itemInCell: CD.Rect; SELECT TRUE FROM symInst.ob.class=symbolicRectsClass => itemInCell _ [x1: 0, y1: 0, x2: symInst.ob.size.x, y2: symInst.ob.size.y]; symInst.ob.class=symbolicLineClass => itemInCell _ [x1: 0, y1: 0, x2: 0, y2: symInst.ob.size.y]; symInst.ob.class=symbolicPointClass => itemInCell _ [0, 0, 0, 0]; ENDCASE => ERROR; RETURN [CDOrient.MapRect[ itemInCell: itemInCell, cellInstPos: symInst.location, cellSize: symInst.ob.size, cellInstOrient: symInst.orientation ]] END; <<>> EnumerateSymbolicObs: PUBLIC PROC [cellOb: CD.Object_NIL, eachInst: CDSymbolicObjects.InstEnumerator] RETURNS [quit: BOOL_FALSE] = BEGIN cp: CD.CellPtr; WITH cellOb.specificRef SELECT FROM c: CD.CellPtr => cp _ c; ip: CDImports.ImportPtr => { -- HACKK until imports handle pins reasonably IF ip.boundInstance=NIL THEN RETURN [TRUE]; quit _ EnumerateSymbolicObs[ip.boundInstance.ob, eachInst]; RETURN }; ENDCASE => RETURN [TRUE]; FOR list: CD.InstanceList _ cp.contents, list.rest WHILE (list#NIL AND ~quit) DO IF IsSymbolicOb[list.first.ob] THEN { quit _ eachInst[list.first]; -- do NOT catch errors }; ENDLOOP; END; FindSymbolicObs: PUBLIC PROC [cellOb: CD.Object_NIL, name: Rope.ROPE] RETURNS [il: CD.InstanceList_NIL]= BEGIN Enumerate: CDSymbolicObjects.InstEnumerator = { IF Rope.Equal[GetName[inst], name] THEN il _ CONS[inst, il]; }; [] _ EnumerateSymbolicObs[cellOb, Enumerate]; END; <<>> WritePin: CD.InternalWriteProc -- PROC [me: Object] -- = BEGIN CDIOExtras.WritePos[me.size]; END; ReadPin: CD.InternalReadProc --PROC [] RETURNS [Object]-- = BEGIN RETURN [CreateRectOb[CDIOExtras.ReadPos[]]] END; ReadSegment: CD.InternalReadProc --PROC [] RETURNS [Object]-- = BEGIN p: CD.Position _ CDIOExtras.ReadPos[]; RETURN [CreateLineOb[p.y, p.x]] END; ShowSelectedPin: PROC [inst: CD.Instance, pos: CD.Position, orient: CD.Orientation, pr: CD.DrawRef] = BEGIN pr.drawRect[CDOrient.RectAt[pos, inst.ob.size, orient], CD.highLightShade, pr] END; DrawPin: PROC [inst: CD.Instance, pos: CD.Position, orient: CD.Orientation, pr: CD.DrawRef] = BEGIN DrawPinInContext: PROC [context: Imager.Context, ob: CD.Object, layer: CD.Layer] = BEGIN Imager.MaskVector[context, [0, 0], [ob.size.x, ob.size.y]]; Imager.MaskVector[context, [0, ob.size.y], [ob.size.x, 0]]; END; IF pr.symbolics THEN { pr.drawContext[pr, DrawPinInContext, inst.ob, pos, orient, pinLayer]; pr.drawComment[r: CDOrient.RectAt[pos, inst.ob.size, orient], comment: GetName[inst], pr: pr] } END; DrawSegment: PROC [inst: CD.Instance, pos: CD.Position, orient: CD.Orientation, pr: CD.DrawRef] = BEGIN DrawSegmentInContext: PROC [context: Imager.Context, ob: CD.Object, layer: CD.Layer] = BEGIN Imager.MaskVector[context, [0, 0], [0, ob.size.y]]; Imager.MaskVector[context, [0, 0], [ob.size.x, ob.size.y/2]]; Imager.MaskVector[context, [0, ob.size.y], [ob.size.x, ob.size.y/2]]; END; IF pr.symbolics THEN { pr.drawContext[pr, DrawSegmentInContext, inst.ob, pos, orient, segmentLayer]; pr.drawComment[r: CDOrient.RectAt[pos, inst.ob.size, orient], comment: GetName[inst], pr: pr] } END; DrawMark: PROC [inst: CD.Instance, pos: CD.Position, orient: CD.Orientation, pr: CD.DrawRef] = BEGIN DrawPath: PROC [context: Imager.Context, ob: CD.Object, layer: CD.Layer] = BEGIN Imager.MaskFillTrajectory[context, markPath]; END; IF pr.symbolics THEN { pr.drawContext[pr, DrawPath, markOb, pos, orient, markLayer] } END; WriteMark: CD.InternalWriteProc --PROC [me: Object]-- = {}; ReadMark: CD.InternalReadProc --PROC [] RETURNS [Object]-- = {RETURN [markOb]}; CreateMarkPath: PROC [] RETURNS [markPath: ImagerPath.Trajectory] = BEGIN markPath _ ImagerPath.MoveTo[[0, 0]]; markPath _ ImagerPath.LineTo[markPath, [0, 3]]; markPath _ ImagerPath.LineTo[markPath, [1, 2]]; markPath _ ImagerPath.LineTo[markPath, [3, 4]]; markPath _ ImagerPath.LineTo[markPath, [4, 3]]; markPath _ ImagerPath.LineTo[markPath, [2, 1]]; markPath _ ImagerPath.LineTo[markPath, [3, 0]]; markPath _ ImagerPath.LineTo[markPath, [0, 0]]; END; symbolicRectsClass: PUBLIC REF CD.ObjectClass _ CD.RegisterObjectClass[$PinOb0x]; symbolicLineClass: PUBLIC REF CD.ObjectClass _ CD.RegisterObjectClass[$SymbolicSegmentx]; symbolicPointClass: PUBLIC REF CD.ObjectClass _ CD.RegisterObjectClass[$AlignmentMarkObx]; END.