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: CD.ObjectClass = CD.RegisterObjectClass[key, [
interestRect: InterestRect,
drawMe: DrawMe,
quickDrawMe: QuickDrawMe,
internalRead: ReadMe,
describe: Describe
]]; 

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] =
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 =
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.undefLayer,
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.shadeLayer, 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.shadeLayer, 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];
CDIO.WritePos[me.size];
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 _ CDBasics.MaxPoint[CDIO.ReadPos[], [1, 1]];
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 {
[] _ CDDirectory.Remove[CDIO.DesignInReadOperation[], CDDirectory.Name[ob], ob];
RETURN [ob];
};
TerminalIO.WriteRope["**generated object not created\n"];
ob _ CDRects.CreateRect[size, CD.errorLayer];
RETURN [ob]
END;

Expand: PROC [me: CD.Object, fromOrNil: CD.Design_NIL, into: CD.Design_NIL, friendly: BOOL_FALSE] RETURNS [
new: CD.Object_NIL, 
topMode: CDDirectory.DMode_ready, 
childMode: CDDirectory.ImmOrIncl_immutable
] =
BEGIN
pp: DynamicPtr = NARROW[me.specificRef];
IF pp.pseudoApp#NIL THEN
[new, topMode, childMode] _ CDDirectory.Another[pp.pseudoApp.ob, fromOrNil, into]
END;

Another: PROC [me: CD.Object, fromOrNil: CD.Design_NIL, into: CD.Design_NIL, friendly: BOOL_FALSE] RETURNS [
new: CD.Object_NIL, 
topMode: CDDirectory.InclOrReady_ready, 
childMode: CDDirectory.ImmOrIncl_included
] =
BEGIN
pp: DynamicPtr = NARROW[me.specificRef];
new _ InternalCreate[design: into,
size: me.size,
generatorKey: pp.generatorKey,
project: pp.project,
catch: TRUE,
include: FALSE
];
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 
[useTable, normalTable, autoProject] _ MakeAnIndirector[to];
[] _ SymTab.Insert[CDGenerateBackdoor.publicTables, f.autoProject, LOOPHOLE[useTable]];
};
END;

CrazoIndirector: CDGenerateBackdoor.IGeneratorProc =
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.NewInstI[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.RemoveIfUnused[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, [
enumerateChildObjects: EnumerateItsObjects,
replaceDirectChilds: ReplaceDirectChilds,
another: Another,
expand: Expand
]];
END; 

Init[];
END. 

LCDDynamicObsImpl.mesa   (part of ChipNDale)
Copyright c 1984, 1985 by Xerox Copporation.  All rights reserved.
by Christian Jacobi,  November 9, 1984 2:30:07 pm PST 
last edited Christian Jacobi,  March 25, 1986 5:24:32 pm PST
--dont write....  internalWrite: WriteMe,
--me: child to be included
--x: RefTab.Ref
--we can't do it but we recompute if old appears
--hack: read routine is supposed to return object not already in design and re-include it...
--deals with concurency problems
PROC [design: CD.Design, key: Rope.ROPE, table: Table, data: REF] RETURNS [ob: CD.Object_NIL]
�Êp˜
codeš
œ+™+Kšœ
Ïm
œ7™BKš
œ6™6Kš
œ<™<K˜—š
Ïk	˜	Kšžœ
˜Kš
œ	˜	K˜Kš
œ˜Kš
œ˜Kš
œ
˜
Kš
œ	˜	Kš
œ˜Kš
œ˜Kš
œ
˜
K˜Kš
œ˜Kš
œ˜Kš
œ	˜	Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kšœ
žœžœ˜Kš
œ˜Kš
œ˜Kš
œ˜—K˜šÐblœžœ
žœÏc
˜#Kšžœ
žœažœT˜Ã
Kšž	œ˜Kšžœ˜—Kš
ž˜K˜Kšœžœžœ˜"šœžœžœ˜Kšœžœžœ˜Kšœžœ˜Kšœžœ
˜Kšœžœžœ
˜Kšœžœ
˜ Kšœžœ
˜Kšœžœž˜Kš
œ˜—K˜Kšœžœ˜šœžœžœ˜5Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ)™)Kš
œ˜Kš
œ˜—K˜šÏnœžœžœ1žœ˜YKš
ž˜Kšœžœ˜(Kšžœžœ
žœ˜/Kšžœ
˜—˜š¡œžœžœžœ˜,Kš
œ™Kš
œ™Kš
ž˜šžœžœ ˜<Kšœžœ˜Kšœ
žœ˜-šžœ
˜Kšžœžœ ,˜Tšžœžœ ˜9Kš
œ6˜6——K˜
—Kšžœ
˜——K˜š¡œžœžœ˜*Kš
ž˜Kšœžœ˜(Kšœžœ
˜šžœžœ
žœ˜Kš
œ˜Kš
œ'˜'Kš
œ˜—Kšžœ
˜—K˜šÏbœ"˜5Kš
œ0™0Kš
ž˜Kšœžœ˜(šžœžœ
žœ˜šžœ0žœžœ
ž˜BKšžœ˜ šžœ
žœ
žœ,žœ˜EKš
œ˜Kš
ž˜K˜
—Kš
ž˜—Kš
œ˜—Kšžœ
˜—K˜š¡œžœ
žœžœžœžœ
˜ZKš
ž˜Kš
œ=˜=Kšœ.ž
˜/Kšžœ
˜—K˜š¡œžœ
žœ	˜)Kšœžœ˜Kšœžœžœ
˜Kšœžœžœ
˜Kšœžœ
žœ
˜Kš	œ	žœ
žœžœžœ
˜)Kš
ž˜Kšœžœ˜Kš
œ˜Kš
œ'˜'šœžœ˜Kš
œ˜Kš
œ˜Kš
œ"˜"Kš
œ˜—šœžœ
žœ˜Kš
œ˜Kš
œ
˜
Kšœžœ˜Kš
œ˜Kš
œ˜—Kšžœ	žœ6˜EKšœ !˜;Kšžœ˜Kšžœ
˜—K˜š
¡œžœžœ	žœžœ˜4Kš
ž˜Kšœžœ˜(Kšžœj˜pKšžœ
˜—K˜š
¡œžœžœžœžœ
˜JKšœžœ˜Kš
ž˜Kšœžœ˜-Kšžœžœ
žœ,˜Dšžœ˜Kšœ8žœ˜Kš
œ;˜;Kš
œ˜Kš
œ˜Kš
œ
˜
—K˜
—Kšžœ˜K˜—š
¡œžœžœžœžœ
˜OKšœžœ˜Kš
ž˜Kšœžœ˜-šžœžœ
žœ
˜Kš
œ@˜@—šžœ˜Kšœ8žœ˜Kš
œ;˜;Kš
œ˜Kš
œ˜Kš
œ
˜
—K˜
—Kšžœ˜—K˜š¡œžœ œ˜7Kš
ž˜Kšœžœ˜(Kš
œ˜Kš
œ˜Kš
œ#˜#Kšžœ
˜—K˜š¢œžœ œ˜:Kš
ž˜Kšœžœ˜Kšœžœ
˜Kšœžœ
˜!Kš
œ˜Kš
œ1˜1Kš
œ˜Kš
œ"˜"Kš
œ+˜+Kšœ"žœ(˜Nšžœžœ
žœžœ˜!Kš
œ\™\Kšœžœ4˜PKšžœ˜K˜—Kš
œ9˜9Kšœžœ
˜-Kšžœ˜Kšžœ
˜—K˜š¡œžœžœžœžœžœžœžœ
žœžœžœžœT˜Ò
Kš
ž˜Kšœžœ˜(šžœžœ
ž˜Kš
œQ˜Q—Kšžœ
˜—K˜š¡œžœžœžœžœžœžœžœ
žœ
žœžœžœY˜Ø
Kš
ž˜Kšœžœ˜(š
œ"˜"Kš
œ˜Kš
œ˜Kš
œ˜Kšœž˜Kšœ	ž˜K˜—Kšžœ
˜—K˜K˜'Kšœžœžœ žœ˜WK˜š¡œžœ
žœžœžœ
žœ˜[Kš
ž˜Kš
œ=˜=Kšžœ
˜—K˜š¡œžœžœžœD˜rKšžœ
ž˜
Kš
œ)˜)šžœžœžœ
ž˜:šœžœ˜Kš
œ˜Kš
œ˜K˜
—šžœžœ˜Kšœžœ
žœ&žœ˜?š
œ:˜:Kš
œ˜Kš
œ˜Kš
œ!˜!Kšœž˜Kš
œ˜—Kš
œ5˜5Kšœžœ +˜[Kšœžœ *˜WKš
œ ™ Kš
œ<˜<KšœCžœ˜WK˜——Kšžœ
˜—K˜š¢œ%˜4Kšžœ
žœžœžœžœžœžœ
™]Kš
ž
˜
Kš
œD˜DKšœžœ
žœžœ˜CKšœžœ˜(Kš
œI˜IKšžœ
˜—K˜š¡œžœžœžœžœžœžœ
žœ˜PKš
ž˜Kšœžœ
žœ
˜Kšœžœ˜Kšœžœ˜(šžœžœ
žœž	œ˜-Kš
œR˜RK˜—Kš	œ‡
žœžœ
žœžœ˜À
šžœžœžœ
žœ˜Kšœžœžœ
˜Kšœžœ(˜2Kšœ	žœ˜Kšœžœžœ˜%Kšœžœžœ˜(Kšžœžœ
žœ˜2Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜šžœžœ
žœ˜šžœžœ
žœ˜(šœžœ˜)Kš
œ˜Kš
œ˜Kš
œ˜—š
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜—šžœžœ
žœžœ
˜0Kš
œ3˜3—K˜—Kš
œ˜K˜—Kš
œ
˜
—Kšžœ
˜—K˜š
¡œžœžœ	žœžœ˜6Kš
ž˜Kšžœžœ ˜.Kšžœ
˜K˜—š¡œžœ˜Kš
ž˜šœžœH˜OKš
œ+˜+Kš
œ)˜)Kš
œ˜Kš
œ˜Kš
œ˜—Kšžœ˜—K˜K˜Kšžœ˜K˜—…—"Š1F