DIRECTORY IO, Pipal, PipalInt, PipalModify, RefTab, TerminalIO; PipalModifyImpl: CEDAR PROGRAM IMPORTS IO, Pipal, PipalInt, RefTab, TerminalIO EXPORTS PipalModify = BEGIN OPEN PipalModify; Undo: PUBLIC PROC [world: World] = { event: Event = world.undoEvents.first; object: Pipal.Object = world.object; state: REF = world.state; TerminalIO.PutF["Undoing %g.\n", IO.rope[event.message]]; world.undoEvents _ world.undoEvents.rest; world.object _ event.object; world.state _ event.state; event.object _ object; event.state _ state; world.redoEvents _ CONS [event, world.redoEvents]; }; Redo: PUBLIC PROC [world: World] = { event: Event = world.redoEvents.first; object: Pipal.Object = world.object; state: REF = world.state; TerminalIO.PutF["Redoing %g.\n", IO.rope[event.message]]; world.redoEvents _ world.redoEvents.rest; world.object _ event.object; world.state _ event.state; event.object _ object; event.state _ state; world.undoEvents _ CONS [event, world.undoEvents]; }; Reset: PUBLIC PROC [world: World] = { WHILE world.undoEvents#NIL DO Undo[world] ENDLOOP; }; Commit: PUBLIC PROC [world: World] = { TerminalIO.PutF["Committing.\n"]; world.undoEvents _ NIL; world.redoEvents _ NIL; }; Do: PUBLIC PROC [world: World, message: Pipal.ROPE, newObject: Pipal.Object _ NIL, newState: REF _ NIL] = { event: Event = NEW [EventRec _ [message: message, object: world.object, state: world.state]]; TerminalIO.PutF["Doing %g.\n", IO.rope[message]]; world.undoEvents _ CONS [event, world.undoEvents]; world.object _ newObject; world.state _ newState; }; Reachable: PUBLIC PROC [root, candidate: Pipal.Object] RETURNS [BOOL] = { IsChildCandidate: PipalInt.EachChildProc = {quit _ child=candidate}; IsChildAncester: PipalInt.EachChildProc = {quit _ Reachable[child, candidate]}; RETURN [SELECT TRUE FROM root=candidate => TRUE, NOT PipalInt.HasEnumerate[root] => FALSE, PipalInt.ObjectEnumerate[root, IsChildCandidate] => TRUE, -- speed up only ENDCASE => PipalInt.ObjectEnumerate[root, IsChildAncester] ]; }; ReachableFromRoots: PUBLIC PROC [roots: Pipal.Objects, candidate: Pipal.Object] RETURNS [BOOL _ FALSE] = { WHILE roots#NIL DO IF Reachable[roots.first, candidate] THEN RETURN [TRUE]; roots _ roots.rest ENDLOOP; }; AnyReachable: PUBLIC PROC [root: Pipal.Object, table: RefTab.Ref] RETURNS [BOOL] = { EachOldNew: RefTab.EachPairAction = {quit _ Reachable[root, key]}; RETURN [RefTab.Pairs[table, EachOldNew]]; }; AnyReachableFromRoots: PUBLIC PROC [roots: Pipal.Objects, table: RefTab.Ref] RETURNS [BOOL] = { EachOldNew: RefTab.EachPairAction = {quit _ ReachableFromRoots[roots, key]}; RETURN [RefTab.Pairs[table, EachOldNew]]; }; replaceMethod: PUBLIC Pipal.Method _ Pipal.RegisterMethod["Replace"]; Replace: PUBLIC ReplaceProc = { newParent _ (NARROW [Pipal.ObjectMethod[parent, replaceMethod], REF ReplaceProc]^)[parent, table]; }; ReplaceRecursive: PROC [old: Pipal.Object, table: RefTab.Ref] RETURNS [new: Pipal.Object] = { ReplaceChildRecursive: PipalInt.EachChildProc = { newChild: Pipal.Object _ RefTab.Fetch[table, child].val; IF newChild#NIL THEN RETURN; newChild _ ReplaceRecursive[child, table]; IF newChild=child THEN RETURN; [] _ RefTab.Store[table, child, newChild]; }; new _ RefTab.Fetch[table, old].val; IF new#NIL THEN RETURN [new]; IF NOT AnyReachable[old, table] THEN RETURN [old]; [] _ PipalInt.ObjectEnumerate[old, ReplaceChildRecursive]; new _ Replace[old, table]; [] _ RefTab.Store[table, old, new]; }; TransitiveReplace: PUBLIC PROC [oldRoots: Pipal.Objects, table: RefTab.Ref] RETURNS [newRoots: Pipal.Objects] = { reversed: Pipal.Objects _ NIL; IF AnyReachableFromRoots[oldRoots, table] THEN RETURN [oldRoots]; WHILE oldRoots#NIL DO old: Pipal.Object _ oldRoots.first; new: Pipal.Object _ ReplaceRecursive[old, table]; oldRoots _ oldRoots.rest; reversed _ CONS [new, reversed]; ENDLOOP; WHILE reversed#NIL DO reversed _ reversed.rest; newRoots _ CONS [reversed.first, newRoots] ENDLOOP; }; ReplaceInWorld: PUBLIC PROC [world: World, oldChild, newChild: Pipal.Object _ NIL] = { table: RefTab.Ref _ RefTab.Create[]; newObject: Pipal.Object; [] _ RefTab.Store[table, oldChild, newChild]; newObject _ ReplaceRecursive[world.object, table]; Do[world, IO.PutFR["Replacement of %g by %g in world", IO.rope[Pipal.DescribeToRope[oldChild, 0, 1]], IO.rope[Pipal.DescribeToRope[newChild, 0, 1]]], newObject, world.state]; }; Trans: PRIVATE PROC [table: RefTab.Ref, old: Pipal.Object] RETURNS [new: Pipal.Object] = { new _ RefTab.Fetch[table, old].val; IF new=NIL THEN new _ old; }; OverlayReplace: ReplaceProc = { overlay: Pipal.Overlay _ NARROW [parent]; children: Pipal.Objects _ NIL; FOR i: NAT DECREASING IN [0 .. overlay.size) DO children _ CONS [Trans[table, overlay[i]], children]; ENDLOOP; newParent _ Pipal.CreateOverlay[children]; }; TransformReplace: ReplaceProc = { transform: PipalInt.Transform _ NARROW [parent]; newParent _ PipalInt.CreateTransform[transform.transformation, Trans[table, transform.child]]; }; TranslationReplace: ReplaceProc = { translation: PipalInt.Translation _ NARROW [parent]; newParent _ PipalInt.CreateTranslation[translation.vector, Trans[table, translation.child]]; }; OrientReplace: ReplaceProc = { orient: PipalInt.Orient _ NARROW [parent]; newParent _ PipalInt.CreateOrient[orient.orientation, Trans[table, orient.child]]; }; Pipal.PutClassMethod[Pipal.overlayClass, replaceMethod, NEW [ReplaceProc _ OverlayReplace]]; Pipal.PutClassMethod[PipalInt.transformClass, replaceMethod, NEW [ReplaceProc _ TransformReplace]]; Pipal.PutClassMethod[PipalInt.translationClass, replaceMethod, NEW [ReplaceProc _ TranslationReplace]]; Pipal.PutClassMethod[PipalInt.orientClass, replaceMethod, NEW [ReplaceProc _ OrientReplace]]; END. 8PipalModifyImpl.mesa Copyright ╙ 1988 by Xerox Corporation. All rights reserved. Bertrand Serlet January 26, 1988 2:02:36 am PST Louis Monier January 20, 1988 2:51:13 am PST Generic Operations on Worlds Transitive Closure Replacement Temporary Hack .... Replacement for Primitive Classes Initialization Э╩=ШЦ "Cedar" styleЪЬЩJЪЬ<Щ