JunoImageImpl.mesa
Pieces from JunoTop.mesa created May 1981 by Greg Nelson, Donna Auguste
Last Edited by: Gnelson, January 17, 1984 11:32 am
Last Edited by: Maureen Stone January 19, 1984 12:08 pm
Last Hacked by: Jorge Stolfi June 13, 1984 10:10:34 am PDT
Procedures to manipulate and paint the current Juno image.
DIRECTORY
JunoStorage,
JunoImage,
JunoUserEvents USING [bugout],
JunoOldSolver USING [Solve, Outcome],
IO USING [atom, PutF],
RealFns USING [SqRt];
- - - - THE CURRENT IMAGE
thePoints: PointList ← [NIL, NIL];
theItems: ItemList ← [NIL, NIL];
PurgeImage:
PUBLIC
PROC =
BEGIN
GcPoints [start: thePoints.first, lim: NIL]; thePoints ← [NIL, NIL];
GcItems[start: theItems.first, lim: NIL]; theItems ← [NIL, NIL]
END;
- - - - IMAGE POINTS
AddPoint:
PUBLIC
PROC [p: Point] =
BEGIN
thePoints ← InsertPoint[p, thePoints.last, thePoints];
Evs.bugout.PutF["Im.AddPoint: %g\n", IO.atom[p.name]]
END;
RemovePoint:
PUBLIC
PROC [p: Point] =
BEGIN
thePoints ← DeletePoint[p, NIL, thePoints];
Evs.bugout.PutF["Im.RemovePoint: %g\n", IO.atom[p.name]];
GcPoints[p, p.link]
END;
SortPoints:
PUBLIC
PROC =
BEGIN
[thePoints.first, thePoints.last] ← DoSortPoints[thePoints.first]
END;
DoSortPoints:
PROC [in: Point]
RETURNS [first, last: Point] =
Sorts in, in.link, in.link.link, ... (up to last point) by increasing x-coordinate.
Should be O(n log n) worst case, O(n) if points are already sorted, and mostly fast if points are mostly sorted.
Hope it works.
BEGIN
p, q, pl, ql: Point ←
NIL;
runs:
INTEGER;
DO
Do one more pass over the entire list:
runs ← 0; first ← last ← NIL;
DO
Are there any more runs?
IF in = NIL THEN EXIT;
runs ← runs+1; -- we are going to produce at least one more merged run
Get the next ascending run:
p ← in; in ← in.link;
pl ← p;
WHILE in # NIL AND in.coords.x >= pl.coords.x DO
pl ← in; in ← in.link
ENDLOOP;
If that is the only remaining run, we don't have to merge:
IF in = NIL THEN
{IF first = NIL THEN first ← p;
last ← pl; EXIT};
Get the run after that (may be empty):
q ← in;
ql ← in; in ← in.link;
WHILE in # NIL AND in.coords.x >= ql.coords.x DO
ql ← in; in ← in.link
ENDLOOP;
Now the situation is like this:
last p pl q ql in
! ! ! ! ! !
... - A - B - B - ... - B - C - C - ... - C - D - ...
where B, C are non-empty increasing runs (last and/or in may be NIL).
Merge the B and C runs into a single run:
DO
--here p # q and q # in
IF p.coords.x < q.coords.x THEN
{IF first = NIL THEN first ← p;
last ← p; p ← p.link;
IF p = q THEN {last ← ql; EXIT}}
ELSE
{IF first = NIL THEN first ← q ELSE last.link ← q;
last ← q; q ← q.link;
last.link ← p; pl.link ← q;
IF q = in THEN {last ← pl; EXIT}};
ENDLOOP
ENDLOOP;
IF runs < 2 THEN RETURN;
in ← first
ENDLOOP
END;
- - - - ELEMENT ENUMERATION
EnumPoints:
PUBLIC
PROC [Proc: PointVisitProc] =
BEGIN
FOR p: Point ← thePoints.first, p.link WHILE p # NIL DO Proc[p] ENDLOOP
END;
ReplacePoints:
PUBLIC
PROC [Proc: PointReplaceProc] =
BEGIN
ant, new, next: Point ← NIL;
FOR p: Point ← thePoints.first, next WHILE p # NIL DO
next ← p.link;
new ← Proc[p];
IF new # p THEN
{thePoints ← DeletePoint[p, ant, thePoints];
Evs.bugout.PutF["Im.ReplacePoints: deleted %g", IO.atom[p.name]];
IF new # NIL THEN
{thePoints ← InsertPoint[new, ant, thePoints];
Evs.bugout.PutF[" added %g", IO.atom[p.name]];
ant ← new};
Evs.bugout.PutF["\n"]}
ELSE
{ant ← p}
ENDLOOP
END;
EnumItems:
PUBLIC
PROC [Proc: ItemVisitProc] =
BEGIN
FOR item: Item ← theItems.first, item.link WHILE item # NIL DO Proc[item] ENDLOOP
END;
EnumArgs:
PROC [args:
LIST
OF
REF
ANY, Proc: PointVisitProc] =
Enumerates all points in a multi-level list structure
{FOR p: LIST OF REF ANY ← args, p.rest WHILE p # NIL DO
WITH p.first SELECT FROM
pt: Point => Proc[pt];
lst: LIST OF REF ANY => EnumArgs[lst, Proc];
ENDCASE
ENDLOOP};
EnumItemPoints:
PUBLIC
PROC [item: Item, Proc: PointVisitProc] =
BEGIN
EnumArgs[item.args, Proc];
IF item.frame.org # NIL THEN Proc[item.frame.org];
IF item.frame.hor # NIL THEN Proc[item.frame.hor];
IF item.frame.ver # NIL THEN Proc[item.frame.ver]
END;
ReplaceArgs:
PROC [args:
LIST
OF
REF
ANY, Proc: PointReplaceProc] =
Replaces all points in a multi-level list structure. The PointReplaceproc must not return NIL.
{FOR p: LIST OF REF ANY ← args, p.rest WHILE p # NIL DO
WITH p.first SELECT FROM
pt: Point => {p.first ← Proc[pt]; IF p.first = NIL THEN ERROR};
lst: LIST OF REF ANY => ReplaceArgs[lst, Proc];
ENDCASE
ENDLOOP};
ReplaceItemPoints:
PUBLIC
PROC [item: Item, Proc: PointReplaceProc] =
BEGIN
ReplaceArgs[item.args, Proc];
IF item.frame.org # NIL THEN item.frame.org ← Proc[item.frame.org];
IF item.frame.hor # NIL THEN item.frame.hor ← Proc[item.frame.hor];
IF item.frame.ver # NIL THEN item.frame.ver ← Proc[item.frame.ver]
END;
- - - - POINT LOCATION
Distance:
PROC [p, q: Coords]
RETURNS [
REAL] =
INLINE
BEGIN
dx: REAL = p.x-q.x;
dy: REAL = p.y-q.y;
RETURN[RealFns.SqRt[dx*dx+dy*dy]] -- Is SqRt fast enough?
END;
FindPoint:
PUBLIC
PROC [coords: Coords, wound:
BOOL ←
FALSE]
RETURNS [champ: Point] =
BEGIN
champdistance, pdistance: REAL;
champ ← NIL;
champdistance ← 1.0E+30;
FOR p: Point ← thePoints.first, p.link WHILE p # NIL DO
IF wound AND p.wn = 0 THEN LOOP;
pdistance ← Distance[p.coords, coords];
IF pdistance < champdistance THEN
{champ ← p; champdistance ← pdistance}
ENDLOOP
END;
- - - - BALOON SELECTION
BaloonSelect:
PUBLIC
PROC [start: IntCoords, NextPoint: NextPointProc] =
BEGIN
WARNING: while this procedure is working, the links of the image points list are not valid.
temp, pl, pr: Point;
old: IntCoords ← start;
new: IntCoords;
lastPoint: BOOL ← FALSE;
BaloonSelect works by repeatedly sampling the calling the procedure Wind for each point on the outline of the baloon:
Wind:
PROCEDURE =
BEGIN
The effect of Wind is to compute the winding number of the small segment from old to new around every point.
The winding number of the segment around the point (px, py) is zero unless px is in the range [old.x, new.x) and the point p is abovethe line through old and new. If non-zero, it is 1 or -1 according as new.x > old.x or new.x < old.x.
To rapidly find the points (px,py) such that px is in [old.x, new.x), we arrange that (a) the points pl, pl.link, pl.link.link ... are exactly those points whose x coordinates are less than old.x, and the points are listed in decreasing order of their x coordinates, and (b) the points pr, pr.link, pr.link.link, ... are exactly those points whose x coordinates are greater than or equal to old.x, and the points are listed in increasing order of their x coordinates.
IF old.x < new.x
THEN
-- move right:
{WHILE pr #
NIL
AND pr.coords.x < new.x
DO
pc: Coords = pr.coords;
-- transfer one point from the list pr to the list pl:
temp ← pr.link;
pr.link ← pl;
pl ← pr;
pr ← temp;
Now update winding number of point if it is above line of mouse motion.
IF (pc.y - old.y)*(new.x - old.x) > (new.y - old.y)*(pc.x - old.x) THEN
{pl.wn ← pl.wn + 1}
ENDLOOP}
ELSE
IF old.x > new.x
THEN
-- move left:
{
WHILE pl #
NIL
AND pl.coords.x >= new.x
DO
pc: Coords = pl.coords;
temp ← pl.link;
pl.link ← pr;
pr ← pl;
pl ← temp;
IF (pc.y - new.y)*(old.x - new.x) > (old.y - new.y)*(pc.x - new.x) THEN
{pr.wn ← pr.wn - 1}
ENDLOOP};
END;
PreparePointLists:
PROCEDURE =
{-- Prepares the point lists pl and pr for Wind
SortPoints; -- just to make sure
pr ← thePoints.first; pl ← NIL;
WHILE pr # NIL AND pr.coords.x < start.x DO
temp ← pr.link; pr.link ← pl; pl ← pr; pr ← temp
ENDLOOP};
RestorePointList:
PROCEDURE =
{-- Restores the point list
WHILE pl # NIL DO
temp ← pl.link; pl.link ← pr; pr ← pl; pl ← temp
ENDLOOP};
PreparePointLists;
{ENABLE UNWIND => {RestorePointList};
UNTIL lastPoint DO
[new, lastPoint] ← NextPoint[];
Wind;
old ← new;
ENDLOOP;
new ← start; -- close baloon
Wind};
RestorePointList
END;
AnyWoundPoints:
PUBLIC
PROC
RETURNS [
BOOL] =
BEGIN
FOR p: Point ← thePoints.first, p.link WHILE p # NIL DO
IF p.wn#0 THEN RETURN [TRUE]
ENDLOOP;
RETURN [FALSE]
END;
ItemIsWound:
PUBLIC
PROC [item: Item]
RETURNS [wound:
BOOL] =
BEGIN
TestPoint: PointVisitProc = {wound ← wound AND p.wn # 0};
wound ← TRUE;
EnumItemPoints[item, TestPoint]
END;