
    <<LichenFromExtImpl1.Mesa>>
        <<Last tweaked by Mike Spreitzer on April 29, 1988 11:45:32 am PDT>>

    DIRECTORY AbSets, Basics, BiRels, Buttons, Containers, FS, Icons, IntStuff, IO, LichenDataOps, LichenDataStructure, 
    LichenFromExtPrivate, List, PieViewers, Process, ProcessProps, RefText, Rope, RopeHash, SetBasics, ViewerOps, ViewerTools;

    LichenFromExtImpl1: CEDAR MONITOR
        LOCKS dr USING dr: DesignReading
        IMPORTS AbSets, BiRels, Buttons, Containers, FS, Icons, IO, LichenDataOps, LichenDataStructure, LichenFromExtPrivate, List, 
        PieViewers, Process, ProcessProps, RefText, Rope, RopeHash, SetBasics, ViewerOps, ViewerTools
        EXPORTS LichenFromExtPrivate
        =

    BEGIN OPEN LichenDataOps, LichenDataStructure, LichenFromExtPrivate, Sets:AbSets, IS:IntStuff;

    readers: Fn _ BiRels.CreateHashDictionary[TRUE];

    pacifierIcon: Icons.IconFlavor _ Icons.NewIconFromFile["Lichen.icons", 0];
    pacifyPeriod: Process.Milliseconds _ 2500;
    labelHeight: INTEGER _ 27;
    pauseWidth: INTEGER _ 60;
    pieDiameter: INTEGER _ 50;

    ReadDesign: PROC [rootCellFileName: ROPE, oldDR: DesignReading _ NIL] RETURNS [dr: DesignReading] =
        BEGIN
        Doit: PROC = {
            dr.stack _ NIL;
            [] _ ReadCellType[dr.d, rootCellFileName, dr]};
        IF oldDR = NIL THEN {
            cp: FS.ComponentPositions;
            fullFName, designName: ROPE;
            [fullFName, cp, ] _ FS.ExpandName[rootCellFileName];
            designName _ fullFName.Substr[start: cp.base.start, len: cp.base.length];
            {d: Design ~ CreateDesign[OneRope[designName]];
            dr _ NEW [DesignReadingRep _ [
                d: d,
                wDir: fullFName.Substr[len: cp.base.start],
                fetTypes: BiRels.CreateHashTable[[fetSpace, SetBasics.refs]],
                unkosherArrays: Sets.CreateHashSet[],
                toMerge: BiRels.CreateHashTable[[paths, SetBasics.refs]],
                arraySpecs: BiRels.CreateHashTable[[d.eSpace, SetBasics.refs]],
                buffer: RefText.New[200],
                pacifier: Containers.Create[info: [name: designName.Cat[" pacifier"], icon: pacifierIcon]],
                pie: NIL,
                label: NIL,
                pause: NIL
                ]];
            TRUSTED {
                Process.InitializeCondition[@dr.change, Process.SecondsToTicks[60]];
                Process.EnableAborts[@dr.change]};
            dr.pause _ Buttons.Create[info: [name: "Pause", parent: dr.pacifier, wx: 0, wy: 0, ww: pauseWidth, wh: labelHeight], proc: 
            TogglePause, clientData: dr];
            dr.label _ ViewerTools.MakeNewTextViewer[info: [parent: dr.pacifier, wx: dr.pause.wx+dr.pause.ww, wy: 0, ww: 100, wh: labelHeight]];
            Containers.ChildXBound[container: dr.pacifier, child: dr.label];
            dr.pie _ PieViewers.Create[parent: dr.pacifier, x: 0, y: dr.label.wy+dr.label.wh, diameter: pieDiameter, total: 1.0, divisions: 
            100];
            Containers.ChildXBound[container: dr.pacifier, child: dr.pie];
            Containers.ChildYBound[container: dr.pacifier, child: dr.pie];
            ViewerOps.SetOpenHeight[dr.pacifier, dr.pie.wy+dr.pie.wh];
            TRUSTED {Process.Detach[FORK Pacify[dr]]};
            }}
        ELSE {
            dr _ oldDR;
            };
        ProcessProps.PushPropList[List.PutAssoc[$WorkingDirectory, dr.wDir, NIL], Doit];
        END;

    Wait: ENTRY PROC [dr: DesignReading] = {
        ENABLE UNWIND => NULL;
        WHILE dr.stop DO WAIT dr.change ENDLOOP};

    Pacify: PROC [dr: DesignReading] = {
        lastStack: SourceList _ NIL;
        lastIndex: INT _ 0;
        ViewerOps.OpenIcon[icon: dr.pacifier, bottom: FALSE];
        WHILE NOT dr.pacifier.destroyed DO
            WithLock: ENTRY PROC [dr: DesignReading] = {
                ENABLE UNWIND => NULL;
                IF dr.stack = NIL THEN {
                    IF dr.stack # lastStack THEN {
                        lastStack _ dr.stack;
                        ViewerTools.SetContents[dr.label, "Idle"];
                        PieViewers.Set[dr.pie, 0];
                        };
                    }
                ELSE {
                    index: INT = dr.stack.first.stream.GetIndex[];
                    IF dr.stack # lastStack OR index # lastIndex THEN {
                        lastStack _ dr.stack;
                        lastIndex _ index;
                        ViewerTools.SetContents[dr.label, IO.PutFR["%g%g%g[%g]", [rope[dr.prefix]], [rope[dr.curCellTypeName]], [rope[IF dr.curArray THEN 
                        ".aext" ELSE ""]], [integer[index]]]];
                        PieViewers.Set[dr.pie, index/dr.curCellFileLength];
                        };
                    };
                };
            Process.Pause[Process.MsecToTicks[pacifyPeriod]];
            WithLock[dr];
            ENDLOOP;
        RETURN};

    TogglePause: Buttons.ButtonProc = {
        dr: DesignReading = NARROW[clientData];
        Flip: ENTRY PROC [dr: DesignReading] = {
            ENABLE UNWIND => NULL;
            dr.stop _ NOT dr.stop;
            BROADCAST dr.change};
        Flip[dr];
        Buttons.ReLabel[dr.pause, IF dr.stop THEN "Continue" ELSE "Pause"];
        };

    DoPushed: PROC [dr: DesignReading, cellTypeName: ROPE, array: BOOL, s: Source, Proc: PROC [Source]] = {
        cooler: SourceList = dr.stack;
        oldCellTypeName: ROPE = dr.curCellTypeName;
        oldArray: BOOL = dr.curArray;
        oldPrefix: ROPE = dr.prefix;
        oldCellFileLength: REAL = dr.curCellFileLength;
        newPrefix: ROPE = FmtStack[cooler];
        newCellFileLength: INT = MAX[s.stream.GetLength[], 1];
        Push: ENTRY PROC [dr: DesignReading] = {
            ENABLE UNWIND => NULL;
            dr.stack _ CONS[s, dr.stack];
            dr.curCellTypeName _ cellTypeName;
            dr.curArray _ array;
            dr.prefix _ newPrefix;
            dr.curCellFileLength _ newCellFileLength;
            };
        Pop: ENTRY PROC [dr: DesignReading] = {
            ENABLE UNWIND => NULL;
            dr.stack _ cooler;
            dr.curCellTypeName _ oldCellTypeName;
            dr.curArray _ oldArray;
            dr.prefix _ oldPrefix;
            dr.curCellFileLength _ oldCellFileLength;
            };
        Push[dr];
        Proc[s !UNWIND => Pop[dr]];
        Pop[dr];
        };

    ReadCellType: PUBLIC PROC [d: Design, cellFileName: ROPE, dr: DesignReading] RETURNS [ct: CellType] = {
        cp: FS.ComponentPositions;
        fullFName, cellTypeName: ROPE;
        from: IO.STREAM;
        s: Source;
        cr: CellReading;
        Pushed: PROC [s: Source] = {PushedRead[dr, cr, s, FALSE]};
        [fullFName, cp] _ ExtendName[cellFileName, "ext"];
        cellTypeName _ fullFName.Substr[start: cp.base.start, len: cp.base.length];
        ct _ CreateCellType[d, unorganized, OneRope[cellTypeName]];
        cr _ NEW[CellReadingRep _ [dr: dr, ct: ct, name: cellTypeName, newArrays: Sets.CreateHashSet[]]];
        s _ [from _ FS.StreamOpen[fullFName], fullFName];
        DoPushed[dr, cellTypeName, FALSE, s, Pushed];
        from.Close[];
        RETURN};

    TryArrayFile: PUBLIC PROC [cr: CellReading] = {
        fullFName: ROPE = ExtendName[cr.name, "aext"].fullFName;
        s: Source = [FS.StreamOpen[fullFName], fullFName];
        Pushed: PROC [s: Source] = {
            PushedRead[cr.dr, cr, s, TRUE];
            FinishWaitingMerges[cr];
            RETURN};
        FinishArray: PROC [ra: Sets.Value] ~ {
            act: CellType ~ NARROW[ra.VA];
            FinishedMakingArrayConnections[act];
            RETURN};
        IF (NOT cr.dr.toMerge.Empty[]) OR cr.waitingMerges # NIL THEN ERROR;
        DoPushed[cr.dr, cr.name, TRUE, s, Pushed];
        s.stream.Close[];
        cr.newArrays.Enumerate[FinishArray];
        RETURN};

    PushedRead: PROC [dr: DesignReading, cr: CellReading, s: Source, nested: BOOL] = {
        from: IO.STREAM = s.stream;
        ct: CellType = cr.ct;
        d: Design ~ dr.d;
        DO
            keyword: ROPE;
            reader: Reader;
            Process.CheckForAbort[];
            [] _ from.SkipWhitespace[];
            IF from.EndOf[] THEN EXIT;
            IF dr.stop THEN Wait[dr];
            keyword _ from.GetTokenRope[TokenBreak].token;
            reader _ NARROW[readers.ApplyA[keyword].MDA];
            IF reader # NIL
                THEN reader.read[s, reader, cr]
                ELSE {ERROR--let's not be sloppy--;
                    <<terms: Terms _ GetLineTerms[from];
                    reln: ATOM _ Atom.MakeAtom[keyword];
                    ct.otherPublic _ Assert[reln, terms, ct.otherPublic];>>
                    };
            ENDLOOP;
        IF (NOT dr.toMerge.Empty[]) THEN {
            IF cr.firstMerge THEN ERROR;
            DoMerges[s, cr];
            }
        ELSE IF cr.firstMerge THEN {cr.firstMerge _ FALSE; TryArrayFile[cr]};
        IF nested THEN RETURN;
        {CleanupChild: PROC [ra: Sets.Value] = {
            ci: CellInstance = NARROW[ra.VA];
            childType: CellType = NARROW[d.ciType.ApplyA[ci].MA];
            IF childType.asArray # NIL THEN CheckArrayUsage[d, childType];
            RETURN};
        d.cct[i].EnumerateMapping[AV[ct], CleanupChild, rightToLeft];
        RETURN}};

    CheckArrayUsage: PUBLIC PROC [d: Design, act: CellType] ~ {
        IF d.arrayElt.HasMapA[act, rightToLeft] OR d.ciType.MappingSize[AV[act], rightToLeft] # IS.one THEN ERROR;
        };

    FmtStack: PROC [stack: SourceList] RETURNS [prefix: ROPE] = {
        prefix _ NIL;
        FOR stack _ stack, stack.rest WHILE stack # NIL DO
            full: ROPE;
            cp: FS.ComponentPositions;
            [full, cp, ] _ FS.ExpandName[stack.first.name];
            prefix _ IO.PutFR["%g[%g], %g", [rope[full.Substr[cp.base.start, cp.base.length]]], [integer[IO.GetIndex[stack.first.stream]]], 
            [rope[prefix]]];
            ENDLOOP;
        RETURN};

    paths: PUBLIC SetBasics.Space ~ NEW [SetBasics.SpacePrivate _ [
        Contains: PathsContains,
        Equal: PathsEqual,
        AHash: PathsHash,
        ACompare: PathsCompare,
        name: "paths"
        ]];

    PathsContains: PROC [data: REF ANY, v: Sets.Value] RETURNS [BOOL] ~ {
        RETURN [WITH v.ra SELECT FROM
            x: Path => TRUE,
            ENDCASE => FALSE]};

    PathsEqual: PROC [data: REF ANY, v1, v2: Sets.Value] RETURNS [BOOL] --SetBasics.EqualProc-- ~ {
        p1: Path ~ NARROW[v1.VA];
        p2: Path ~ NARROW[v2.VA];
        RETURN [ComparePaths[p1, p2]=equal]};

    PathsHash: PROC [data: REF ANY, v: Sets.Value] RETURNS [CARDINAL] --SetBasics.HashProc-- ~ {
        RETURN [HashPath[NARROW[v.VA]]]};

    PathsCompare: PROC [data: REF ANY, v1, v2: Sets.Value] RETURNS [c: SetBasics.TotalComparison] --SetBasics.CompareProc-- ~ {
        p1: Path ~ NARROW[v1.VA];
        p2: Path ~ NARROW[v2.VA];
        RETURN ComparePaths[p1, p2]};

    ComparePaths: PUBLIC PROC [path1, path2: Path] RETURNS [c: SetBasics.TotalComparison] = {
        DO
            IF path1 = path2 THEN RETURN [equal];
            IF path1 = NIL THEN RETURN [less];
            IF path2 = NIL THEN RETURN [greater];
            WITH path1.first SELECT FROM
                r1: ROPE => WITH path2.first SELECT FROM
                    r2: ROPE => c _ SetBasics.Unbasicify[r1.Compare[r2]];
                    x2: REF Range2 => c _ less;
                    ENDCASE => ERROR;
                s1: REF Range2 => WITH path2.first SELECT FROM
                    r2: ROPE => c _ greater;
                    s2: REF Range2 =>
                        IF (c _ IntCompare[s1[X].min, s2[X].min]) = equal THEN
                        IF (c _ IntCompare[s1[X].maxPlusOne, s2[X].maxPlusOne]) = equal THEN
                        IF (c _ IntCompare[s1[Y].min, s2[Y].min]) = equal THEN
                        c _ IntCompare[s1[Y].maxPlusOne, s2[Y].maxPlusOne];
                    ENDCASE => ERROR;
                ENDCASE => ERROR;
            IF c # equal THEN RETURN;
            path1 _ path1.rest;
            path2 _ path2.rest;
            ENDLOOP;
        };

    HashPath: PROC [path: Path] RETURNS [hash: CARDINAL] = {
        hash _ 0;
        FOR path _ path, path.rest WHILE path # NIL DO
            WITH path.first SELECT FROM
                r: ROPE => hash _ hash + RopeHash.FromRope[r];
                x: REF Range2 => hash _ hash + SetBasics.HashIntI[x[X].min] + SetBasics.HashIntI[x[X].maxPlusOne] + SetBasics.HashIntI[x[Y].min] + 
                SetBasics.HashIntI[x[Y].maxPlusOne];
                ENDCASE => ERROR;
            ENDLOOP;
        };

    fetSpace: Sets.Space ~ NEW [SetBasics.SpacePrivate _ [
        Contains: FetsContains,
        Equal: FetsEqual,
        AHash: FetsHash,
        ACompare: FetsCompare,
        name: "fets"]];

    FetsContains: PROC [data: REF ANY, v: Sets.Value] RETURNS [BOOL] ~ {
        IF v.i#0 THEN RETURN [FALSE];
        WITH v.ra SELECT FROM
            x: FetType => RETURN [TRUE];
            ENDCASE => RETURN [FALSE];
        };

    FetsHash: PROC [data: REF ANY, v: Sets.Value] RETURNS [hash: CARDINAL] ~ {
        ft: FetType ~ NARROW[v.VA];
        hash _ RopeHash.FromRope[ft.className];
        hash _ (hash + 3*ft.area + 11*ft.perim + 101*ft.twiceLength) MOD 65536;
        RETURN};

    FetsEqual: PROC [data: REF ANY, v1, v2: Sets.Value] RETURNS [BOOL]
        ~ {RETURN [FetsCompare[data, v1, v2]=equal]};

    FetsCompare: PROC [data: REF ANY, v1, v2: Sets.Value] RETURNS [c: SetBasics.TotalComparison] ~ {
        k1: FetType ~ NARROW[v1.VA];
        k2: FetType ~ NARROW[v2.VA];
        IF (c _ SetBasics.Unbasicify[k1.className.Compare[k2.className]]) # equal THEN RETURN;
        IF (c _ IntCompare[k1.area, k2.area]) # equal THEN RETURN;
        IF (c _ IntCompare[k1.perim, k2.perim]) # equal THEN RETURN;
        IF (c _ IntCompare[k1.twiceLength, k2.twiceLength]) # equal THEN RETURN;
        RETURN [equal]};

    IntCompare: PROC [a, b: INT] RETURNS [SetBasics.TotalComparison]
        ~ SetBasics.CompareIntI;

    Register: PUBLIC PROC [keyword: ROPE, read: PROC [s: Source, reader: Reader, cr: CellReading], data: REF ANY _ NIL] = {
        r: Reader _ NEW [ReaderRep _ [keyword, read, data]];
        readers.AddNewAA[keyword, r];
        };

    Start: PROC = {
        };

    Start[];

    END.