
    <<CDOpsImpl.mesa       (part of ChipNDale)>>
        <<Copyright © 1983, 1986 by Xerox Corporation.  All rights reserved.>>
        <<by Christian Jacobi,  July 12, 1983 10:56 am >>
        <<last edited by Christian Jacobi,  May 22, 1986 5:11:56 pm PDT>>
        <<Last Edited by: Jacobi July 23, 1986 3:42:45 pm PDT>>
        <<Last edited by: Christian Jacobi, September 1, 1986 11:23:15 am PDT>>

    DIRECTORY
        Atom,
        CD,
        CDBasics,
        CDCells,
        CDDrawQueue,
        CDEvents,
        CDInstances,
        CDIO,
        CDOps,
        CDOpsExtras,
        CDOrient,
        CDProperties,
        CDRects,
        CDSimpleOps,
        CDValue,
        HashTable,
        Process, 
        Rope USING [ROPE],
        SafeStorage,
        TerminalIO,
        UserProfile;

    CDOpsImpl: CEDAR MONITOR 
        IMPORTS Atom, CD, CDBasics, CDCells, CDDrawQueue, CDEvents, CDInstances, CDIO, CDOps, CDOrient, CDProperties, CDRects, CDSimpleOps, 
        CDValue, HashTable, Process, SafeStorage, TerminalIO, UserProfile
        EXPORTS CDOps, CDOpsExtras
        SHARES CD = 
    BEGIN
    createEvent: CDEvents.EventRegistration=CDEvents.RegisterEventType[$CreateNewDesign];
    resetDesignEvent: CDEvents.EventRegistration=CDEvents.RegisterEventType[$ResetDesign];
    delayedKey: REF _ NEW[INT];

    DelRec: TYPE = RECORD [
        delayedList: LIST OF Remember_NIL,
        length: INT _ 0
        ];

    GetDelRec: PROC [design: CD.Design] RETURNS [REF DelRec] = {
        x: REF _ CDValue.Fetch[boundTo: design, key: delayedKey, propagation: design];
        IF x#NIL AND ISTYPE[x, REF DelRec] THEN RETURN [NARROW[x]]
        ELSE {
            dr: REF DelRec = NEW[DelRec_[NIL]];
            CDValue.Store[design, delayedKey, dr];
            RETURN [dr]
            }
        };

    Remember: TYPE = RECORD [area: CD.Rect, clear: BOOL];

    InternalResetDesign: PROC[design: CD.Design] = {
        <<--is local since it does not cause a redraw>>
        dummy: CD.Object _ CDCells.CreateEmptyCell[];
        dummy.size _ CDBasics.highposition;
        design.cdDirectoryPriv _ HashTable.Create[101, HashTable.RopeEqual, HashTable.HashRope];
        design^.actual _ LIST[CD.PushRec[
            dummyCell: CDInstances.NewInst[ob: dummy],
            mightReplace: NIL,
            specific: NARROW[dummy.specificRef],
            deletedList: NIL]];
        };

    CreateDesign: PUBLIC PROC [technology: CD.Technology] RETURNS [design: CD.Design] = {
        IF technology=NIL THEN ERROR CD.Error[callingError, "NIL technology"];
        design _ NEW[CD.DesignRec_[
            properties: CD.InitPropRef[],
            technology: technology,
            reserved: NEW[LONG POINTER _ NIL] --type has no property write proc
            ]];
        IF finalizing THEN SafeStorage.EnableFinalization[design];
        InternalResetDesign[design]; -- must not cause redraw since event not yet processed
        [] _ CDEvents.ProcessEvent[createEvent, design]; 
        };

    ResetDesign: PUBLIC PROC [design: CD.Design] = {
        InternalResetDesign[design];
        [] _ CDEvents.ProcessEvent[resetDesignEvent, design]; 
        CDValue.Store[design, delayedKey, NIL];
        Redraw[design];
        };

    RealTopCell: PUBLIC PROC [design: CD.Design] RETURNS [dummyCell: CD.Object] = {
        FOR l: LIST OF CD.PushRec _ design^.actual, l.rest DO
            IF l.rest=NIL THEN RETURN [l.first.dummyCell.ob]
            ENDLOOP
        };

    PushedTopCell: PUBLIC PROC [design: CD.Design] RETURNS [dummyCell: CD.Object] = {
        RETURN [design^.actual.first.dummyCell.ob];
        };

    RemoveInstance: PUBLIC PROC [design: CD.Design, inst: CD.Instance, draw: BOOL_TRUE] = {
        il: CD.InstanceList _ CDOps.InstList[design];
        IF il#NIL THEN 
            IF il.first=inst THEN CDOps.SetInstList[design, il.rest]
            ELSE
                FOR l: CD.InstanceList _ il, l.rest WHILE l.rest#NIL DO
                    IF l.rest.first=inst THEN {l.rest_l.rest.rest; EXIT}
                    ENDLOOP;
        IF draw THEN DelayedRedraw[design, CDInstances.InstRectO[inst]];
        };

    SelectNewMode: PROC[design: CD.Design] RETURNS [BOOL] = {
        mode: INT = CDValue.FetchInt[boundTo: design, key: $CDxSelectNewMode, propagation: technology, ifNotFound: 0];
        RETURN [mode=1]
        };

    IncludeObjectI: PUBLIC PROC[design: CD.Design, ob: CD.Object, location: CD.Position, orientation: CD.Orientation] = {
        inst: CD.Instance;
        IF ob#NIL THEN {
            inst _ CDInstances.NewInstI[ob: ob, location: location, orientation: orientation ];
            IF SelectNewMode[design] THEN {
                CDSimpleOps.DeselectAll[design];
                inst.selected _ TRUE;
                };
            IncludeInstance[design, inst];
            }
        };

    IncludeInstance: PUBLIC PROC [design: CD.Design, inst: CD.Instance, draw: BOOL_TRUE] = {
        IF inst=NIL THEN ERROR CD.Error[callingError, "Include of NIL application"];
        IF inst.ob=NIL THEN ERROR CD.Error[callingError, "Include application with NIL object"];
        CDOps.SetInstList[design, CONS[inst, CDOps.InstList[design]]];
        IF draw THEN DelayedRedraw[design, CDInstances.InstRectO[inst], TRUE];
        };

    IncludeInstanceList: PUBLIC PROC [design: CD.Design, il: CD.InstanceList, draw: BOOL_TRUE] = {
        FOR list: CD.InstanceList _ il, list.rest WHILE list#NIL DO
            IncludeInstance[design, list.first, draw];
            ENDLOOP;
        };

    Redraw: PUBLIC PROC [design: CD.Design, r: CD.Rect_CDOps.all, eraseFirst: BOOL_TRUE] = {
        CDDrawQueue.InsertDrawCommand[design, CDDrawQueue.Request[IF eraseFirst THEN $redraw ELSE $draw, r]];
        };


    CheckForShorten: PROC [dl: REF DelRec] = INLINE {
        IF dl.length>20 THEN {
            clear: BOOL _ FALSE;
            r: CD.Rect _ CDBasics.empty;
            FOR lst: LIST OF Remember _ dl.delayedList, lst.rest WHILE lst#NIL DO
                clear _ clear OR lst.first.clear;
                r _ CDBasics.Surround[r, lst.first.area]
                ENDLOOP;
            dl.delayedList _ LIST[Remember[area: r, clear: clear]];
            dl.length _ 1
            };
        };

    DelayedRedraw: PUBLIC ENTRY PROC [design: CD.Design, r: CD.Rect, eraseFirst: BOOL_TRUE] = {
        ENABLE UNWIND => NULL;
        IF design#NIL THEN {
            dl: REF DelRec = GetDelRec[design];
            IF dl.delayedList=NIL THEN {
                dl.delayedList _  LIST[Remember[area: r, clear: eraseFirst]];
                dl.length _ 1
                }
            ELSE {
                list: LIST OF Remember _ dl.delayedList;
                DO
                    <<--ASSERTION1: {list#NIL}>>
                    <<--ASSERTION2: {no list rectangle is completely covered by an other one}>>
                    IF CDBasics.Intersect[list.first.area, r] THEN {
                        IF CDBasics.Inside[r, list.first.area] THEN { 
                            <<--r is contained somewhere; we dont include it>>
                            <<--it is unlikely that a small area is cleared and a big one not>>
                            list.first.clear _ list.first.clear OR eraseFirst;
                            <<--assertion2 => no other elements could be removed>>
                            RETURN
                            }
                        ELSE IF CDBasics.Inside[list.first.area, r] THEN {
                            <<--r contains an element; we remove this element and all others>>
                            <<--        which are contained in r>>
                            <<--it is unlikely that a small area is cleared and a big one not>>
                            remember: LIST OF Remember _ list;
                            eraseFirst _ list.first.clear OR eraseFirst;
                            list.first.area _ r;
                            <<--remove all other element contained in r; to maintain assertion2>>
                            WHILE list.rest#NIL DO
                                <<assert3: list#NIL>>
                                IF CDBasics.Inside[list.rest.first.area, r] THEN {
                                    eraseFirst _ list.rest.first.clear OR eraseFirst;
                                    list.rest _ list.rest.rest; --does not change list -> keeps assertion3
                                    dl.length _ dl.length-1;
                                    }
                                ELSE list _ list.rest --since list.rest#NIL -> keeps assertion3
                                ENDLOOP;
                            remember.first.clear _ eraseFirst;
                            RETURN
                            }
                        };
                    IF list.rest#NIL THEN list_list.rest
                    ELSE {
                        list.rest _ LIST[Remember[area: r, clear: eraseFirst]];
                        dl.length _ dl.length+1;
                        CheckForShorten[dl];
                        RETURN
                        }
                    ENDLOOP;
                } --of dl.delayedList#NIL
            } --of design#NIL
        };

    DoTheDelayedRedraws: PUBLIC ENTRY PROC [design: CD.Design] = {
        ENABLE UNWIND => NULL;
        sq: REF DelRec = GetDelRec[design];
        UNTIL sq.delayedList=NIL DO
            CDDrawQueue.InsertDrawCommand[design, CDDrawQueue.Request[(IF sq.delayedList.first.clear THEN $redraw ELSE $draw), 
            sq.delayedList.first.area]];
            sq.delayedList _ sq.delayedList.rest
            ENDLOOP;
        sq.length _ 0;
        };

    DrawDesign: PUBLIC PROC[design: CD.Design, pr: CD.DrawRef] = {
        FOR w: LIST OF CD.PushRec _ design^.actual, w.rest WHILE w#NIL DO
            IF pr.stopFlag^ THEN EXIT;
            pr.drawChild[w.first.dummyCell, [0, 0], CDOrient.original, pr];
            ENDLOOP;
        }; 

    RedrawInstance: PUBLIC PROC[design: CD.Design, inst: CD.Instance_NIL, erase: BOOL_TRUE] = {
        IF inst#NIL THEN DelayedRedraw[design, CDInstances.InstRectO[inst], erase]
        ELSE DelayedRedraw[design, CDBasics.universe, erase]
        };

    QuickDrawDesign: PUBLIC PROC[design: CD.Design, pr: CD.DrawRef] = {

        SomeCommon: PROC[ob: CD.Object, pos: CD.Position, orient: CD.Orientation,
            pr: CD.DrawRef] RETURNS [BOOLEAN] = INLINE {
            RETURN CDBasics.Intersect[CDOrient.RectAt[pos, ob.size, orient], pr.interestClip] 
            }; 

        DrawAndShowSelectionList: PROC [list: CD.InstanceList, pr: CD.DrawRef] = INLINE {
            FOR w: CD.InstanceList _ list, w.rest WHILE w#NIL DO
                IF SomeCommon[w.first.ob, w.first.location, w.first.orientation, pr] THEN {
                    IF pr.stopFlag^ THEN EXIT;
                    w.first.ob.class.quickDrawMe[w.first, w.first.location, w.first.orientation, pr];
                    IF w.first.selected THEN
                        w.first.ob.class.showMeSelected[w.first, w.first.location, w.first.orientation, pr];
                    };
                ENDLOOP;
            }; 

        QuickDrawPushedCell: PROC [cp: CD.CellPtr, pr: CD.DrawRef] = INLINE {
            IF pr.borders AND cp.drawBorder THEN pr.drawOutLine[cp.ir, CD.outlineLayer, pr];
            FOR w: CD.InstanceList _ cp.contents, w.rest WHILE w#NIL DO
                IF SomeCommon[w.first.ob, w.first.location, w.first.orientation, pr] THEN {
                    IF pr.stopFlag^ THEN EXIT;
                    w.first.ob.class.quickDrawMe[w.first, w.first.location, w.first.orientation, pr];
                    }
                ENDLOOP;
            }; 
        <<>>
        <<-- drawDesign>>
        pr.setGround[pr: pr, pushedOut: FALSE];
        DrawAndShowSelectionList[CDOps.InstList[design], pr];
        IF design^.actual.rest#NIL THEN {
            pr.drawOutLine[design^.actual.first.specific.ir, CD.outlineLayer, pr];
            IF pr.environment THEN { 
                pr.setGround[pr: pr, pushedOut: TRUE];
                FOR w: LIST OF CD.PushRec _ design^.actual.rest, w.rest WHILE w#NIL DO
                    IF pr.stopFlag^ THEN EXIT;
                    QuickDrawPushedCell[w.first.specific, pr];
                    ENDLOOP;
                };
            }
        }; 

    PointedInstance: PUBLIC PROC  [design: CD.Design, pos: CD.Position] RETURNS [CD.Instance] = {
        RETURN [ CDInstances.InstanceAt[CDOps.InstList[design], pos] ];
        };

    SelectedInstance: PUBLIC PROC [design: CD.Design] RETURNS [first: CD.Instance_NIL, multiple: BOOL_FALSE] = {
        <<--first: returns ref to any selected application if there is one or more, otherwise nil.>>
            <<--multiple: more than one application is selected>>
        FOR w: CD.InstanceList _ CDOps.InstList[design], w.rest WHILE w#NIL DO
            IF w.first.selected THEN
                IF first=NIL THEN first_w.first
                ELSE {multiple_TRUE; RETURN}
            ENDLOOP;
        };

    ObjectInfo: PUBLIC PROC[ob: CD.Object] RETURNS [Rope.ROPE] = {
        IF ob=NIL THEN RETURN ["nil object"]
        ELSE IF ob.class.describe#NIL THEN RETURN [ob.class.describe[ob]] 
        ELSE RETURN [Atom.GetPName[ob.class.objectType]]
        };

    LayerName: PUBLIC PROC[lev: CD.Layer] RETURNS [Rope.ROPE] = {
        uniqueKey: ATOM = CD.LayerKey[lev];
        IF uniqueKey=NIL THEN RETURN ["bad layer"]; 
        RETURN [Atom.GetPName[uniqueKey]]
        };

    ReOrderInstance: PUBLIC PROC [design: CD.Design, inst: CD.Instance] = {
        <<--on return: design has exactly one occurrence of inst, and it is at the end. >>
        <<--(includes inst if necessary and removes double occurences)>>
        il: CD.InstanceList _ CDOps.InstList[design];
        found: BOOL _ FALSE;
        IF inst=NIL THEN ERROR CD.Error[callingError, "Reorder of NIL application"];
        WHILE il#NIL AND il.first=inst DO {found_TRUE; il _ il.rest} ENDLOOP;
        IF il=NIL THEN {
            IF found THEN il_LIST[inst] 
            ELSE ERROR CD.Error[callingError, "Reorder of application not in design"];
            }
        ELSE 
            FOR l: CD.InstanceList _ il, l.rest DO
                <<-- l#NIL AND l.first#inst holds at this point>>
                WHILE l.rest#NIL AND l.rest.first=inst DO {found_TRUE; l.rest _ l.rest.rest} ENDLOOP;
                IF l.rest=NIL THEN {
                    IF found THEN l.rest _ LIST[inst]
                    ELSE ERROR CD.Error[callingError, "Reorder of application not contained in design"];
                    EXIT
                    }
                ENDLOOP;
        CDOps.SetInstList[design, il];
        };


    <<-- Finalization -->>
    <<-- designs are finalized to break circularities involving objects or instances>>

    DrawCollected: PROC [inst: CD.Instance, pos: CD.Position, orient: CD.Orientation,
        pr: CD.DrawRef] = {
        pr.drawRect[CDOrient.RectAt[pos, inst.ob.size, orient], CD.errorLayer, pr]
        }; 

    ReadCollected: CD.InternalReadProc --PROC [] RETURNS [Object]-- = {
        sz: CD.Position = CDIO.ReadPos[];
        ob: CD.Object = CDRects.CreateRect[sz, CD.errorLayer];
        r: Rope.ROPE = "*design of this object has been destroyed; bug in creator program\n";
        CDProperties.PutObjectProp[ob, $SignalName, r];
        TerminalIO.WriteRope[r];
        RETURN [ob]
        };

    WriteCollected: CD.InternalWriteProc -- PROC [me: Object] -- = {
        CDIO.WritePos[CD.InterestSize[me]];
        TerminalIO.WriteRope["*write object which has been destroyed\n"];
        };

    gCollectedClass: CD.ObjectClass = CD.RegisterObjectClass[$GCollected, [
        drawMe: DrawCollected,
        quickDrawMe: DrawCollected,
        internalRead: ReadCollected,
        internalWrite: WriteCollected,
        description: "garbage object; design has been destroyed"
        ]];
    <<>>
    DestroyEachObject: HashTable.EachPairAction = {
        WITH value SELECT FROM
            ob: CD.Object => IF ob.class=NIL OR ob.class.inDirectory THEN {
                ob.class _ gCollectedClass; 
                ob.layer _ CD.errorLayer; 
                ob.specificRef _ NIL;
                ob.properties _ NIL;
                };
            ENDCASE => NULL;
        };

    FinalizeDesign: PROC [d: CD.Design] = {
        d.properties _ NIL;
        IF d.cdDirectoryPriv#NIL AND CDValue.Fetch[d, $KeepObjects]=NIL THEN
            [] _ NARROW[d.cdDirectoryPriv, HashTable.Table].Pairs[DestroyEachObject];
        WHILE d.actual#NIL DO
            d.actual.first.dummyCell.properties _ NIL;
            IF d.actual.first.mightReplace#NIL THEN d.actual.first.mightReplace.properties _ NIL;
            d.actual.first.deletedList _ NIL;
            d.actual _ d.actual.rest;
            ENDLOOP;
        d.cdDirectoryPriv _ NIL;
        d.cdValuePriv _ NIL;
        d.cdSequencerPriv _ NIL;
        d.cdDrawQueuePriv _ NIL;
        };

    FinalizerProcess: PROC[fooFQ: SafeStorage.FinalizationQueue] = {
        DO
            d: CD.Design = NARROW[SafeStorage.FQNext[fooFQ]];
            FinalizeDesign[d];
            ENDLOOP
        };

    finalizing: BOOL = UserProfile.Boolean["ChipNDale.DoFinalization", TRUE];
    IF finalizing THEN {
        fooFQ: SafeStorage.FinalizationQueue = SafeStorage.NewFQ[];
        IF Atom.GetProp[$ChipNDalePrivate, $FinalizationEnabled]=$TRUE THEN
            SafeStorage.ReEstablishFinalization[CODE[CD.DesignRec], 0, fooFQ]
        ELSE {
            SafeStorage.EstablishFinalization[CODE[CD.DesignRec], 0, fooFQ];
            Atom.PutProp[$ChipNDalePrivate, $FinalizationEnabled, $TRUE];
            };
        TRUSTED {Process.Detach[FORK FinalizerProcess[fooFQ]]};
        };
    CDValue.RegisterKey[$KeepObjects];
    END.