
<<CDCoreImpl.mesa>>
<<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
<<by Christian Jacobi, August 14, 1985 2:35:33 pm PDT>>
<<Last Edited by Christian Jacobi, October 4, 1985 4:40:21 pm PDT>>
<<>>
    DIRECTORY 
        Atom,
        CD,
        CDCore,
        CDDirectory,
        CDEvents,
        CDProperties,
        Core,
        CoreProperties,
        RefTab,
        Rope;

    CDCoreImpl: CEDAR MONITOR
        IMPORTS Atom, CD, CDDirectory, CDEvents, CDProperties, CoreProperties, RefTab
        EXPORTS CDCore =
    BEGIN

    Problem: PUBLIC SIGNAL [messagetype: CDCore.ProblemType, message: Rope.ROPE _ NIL] = CODE;

    myCDProperty: ATOM _ $CDToCore;
    myCoreProperty: ATOM _ $CDToCore;
    registrationTab: RefTab.Ref _ RefTab.Create[];

    CoreCellDescriptorRec: TYPE = RECORD [c: Core.CellType, d: Core.Design];
    RegistrationRec: TYPE = RECORD [createProc: CDCore.CreateProc, registrationKey: REF_NIL];

    RegisterGenerator: PUBLIC ENTRY PROC [createProc: CDCore.CreateProc, name: ATOM, registrationKey: REF _ NIL] =
        BEGIN ENABLE UNWIND => NULL;
        WITH RefTab.Fetch[registrationTab, name].val SELECT FROM
            r: REF RegistrationRec => {
                IF r.registrationKey#registrationKey OR registrationKey=NIL THEN
                    RETURN WITH ERROR CD.Error[doubleRegistration];
                r.createProc _ createProc;
                }
            ENDCASE => 
                [] _ RefTab.Store[registrationTab, name, NEW[RegistrationRec _ [createProc, registrationKey]]]
        END;

    CreateCDFromCore: PUBLIC PROC [coreDesign: Core.Design, coreCellType: Core.CellType, cdDesign: CD.Design] RETURNS [ob: CD.Object _ 
    NIL] =
        BEGIN

        FetchGenerator: PROC [key: ATOM] RETURNS [createProc: CDCore.CreateProc_NIL] =
            BEGIN
            WITH RefTab.Fetch[registrationTab, key].val SELECT FROM
                r: REF RegistrationRec => createProc _ r.createProc;
                ENDCASE => ERROR Problem[noGenerator];
            END;

        GetParameter: PROC [coreCellType: Core.CellType] RETURNS [key: ATOM, param: LIST OF REF ANY _ NIL] =
            BEGIN
            x: REF _ CoreProperties.GetProp[coreCellType.properties, coreGenerateLayout];
            IF x=NIL THEN
                x _ CoreProperties.GetProp[coreCellType.class.properties, coreGenerateLayout];
            WITH x SELECT FROM
                a: ATOM => key _ a;
                lora: LIST OF REF ANY => {
                    param _ lora.rest;
                    WITH lora.first SELECT FROM
                        a: ATOM => key _ a;
                        r: Rope.ROPE => key _ Atom.MakeAtom[r];
                        ENDCASE => ERROR Problem[generatorParameterError, "type of property"];
                    };
                loa: LIST OF ATOM => {
                    TRUSTED {param _ LOOPHOLE[loa.rest]};
                    key _ loa.first;
                    };
                r: Rope.ROPE => key _ Atom.MakeAtom[r];
                lor: LIST OF Rope.ROPE => {
                    TRUSTED {param _ LOOPHOLE[lor.rest]};
                    key _ Atom.MakeAtom[lor.first];
                    };
                ENDCASE => ERROR Problem[generatorParameterError, "type of property"];
            END;
        <<>>
        <<--CreateCDFromCore>>
        ob _ FetchCDFromCore[cdDesign, coreDesign, coreCellType];
        IF ob=NIL THEN {
            proc: CDCore.CreateProc;
            key: ATOM;
            param: LIST OF REF ANY;
            [key, param] _ GetParameter[coreCellType]; 
            proc _ FetchGenerator[key];
            ob _ proc[coreDesign: coreDesign, coreCellType: coreCellType, cdDesign: cdDesign, param: param, key: key];
            IF ob=NIL THEN ERROR Problem[generatorFailed];
            MakeMatch[cdDesign, ob, coreDesign, coreCellType];
            }
        END;

    FetchCDFromCore: PROC [cdDesign: CD.Design, coreDesign: Core.Design, coreCellType: Core.CellType] RETURNS [ob: CD.Object _ NIL] =
        BEGIN
        CheckMatch: PROC [design: CD.Design, ob: CD.Object, coreDesign: Core.Design, coreCellType: Core.CellType] RETURNS [ok: BOOL_TRUE] =
            BEGIN
            IF ob.class.inDirectory THEN {
                ob1: CD.Object _ CDDirectory.Fetch[design, CDDirectory.Name[ob]].object;
                IF ob1=NIL OR ob1#ob THEN RETURN [ok_FALSE];
                WITH CDProperties.GetPropFromObject[from: ob1, prop: myCDProperty] SELECT FROM
                    r: REF CoreCellDescriptorRec => ok _ r.d=coreDesign AND r.c=coreCellType;
                    ENDCASE => ok _ FALSE;
                };
            IF ok THEN ok _ ob=CoreProperties.GetProp[coreCellType.properties, myCoreProperty];
            END;
        WITH CoreProperties.GetProp[coreCellType.properties, myCoreProperty] SELECT FROM
            o: CD.Object => IF CheckMatch[cdDesign, o, coreDesign, coreCellType] THEN ob_o;
            ENDCASE => NULL;
        END;

    MakeMatch: PROC [design: CD.Design, ob: CD.Object, coreDesign: Core.Design, coreCellType: Core.CellType] =
        BEGIN
        coreCellType.properties _ CoreProperties.PutProp[coreCellType.properties, myCoreProperty, ob];
        CDProperties.PutPropOnObject[ob, myCDProperty, 
            NEW[CoreCellDescriptorRec _ [c: coreCellType, d: coreDesign]]];
        END;

    InvalidateCache: PUBLIC PROC [what: REF] =
        BEGIN
        WITH what SELECT FROM
            ob: CD.Object => CDProperties.PutPropOnObject[ob, myCDProperty, NIL];
            cc: Core.CellType => 
                cc.properties _ CoreProperties.PutProp[cc.properties, myCoreProperty, NIL];
            ENDCASE => NULL;
        END;

    ObjectHasChanged: CDEvents.EventProc = 
        BEGIN
        InvalidateCache[x];
        END;

    coreGenerateLayout: ATOM _ --CDCore.generateLayout-- $GenLayout;
    [] _ CoreProperties.RegisterProperty[coreGenerateLayout];
    [] _ CoreProperties.RegisterProperty[myCoreProperty];
    [] _ CDProperties.RegisterProperty[myCDProperty];
    CDEvents.RegisterEventProc[event: $AfterChange, proc: ObjectHasChanged];
    END.