PipalModifyImpl.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
DIRECTORY IO, Pipal, PipalInt, PipalModify, RefTab, TerminalIO;
PipalModifyImpl: CEDAR PROGRAM
IMPORTS IO, Pipal, PipalInt, RefTab, TerminalIO
EXPORTS PipalModify =
BEGIN OPEN PipalModify;
Generic Operations on Worlds
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;
};
Transitive Closure
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]];
};
Replacement
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;
};
Temporary Hack ....
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];
};
Replacement for Primitive Classes
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]];
};
Initialization
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.