CDDynamicObsImpl.mesa (part of ChipNDale)
Copyright © 1984, 1985 by Xerox Copporation. All rights reserved.
Created by Christian Jacobi, November 9, 1984 2:30:07 pm PST
Last edited by: Christian Jacobi, October 20, 1986 12:55:01 pm PDT
DIRECTORY
CD,
CDBasics,
CDDirectory,
CDDirectoryOps,
CDDynamicObs,
CDEvents,
CDGenerate,
CDGenerateBackdoor,
CDImports,
CDInstances,
CDIO,
CDOps,
CDRects,
CDValue,
RefTab,
Rope,
RuntimeError USING [UNCAUGHT],
SymTab,
TerminalIO,
TokenIO;
CDDynamicObsImpl:
CEDAR
MONITOR
IMPORTS CD, CDBasics, CDDirectory, CDDirectoryOps, CDGenerate, CDGenerateBackdoor, CDImports, CDInstances, CDIO, CDOps, CDRects, RefTab, Rope, RuntimeError, SymTab, TerminalIO, TokenIO
EXPORTS CDDynamicObs
SHARES CDDirectory =
BEGIN
DynamicPtr: TYPE = REF DynamicRep;
DynamicRep:
TYPE =
RECORD [
pseudoInst: CD.Instance ← NIL,
ir: CD.Rect ← [0, 0, -1, -1],
used: RefTab.Ref ← NIL,
project: Rope.ROPE ← NIL,
passContext: CDGenerate.Context←NIL,
genContext: CDGenerate.Context←NIL,
generatorKey: Rope.ROPE ← NIL
];
key: ATOM = $CDDynamicObs;
class:
CD.ObjectClass =
CD.RegisterObjectClass[key, [
interestRect: InterestRect,
drawMe: DrawMe,
quickDrawMe: QuickDrawMe,
internalRead: ReadMe,
--dont write.... internalWrite: WriteMe,
describe: Describe
]];
EnumerateItsObjects:
PROC [me:
CD.Object, p: CDDirectory.EnumerateObjectsProc, x:
REF] = {
pp: DynamicPtr = NARROW[me.specific];
IF pp.pseudoInst#NIL THEN p[pp.pseudoInst.ob, x];
};
IncludeChild:
PROC [me:
CD.Object, x:
REF] = {
--me: child to be included
--x: RefTab.Ref
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.specific, DynamicPtr] --it will propagate changes of it's children
AND ~CDImports.IsImport[me]
THEN
--it will not change...
CDDirectory.EnumerateChildObjects[me, IncludeChild, x]
}
};
BuildChildrenList:
PROC [me:
CD.Object] = {
pp: DynamicPtr = NARROW[me.specific];
pp.used ← NIL;
IF pp.pseudoInst#
NIL
THEN {
pp.used ← RefTab.Create[];
IncludeChild[pp.pseudoInst.ob, pp.used];
};
};
ReplaceDirectChilds: CDDirectory.ReplaceDChildsProc = {
--we can't do it but we recompute if old appears
pp: DynamicPtr = NARROW[me.specific];
IF pp.pseudoInst#
NIL
THEN {
FOR rl: CDDirectory.ReplaceList ← replace, rl.rest
WHILE rl#
NIL
DO
IF pp.pseudoInst.ob=rl.first.old
OR (pp.used#
NIL
AND RefTab.Fetch[pp.used, rl.first.old].found)
THEN {
[] ← BuildUp[me, design];
RETURN
}
ENDLOOP
};
};
Create:
PUBLIC
PROC [design:
CD.Design, project, key: Rope.
ROPE]
RETURNS [ob:
CD.Object] = {
context: CDGenerate.Context ← MakeAnIndirector[project].useContext;
ob ← CDGenerate.FetchNCall[context, design, key];
};
InternalCreate:
PROC [design:
CD.Design, r:
CD.Rect ← [0, 0, 1, 1], project: Rope.
ROPE ←
NIL, generatorKey: Rope.
ROPE ←
NIL, catch:
BOOL←
TRUE, include:
BOOL←
TRUE]
RETURNS [
CD.Object] = {
ob: CD.Object;
pp: DynamicPtr;
r.x2 ← MAX[r.x2, r.x1+1];
r.y2 ← MAX[r.y2, r.y1+1];
pp ←
NEW[DynamicRep ← [
project: project,
generatorKey: generatorKey,
ir: r
]];
ob ←
NEW[
CD.ObjectRep ← [
bbox: r,
class: class,
layer: CD.undefLayer,
specific: pp
]];
IF include THEN [] ← CDDirectory.Include[design: design, object: ob];
[] ← BuildUp[ob, design]; -- no repositioning needs be done
RETURN [ob]
};
Describe:
PROC[me:
CD.Object]
RETURNS [Rope.
ROPE] = {
pp: DynamicPtr = NARROW[me.specific];
RETURN [Rope.Cat["generated object [", Rope.Cat[pp.project, ".", pp.generatorKey], "] ", CDDirectory.Name[me]]]
};
DrawMe:
PROC [inst:
CD.Instance, trans:
CD.Transformation, pr:
CD.DrawRef] = {
pp: DynamicPtr = NARROW[inst.ob.specific];
IF pp.pseudoInst#NIL THEN pr.drawChild[pp.pseudoInst, trans, pr]
ELSE {
r: CD.Rect = CDBasics.MapRect[CD.InterestRect[inst.ob], trans];
pr.drawRect[r, CD.shadeLayer, pr];
pr.drawComment[r, CDDirectory.Name[inst.ob], pr]
}
};
QuickDrawMe:
PROC [inst:
CD.Instance, trans:
CD.Transformation, pr:
CD.DrawRef] = {
pp: DynamicPtr = NARROW[inst.ob.specific];
IF pp.pseudoInst#
NIL
THEN
pp.pseudoInst.ob.class.quickDrawMe[pp.pseudoInst, trans, pr]
ELSE {
r: CD.Rect = CDBasics.MapRect[CD.InterestRect[inst.ob], trans];
pr.drawRect[r, CD.shadeLayer, pr];
pr.drawComment[r, CDDirectory.Name[inst.ob], pr]
}
};
WriteMe:
CD.InternalWriteProc = {
pp: DynamicPtr = NARROW[ob.specific];
CDIO.WriteRect[h, ob.bbox];
TokenIO.WriteRope[h, pp.project];
TokenIO.WriteRope[h, pp.generatorKey];
};
ReadMe:
CD.InternalReadProc = {
ob: CD.Object;
r: CD.Rect;
generatorKey, project: Rope.ROPE;
context: CDGenerate.Context;
r ← CDIO.ReadRect[h];
project ← TokenIO.ReadRope[h];
generatorKey ← TokenIO.ReadRope[h];
context ← MakeAnIndirector[project].useContext;
ob ← CDGenerate.FetchNCall[context, CDIO.DesignInReadOperation[h], generatorKey];
IF ob#
NIL
AND ob.bbox=r
THEN {
--hack: read routine is supposed to return object not already in design and re-include it...
[] ← CDDirectory.Remove[CDIO.DesignInReadOperation[h], CDDirectory.Name[ob], ob];
RETURN [ob];
};
TerminalIO.PutRope["**generated object not created\n"];
ob ← CDRects.CreateRect[CDBasics.SizeOfRect[r], CD.errorLayer];
RETURN [ob]
};
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
] = {
pp: DynamicPtr = NARROW[me.specific];
IF pp.pseudoInst#
NIL
THEN
[new, topMode, childMode] ← CDDirectory.Another[pp.pseudoInst.ob, fromOrNil, into]
};
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
] = {
pp: DynamicPtr = NARROW[me.specific];
new ← InternalCreate[design: into,
r: me.bbox,
generatorKey: pp.generatorKey,
project: pp.project,
catch: TRUE,
include: FALSE
];
};
myContexts: RefTab.Ref ← RefTab.Create[];
Finder: TYPE = RECORD[realProject, autoProject: Rope.ROPE, useContext: CDGenerate.Context];
GetContext:
PUBLIC
PROC [for: Rope.
ROPE]
RETURNS [name: Rope.
ROPE, context: CDGenerate.Context] = {
[useContext: context, autoProject: name] ← MakeAnIndirector[for];
};
MakeAnIndirector:
PROC [to: Rope.
ROPE]
RETURNS [useContext, normalContext: CDGenerate.Context, autoProject: Rope.
ROPE] = {
normalContext ← CDGenerate.AssertContext[to];
WITH myContexts.Fetch[normalContext].val
SELECT
FROM
find:
REF Finder => {
useContext ← find.useContext;
autoProject ← find.autoProject;
}
ENDCASE => {
f: REF Finder = NEW[Finder ← [realProject: to, useContext: NIL]];
f.useContext ← useContext ← CDGenerateBackdoor.CreateIndirect[
onTopOf: normalContext,
iGenerator: CrazoIndirector,
selector: CDGenerate.SelectOneOf,
cache: TRUE
];
autoProject ← f.autoProject ← Rope.Cat["%AUTO-", to];
[] ← myContexts.Insert[normalContext, f]; --the real entry to use is the normalcontext
[] ← myContexts.Insert[useContext, f]; --prevents creation of (direct) recursion
--deals with concurency problems
[useContext, normalContext, autoProject] ← MakeAnIndirector[to];
[] ← SymTab.Insert[CDGenerateBackdoor.publicContexts, f.autoProject, useContext];
};
};
CrazoIndirector: CDGenerateBackdoor.IGeneratorProc = {
PROC [design: CD.Design, key: Rope.ROPE, context: Context, data: REF] RETURNS [ob: CD.Object←NIL]
onTopOf: CDGenerate.Context ← CDGenerateBackdoor.Indiretee[realContext];
finder: REF Finder ← NARROW[myContexts.Fetch[onTopOf].val];
project: Rope.ROPE ← finder.realProject;
ob ← InternalCreate[design: design, generatorKey: key, project: project];
};
BuildUp:
PROC[ob:
CD.Object, design:
CD.Design←
NIL]
RETURNS [done:
BOOL←
FALSE] = {
ok: BOOL←TRUE;
refOb: CD.Object;
pp: DynamicPtr = NARROW[ob.specific];
IF pp.passContext=
NIL
OR pp.genContext
=NIL THEN {
[useContext: pp.passContext, normalContext: pp.genContext] ← MakeAnIndirector[pp.project];
};
refOb ← CDGenerateBackdoor.FetchIndirect[passContext: pp.passContext, realContext: pp.genContext, design: design, key: pp.generatorKey, cache: FALSE ! RuntimeError.UNCAUGHT => {ok ← FALSE; CONTINUE}];
IF ok
AND refOb#
NIL
THEN {
oldRef: CD.Object←NIL;
newInst: CD.Instance ← CDInstances.NewInst[refOb];
oldR: CD.Rect ← ob.bbox;
oldIr: CD.Rect = CD.InterestRect[ob];
newIr: CD.Rect = CD.InterestRect[refOb];
IF pp.pseudoInst#NIL THEN oldRef ← pp.pseudoInst.ob;
pp.pseudoInst ← newInst;
BuildChildrenList[ob];
ob.bbox ← refOb.bbox;
pp.ir ← newIr;
IF design#
NIL
THEN {
IF ob.bbox#oldR
OR oldIr#newIr
THEN {
CDDirectory.PropagateResize[design, ob];
IF oldRef#
NIL
AND oldRef.class.inDirectory
THEN
[] ← CDDirectoryOps.RemoveIfUnused[design, oldRef]
};
CDOps.Redraw[design]
};
}
};
InterestRect:
PROC [ob:
CD.Object]
RETURNS [
CD.Rect] = {
RETURN [NARROW[ob.specific, DynamicPtr].ir]
};
Init:
PROC [] = {
pp:
REF CDDirectory.DirectoryProcs = CDDirectory.InstallDirectoryProcs[class, [
enumerateChildObjects: EnumerateItsObjects,
replaceDirectChilds: ReplaceDirectChilds,
another: Another,
expand: Expand
]];
};
Init[];
END.