
<<WindSweepImpl.mesa>>
    <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
    <<Greene, March 28, 1986 5:42:23 pm PST>>

DIRECTORY
Commander USING [CommandProc, Register],
Containers USING [Container, Create],
Imager USING [Context, Color, ScaleT, MaskFillTrajectory, MaskStrokeTrajectory, SetColor, black, SetStrokeWidth, SetStrokeEnd, 
SetStrokeJoint],
ImagerColor USING [ColorFromRGB],
ImagerPath USING[LineTo, MoveTo, Trajectory],
Menus USING[CreateMenu, AppendMenuEntry, CreateEntry, Menu, ClickProc],
Real USING [Float, Round],
Rope USING [ROPE],
Sweep,
TIPUser USING [TIPScreenCoords, InstantiateNewTIPTable],
Vector2 USING [VEC],
ViewerClasses USING [ViewerClass, ViewerClassRec, Viewer, PaintProc, NotifyProc],
ViewerOps USING [CreateViewer, RegisterViewerClass, PaintViewer];

WindSweepImpl: CEDAR MONITOR
LOCKS my USING my: State
IMPORTS Containers, Commander, Imager, ImagerPath, ImagerColor, Menus, Real, Sweep, TIPUser, ViewerOps =

BEGIN OPEN Sweep;

Scale: INT _ 50;

WindLine: TYPE = REF WindLineRec;
WindLineRec: TYPE = RECORD [
deltaWind: INTEGER
];

windPlusOne: WindLine = NEW[WindLineRec _ [deltaWind: 1]];

WindCopy: CopyLineProc = {
RETURN[stateIn];   --WindLineRec's are imutable
};

WindCombine: CombineLineProc = {
s1: WindLine _ NARROW[state1];
s2: WindLine _ NARROW[state2];
sO: WindLine _ NEW[WindLineRec _ [deltaWind: s1.deltaWind + s2.deltaWind]];
RETURN[sO];
};

WindFlip: FlipLineProc = {
sI: WindLine _ NARROW[stateIn];
sO: WindLine _ NEW[WindLineRec _ [deltaWind: - sI.deltaWind]];
RETURN[sO];
};


WindRegion: TYPE = REF WindRegionRec;
WindRegionRec: TYPE = RECORD[
wind: INTEGER];

windInfinityRegion: WindRegion = NEW[WindRegionRec _ [wind: 0]];

WindStart: StartRegionProc = {
rR: WindRegion _ NARROW[regionPrevious];
RETURN[NEW[WindRegionRec _ [wind: rR.wind + NARROW[lineRight.state, WindLine].deltaWind]]];
};

WindStop: StopRegionProc = {
rC:WindRegion _ NARROW[regionCenter];
IF NOT FigureImportant[NARROW[lineLeft.state], rC] THEN RemoveLineFromEndPoints[lineLeft];
};


WindMerge: MergeRegionProc = {
rR: WindRegion _ NARROW[regionRight];
IF NOT FigureImportant[NARROW[lineRight.state], rR] THEN RemoveLineFromEndPoints[lineRight]; 
RETURN[regionRight];
};

WindLineChange: LineChangeRegionProc = {
IF side = left THEN {
rC: WindRegion _ NARROW[regionCenter];
IF NOT FigureImportant[NARROW[lineOld.state], rC] THEN RemoveLineFromEndPoints[lineOld];
};
};


    FigureImportant: PROC [lineLeftState: WindLine, regionCenter: WindRegion] RETURNS [BOOLEAN] ~ {
        IF lineLeftState.deltaWind = 0 THEN RETURN[FALSE];
        IF regionCenter.wind = 0 THEN RETURN[TRUE];
        IF lineLeftState.deltaWind + regionCenter.wind = 0 THEN RETURN[TRUE];
        RETURN[FALSE];
        };

lightGreen: Imager.Color = ImagerColor.ColorFromRGB[[0.0, 1.0, 0.0]];
darkBlue: Imager.Color = ImagerColor.ColorFromRGB[[0.0, 0.0, .7]];
lightRed: Imager.Color = ImagerColor.ColorFromRGB[[0.9, 0.0, 0.0]];


State: TYPE = REF StateRec;
StateRec: TYPE = MONITORED RECORD [
outer: Containers.Container _ NIL,
menu: Menus.Menu,
inner: ViewerClasses.Viewer,
originX, originY: INT,
loopInProgress: BOOLEAN _ FALSE,
mouse: TIPUser.TIPScreenCoords,
input: Graph _ NewGraph[],
reduced: BOOLEAN _ FALSE,
output: Graph];

Change: TYPE =  REF ChangeRec;
ChangeRec: TYPE = RECORD[doc: Rope.ROPE];

allFlag: Change = NIL;
lastLine: Change = NEW[ChangeRec _ ["Paint Last Line"]];
 

ShowWind: Commander.CommandProc = {
my: State _ NEW[StateRec];

my.menu _ Menus.CreateMenu[];

my.menu.AppendMenuEntry[Menus.CreateEntry["Clear", ClearProc, my]];
my.menu.AppendMenuEntry[Menus.CreateEntry["Reduce", ReduceProc, my]];

my.outer _ Containers.Create[[
name: "Wind",
menu: my.menu,
scrollable: FALSE]];

my.inner _ ViewerOps.CreateViewer[
flavor: $ShowWind,
info: [wx: 10, wy: 10, wh: 400, ww: 600, parent: my.outer, data: my]];

ViewerOps.PaintViewer[viewer: my.inner, hint: all];

};

ClearProc:  Menus.ClickProc = {
my: State _ NARROW[clientData];
ClearLocked[my];
ViewerOps.PaintViewer[viewer: my.inner, hint: all];
};

ClearLocked: ENTRY PROC[my: State] ~ {
ENABLE UNWIND => NULL;
    DestroyGraph[my.input]; my.input _ NewGraph[];
    DestroyGraph[my.output]; my.output _ NIL;
my.reduced _ my.loopInProgress _ FALSE;
};

ReduceProc:  Menus.ClickProc = {
my: State _ NARROW[clientData];
ReduceLocked[my];
ViewerOps.PaintViewer[viewer: my.inner, hint: all, whatChanged: allFlag];
};

ReduceLocked: ENTRY PROC[my: State] ~ {
ENABLE UNWIND => NULL;
CloseLoop[my];
    my.output _ Intersect[CopyGraph[my.input], WindCopy, WindCombine, WindFlip];
    my.output _ Sweep[my.output, windInfinityRegion, WindStart, WindStop, NilSplit, WindMerge, WindLineChange];
    my.reduced _ TRUE; 
};


ShowWindPaint: ViewerClasses.PaintProc = {
my:State _ NARROW[self.data];

    context.ScaleT[40.0/Scale];
context.SetStrokeEnd[round];
context.SetStrokeJoint[round];

PaintLocked[my, context, whatChanged];
    };

    MonotoneRegion: TYPE = REF MonotoneRegionRec;
    MonotoneRegionRec: TYPE = RECORD [
        inside: BOOLEAN,
        lastPointSeen: Point _ NIL,
        mustConnect: BOOLEAN _ FALSE
        ];

    monotoneInfinityRegion: MonotoneRegion = NEW[MonotoneRegionRec _ [inside: FALSE]];

    PaintLocked: ENTRY PROC [my: State, context: Imager.Context, whatChanged: REF ANY] ~ {
    OPEN Imager, ImagerPath;
    ENABLE UNWIND => NULL;
    garbage: Graph;

    MonotoneStart: StartRegionProc = {
        rR: MonotoneRegion _ NARROW[regionPrevious];
        RETURN[NEW[MonotoneRegionRec _ [inside: NOT rR.inside, lastPointSeen: lineLeft.above]]];
    };

    MonotoneStop: StopRegionProc = {
        rC: MonotoneRegion _ NARROW[regionCenter];
        IF rC.inside THEN  {
            Resolve[rC, lineLeft.below, left];
            WalkPerimeter[lineRight];
            };
    };

    MonotoneSplit: SplitRegionProc = {
        rR: MonotoneRegion _ NARROW[regionRight];
        line: Line;
        point: Point _ lineRight.above;
        IF rR.inside THEN {
            line _ NEW[LineRec _ [above: rR.lastPointSeen, below: point]];
            InsertLineInEndPoints[line];
            rR.mustConnect _ FALSE;
            rR.lastPointSeen _ point;
            RETURN[NEW[MonotoneRegionRec _ [inside: TRUE, lastPointSeen: point]]];
            }
        ELSE
            RETURN[rR];
    };

    MonotoneMerge: MergeRegionProc = {
        rL: MonotoneRegion _ NARROW[regionLeft];
        rR: MonotoneRegion _ NARROW[regionRight];
        point: Point _ lineRight.below;
        IF rL.inside THEN {
            IF NOT rR.inside THEN ERROR;
            Resolve[rR, point, left]; Resolve[rL, point, right];
            rR.mustConnect _ TRUE; 
            };
    RETURN[rR];
    };

    MonotoneLineChange: LineChangeRegionProc = {
        rC: MonotoneRegion _ NARROW[regionCenter];
        point: Point _ lineNew.above;
        IF rC.inside THEN Resolve[rC, point, side];
    };


    Resolve: PROC [r: MonotoneRegion, p: Point, position: LeftOrRight] ~ {
    line: Line;
        IF r.mustConnect THEN {
        line _ NEW[LineRec _ [above: r.lastPointSeen, below: p]];
        InsertLineInEndPoints[line];
        r.mustConnect _ FALSE;
        IF position = left THEN WalkPerimeter[line] ELSE WalkPerimeter[line.clockwiseAroundBelow];
        };
    r.lastPointSeen _ p;
    };


    WalkPerimeter: PROC [start: Line] ~ {
        traj: Trajectory _ MoveTo[Vfi[start.below.x, start.below.y]];
        WHILE start.clockwiseAroundAbove = NIL DO
            start _ start.above.incoming;
            traj _ traj.LineTo[Vfi[start.below.x, start.below.y]];
            ENDLOOP;
        start _ start.clockwiseAroundAbove;
        traj _ traj.LineTo[Vfi[start.above.x, start.above.y]];
        WHILE start.clockwiseAroundBelow = NIL DO
            start _ start.below.outgoing;
            traj _ traj.LineTo[Vfi[start.above.x, start.above.y]];
            ENDLOOP;
        context.SetColor[lightGreen];
        MaskFillTrajectory[context, traj];
        context.SetColor[black];
        MaskStrokeTrajectory[context, traj, TRUE];
        };

    PaintLines: PROC [in: Graph, pointSize, lineSize: REAL] = {
    PerLine: PROC [l: Line] RETURNS [BOOL] ~ {
        IndividualLine[l, pointSize, lineSize]; RETURN[FALSE];
        };
    IF in = NIL THEN RETURN;
    [] _ EnumerateLines[in, PerLine];
        };

    IndividualLine: PROC [l: Line, pointSize, lineSize: REAL] ~ {
        context.SetStrokeWidth[pointSize];
        context.MaskStrokeTrajectory[MoveTo[Vfi[l.above.x, l.above.y]].LineTo[Vfi[l.above.x, l.above.y]]];
        context.MaskStrokeTrajectory[MoveTo[Vfi[l.below.x, l.below.y]].LineTo[Vfi[l.below.x, l.below.y]]];
        context.SetStrokeWidth[lineSize];
        context.MaskStrokeTrajectory[MoveTo[Vfi[l.below.x, l.below.y]].LineTo[Vfi[l.above.x, l.above.y]]];
        };

    IF whatChanged = allFlag THEN {
        context.SetColor[lightRed];
        PaintLines[my.input, .2*Scale, .1*Scale];
        context.SetColor[darkBlue];
        PaintLines[my.output, .11*Scale, .04*Scale];

        context.SetStrokeWidth[.05*Scale];
    context.SetColor[black];
        FOR i: INT IN [1..15] DO
            FOR j: INT IN [1..10] DO
                context.MaskStrokeTrajectory[MoveTo[Vfi[i*Scale,j*Scale]].LineTo[Vfi[i*Scale,j*Scale]]];
                ENDLOOP;
            ENDLOOP;

        IF my.reduced THEN {
            context.SetStrokeWidth[.06*Scale];
            garbage _ Sweep[CopyGraph[my.output, WindCopy], monotoneInfinityRegion, MonotoneStart, MonotoneStop, MonotoneSplit, MonotoneMerge, 
            MonotoneLineChange];
            DestroyGraph[garbage];
            }
        }
    ELSE
        {IF whatChanged # lastLine THEN ERROR;
        context.SetColor[lightRed];
        IndividualLine[LastLine[my.input], .2*Scale, .1*Scale];
        };
    };

    Vfi: PROC [i, j: INT] RETURNS [Vector2.VEC] ~ {
        RETURN[[Real.Float[i], Real.Float[j]]];
        };

    PaintRequest: TYPE = {none, all, lastLine};

    LineComing: ViewerClasses.NotifyProc ~ {
    my: State _NARROW[self.data];
    paint: PaintRequest _ LineComingLocked[my, input];
    IF paint = all THEN ViewerOps.PaintViewer[viewer: my.inner, hint: all, whatChanged: allFlag]
    ELSE IF paint = lastLine THEN ViewerOps.PaintViewer[viewer: my.inner, hint: all, clearClient: FALSE, whatChanged: lastLine];
    };

    LineComingLocked: ENTRY PROC[my: State, input: LIST OF REF ANY]  RETURNS [paint: PaintRequest _ none] ~ {
    ENABLE UNWIND => NULL;
    headX, headY: INT;
    FOR list: LIST OF REF ANY _ input, list.rest UNTIL list = NIL DO
        WITH list.first SELECT FROM
            a: ATOM  => SELECT a FROM
            $Head    => {
            headX _ IS[my.mouse.mouseX]; headY _ IS[my.mouse.mouseY];
            IF NOT my.loopInProgress THEN {
            my.originX _ headX;  my.originY _ headY;
            my.input _ NewPoint[my.input, headX, headY];
            my.loopInProgress _ TRUE;
            }
            ELSE {
            my.input _ LineTo[my.input, headX, headY, windPlusOne, WindFlip];
            paint _ IF paint = none THEN lastLine ELSE all;
            };
            };
            $Tail => {
            IF my.loopInProgress THEN paint _ IF paint = none THEN lastLine ELSE all;
            CloseLoop[my];
            };
            ENDCASE    => NULL;
        z: TIPUser.TIPScreenCoords => my.mouse _ z;
        ENDCASE => ERROR;
    ENDLOOP;
};

    CloseLoop: PROC [my: State]  ~ {
        IF my.loopInProgress THEN {
            my.loopInProgress _ FALSE;
            my.input _ LineTo[my.input, my.originX, my.originY, windPlusOne, WindFlip];
        };
        };

    IS: PROC [i: INT] RETURNS [o: INT] ~ INLINE {
        RETURN[Real.Round[i*Scale/40.0]];
        };


displayerClass: ViewerClasses.ViewerClass _ NEW[ViewerClasses.ViewerClassRec _
[paint: ShowWindPaint, notify: LineComing, tipTable: TIPUser.InstantiateNewTIPTable["WindSweep.tip"]]];
ViewerOps.RegisterViewerClass[$ShowWind, displayerClass];
Commander.Register[key: "ShowWind", proc: ShowWind, doc: "To Debug Winding"];

    END.