<> <> <> <> DIRECTORY CD, CDApplications, CDCallSpecific, CDCells, CDDirectory, CDDirectoryExtras, CDMenus, CDEvents, CDBasics, CDIO, CDMarks, CDInterestRects, CDOps, CDOrient, CDProperties, CDValue, Process USING [Yield], Rope, TokenIO, TerminalIO; CDCellsImpl: CEDAR PROGRAM IMPORTS CDDirectoryExtras, CD, CDApplications, CDCallSpecific, CDInterestRects, CDIO, CDDirectory, CDEvents, CDBasics, CDMarks, CDMenus, CDOps, CDOrient, CDProperties, CDValue, Process, Rope, TokenIO, TerminalIO EXPORTS CDCells SHARES CDDirectory, CDDirectoryExtras = BEGIN -- -- -- -- -- -- -- -- -- -- -- -- pForCells: REF CD.ObjectProcs ~ CD.RegisterObjectType[$Cell]; beforeReplacement: CDEvents.EventRegistration ~ CDEvents.RegisterEventType[$BeforeCellReplacement]; afterReplacement: CDEvents.EventRegistration ~ CDEvents.RegisterEventType[$AfterCellReplacement]; pushEvent: CDEvents.EventRegistration ~ CDEvents.RegisterEventType[$AfterPush]; popEvent: CDEvents.EventRegistration ~ CDEvents.RegisterEventType[$AfterPop]; DangerousGetChangeEvent: PROC [] RETURNS [CDEvents.EventRegistration] = <> BEGIN x: REF = CDValue.Fetch[key: $CDxPrivateAfterChange]; IF x#NIL THEN TRUSTED {RETURN [LOOPHOLE[x]]} ELSE { changeEvent: CDEvents.EventRegistration ~ CDEvents.RegisterEventType[$AfterChange]; CDValue.Store[key: $CDxPrivateAfterChange, value: changeEvent]; RETURN [changeEvent] } END; changeEvent: CDEvents.EventRegistration ~ DangerousGetChangeEvent[]; fullPopMenu: REF = CDMenus.CreateMenu["Pop from cell"]; partialPopMenu: REF = CDMenus.CreateMenu["Pop from cell"]; emptyPopMenu: REF = CDMenus.CreateMenu["Pop from cell: empty cell"]; Init: PROC [] = BEGIN dp: REF CDDirectory.DirectoryProcs ~ CDDirectory.InstallDirectoryProcs[pForCells]; dp.enumerateChildObjects _ EnumerateChildObjects; dp.adjustItself _ AdjustItself; dp.repositionElements _ RepositionElementsForCell; dp.computeBounds _ ComputeBounds; dp.key _ Key; dp.name _ Name; dp.setName _ SetName; dp.another _ Another; dp.replaceDirectChilds _ ReplaceDirectChildForCells; pForCells.drawMe _ DrawMeForCells; pForCells.quickDrawMe _ QuickDrawMeForCells; pForCells.showMeSelected _ DrawCellSelection; pForCells.internalRead _ ReadCell; pForCells.internalWrite _ WriteCell; pForCells.describe _ Describe; <> CDDirectoryExtras.InstallReplaceDChildProc[pForCells, NewReplaceDirectChildForCells]; CDCallSpecific.Register[$Expand, pForCells, Expand]; CDMenus.CreateEntry[fullPopMenu, "flush", $flush]; CDMenus.CreateEntry[partialPopMenu, "flush", $flush]; CDMenus.CreateEntry[emptyPopMenu, "flush", $flush]; CDMenus.CreateEntry[fullPopMenu, "new cell", $new]; CDMenus.CreateEntry[partialPopMenu, "new cell", $new]; CDMenus.CreateEntry[fullPopMenu, "replace", $replace]; END; <> <> <> <> <> <<>> <> <> <> <> <> SetName: PROC [me: CD.ObPtr, r: Rope.ROPE] = BEGIN cptr: CD.CellPtr = NARROW[me.specificRef]; cptr.name _ r END; Name: PROC [me: CD.ObPtr] RETURNS [Rope.ROPE] = BEGIN cptr: CD.CellPtr = NARROW[me.specificRef]; RETURN [cptr.name] END; Key: PROC [me: CD.ObPtr] RETURNS [Rope.ROPE] = BEGIN cptr: CD.CellPtr = NARROW[me.specificRef]; RETURN [cptr.key] END; EnumerateChildObjects: PROC [me: CD.ObPtr, p: CDDirectory.EnumerateObjectsProc, x: REF] = BEGIN cptr: CD.CellPtr = NARROW[me.specificRef]; FOR w: CD.ApplicationList _ cptr.contents, w.rest WHILE w#NIL DO p[w.first.ob, x] ENDLOOP END; Another: PROC [me: CD.ObPtr, from, to: CD.Design] RETURNS [CD.ObPtr] = BEGIN oldCp: CD.CellPtr = NARROW[me.specificRef]; newOb: CD.ObPtr = CreateEmptyCell[]; newCp: CD.CellPtr = NARROW[newOb.specificRef]; newOb.size _ me.size; newCp.name _ oldCp.name; newCp.key _ oldCp.key; newCp.simplifyOn _ oldCp.simplifyOn; newCp.contents _ CDApplications.CopyList[oldCp.contents]; newOb.properties _ CDProperties.CopyProps[me.properties]; [] _ CDDirectory.Include[to, newOb]; RETURN [newOb] END; DrawMeForCells: PROC [aptr: CD.ApplicationPtr, pos: CD.DesignPosition, orient: CD.Orientation, pr: CD.DrawRef] = BEGIN ENABLE UNWIND => IF pr.nesting.first=aptr THEN pr.nesting _ pr.nesting.rest; cptr: CD.CellPtr ~ NARROW[aptr.ob.specificRef]; r: CD.DesignRect; pr.nesting _ CONS[aptr, pr.nesting]; FOR w: CD.ApplicationList _ cptr.contents, w.rest WHILE w#NIL DO r _ CDOrient.MapRect[ itemInCell: CDOrient.RectAt[w.first.location, w.first.ob.size, w.first.orientation], cellSize: aptr.ob.size, cellInstOrient: orient, cellInstPos: pos]; IF CDBasics.Intersect[r, pr.worldClip] THEN { IF pr.stopFlag^ THEN EXIT; pr.drawChild[ w.first, CDBasics.BaseOfRect[r], CDOrient.ComposeOrient[w.first.orientation, orient], pr]; } ENDLOOP; Process.Yield[]; IF pr.nesting.first=aptr THEN pr.nesting _ pr.nesting.rest END; QuickDrawMeForCells: PROC [aptr: CD.ApplicationPtr, pos: CD.DesignPosition, orient: CD.Orientation, pr: CD.DrawRef] = BEGIN ENABLE UNWIND => IF pr.nesting.first=aptr THEN pr.nesting _ pr.nesting.rest; cptr: CD.CellPtr ~ NARROW[aptr.ob.specificRef]; r: REAL; IF (r _ pr.scaleHint*aptr.ob.size.y)0 THEN { pr.outLineProc[CDOrient.RectAt[pos, aptr.ob.size, orient], pr]; IF r>9 THEN pr.drawComment[CDOrient.RectAt[pos, aptr.ob.size, orient], cptr.name, pr]; } ELSE { r: CD.DesignRect; pr.nesting _ CONS[aptr, pr.nesting]; FOR w: CD.ApplicationList _ cptr.contents, w.rest WHILE w#NIL DO r _ CDOrient.MapRect[ itemInCell: CDOrient.RectAt[w.first.location, w.first.ob.size, w.first.orientation], cellSize: aptr.ob.size, cellInstOrient: orient, cellInstPos: pos]; IF CDBasics.Intersect[r, pr.worldClip] THEN { IF pr.stopFlag^ THEN EXIT; w.first.ob.p.quickDrawMe[ w.first, CDBasics.BaseOfRect[r], CDOrient.ComposeOrient[w.first.orientation, orient], pr]; } ENDLOOP; Process.Yield[]; IF pr.nesting.first=aptr THEN pr.nesting _ pr.nesting.rest } END; DrawCellSelection: PROC [aptr: CD.ApplicationPtr, pos: CD.DesignPosition, orient: CD.Orientation, pr: CD.DrawRef] = BEGIN IF (pr.scaleHint*aptr.ob.size.y)0 THEN pr.drawRect[CDOrient.RectAt[pos, aptr.ob.size, orient], CD.highLightShade, pr] ELSE { pr.outLineProc[ CDOrient.MapRect[ itemInCell: CDInterestRects.GetInterestRect[aptr.ob].r, cellSize: aptr.ob.size, cellInstOrient: orient, cellInstPos: pos ], pr ] } END; RemoveSelectedFromWorld: PROC [design: CD.Design] RETURNS [CD.ApplicationList] = <<-- removes the selected applications from design and returns them>> BEGIN remove, keep: CD.ApplicationList _ NIL; [others: keep, selected: remove] _ CDApplications.SplitSelected[CDOps.AppList[design]]; CDOps.SetAppList[design, keep]; RETURN [remove] END; CreateEmptyCell: PUBLIC PROC [] RETURNS [CD.ObPtr] = <<-- does not includes the cell into any design or celldirectory>> <<-- does not name the cell>> BEGIN ob: CD.ObPtr ~ NEW[CD.ObjectDefinition]; cp: CD.CellPtr ~ NEW[CD.CellRecord]; ob.p _ pForCells; ob.size _ [0, 0]; ob.specificRef _ cp; cp.simplifyOn _ 50; RETURN [ob] END; CreateCellObject: PROC [use: CD.ApplicationList, orient: CD.Orientation_CDOrient.original] RETURNS [CD.ObPtr] = <<-- not yet included in design>> BEGIN ob: CD.ObPtr ~ CreateEmptyCell[]; cp: CD.CellPtr ~ NARROW[ob.specificRef]; gOutR: CD.DesignRect ~ CDApplications.BoundingRect[use]; -- coordsys of use, non oriented <<-- gInR: CD.DesignRect ~ BoundingRectI[use]; XXX>> ob.size _ CDOrient.OrientedSize[CDBasics.SizeOfRect[gOutR], orient]; cp.name _ NIL; cp.contents _ CDApplications.DeComposedCopy[use, CDBasics.BaseOfRect[gOutR], ob.size, orient]; RETURN [ob] END; IncludeAndNameCell: PROC [design: CD.Design, cp: CD.ObPtr, interactive: BOOL_TRUE, allowAbort: BOOL_FALSE] RETURNS [done: BOOL_FALSE] = BEGIN aborted: BOOL _ FALSE; name: Rope.ROPE; cptr: CD.CellPtr ~ NARROW[cp.specificRef]; IF ~interactive THEN [] _ CDDirectory.Include[design, cp] ELSE DO ENABLE TerminalIO.UserAbort => {aborted _ TRUE; CONTINUE}; IF aborted THEN { TerminalIO.WriteRope[" **name input aborted\n"]; IF allowAbort THEN RETURN; name _ "-no name"; } ELSE name _ TerminalIO.RequestRope["enter name for cell: "]; IF CDDirectory.Include[design: design, object: cp, alternateName: name, fiddleName: aborted OR Rope.IsEmpty[name]] THEN { TerminalIO.WriteRope["Cell "]; TerminalIO.WriteRope[cptr.name]; TerminalIO.WriteRope[" included\n"]; done _ TRUE; RETURN; }; TerminalIO.WriteRope["Cell "]; TerminalIO.WriteRope[cptr.name]; TerminalIO.WriteRope[" does already exist\n"]; TerminalIO.WriteRope["name not accepted, please repeat\n"]; aborted _ FALSE; ENDLOOP; END; CreateCellSelected: PUBLIC PROC [design: CD.Design, name: Rope.ROPE_NIL] RETURNS [done: BOOL_FALSE, cellOb: CD.ObPtr_NIL] = <<-- if name is NIL: interactive read for name>> <<-- cell is included in directory>> BEGIN sel: CD.ApplicationList ~ RemoveSelectedFromWorld[design]; app: CD.ApplicationPtr ~ NEW[CD.Application]; b: CD.DesignRect ~ CDApplications.BoundingRect[sel]; cptr: CD.CellPtr; app.ob _ cellOb _ CreateCellObject[use: sel]; cptr _ NARROW[cellOb.specificRef]; cptr.name _ name; app.location _ CDBasics.BaseOfRect[b]; app.selected _ TRUE; IF NOT CDBasics.NonEmpty[b] THEN { TerminalIO.WriteRope["no empty cell\n"]; RETURN [done: FALSE, cellOb: NIL] }; IF name=NIL THEN { IF ~IncludeAndNameCell[design: design, cp: cellOb, allowAbort: TRUE, interactive: TRUE].done THEN { <<--undo the command>> CDOps.IncludeApplicationList[design, sel, FALSE]; RETURN [done: FALSE, cellOb: NIL] }; } ELSE [] _ CDDirectory.Include[design, cellOb]; CDOps.IncludeApplication[design, app, TRUE]; -- redraw removes seletion RETURN [done: TRUE, cellOb: cellOb] END; IsCell: PROC [aptr: CD.ApplicationPtr] RETURNS [yes: BOOL _ FALSE] = <<--verbose if aptr is not a cell>> BEGIN IF aptr=NIL THEN TerminalIO.WriteRope[" no object\n"] ELSE IF aptr.ob=NIL OR aptr.ob.specificRef=NIL THEN TerminalIO.WriteRope[" bad object\n"] ELSE IF NOT ISTYPE[aptr.ob.specificRef, CD.CellPtr] THEN { TerminalIO.WriteRope[" object is not cell but "]; TerminalIO.WriteRope[CDOps.Info[aptr.ob]]; TerminalIO.WriteLn[]; } ELSE yes _ TRUE END; PushInCellSelected: PUBLIC PROC [design: CD.Design] RETURNS [done: BOOL _ FALSE] = BEGIN first: CD.ApplicationPtr; multiple: BOOL; [first, multiple] _ CDOps.SelectedApplication[design]; IF multiple THEN TerminalIO.WriteRope[" multiple selected object\n"] ELSE done _ DoPushInCell[design, first]; END; PushInCellPointed: PUBLIC PROC [design: CD.Design, pos: CD.DesignPosition] RETURNS [done: BOOL _ FALSE] = BEGIN done _ DoPushInCell[design, CDOps.PointedApplication[design, pos]] END; DoPushInCell: PROC [design: CD.Design, originalApp: CD.ApplicationPtr] RETURNS [done: BOOL_FALSE] = BEGIN IF IsCell[originalApp] THEN { cptr: CD.CellPtr ~ NARROW[originalApp.ob.specificRef]; dummy: CD.ObPtr ~ CreateEmptyCell[]; newCptr: CD.CellPtr ~ NARROW[dummy.specificRef]; dummyCellAp: CD.ApplicationPtr; dummy.size _ CDBasics.highposition; FOR l: LIST OF CD.PushRec _ design.actual, l.rest WHILE l#NIL DO IF l.first.mightReplace#NIL AND l.first.mightReplace.ob=originalApp.ob THEN { TerminalIO.WriteRope[" push not possible; [already pushed in "]; TerminalIO.WriteRope[CDOps.Info[l.first.mightReplace.ob]]; TerminalIO.WriteRope["]\n"]; RETURN [FALSE] } ENDLOOP; newCptr.name _ cptr.name; newCptr.contents _ CDApplications.ComposedCopy[ al: cptr.contents, cellPos: originalApp.location, cellSize: originalApp.ob.size, cellOrient: originalApp.orientation ]; dummyCellAp _ CDApplications.NewApplicationI[ ob: dummy, properties: CDProperties.CopyProps[originalApp.properties] ]; dummy.properties _ CDProperties.CopyProps[originalApp.ob.properties]; CDOps.RemoveApplication[design, originalApp]; design^.actual _ CONS[ CD.PushRec[dummyCell: dummyCellAp, specific: newCptr, mightReplace: originalApp], design^.actual]; [] _ CDEvents.ProcessEvent[pushEvent, design]; RETURN [TRUE]; } END; PopFromCell: PUBLIC PROC [design: CD.Design, m: CDCells.Method_interactive, name: Rope.ROPE_NIL] RETURNS [done: BOOL] = BEGIN done _ IPopFromCell[design, m, name]; IF done THEN [] _ CDEvents.ProcessEvent[popEvent, design]; END; IPopFromCell: PROC [design: CD.Design, m: CDCells.Method, name: Rope.ROPE] RETURNS [done: BOOL_FALSE] = BEGIN currentRect, pushedRect: CD.DesignRect; currentAptr, pushedAptr: CD.ApplicationPtr; currentCellOb: CD.ObPtr; currentCellPtr, pushedCellPtr: CD.CellPtr; DoFlush: PROC [] = BEGIN b: BOOL _ design^.actual.first.indirectlyChanged; TerminalIO.WriteRope["flush\n"]; design^.actual _ design^.actual.rest; design^.actual.first.indirectlyChanged _ TRUE; IF b THEN design^.actual.first.indirectlyChanged _ TRUE; CDOps.IncludeApplication[design, pushedAptr, FALSE]; END; BasePointRect: PROC [r: CD.Rect] RETURNS [CD.Rect] = INLINE { RETURN [[x1: r.x1, y1: r.y1, x2: r.x1, y2: r.y1]] }; DoReplace: PROC [] = BEGIN [] _ CDEvents.ProcessEvent[beforeReplacement, design, pushedAptr.ob]; TerminalIO.WriteRope["replace\n"]; <<--HACK for CDDirectory XXX>> CDProperties.PutPropOnObject[onto: currentCellOb, prop: $Owner, val: design]; design^.actual _ design^.actual.rest; design^.actual.first.indirectlyChanged _ TRUE; <> pushedCellPtr.contents _ currentCellPtr.contents; IF pushedRect#currentRect THEN { -- both in design coordinates oldSize: CD.DesignPosition _ pushedAptr.ob.size; newFakeOrigin: CD.DesignRect; --absolute coordinates newInOldCoordinates: CD.DesignRect; --coordinates of old cell pushedAptr.ob.size _ CDOrient.OrientedSize[CDBasics.SizeOfRect[currentRect], pushedAptr.orientation]; newFakeOrigin _ CDOrient.MapRect[ itemInCell: [0, 0, 0, 0], cellSize: pushedAptr.ob.size, cellInstOrient: pushedAptr.orientation, cellInstPos: currentAptr.location ].itemInWorld; newInOldCoordinates _ CDOrient.DeMapRect[ itemInWorld: newFakeOrigin, cellSize: oldSize, cellInstOrient: pushedAptr.orientation, cellInstPos: pushedAptr.location ].itemInCell; CDDirectoryExtras.RepositionObject[design: design, ob: pushedAptr.ob, oldSize: oldSize, baseOff: CDBasics.BaseOfRect[newInOldCoordinates] ]; }; pushedAptr.location _ currentAptr.location; CDOps.IncludeApplication[design, pushedAptr, FALSE]; [] _ CDEvents.ProcessEvent[afterReplacement, design, pushedAptr.ob]; END; DoNewCell: PROC [interactive: BOOL_FALSE] = BEGIN interestRect: CD.DesignRect; useInnerrect: BOOL; TerminalIO.WriteRope["new cell\n"]; [interestRect, useInnerrect] _ CDInterestRects.GetInterestRect[pushedAptr.ob]; currentAptr.ob _ currentCellOb; design^.actual _ design^.actual.rest; design^.actual.first.indirectlyChanged _ TRUE; design^.actual.first.changed _ TRUE; IF ~IncludeAndNameCell[design, currentCellOb, interactive, FALSE].done THEN ERROR; IF ~useInnerrect THEN { gIntRect: CD.DesignRect = CDOrient.MapRect[ itemInCell: interestRect, cellSize: pushedAptr.ob.size, cellInstOrient: pushedAptr.orientation, cellInstPos: pushedAptr.location ]; interestRect _ CDOrient.DeMapRect[ itemInWorld: gIntRect, cellSize: currentAptr.ob.size, cellInstOrient: currentAptr.orientation, cellInstPos: currentAptr.location ]; CDInterestRects.SetInterestRect[currentCellOb, interestRect] }; CDOps.IncludeApplication[design, currentAptr, FALSE]; END; menu: REF _ fullPopMenu; IF design^.actual.rest=NIL THEN {TerminalIO.WriteRope["not in cell\n"]; RETURN [FALSE]}; pushedAptr _ design^.actual.first.mightReplace; pushedCellPtr _ NARROW[pushedAptr.ob.specificRef]; pushedRect _ CDOrient.RectAt[pushedAptr.location, pushedAptr.ob.size, pushedAptr.orientation]; -- design cordinates TerminalIO.WriteRope["Pop from cell "]; TerminalIO.WriteRope[pushedCellPtr.name]; TerminalIO.WriteLn[]; CDApplications.DeSelectList[CDOps.AppList[design]]; currentRect _ CDApplications.BoundingRect[CDOps.AppList[design]]; -- design coordinates currentCellOb _ CreateCellObject[use: CDOps.AppList[design], orient: pushedAptr.orientation]; currentCellPtr _ NARROW[currentCellOb.specificRef]; currentAptr _ CDApplications.NewApplicationI[ob: currentCellOb, location: CDBasics.BaseOfRect[currentRect], orientation: pushedAptr.orientation, properties: CDProperties.CopyProps[pushedAptr.properties] ]; currentCellOb.properties _ CDProperties.CopyProps[pushedAptr.ob.properties]; <> <> <> <<[interestRect, useInnerrect] _ CDInterestRects.GetInterestRect[pushedAptr.ob];>> <> <> <> <> <> <> <<];>> <> <> <> <> <> <<];>> <> <<};>> <> IF m=flush OR (m=interactive AND ~design^.actual.first.changed) THEN { DoFlush[]; RETURN [TRUE] }; IF CDBasics.NonEmpty[currentRect] THEN { mark: CDMarks.MarkRange; IF m=newcell THEN {DoNewCell[interactive: FALSE]; RETURN [TRUE]}; mark _ CDMarks.GetNewMark[design! CD.Error => GOTO markProblem]; CDMarks.MarkUnMarkedInclusiveChildren[design, currentCellOb, mark]; IF pushedAptr.ob.marked=mark THEN { -- recursive TerminalIO.WriteRope[" Original cell used inside, replace not possible\n"]; IF m=replace THEN RETURN[FALSE]; menu _ partialPopMenu; } ELSE { --ok, normal case IF m=replace THEN {DoReplace[]; RETURN [TRUE]}; } } ELSE { -- empty TerminalIO.WriteRope[" create empty cell not possible\n"]; IF m#interactive THEN {DoFlush[]; RETURN [TRUE]}; menu _ emptyPopMenu; }; SELECT CDMenus.CallMenu[menu] FROM $flush => DoFlush[]; $replace => DoReplace[]; $new => DoNewCell[interactive: TRUE]; ENDCASE => {TerminalIO.WriteRope["skipped\n"]; RETURN [FALSE]}; RETURN [TRUE]; EXITS markProblem => TerminalIO.WriteRope["internal problem; not done\n"]; END; <<-- -- -- -- -- -- -- -- -- -- -- -->> Expand: CDCallSpecific.CallProc = BEGIN cptr: CD.CellPtr ~ NARROW[aptr.ob.specificRef]; removeMe _ TRUE; repaintMe _ TRUE; include _ CDApplications.ComposedCopy[ cptr.contents, aptr.location, aptr.ob.size, aptr.orientation]; repaintInclude _ TRUE; END; <<-- -- -- -- -- -- -- -- -- -- -- -->> ComputeBounds: PROC [ob: CD.ObPtr] RETURNS [CD.DesignRect] = <<--returns bounds in coordinate system of ob itself>> BEGIN WITH ob.specificRef SELECT FROM cptr: CD.CellPtr => RETURN [CDApplications.BoundingRect[cptr.contents]]; ENDCASE => ERROR; END; <> <> <> <> <> <> <> <> <> <<>> <> <<--returns bounds in coordinate system of ob itself>> <> <> < RETURN [BoundingRectI[cptr.contents]]; >> < ERROR;>> <> AdjustItself: PROC [objToReposition: CD.ObPtr, newBound: CD.DesignRect] = <<--newBound is expected to be in coordinate system of objToReposition itself>> BEGIN objToReposition.size _ CDBasics.SizeOfRect[newBound]; WITH objToReposition.specificRef SELECT FROM cptr: CD.CellPtr => CDApplications.TranslateList[cptr.contents, CDBasics.NegOffset[CDBasics.BaseOfRect[newBound]]]; ENDCASE => ERROR; ERROR END; RepositionElementsForCell: PROC [me: CD.ObPtr, objToReposition: CD.ObPtr, oldSize: CD.DesignPosition, -- of objToReposition newBound: CD.DesignRect, -- of objToReposition design: CD.Design] = BEGIN RepositionApplication: PROC [aptr: CD.ApplicationPtr] = --INLINE-- <<-- repositions an application if it calls objToReposition>> <<-- oldSize: size of the original objToReposition >> <<-- objToReposition object needing reposition>> <<-- newBound: bound of new objToReposition in coords of old objToReposition>> BEGIN changeMade _ TRUE; <<--XXX--TerminalIO.WriteRope["changeMade _ TRUE\n"];>> aptr.location _ CDOrient.MapPosition[ itemInCell: newBound, cellSize: oldSize, cellInstOrient: aptr.orientation, cellInstPos: aptr.location ]; END; changeMade: BOOL _ FALSE; cptr: CD.CellPtr = NARROW[me.specificRef]; <<--XXX--TerminalIO.WriteRope["enter RepositionElementsForCell "];>> <<--XXX--TerminalIO.WriteRope[CDDirectory.Name[me]];>> <<--XXX--TerminalIO.WriteRope["\n"];>> FOR w: CD.ApplicationList _ cptr.contents, w.rest WHILE w#NIL DO IF w.first.ob=objToReposition THEN RepositionApplication[w.first]; ENDLOOP; IF changeMade THEN IF CDBasics.RectAt[[0, 0], me.size]#CDApplications.BoundingRect[cptr.contents] THEN CDDirectory.RepositionAnObject[design, me]; <<--XXX--TerminalIO.WriteRope["leave RepositionElementsForCell\n"];>> ERROR END; -- -- -- -- -- -- -- -- -- -- -- -- ReadCell: CD.InternalReadProc --PROC [] RETURNS [ObPtr]-- = BEGIN ob: CD.ObPtr ~ CreateEmptyCell[]; specific: CD.CellPtr ~ NARROW[ob.specificRef]; ob.size.x _ TokenIO.ReadInt[]; ob.size.y _ TokenIO.ReadInt[]; IF CDIO.VersionKey[]<1 THEN { specific.name _ TokenIO.ReadRope[]; } ELSE { specific.simplifyOn _ TokenIO.ReadInt[]; }; specific.contents _ CDIO.ReadApplicationList[]; RETURN [ob]; END; WriteCell: CD.InternalWriteProc -- PROC [me: ObPtr] -- = BEGIN specific: CD.CellPtr ~ NARROW[me.specificRef]; TokenIO.WriteInt[me.size.x]; TokenIO.WriteInt[me.size.y]; TokenIO.WriteInt[specific.simplifyOn]; CDIO.WriteApplicationList[specific.contents]; END; Describe: PROC[me: CD.ObPtr] RETURNS [Rope.ROPE] = BEGIN specific: CD.CellPtr = NARROW[me.specificRef]; RETURN [Rope.Concat["cell ", specific.name]] END; ReplaceDirectChildForCells: CDDirectory.ReplaceDirectChildProc = BEGIN <> <> <> <> <> <> <> <> <> <> <> <<]; >> <> <> <> <> <> <<];>> <> <> <> <<];>> <<};>> <> <> <<};>> <> <<-- XXX change interface to list of replace records>> <<-- that makes a nested loop before this comment, but the if >> <<-- statement after this comment is executed only once; this stops recursion!!>> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <<]>> <<}>> <<};>> ERROR END; NewReplaceDirectChildForCells: CDDirectoryExtras.ReplaceDChildsProc = <<-- PROC[me: CD.ObPtr, design: CD.Design, replace: LIST OF REF ReplaceRec] -->> BEGIN needReposition: BOOL = CDDirectoryExtras.ReplaceDirectChildForDummyCells[me, replace]; IF needReposition THEN changed _ CDDirectoryExtras.RepositionCell[me, design]; END; <<>> -- -- -- -- -- -- -- -- -- -- -- -- RemoveApplication: PUBLIC PROC [design: CD.Design, cell: CD.ObPtr, aptr: CD.ApplicationPtr, draw: BOOL_TRUE] RETURNS [removed: CD.ApplicationPtr_NIL, repositioned: BOOL_FALSE] = <<--If necessary, modifies the boundary and translates all applications of the cell,>> <<-- and further, translates all the instances of the cell. This changes the>> <<-- parent cells, which therefore may be repositioned recursively too. >> <<--noop if cell does not contain aptr (directly).>> <<--Do not assume aptr^ to be freed for other use but use removed; >> <<-- removed=NIL: aptr has not successfully been removed>> <<-- removed#NIL: aptr is removed, removed is a copy of aptr for arbitrary re-use. >> BEGIN cp: CD.CellPtr = NARROW[cell.specificRef]; IF aptr=NIL THEN RETURN; IF cp.contents#NIL THEN { IF cp.contents.first=aptr THEN { removed _ cp.contents.first; cp.contents _ cp.contents.rest } ELSE FOR list: CD.ApplicationList _ cp.contents, list.rest WHILE list.rest#NIL DO IF list.rest.first=aptr THEN { removed _ list.rest.first; list.rest _ list.rest.rest; EXIT } ENDLOOP; }; IF aptr.ob=NIL THEN RETURN [NIL]; IF draw AND design#NIL THEN CDOps.DelayedRedraw[design: design, eraseFirst: TRUE]; repositioned _ CDDirectoryExtras.RepositionCell[cell, design]; [] _ CDEvents.ProcessEvent[changeEvent, design, cell]; END; IncludeApplication: PUBLIC PROC [design: CD.Design, cell: CD.ObPtr, aptr: CD.ApplicationPtr, draw: BOOL_TRUE, relativeTo: CD.ApplicationPtr_NIL] RETURNS [repositioned: BOOL_FALSE] = <<--aptr^ is supposed to be referenced by aptr exclusively, and aptr^ may be changed by>> <<-- IncludeApplication.>> <<--If necessary, modifies the boundary and translates all applications of the cell,>> <<-- and further, translates all the instances of the cell. This changes the>> <<-- parent cells, which therefore may be repositioned recursively too. >> <<--relativeTo#NIL: handy but trivial hook for clients which fear that repositioning >> <<-- fools their origin: aptr is first translated by relativeTo.location: if relativeTo >> <<-- points to an application of the cell itself, repositioning changes relativeTo^ >> <<-- exactly the right amount to compensate for the repositioning. It is the clients >> <<-- responsibility that relativeTo is actual contained by cell.>> BEGIN cp: CD.CellPtr = NARROW[cell.specificRef]; IF aptr=NIL OR aptr.ob=NIL OR aptr=relativeTo THEN ERROR; <<--check first if application is already contained by cell>> FOR list: CD.ApplicationList _ cp.contents, list.rest WHILE list#NIL DO IF list.first=aptr THEN RETURN ENDLOOP; IF relativeTo#NIL THEN aptr.location _ CDBasics.AddPoints[relativeTo.location, aptr.location]; cp.contents _ CONS[aptr, cp.contents]; IF draw AND design#NIL THEN CDOps.DelayedRedraw[design: design, eraseFirst: FALSE]; repositioned _ CDDirectoryExtras.RepositionCell[cell, design]; [] _ CDEvents.ProcessEvent[changeEvent, design, cell] END; -- -- -- -- -- -- -- -- -- -- -- -- Init[]; END.