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.