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, March 25, 1986 5:24:32 pm PST
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,
--dont write.... internalWrite: WriteMe,
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] =
--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.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 {
--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.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
--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.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.