
    <<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.