CDDynamicObsImpl.mesa (part of ChipNDale)
Copyright © 1984, 1987 by Xerox Copporation. All rights reserved.
Created by Christian Jacobi, November 9, 1984 2:30:07 pm PST
Last edited by: Christian Jacobi, February 24, 1987 12:02:56 pm PST
DIRECTORY
CD,
CDBasics,
CDDirectory,
CDDirectoryOps,
CDDynamicObs,
CDEvents,
CDGenerate,
CDGenerateBackdoor,
CDInstances,
CDIO,
CDOps,
CDProperties,
CDRects,
CDValue,
RefTab,
Rope,
RuntimeError USING [UNCAUGHT],
SymTab,
TerminalIO,
TokenIO;
CDDynamicObsImpl:
CEDAR
MONITOR
IMPORTS CD, CDBasics, CDDirectory, CDDirectoryOps, CDEvents, CDGenerate, CDGenerateBackdoor, CDInstances, CDIO, CDOps, CDProperties, 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],
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,
internalWrite: WriteMe,
describe: Describe,
supressTruth: TRUE
]];
EnumerateItsObjects:
PROC [me:
CD.Object, proc: CDDirectory.EachObjectProc, data:
REF]
RETURNS [quit:
BOOL←
FALSE] = {
pp: DynamicPtr = NARROW[me.specific];
IF pp.pseudoInst#NIL THEN quit ← proc[pp.pseudoInst.ob, data];
};
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
THEN {
[] ← BuildUp[me, design];
changed ← TRUE;
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]
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,
specific: pp
]];
BuildUp[ob, design, FALSE]; -- no repositioning needs be done
RETURN [ob]
};
Describe:
CD.DescribeProc = {
pp: DynamicPtr = NARROW[ob.specific];
RETURN [Rope.Cat["generated object (", Rope.Cat[pp.project, ".", pp.generatorKey], ")"]]
};
DrawMe: CD.DrawProc = {
pp: DynamicPtr = NARROW[ob.specific];
IF pp.pseudoInst#NIL THEN pr.drawChild[pr, pp.pseudoInst.ob, trans, readOnlyInstProps]
ELSE {
r: CD.Rect = CDBasics.MapRect[CD.InterestRect[ob], trans];
pr.drawRect[pr, r, CD.shadeLayer];
}
};
QuickDrawMe: CD.DrawProc = {
pp: DynamicPtr = NARROW[ob.specific];
IF pp.pseudoInst#
NIL
THEN
pp.pseudoInst.ob.class.quickDrawMe[pr, pp.pseudoInst.ob, trans, readOnlyInstProps]
ELSE {
r: CD.Rect = CDBasics.MapRect[CD.InterestRect[ob], trans];
pr.drawRect[pr, r, CD.shadeLayer];
}
};
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 {
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, topAccessible:
BOOL←
TRUE, childAccessible:
BOOL←
TRUE] = {
pp: DynamicPtr = NARROW[me.specific];
IF pp.pseudoInst#
NIL
THEN
[new, childAccessible] ← CDDirectory.Another1[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, childAccessible:
BOOL←
TRUE] = {
pp: DynamicPtr = NARROW[me.specific];
new ← InternalCreate[design: into,
r: me.bbox,
generatorKey: pp.generatorKey,
project: pp.project
];
};
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 = {
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, propagate:
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];
};
CDGenerate.Flush[context: pp.genContext, design: design, key: pp.generatorKey];
refOb ← CDGenerateBackdoor.FetchIndirect[passContext: pp.passContext, realContext: pp.genContext, design: design, key: pp.generatorKey, cache: TRUE ! 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;
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.composed
THEN
[] ← CDDirectoryOps.RemoveIfUnused[design, oldRef]
};
CDOps.Redraw[design]
};
}
ELSE TerminalIO.PutRopes["Building dynamic object for", CD.Describe[ob], "failed\n"];
IF propagate THEN CDDirectory.PropagateChange[ob, design]
};
InterestRect:
PROC [ob:
CD.Object]
RETURNS [
CD.Rect] = {
RETURN [NARROW[ob.specific, DynamicPtr].ir]
};
QuitOnData: CDDirectory.EachObjectProc = {
quit ← me=data
};
StartConsume:
PROC [design:
CD.Design] = {
EachObject: CDDirectory.EachObjectProc = {
WITH me.specific
SELECT
FROM
dp: DynamicPtr =>
IF dp.pseudoInst#
NIL
THEN {
change: BOOL ← dp.pseudoInst.ob=data;
IF ~change
THEN
change ← CDDirectory.EnumerateChildObjects[dp.pseudoInst.ob, QuitOnData, data];
IF change THEN BuildUp[me, design, TRUE];
}
ENDCASE => NULL;
};
ob: CD.Object;
WHILE (ob ← PeekQueue[design])#
NIL
DO
[] ← CDDirectory.EnumerateDesign[design: design, proc: EachObject, data: ob, dir: TRUE, top: TRUE, recurse: TRUE];
IF ob#Dequeue[design] THEN ERROR;
ENDLOOP;
};
ObjectChanged: CDEvents.EventProc = {
IF design=NIL THEN RETURN;
WITH x
SELECT
FROM
ob:
CD.Object => {
IF Enqueue[ob, design].first THEN StartConsume[design];
};
ENDCASE => NULL;
};
Enqueue:
ENTRY
PROC [me:
CD.Object, design:
CD.Design]
RETURNS [first:
BOOL←
TRUE] = {
ENABLE UNWIND => NULL;
x: REF;
IF me=NIL OR design=NIL THEN RETURN [FALSE];
x ← CDProperties.GetDesignProp[design, $CDDynamicObjectsPrivate];
WITH x
SELECT
FROM
ol:
LIST
OF
CD.Object => {
first ← FALSE;
FOR l:
LIST
OF
CD.Object ← ol, l.rest
WHILE l#
NIL
DO
IF l.first=me THEN RETURN;
IF l.rest=NIL THEN {l.rest ← LIST[me]; RETURN}
ENDLOOP;
ERROR
};
ENDCASE => {
ol: LIST OF CD.Object ← LIST[me];
CDProperties.PutDesignProp[design, $CDDynamicObjectsPrivate, ol];
}
};
PeekQueue:
ENTRY
PROC [design:
CD.Design]
RETURNS [me:
CD.Object←
NIL] = {
ENABLE UNWIND => NULL;
IF design#
NIL
THEN
WITH CDProperties.GetDesignProp[design, $CDDynamicObjectsPrivate]
SELECT
FROM
ol:
LIST
OF
CD.Object => {
me ← ol.first;
};
ENDCASE => NULL;
};
Dequeue:
ENTRY
PROC [design:
CD.Design]
RETURNS [me:
CD.Object←NIL] = {
ENABLE UNWIND => NULL;
IF design#
NIL
THEN
WITH CDProperties.GetDesignProp[design, $CDDynamicObjectsPrivate]
SELECT
FROM
ol:
LIST
OF
CD.Object => {
me ← ol.first;
CDProperties.PutDesignProp[design, $CDDynamicObjectsPrivate, ol.rest]
};
ENDCASE => NULL;
};
Init:
PROC [] = {
pp:
REF CDDirectory.DirectoryProcs = CDDirectory.InstallDirectoryProcs[class, [
enumerateChildObjects: EnumerateItsObjects,
replaceDirectChilds: ReplaceDirectChilds,
another: Another,
expand: Expand
]];
CDEvents.RegisterEventProc[$AfterChange, ObjectChanged];
};
Init[];
END.