
    <<CDImpl.mesa   (part of ChipNDale)>>
        <<Copyright © 1983, 1986 by Xerox Corporation.  All rights reserved.>>
        <<Created by: Christian Jacobi, June 24, 1983 5:07 pm >>
        <<Last Edited by: Christian Jacobi, December 15, 1986 11:27:46 am PST>>

    DIRECTORY
        Atom,
        Basics,
        CD,
        CDBasics,
        CDDefaultProcs,
        CDEvents,
        CDLayers, 
        CDPrivate,
        Imager,
        PrincOps,
        RefTab,
        Rope,
        SafeStorage;

    CDImpl: CEDAR MONITOR 
        IMPORTS Atom, Basics, CD, CDDefaultProcs, CDEvents, CDLayers, RefTab, SafeStorage 
        EXPORTS CD, CDPrivate
        SHARES CDLayers, CDPrivate = 
    BEGIN

    Error: PUBLIC ERROR[ec: CD.ErrorCode _ programmingError, explanation: Rope.ROPE _ NIL] = CODE;
    permanent: ZONE = SafeStorage.GetPermanentZone[]; 
        <<--assume everithing gets correct even if all references are lost, >>
        <<--don't care about memory area, hint only>>

    layers: PUBLIC REF ARRAY CD.Layer OF CDPrivate.LayerRef = 
        permanent.NEW[ARRAY CD.Layer OF CDPrivate.LayerRef]; 

    registerTechEvent: CDEvents.EventRegistration = CDEvents.RegisterEventType[$RegisterTechnology];

    pureTechRegistration: RefTab.Ref = RefTab.Create[]; -- contains technologies
    allTechRegistration: RefTab.Ref = RefTab.Create[]; 
        <<--all real technology keys are in stored in both RefTab's>>
        <<--the convert technology keys are stored only in allTechRegistration   >>
        <<--This allows enumeration to return each technology just once, independent of convert names   >>

    PrivateTRef: TYPE = REF PrivateTRep;
    PrivateTRep: PUBLIC TYPE = RECORD [
        objectRegisterTab: RefTab.Ref, -- contains object types
        layerKeyTab: RefTab.Ref -- contains Layers
        ];


    nilTechnologyPrivate: PrivateTRef = NEW[PrivateTRep _ [
        objectRegisterTab: RefTab.Create[], --for technology dependant objects it contains NIL 
        layerKeyTab: RefTab.Create[]
        ]];


    RegisterObjectClass: PUBLIC PROC [objectType: ATOM, class: CD.ObjectClassRec] RETURNS [CD.ObjectClass] = {
        done: BOOL;
        c: CD.ObjectClass = permanent.NEW[CD.ObjectClassRec_class];
        c.properties _ CD.InitPropRef[];
        IF objectType#NIL THEN c.objectType _ objectType;
        IF c.drawMe=NIL THEN c.drawMe _ CDDefaultProcs.DrawMe;
        IF c.quickDrawMe=NIL THEN c.quickDrawMe _ CDDefaultProcs.QuickDrawMe;
        IF c.showMeSelected=NIL THEN c.showMeSelected _ CDDefaultProcs.ShowMeSelected;
        IF c.hitInside=NIL THEN c.hitInside _ CDDefaultProcs.HitInside;
        IF c.interestRect=NIL THEN c.interestRect _ CDDefaultProcs.InterestRect;
        IF c.describe=NIL THEN c.describe _ CDDefaultProcs.Describe;
        IF c.describeInst=NIL THEN c.describeInst _ CDDefaultProcs.DescribeInstance;
        IF c.technology=NIL THEN 
            done _ RefTab.Insert[nilTechnologyPrivate.objectRegisterTab, objectType, c]
        ELSE {
            techPriv: PrivateTRef = c.technology.cdPriv;
            objectRegisterTab: RefTab.Ref = techPriv.objectRegisterTab;
            globFound: BOOL;
            x: REF;
            [globFound, x] _ RefTab.Fetch[nilTechnologyPrivate.objectRegisterTab, objectType]; 
                <<--still check if it might be global>>
            IF globFound AND x#NIL THEN done _ FALSE
            ELSE { 
                [] _ RefTab.Insert[nilTechnologyPrivate.objectRegisterTab, objectType, NIL]; 
                    <<--global register it used per technology>>
                done _ RefTab.Insert[objectRegisterTab, objectType, c]; -- technology register
                }
            };
        IF NOT done THEN ERROR Error[doubleRegistration];
        RETURN [c]
        };

    FetchObjectClass: PUBLIC PROC [objectType: REF, technology: CD.Technology_NIL] RETURNS [CD.ObjectClass] = {
        x: REF;
        class: CD.ObjectClass _ NIL;
        found: BOOL _ FALSE;
        IF technology#NIL THEN { -- search in technology table
            techPriv: PrivateTRef = technology.cdPriv;
            [found, x] _ RefTab.Fetch[techPriv.objectRegisterTab, objectType];
            };
        IF NOT found THEN { -- search in global table
            [found, x] _ RefTab.Fetch[nilTechnologyPrivate.objectRegisterTab, objectType];
            <<--may find it but have NIL value: then is technologydependant>>
            };
        IF found THEN class _ NARROW[x];
        RETURN [class]
        }; 

    lastLayer: CD.Layer _ 6;

    InitiateLayer: PROC [layer: CD.Layer, technology: CD.Technology_NIL, uniqueKey: ATOM] = {
        techPriv: PrivateTRef;
        layers[layer].technology _ technology;
        layers[layer].uniqueKey _ uniqueKey;
        CDLayers.MakePaint[layer];
        IF technology=NIL THEN techPriv _ nilTechnologyPrivate
        ELSE {
            techPriv _ technology.cdPriv;
            technology.usedLayers _ CONS[layer, technology.usedLayers]
            };
        [] _ RefTab.Insert[techPriv.layerKeyTab, uniqueKey, layers[layer]];
        };

    ConvertLayer: PUBLIC ENTRY PROC [technology: CD.Technology, uniqueKey: ATOM, into: CD.Layer] = {
        <<--Helps conversion when layers are renamed>>
        ENABLE UNWIND => NULL;
        techPriv: PrivateTRef;
        IF uniqueKey=NIL OR uniqueKey=$NIL THEN RETURN WITH ERROR Error[callingError, "bad uniqueKey"]; -- avoid problems with NIL as ATOM; 
        any IO routine might use $NIL instead
        IF technology=NIL THEN techPriv _ nilTechnologyPrivate
        ELSE techPriv _ technology.cdPriv;
        [] _ RefTab.Insert[techPriv.layerKeyTab, uniqueKey, layers[into]];
        };

    NewLayer: PUBLIC ENTRY PROC [technology: CD.Technology_NIL, uniqueKey: ATOM] RETURNS [CD.Layer] = {
        ENABLE UNWIND => NULL;
        IF uniqueKey=NIL OR uniqueKey=$NIL THEN 
            RETURN WITH ERROR Error[callingError, "bad uniqueKey"]; 
            -- avoid problems with NIL as ATOM; any IO routine might use $NIL instead
        IF lastLayer>=CD.layerNum-1 THEN 
            RETURN WITH ERROR Error[noResource, "too many layers requested; (probably too many different technologies used)"];
        lastLayer _ lastLayer+1;
        InitiateLayer[lastLayer, technology, uniqueKey];
        RETURN [lastLayer]
        };

    FetchLayer: PUBLIC PROC [t: CD.Technology, uniqueKey: ATOM] RETURNS [CD.Layer] = {
        found: BOOL_FALSE;
        l: CD.Layer _ CD.errorLayer;
        x: REF;
        IF t#NIL THEN {
            techPriv: PrivateTRef = t.cdPriv;
            [found: found, val: x] _ RefTab.Fetch[techPriv.layerKeyTab, uniqueKey];
            };
        IF ~found THEN {
            [found: found, val: x] _ RefTab.Fetch[nilTechnologyPrivate.layerKeyTab, uniqueKey];
            };
        IF found THEN l _ NARROW[x, CDPrivate.LayerRef].number;
        RETURN [l]
        };

    LayerTechnology: PUBLIC PROC [l: CD.Layer] RETURNS [CD.Technology] = {
        RETURN [layers[l].technology];
        };

    LayerKey: PUBLIC PROC [l: CD.Layer] RETURNS [ATOM] = {
        RETURN [layers[l].uniqueKey];
        };

    CreateDrawRef: PUBLIC PROC [inf: CD.DrawInformation] RETURNS [dr: CD.DrawRef] = {
        dr _ NEW[CD.DrawInformation _ inf];
        dr.properties _ NEW[CD.PropList_NIL];
        IF dr.drawChild=NIL THEN dr.drawChild_CDDefaultProcs.DrawChild;
        IF dr.drawChildSel=NIL THEN dr.drawChildSel_CDDefaultProcs.DrawChildSel;
        IF dr.drawRect=NIL THEN dr.drawRect_CDDefaultProcs.DrawRect;
        IF dr.drawOutLine=NIL THEN dr.drawOutLine_CDDefaultProcs.ContextOutLine;
        IF dr.drawContext=NIL THEN dr.drawContext_CDDefaultProcs.DrawContext;
        IF dr.drawComment=NIL THEN dr.drawComment_CDDefaultProcs.DrawComment;
        IF dr.stopFlag=NIL THEN dr.stopFlag_NEW[BOOL_FALSE];
        IF dr.priorityChecker=NIL THEN dr.priorityChecker _ CDDefaultProcs.IgnorePriority;
        IF dr.setGround=NIL THEN dr.setGround _ CDDefaultProcs.IgnoreGround;
        };

    RegisterTechnology: PUBLIC PROC [key: ATOM, name: Rope.ROPE, lambda: CD.Number] RETURNS [CD.Technology] = {
        <<--not ENTRY since RefTab.Insert does necessary monitoring and CDEvents.ProcessEvent>>
        <<--is dangerous>>
        t: CD.Technology = permanent.NEW[CD.TechnologyRep_[
            properties: CD.InitPropRef[],
            key: key,
            name: IF name#NIL THEN name ELSE Atom.GetPName[key],
            lambda: lambda,
            usedLayers: NIL,
            cdPriv: permanent.NEW[PrivateTRep _ [RefTab.Create[], RefTab.Create[]]]
            ]];
        IF ~RefTab.Insert[allTechRegistration, key, t] THEN {
            Error[doubleRegistration, "technology exist already"];
            };
        [] _ RefTab.Insert[pureTechRegistration, key, t];
        [] _ CDEvents.ProcessEvent[ev: registerTechEvent, design: NIL, x: t];
        RETURN[t]
        };

    ConvertTechnologyKey: PUBLIC PROC [technology: CD.Technology, oldKey: ATOM] = {
        IF technology=NIL THEN Error[callingError];
        IF ~RefTab.Insert[allTechRegistration, oldKey, technology] THEN {
            Error[doubleRegistration, "technology key exist already"];
            };
        };

    FetchTechnology: PUBLIC PROC [key: ATOM] RETURNS [tech: CD.Technology] = {
        RETURN [NARROW[RefTab.Fetch[allTechRegistration, key].val]]
        };

    EnumerateTechnologies: PUBLIC PROC [proc: CD.TechnologyEnumerator] RETURNS [quit: BOOL] = {
        Action: RefTab.EachPairAction = {
            quit _ proc[NARROW[val]]
            };
        quit _ RefTab.Pairs[pureTechRegistration, Action];
        };

DEnumProc: TYPE = PROC [p: CDPrivate.DesignEnumerator] RETURNS [BOOL];
dEnumerators: LIST OF DEnumProc_NIL;

EnumDesigns: PUBLIC PROC [p: CDPrivate.DesignEnumerator] RETURNS [quit: BOOL_FALSE] = {
seen: RefTab.Ref _ RefTab.Create[5];
Inner: CDPrivate.DesignEnumerator = {
IF RefTab.Insert[seen, design, design] THEN quit _ p[design]
};
FOR el: LIST OF DEnumProc _ dEnumerators, el.rest WHILE el#NIL AND ~quit DO
quit _ el.first[Inner];
ENDLOOP;
};

InstallDesignEnumerator: PUBLIC ENTRY PROC [enum: DEnumProc] = {
IF enum#NIL THEN dEnumerators _ CONS[enum, dEnumerators];
};

    GetGrid: PUBLIC PROC [design: CD.Design, hint: REF_NIL] RETURNS [g: CD.Number_1] = {
        IF getGrid#NIL THEN g _ getGrid[design, hint];
        };

    getGrid: PROC [design: CD.Design, hint: REF_NIL] RETURNS [CD.Number] _ DefaultGetGrid;

        DefaultGetGrid: PROC [design: CD.Design, hint: REF_NIL] RETURNS [CD.Number] = {
            RETURN [design.technology.lambda]
            };

    InstallGetGrid: PUBLIC PROC [g: PROC [design: CD.Design, hint: REF_NIL] RETURNS [CD.Number]] = {
        IF g#NIL THEN getGrid _ g;
        };

    Hash: PUBLIC PROC [x: REF] RETURNS [h: CARDINAL] = {
        Munch: PROC [REF] RETURNS [CARDINAL] = TRUSTED MACHINE CODE {
            PrincOps.zXOR;
            };
        WITH x SELECT FROM
            ob: CD.Object => {
                h _ Munch[ob.class];
                h _ Basics.BITXOR[h, ((ob.bbox.x2-ob.bbox.x1) MOD 100B)*1000B];
                h _ Basics.BITXOR[h, ((ob.bbox.y2-ob.bbox.y1) MOD 1000B)*100B];
                h _ Basics.BITXOR[h, ob.layer];
                };
            ENDCASE => h _ Munch[x];
        };

    Equal: PUBLIC PROC[x, y: REF] RETURNS [BOOL] = {
        ob1: CD.Object = NARROW[x];
        ob2: CD.Object = NARROW[y];
        RETURN [
            ob1.class=ob2.class AND ob1.bbox=ob2.bbox AND ob1.layer=ob2.layer AND  
            CD.InterestRect[ob1]=CD.InterestRect[ob2]
            ]
        };

    blueLayer, redLayer, greenLayer, yellowLayer: CD.Layer;

    IF registerTechEvent=NIL THEN ERROR;  
    FOR l: CD.Layer IN CD.Layer DO
        layers[l] _ permanent.NEW[CDPrivate.LayerRec _ [
            properties: CD.InitPropRef[],
            number: l
            ]];
        layers[l].globalUniqueKey _ layers[l];
        ENDLOOP;
    InitiateLayer[CD.undefLayer, NIL, $undefLayer];
        CDLayers.MakeAbstract[CD.undefLayer];
    InitiateLayer[CD.shadeLayer, NIL, $shadeLayer];
    InitiateLayer[CD.errorLayer, NIL, $errorLayer];
    InitiateLayer[CD.backgroundLayer, NIL, $backGround];
        CDLayers.MakeAbstract[CD.backgroundLayer];
    InitiateLayer[CD.outlineLayer, NIL, $outline];
        CDLayers.MakeAbstract[CD.outlineLayer];
    InitiateLayer[CD.selectionLayer, NIL, $selection];
        CDLayers.MakeAbstract[CD.selectionLayer];
    InitiateLayer[CD.commentLayer, NIL, $comment];

    blueLayer _ NewLayer[NIL, $blue];
    redLayer _ NewLayer[NIL, $red];
    greenLayer _ NewLayer[NIL, $green];
    yellowLayer _ NewLayer[NIL, $yellow];
    END. 

    <<>>