<> <> <> <> <> <> <> <> <> <> <> <<>> DIRECTORY CD, CDCells, CDDirectory, CDEvents, CDInstances, CDMenus, CDOps, CDPanelFonts, CDProperties, CDSatellites, CDSequencer, CDTexts, IO, Rope, TerminalIO; CDSatellitesImpl: CEDAR PROGRAM IMPORTS CDCells, CDEvents, CDDirectory, CDInstances, CDMenus, CDOps, CDPanelFonts, CDProperties, CDSequencer, CDTexts, IO, Rope, TerminalIO EXPORTS CDSatellites = BEGIN OPEN CDSatellites; satellitesProp: PUBLIC ATOM _ RegisterProp[$CDSatellitesSatList, TRUE]; <> maxGroupIdProp: PUBLIC ATOM _ RegisterProp[$CDSatellitesMaxGroupId, TRUE]; <> groupIdProp: PUBLIC ATOM _ RegisterProp[$CDSatellitesGroupId, TRUE]; <> commentProp: PUBLIC ATOM _ RegisterProp[$CDSatellitesComment, TRUE]; <> prevNumMasters: NAT _ 0; <> GetSatellites: PUBLIC PROC [from: REF, filterComments: BOOL _ TRUE] RETURNS [sats: InstanceList] = { IF from=NIL THEN sats _ NIL ELSE { sats _ NARROW[CDProperties.GetProp[from, satellitesProp]]; IF filterComments THEN sats _ FilterComments[sats]; }; }; GetSatelliteRopes: PUBLIC PROC [from: REF, filterComments: BOOL _ TRUE] RETURNS [ropes: LIST OF ROPE _ NIL] = { FOR list: InstanceList _ GetSatellites[from, filterComments], list.rest WHILE list#NIL DO rope: ROPE _ NARROW [list.first.ob.specificRef, CDTexts.TextPtr].text; IF CDProperties.GetProp[list.first, commentProp]=NIL THEN ropes _ CONS [rope, ropes]; ENDLOOP; }; EnforceInvariants: PUBLIC PROC [design: CD.Design, world: InstanceList] RETURNS [oSats: InstanceList] = { Node: TYPE = REF NodeRec; NodeRec: TYPE = RECORD [ id: INT _ -1, list: InstanceList _ NIL]; Table: TYPE = REF TableRec; TableRec: TYPE = RECORD [ elements: SEQUENCE size: NAT OF LIST OF Node ]; masterTable: Table _ NEW[TableRec[TableSize[]]]; iSats: InstanceList; maxGroupId: INT; TableSize: PROC [] RETURNS [NAT] = INLINE { FOR sizes: LIST OF NAT _ LIST [7, 17, 31, 67, 253], sizes.rest WHILE sizes#NIL DO IF prevNumMasters <= sizes.first THEN RETURN [sizes.first] ENDLOOP; RETURN [253] }; Hash: PROC [i: INT] RETURNS [INT] = { RETURN[i MOD masterTable.size] }; Store: PROC [inst: CD.Instance] = { id: INT _ GroupIdFast[inst]; hash: INT _ Hash[id]; FOR nl: LIST OF Node _ masterTable[hash], nl.rest WHILE nl#NIL DO IF nl.first.id=id THEN {nl.first.list _ CONS[inst, nl.first.list]; RETURN}; ENDLOOP; masterTable[hash] _ CONS[NEW[NodeRec _ [id: id, list: LIST[inst]]], masterTable[hash]]; }; Fetch: PROC [id: INT] RETURNS [InstanceList] = { hash: INT _ Hash[id]; FOR nl: LIST OF Node _ masterTable[hash], nl.rest WHILE nl#NIL DO IF nl.first.id=id THEN RETURN [nl.first.list]; ENDLOOP; RETURN [NIL]; }; <> IF CDProperties.GetProp[design, maxGroupIdProp]=NIL THEN CDProperties.PutProp[design, maxGroupIdProp, NEW [INT _ 0]]; <> FOR w: InstanceList _ world, w.rest WHILE w#NIL DO IF CDTexts.IsText[w.first.ob] THEN {IF CDProperties.GetProp[w.first, groupIdProp]#NIL THEN iSats _ CONS [w.first, iSats]} ELSE {IF CDProperties.GetProp[w.first, groupIdProp]#NIL THEN {Store[w.first]; CDProperties.PutProp[w.first, satellitesProp, NIL]}} ENDLOOP; <> FOR sl: InstanceList _ iSats, sl.rest WHILE sl#NIL DO Closer: PROC [newMaster: CD.Instance] RETURNS [BOOL] = INLINE { mRect, newMRect, sRect: CD.Rect; IF master=NIL THEN RETURN [TRUE]; mRect _ CDInstances.InstRectO[master]; newMRect _ CDInstances.InstRectO[newMaster]; sRect _ CDInstances.InstRectO[sl.first]; RETURN[RectMinDist[newMRect, sRect] < RectMinDist[mRect, sRect]]; }; master: CD.Instance _ NIL; satGId: INT _ GroupIdFast[sl.first]; FOR ml: InstanceList _ Fetch[satGId], ml.rest WHILE ml#NIL DO IF satGId#GroupIdFast[ml.first] THEN LOOP; IF Closer[ml.first] THEN master _ ml.first; ENDLOOP; IF master=NIL THEN CDProperties.PutProp[sl.first, groupIdProp, NIL] ELSE EnsureSatelliteOnList[master, sl.first]; ENDLOOP; <> maxGroupId _ NARROW [CDProperties.GetProp[design, maxGroupIdProp], REF INT]^; prevNumMasters _ 0; FOR i: INT IN [0..masterTable.size) DO FOR nl: LIST OF Node _ masterTable[i], nl.rest WHILE nl#NIL DO prevNumMasters _ prevNumMasters+1; FOR ml: InstanceList _ nl.first.list.rest, ml.rest WHILE ml#NIL DO maxGroupId _ maxGroupId+1; CDProperties.PutProp[ml.first, groupIdProp, NEW [INT _ maxGroupId]]; FOR sl: InstanceList _ NARROW[CDProperties.GetProp[ml.first, satellitesProp]], sl.rest WHILE sl#NIL DO CDProperties.PutProp[sl.first, groupIdProp, NEW [INT _ maxGroupId]]; ENDLOOP; ENDLOOP; ENDLOOP; ENDLOOP; CDProperties.PutProp[design, maxGroupIdProp, NEW [INT _ maxGroupId]]; <> oSats _ NIL; FOR w: InstanceList _ world, w.rest WHILE w#NIL DO IF CDTexts.IsText[w.first.ob] AND CDProperties.GetProp[w.first, groupIdProp]=NIL THEN oSats _ CONS [w.first, oSats] ENDLOOP; }; MakeInstanceSatellite: PUBLIC PROC [design: CD.Design, master: CD.Instance, text: CD.Instance] = { EnsureSatelliteOnList[master, text]; IF CDProperties.GetProp[master, groupIdProp]=NIL THEN { ref: REF INT _ NARROW[CDProperties.GetProp[design, maxGroupIdProp]]; ref^ _ ref^+1; CDProperties.PutProp[master, groupIdProp, NEW [INT _ ref^]]; }; CDProperties.PutProp[text, groupIdProp, NEW[INT _ GroupId[master]]]; }; <> DoEnforceDesignInvariants: CDEvents.EventProc = { IF design=NIL THEN RETURN; -- sounds like a hack, but design is sometimes NIL!! EnforceDesignInvariants[design]; }; EnforceDesignInvariants: PUBLIC PROC [design: CD.Design] = { headPushRecs: LIST OF CD.PushRec; EnforceForEachCell: CDDirectory.EachEntryAction = { IF NOT CDCells.IsCell[ob] THEN RETURN; CDProperties.PutObjectProp[ob, satellitesProp, EnforceInvariants[design, NARROW [ob.specificRef, CD.CellPtr].contents]] }; [] _ CDDirectory.Enumerate[design, EnforceForEachCell]; headPushRecs _ design.actual; WHILE headPushRecs.rest#NIL DO headPushRecs _ headPushRecs.rest ENDLOOP; CDProperties.PutDesignProp[design, satellitesProp, EnforceInvariants[design, headPushRecs.first.specific.contents]]; }; <<>> <> AfterCellReplacement: CDEvents.EventProc = { ob: CD.Object _ NARROW [x]; oSats: InstanceList _ EnforceInvariants[design, NARROW[ob.specificRef, CD.CellPtr].contents]; CDProperties.PutObjectProp[ob, satellitesProp, oSats] }; <> <<>> <> SelectInstanceGroupCommand: PROC [comm: CDSequencer.Command] = { world: InstanceList _ CDOps.InstList[comm.design]; multiple: BOOL; selected: CD.Instance; numSats: INT; [] _ EnforceInvariants[comm.design, world]; [selected, multiple] _ CDOps.SelectedInstance[comm.design]; IF ~SingleSelected[selected, multiple] THEN RETURN; IF CDProperties.GetProp[selected, groupIdProp]=NIL THEN { TerminalIO.WriteRope["Selected instance is not in any instance group.\n"]; RETURN }; IF CDTexts.IsText[selected.ob] THEN numSats _ SelectInstanceGroup[comm.design, world, FindMaster[world, selected]] ELSE numSats _ SelectInstanceGroup[comm.design, world, selected]; TerminalIO.WriteF["Instance group selected: %g satellites(s) in group.\n", IO.int[numSats]]; }; <> AddInstanceSatelliteCommand: PROC [comm: CDSequencer.Command] = { world: InstanceList _ CDOps.InstList[comm.design]; multiple: BOOL; selected: CD.Instance; name: ROPE; font: CDTexts.CDFont _ CDPanelFonts.CurrentFont[comm.design]; text: CD.Instance; [] _ EnforceInvariants[comm.design, world]; [selected, multiple] _ CDOps.SelectedInstance[comm.design]; IF ~SingleSelected[selected, multiple] THEN RETURN; IF CDTexts.IsText[selected.ob] THEN { TerminalIO.WriteRope["\n** Selected instance is text--can't put a satellite on it.\n"]; RETURN; }; name _ TerminalIO.RequestRope["Type instance satellite: "]; IF name=NIL THEN {TerminalIO.WriteRope["\n** Empty name--can't do it.\n"]; RETURN}; IF font=NIL THEN {TerminalIO.WriteRope["\n** No current font--can't do it.\n"]; RETURN}; text _ NEW [CD.InstanceRep _ [ob: CDTexts.CreateText[name, font], location: comm.pos]]; CDOps.IncludeInstance[comm.design, text]; MakeInstanceSatellite[comm.design, selected, text]; TerminalIO.WriteRope["Instance satellite added\n"]; }; <<>> <> SetInstanceSatellitesCommand: PROC [comm: CDSequencer.Command] = { world: InstanceList _ CDOps.InstList[comm.design]; satellites: InstanceList _ NIL; master: CD.Instance _ NIL; [] _ EnforceInvariants[comm.design, world]; <<>> <> FOR w: InstanceList _ world, w.rest WHILE w#NIL DO inst: CD.Instance _ w.first; IF ~inst.selected THEN LOOP; IF CDTexts.IsText[inst.ob] THEN satellites _ CONS[inst, satellites] ELSE { IF master#NIL THEN {TerminalIO.WriteRope["\n** More than one master selected--can't do it.\n"]; RETURN}; master _ inst} ENDLOOP; IF master=NIL THEN {TerminalIO.WriteRope["\n** No master selected--can't do it.\n"]; RETURN}; <<>> <> IF CDProperties.GetProp[master, satellitesProp]#NIL THEN FOR sl: InstanceList _ NARROW [CDProperties.GetProp[master, satellitesProp]], sl.rest WHILE sl#NIL DO UnmakeInstanceSatellite[world, sl.first]; ENDLOOP; <<>> <> FOR sl: InstanceList _ satellites, sl.rest WHILE sl#NIL DO UnmakeInstanceSatellite[world, sl.first]; MakeInstanceSatellite[comm.design, master, sl.first]; ENDLOOP; TerminalIO.WriteRope["Instance satellites set\n"]; }; SelectObjectGroupCommand: PROC [comm: CDSequencer.Command] = { world: InstanceList _ CDOps.InstList[comm.design]; numSats: INT; [] _ EnforceInvariants[comm.design, world]; numSats _ SelectObjectGroup[comm.design, world]; TerminalIO.WriteF["Object group selected: %g satellites(s) in group.\n", IO.int[numSats]]; }; AddObjectSatelliteCommand: PROC [comm: CDSequencer.Command] = { world: InstanceList _ CDOps.InstList[comm.design]; oSats: InstanceList; name: ROPE; font: CDTexts.CDFont _ CDPanelFonts.CurrentFont[comm.design]; text: CD.Instance; oSats _ EnforceInvariants[comm.design, world]; name _ TerminalIO.RequestRope["Type object satellite: "]; IF name=NIL THEN {TerminalIO.WriteRope["\n** Empty name--can't do it.\n"]; RETURN}; IF font=NIL THEN {TerminalIO.WriteRope["\n** No current font--can't do it.\n"]; RETURN}; text _ NEW [CD.InstanceRep _ [ob: CDTexts.CreateText[name, font], location: comm.pos]]; CDOps.IncludeInstance[comm.design, text]; oSats _ CONS[text, oSats]; CDProperties.PutObjectProp[comm.design.actual.first.dummyCell.ob, satellitesProp, oSats]; TerminalIO.WriteRope["Object satellite added\n"]; }; SetObjectSatellitesCommand: PROC [comm: CDSequencer.Command] = { world: InstanceList _ CDOps.InstList[comm.design]; oSats: InstanceList _ NIL; master: CD.Instance _ NIL; [] _ EnforceInvariants[comm.design, world]; <<>> <> FOR w: InstanceList _ world, w.rest WHILE w#NIL DO inst: CD.Instance _ w.first; IF inst.selected AND CDTexts.IsText[inst.ob] THEN { oSats _ CONS[inst, oSats]; UnmakeInstanceSatellite[world, inst]; } ENDLOOP; CDProperties.PutObjectProp[comm.design.actual.first.dummyCell.ob, satellitesProp, oSats]; TerminalIO.WriteRope["Object satellites set\n"]; }; MakeComment: PROC [comm: CDSequencer.Command] = { world: InstanceList _ CDOps.InstList[comm.design]; done: BOOL _ FALSE; FOR w: InstanceList _ world, w.rest WHILE w#NIL DO IF CDTexts.IsText[w.first.ob] AND w.first.selected THEN { textPtr: CDTexts.TextPtr _ NARROW [w.first.ob.specificRef]; oldFontName: ROPE _ textPtr.cdFont.supposedName; CDProperties.PutProp[w.first, commentProp, commentProp]; IF oldFontName=NIL THEN ERROR; IF ~IsItalic[oldFontName] THEN ChangeFont[comm.design, w.first, Rope.Cat[oldFontName, "I"], textPtr.cdFont.scaleI]; done _ TRUE; } ENDLOOP; TerminalIO.WriteRope[IF done THEN "Made comment\n" ELSE "No selected text\n"]; }; UnMakeComment: PROC [comm: CDSequencer.Command] = { world: InstanceList _ CDOps.InstList[comm.design]; done: BOOL _ FALSE; FOR w: InstanceList _ world, w.rest WHILE w#NIL DO IF CDTexts.IsText[w.first.ob] AND w.first.selected THEN { textPtr: CDTexts.TextPtr _ NARROW [w.first.ob.specificRef]; oldFontName: ROPE _ textPtr.cdFont.supposedName; CDProperties.PutProp[w.first, commentProp, NIL]; IF oldFontName=NIL THEN ERROR; IF IsItalic[oldFontName] THEN ChangeFont[comm.design, w.first, Rope.Substr[oldFontName, 0, Rope.Length[oldFontName]-1], textPtr.cdFont.scaleI]; done _ TRUE; } ENDLOOP; TerminalIO.WriteRope[IF done THEN "UnMade comment\n" ELSE "No selected text\n"] }; <> UnmakeInstanceSatellite: PROC [world: InstanceList, satellite: CD.Instance] = { sats: InstanceList; master: CD.Instance _ FindMaster[world, satellite]; CDProperties.PutProp[satellite, groupIdProp, NIL]; IF master=NIL OR CDProperties.GetProp[master, satellitesProp]=NIL THEN RETURN; sats _ NARROW[CDProperties.GetProp[master, satellitesProp]]; FOR sl: InstanceList _ NARROW[CDProperties.GetProp[master, satellitesProp]], sl.rest WHILE sl#NIL DO IF sl.first#satellite THEN sats _ CONS[sl.first, sats] ENDLOOP; CDProperties.PutProp[master, satellitesProp, sats] }; FilterComments: PROC [sats: InstanceList] RETURNS [result: InstanceList _ NIL] = { FOR l: InstanceList _ sats, l.rest WHILE l#NIL DO IF CDProperties.GetProp[l.first, commentProp]=NIL THEN result _ CONS [l.first, result]; ENDLOOP; }; GroupId: PROC [inst: CD.Instance] RETURNS [INT] = INLINE { IF CDProperties.GetProp[inst, groupIdProp]#NIL THEN RETURN[NARROW[CDProperties.GetProp[inst, groupIdProp], REF INT]^] ELSE RETURN[-1]; }; GroupIdFast: PROC [inst: CD.Instance] RETURNS [INT] = INLINE { RETURN[NARROW[CDProperties.GetProp[inst, groupIdProp], REF INT]^] }; EnsureSatelliteOnList: PROC [master: CD.Instance, satellite: CD.Instance] = { sats: InstanceList; IF CDProperties.GetInstanceProp[master, satellitesProp]=NIL THEN sats _ LIST[satellite] ELSE { sats _ NARROW[CDProperties.GetInstanceProp[master, satellitesProp], InstanceList]; IF ~Member[sats, satellite] THEN sats _ CONS[satellite, sats]; }; CDProperties.PutInstanceProp[master, satellitesProp, sats]; }; <> Member: PROC [insances: InstanceList, inst: CD.Instance] RETURNS [BOOL _ FALSE] = { WHILE insances#NIL DO IF insances.first=inst THEN RETURN [TRUE]; insances _ insances.rest; ENDLOOP; }; <> GroupMember: PROC [instances: InstanceList, inst: CD.Instance] RETURNS [BOOL _ FALSE] = { instGId: INT _ GroupId[inst]; WHILE instances#NIL DO IF GroupId[instances.first]=instGId THEN RETURN [TRUE]; instances _ instances.rest; ENDLOOP; }; FindMaster: PROC [world: InstanceList, satellite: CD.Instance] RETURNS [master: CD.Instance _ NIL] = { satGId: INT _ GroupId[satellite]; FOR w: InstanceList _ world, w.rest WHILE w#NIL DO IF satGId=GroupId[w.first] AND ~CDTexts.IsText[w.first.ob] THEN RETURN [w.first]; ENDLOOP; }; SingleSelected: PROC [selected: CD.Instance, multiple: BOOL] RETURNS [BOOL] = { IF selected=NIL THEN { TerminalIO.WriteRope["\n** No current selection--can't do it.\n"]; RETURN[FALSE]; }; IF multiple THEN { TerminalIO.WriteRope["\n** Multiple instances selected--can't do it.\n"]; RETURN[FALSE]; }; RETURN[TRUE]; }; <<>> <> SelectInstanceGroup: PROC [design: CD.Design, world: LIST OF CD.Instance, master: CD.Instance] RETURNS [numSats: INT] = { satellites: InstanceList; numSats _ 0; IF master=NIL THEN RETURN ELSE satellites _ GetSatellites[master, FALSE]; master.selected _ TRUE; CDOps.RedrawInstance[design, master]; FOR w: InstanceList _ world, w.rest WHILE w#NIL DO IF ~Member[satellites, w.first] THEN LOOP; w.first.selected _ TRUE; numSats _ numSats + 1; CDOps.RedrawInstance[design, w.first]; ENDLOOP; }; SelectObjectGroup: PROC [design: CD.Design, world: LIST OF CD.Instance] RETURNS [numSats: INT] = { numSats _ 0; FOR w: InstanceList _ world, w.rest WHILE w#NIL DO w.first.selected _ FALSE; CDOps.RedrawInstance[design, w.first, TRUE]; ENDLOOP; FOR w: InstanceList _ world, w.rest WHILE w#NIL DO IF ~CDTexts.IsText[w.first.ob] OR CDProperties.GetProp[w.first, groupIdProp]#NIL THEN LOOP; w.first.selected _ TRUE; numSats _ numSats + 1; CDOps.RedrawInstance[design, w.first]; ENDLOOP; }; IntervalMinDist: PROC [i1min, i1max, i2min, i2max: INT] RETURNS [INT] = INLINE { IF i1maxi2max THEN RETURN [i1min-i2max]; RETURN [0]; }; RectMinDist: PROC [rectA, rectB: CD.Rect] RETURNS [INT] = INLINE { xMinDist: INT _ IntervalMinDist[rectA.x1, rectA.x2, rectB.x1, rectB.x2]; yMinDist: INT _ IntervalMinDist[rectA.y1, rectA.y2, rectB.y1, rectB.y2]; IF xMinDist=0 THEN IF yMinDist=0 THEN RETURN [0] ELSE RETURN [yMinDist] ELSE IF yMinDist=0 THEN RETURN [xMinDist] ELSE RETURN [xMinDist+yMinDist] }; RegisterProp: PROC [prop: ATOM, copy: BOOL _ FALSE] RETURNS [sameAtom: ATOM] = { [] _ CDProperties.RegisterProperty[prop, $CDSatellites]; CDProperties.InstallProcs[prop, [makeCopy: IF copy THEN CDProperties.CopyVal ELSE CDProperties.DontCopy]]; sameAtom _ prop; }; ChangeFont: PROC [design: CD.Design, text: CD.Instance, fontName: ROPE, scale: INT] = { font: CDTexts.CDFont _ CDTexts.MakeFont[fontName, scale]; ob: CD.Object _ CDTexts.CreateText[ text: NARROW[text.ob.specificRef, CDTexts.TextPtr].text, font: font, layer: text.ob.layer]; CDOps.DelayedRedraw[design, CDInstances.InstRectO[text]]; IF ob#NIL THEN text.ob _ ob; CDOps.DelayedRedraw[design, CDInstances.InstRectO[text], FALSE]; }; IsItalic: PROC [fontName: ROPE] RETURNS [BOOL] = { RETURN [Rope.Find[fontName, "i", Rope.Length[fontName]-1, FALSE]#-1] }; <<>> <> [] _ CDMenus.CreateMenu["Satellites and Expressions Menu", $SatellitesMenu]; CDMenus.ImplementCommandToCallMenu[$SatellitesMenu, $SatellitesMenu]; CDMenus.ImplementEntryCommand[menu: $SatellitesMenu, entry: "Show Instance Satellites (I-Left)", p: SelectInstanceGroupCommand, key: $SelectInstanceGroup, queue: doQueueAndMark]; CDMenus.ImplementEntryCommand[menu: $SatellitesMenu, entry: "Add Instance Satellite (I-Middle)", p: AddInstanceSatelliteCommand, key: $AddInstanceSatellite, queue: doQueueAndMark]; CDMenus.ImplementEntryCommand[menu: $SatellitesMenu, entry: "Set Instance Satellites (I-Right)", p: SetInstanceSatellitesCommand, key: $SetInstanceSatellites, queue: doQueueAndMark]; CDMenus.ImplementEntryCommand[menu: $SatellitesMenu, entry: "Show Object Satellites (O-Left)", p: SelectObjectGroupCommand, key: $SelectObjectGroup, queue: doQueueAndMark]; CDMenus.ImplementEntryCommand[menu: $SatellitesMenu, entry: "Add Object Satellite (O-Middle)", p: AddObjectSatelliteCommand, key: $AddObjectSatellite, queue: doQueueAndMark]; CDMenus.ImplementEntryCommand[menu: $SatellitesMenu, entry: "Set Object Satellites (O-Right)", p: SetObjectSatellitesCommand, key: $SetObjectSatellites, queue: doQueueAndMark]; CDSequencer.ImplementCommand[key: $MakeComment, proc: MakeComment]; CDSequencer.ImplementCommand[key: $UnMakeComment, proc: UnMakeComment]; CDEvents.RegisterEventProc[$BeforeOutput, DoEnforceDesignInvariants]; CDEvents.RegisterEventProc[$AfterInput, DoEnforceDesignInvariants]; CDEvents.RegisterEventProc[$AfterCellReplacement, AfterCellReplacement]; CDEvents.RegisterEventProc[$InteractiveCreatedCell, AfterCellReplacement]; END.