
<<CDDynamicObsImpl.mesa   (part of ChipNDale)>>
<<Copyright © 1984, 1985 by Xerox Copporation.  All rights reserved.>>
<<by Christian Jacobi,  November 9, 1984 2:30:07 pm PST >>
<<last edited Christian Jacobi,  July 10, 1985 11:36:54 am PDT>>

DIRECTORY
CD,
CDBasics,
CDCallSpecific, 
CDDirectory,
CDDirectoryOps,
CDDynamicObs,
CDEvents,
CDGenerate,
CDGenerateBackdoor,
CDImports,
CDInstances,
CDIO,
CDOps,
CDOrient,
CDRects,
CDValue,
RefTab,
Rope,
RuntimeError USING [UNCAUGHT],
SymTab,
TerminalIO,
TokenIO;

CDDynamicObsImpl: CEDAR MONITOR    
IMPORTS CD, CDBasics, CDDirectory, CDDirectoryOps, CDGenerate, CDGenerateBackdoor, CDImports, CDInstances, CDIO, CDOps, CDOrient, 
CDRects, RefTab, Rope, RuntimeError, SymTab,  TerminalIO, TokenIO
EXPORTS  CDDynamicObs
SHARES CDDirectory =
BEGIN

DynamicPtr: TYPE = REF DynamicRep;
DynamicRep: TYPE = RECORD [
pseudoApp: CD.Instance _ NIL,  
ir: CD.Rect _ [0, 0, -1, -1],
used: RefTab.Ref _ NIL,
project: Rope.ROPE _ NIL,
passTable: CDGenerate.Table_NIL,
genTable: CDGenerate.Table_NIL,
generatorKey: Rope.ROPE _ NIL
];

key: ATOM = $CDDynamicObs;
class: REF CD.ObjectClass = CD.RegisterObjectClass[key]; 

EnumerateItsObjects: PROC [me: CD.Object, p: CDDirectory.EnumerateObjectsProc, x: REF] = 
BEGIN
pp: DynamicPtr = NARROW[me.specificRef];
IF pp.pseudoApp#NIL THEN p[pp.pseudoApp.ob, x];
END;

IncludeChild: PROC [me: CD.Object, x: REF] =
<<--me: child to be included>>
<<--x: RefTab.Ref>>
BEGIN
IF me.class.inDirectory THEN {--otherwise it will not change
used: RefTab.Ref = NARROW[x];
newChild: BOOL _ RefTab.Insert[used, me, me];
IF newChild 
AND ~ISTYPE[me.specificRef, DynamicPtr] --it will propagate changes of it's children
AND ~CDImports.IsImport[me] THEN  --it will not change...
CDDirectory.EnumerateChildObjects[me, IncludeChild, x]
}
END;

BuildChildrenList: PROC [me: CD.Object] = 
BEGIN
pp: DynamicPtr = NARROW[me.specificRef];
pp.used  _ NIL;
IF pp.pseudoApp#NIL THEN {
pp.used  _ RefTab.Create[];
IncludeChild[pp.pseudoApp.ob, pp.used];
};
END;

ReplaceDirectChilds: CDDirectory.ReplaceDChildsProc =
<<--we can't do it but we recompute if old appears>>
BEGIN
pp: DynamicPtr = NARROW[me.specificRef];
IF pp.pseudoApp#NIL THEN {
FOR rl: CDDirectory.ReplaceList _ replace, rl.rest WHILE rl#NIL DO
IF pp.pseudoApp.ob=rl.first.old 
OR (pp.used#NIL AND RefTab.Fetch[pp.used, rl.first.old].found) THEN {
[] _ BuildUp[me, design];
RETURN
}
ENDLOOP
};
END;

Create: PUBLIC PROC [design: CD.Design, project, key: Rope.ROPE] RETURNS [ob: CD.Object] =
BEGIN
table: CDGenerate.Table _ MakeAnIndirector[project].useTable;
ob _ CDGenerate.FetchNCall[table, design, key];
END;

InternalCreate: PROC [design: CD.Design, 
size: CD.Position _ [1, 1],
project: Rope.ROPE _ NIL,
generatorKey: Rope.ROPE _ NIL,
catch: BOOL_TRUE,
include: BOOL_TRUE] RETURNS [CD.Object] =
BEGIN
ob: CD.Object;
pp: DynamicPtr;
size _ CDBasics.MaxPoint[size, [1, 1]];
pp _ NEW[DynamicRep _ [
project: project, 
generatorKey: generatorKey, 
ir: CDBasics.RectAt[[0, 0], size] 
]]; 
ob _ NEW[CD.ObjectRep _ [
size: size,
class: class,
layer: CD.combined,
specificRef: pp
]];
IF include THEN [] _ CDDirectory.Include[design: design, object: ob];
[] _ BuildUp[ob, design]; -- no repositioning needs be done
RETURN [ob]
END;

Describe: PROC[me: CD.Object] RETURNS [Rope.ROPE] = 
BEGIN
pp: DynamicPtr = NARROW[me.specificRef];
RETURN [Rope.Cat["generated object  [", Rope.Cat[pp.project, ".", pp.generatorKey], "] ", CDDirectory.Name[me]]]
END;

DrawMe: PROC [inst: CD.Instance, pos: CD.Position, orient: CD.Orientation,
pr: CD.DrawRef] =
BEGIN
pp: DynamicPtr = NARROW[inst.ob.specificRef];
IF pp.pseudoApp#NIL THEN 
pr.drawChild[pp.pseudoApp, pos, orient, pr]
ELSE {
pr.drawRect[CDOrient.RectAt[pos, inst.ob.size, orient], CD.highLightShade, pr];
pr.drawComment[CDOrient.RectAt[pos, inst.ob.size, orient], 
CDDirectory.Name[inst.ob], 
pr
]
}
END; 

QuickDrawMe: PROC [inst: CD.Instance, pos: CD.Position, orient: CD.Orientation,
pr: CD.DrawRef] =
BEGIN
pp: DynamicPtr = NARROW[inst.ob.specificRef];
IF pp.pseudoApp#NIL THEN 
pp.pseudoApp.ob.class.quickDrawMe[pp.pseudoApp, pos, orient, pr]
ELSE {
pr.drawRect[CDOrient.RectAt[pos, inst.ob.size, orient], CD.highLightShade, pr];
pr.drawComment[CDOrient.RectAt[pos, inst.ob.size, orient], 
CDDirectory.Name[inst.ob], 
pr
]
}
END; 

    WriteMe: CD.InternalWriteProc -- PROC [me: Object] -- =
    BEGIN
    pp: DynamicPtr = NARROW[me.specificRef];
    TokenIO.WriteInt[me.size.x];
    TokenIO.WriteInt[me.size.y];
    TokenIO.WriteRope[pp.project];
    TokenIO.WriteRope[pp.generatorKey];
    END;

ReadMe: CD.InternalReadProc --PROC [] RETURNS [Object]-- =
BEGIN
ob: CD.Object;
size: CD.Position;
generatorKey, project: Rope.ROPE;
table: CDGenerate.Table;
size.x _ MAX[1, TokenIO.ReadInt[]];
size.y _ MAX[1, TokenIO.ReadInt[]];
project _ TokenIO.ReadRope[];
generatorKey _ TokenIO.ReadRope[];
table _ MakeAnIndirector[project].useTable;
ob _ CDGenerate.FetchNCall[table, CDIO.DesignInReadOperation[], generatorKey];
IF ob#NIL AND ob.size=size THEN {
<<--hack: read routine is supposed to return object not already in design and re-include it...>>
[] _ CDDirectory.Remove[CDIO.DesignInReadOperation[], CDDirectory.Name[ob], ob];
RETURN [ob];
};
TerminalIO.WriteRope["**generated object not created\n"];
ob _ CDRects.CreateRect[size, CD.highLightError];
RETURN [ob]
END;

Expand: PROC [me: CD.Object, from, to: CD.Design] RETURNS [ob: CD.Object_NIL] =
BEGIN
pp: DynamicPtr = NARROW[me.specificRef];
IF pp.pseudoApp#NIL THEN
RETURN [CDDirectory.Another[pp.pseudoApp.ob, from, to]]
END;

Another: PROC [me: CD.Object, from, to: CD.Design] RETURNS [CD.Object] =
BEGIN
pp: DynamicPtr = NARROW[me.specificRef];
newOb: CD.Object _ InternalCreate[design: to,
size: me.size,
generatorKey: pp.generatorKey,
project: pp.project,
catch: TRUE,
include: TRUE
];
RETURN [newOb]
END;

myTables: RefTab.Ref _ RefTab.Create[];
Finder: TYPE = RECORD[realProject, autoProject: Rope.ROPE, useTable: CDGenerate.Table];

GetTable: PUBLIC PROC [for: Rope.ROPE] RETURNS [name: Rope.ROPE, table: CDGenerate.Table] =
BEGIN
[useTable: table, autoProject: name] _ MakeAnIndirector[for];
END;

MakeAnIndirector: PROC [to: Rope.ROPE] RETURNS [useTable, normalTable: CDGenerate.Table, autoProject: Rope.ROPE] =
TRUSTED BEGIN
normalTable _ CDGenerate.AssertTable[to];
WITH myTables.Fetch[LOOPHOLE[normalTable]].val SELECT FROM
find: REF Finder => {
useTable _ find.useTable;
autoProject _ find.autoProject;
}
ENDCASE => TRUSTED {
f: REF Finder = NEW[Finder _ [realProject: to, useTable: NIL]];
f.useTable _ useTable _ CDGenerateBackdoor.CreateIndirect[
onTopOf: normalTable,
iGenerator: CrazoIndirector,
selector: CDGenerate.SelectOneOf,
cache: TRUE
];
autoProject _ f.autoProject _ Rope.Cat["%AUTO-", to];
[] _ myTables.Insert[LOOPHOLE[normalTable], f]; --the real entry to use is the normaltable 
[] _ myTables.Insert[LOOPHOLE[useTable], f]; --prevents creation of (direct) recursion 
<<--deals with concurency problems>>
[useTable, normalTable, autoProject] _ MakeAnIndirector[to];
[] _ SymTab.Insert[CDGenerateBackdoor.publicTables, f.autoProject, LOOPHOLE[useTable]];
};
END;

CrazoIndirector: CDGenerateBackdoor.IGeneratorProc =
<<PROC [design: CD.Design, key: Rope.ROPE, table: Table, data: REF] RETURNS [ob: CD.Object_NIL]>>
TRUSTED BEGIN
onTopOf: CDGenerate.Table _ CDGenerateBackdoor.Indiretee[realTable];
finder: REF Finder _ NARROW[myTables.Fetch[LOOPHOLE[onTopOf]].val];
project: Rope.ROPE _ finder.realProject;
ob _ InternalCreate[design: design, generatorKey: key, project: project];
END;

BuildUp: PROC[ob: CD.Object, design: CD.Design_NIL] RETURNS [done: BOOL_FALSE] =
BEGIN
ok: BOOL_TRUE;
refOb: CD.Object;
pp: DynamicPtr = NARROW[ob.specificRef];
IF pp.passTable=NIL OR pp.genTable=NIL THEN {
[useTable: pp.passTable, normalTable: pp.genTable] _ MakeAnIndirector[pp.project];
};
refOb _ CDGenerateBackdoor.FetchIndirect[passTable: pp.passTable, realTable: pp.genTable, design: design, key: pp.generatorKey, 
cache: FALSE ! RuntimeError.UNCAUGHT => {ok _ FALSE; CONTINUE}];
IF ok AND refOb#NIL THEN {
oldRef: CD.Object_NIL;
newApp: CD.Instance _ CDInstances.NewInstance[refOb];
oldSize: CD.Position _ ob.size;
oldIr: CD.Rect = CD.InterestRect[ob];
newIr: CD.Rect = CD.InterestRect[refOb];
IF pp.pseudoApp#NIL THEN oldRef _ pp.pseudoApp.ob;
pp.pseudoApp _ newApp;
BuildChildrenList[ob];
ob.size _ refOb.size;
pp.ir _ newIr;
IF design#NIL THEN {
IF ob.size#oldSize OR oldIr#newIr THEN {
offset: CD.Position _ CDBasics.SubPoints[
CDBasics.BaseOfRect[oldIr], 
CDBasics.BaseOfRect[newIr]
];
CDDirectory.RepositionObject[
design: design, 
ob: ob, 
oldSize: oldSize,
baseOff: offset
];
IF oldRef#NIL AND oldRef.class.inDirectory THEN 
[] _ CDDirectoryOps.RemoveObjectFromDirectory[design, oldRef] 
};
CDOps.DelayedRedraw[design]
};
}
END;
  
InterestRect: PROC [ob: CD.Object] RETURNS [CD.Rect] =
BEGIN
RETURN [NARROW[ob.specificRef, DynamicPtr].ir]
END;

Init: PROC [] = 
BEGIN
pp: REF CDDirectory.DirectoryProcs = CDDirectory.InstallDirectoryProcs[class];
pp.enumerateChildObjects _ EnumerateItsObjects;
pp.replaceDirectChilds _ ReplaceDirectChilds;
pp.another _ Another;
pp.expand _ Expand;
class.interestRect _ InterestRect;
class.drawMe _ DrawMe;
class.quickDrawMe _ QuickDrawMe;
class.internalRead _ ReadMe;
<<--dont write....  class.internalWrite _ WriteMe;>>
class.describe _ Describe;
END; 

Init[];
END.