DIRECTORY

JunoStorage,
JunoImage,
JunoUserEvents USING [bugout],
JunoOldSolver USING [Solve, Outcome],
IO USING [atom, PutF],
RealFns USING [SqRt];

JunoImageImpl: PROGRAM

IMPORTS

JunoStorage,
JunoOldSolver,
JunoUserEvents,
IO,
RealFns  

EXPORTS

JunoImage  

  = 

BEGIN

OPEN

  JunoStorage,
  JunoImage,
  Evs: JunoUserEvents,
  Solv: JunoOldSolver;

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;

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] =

BEGIN

p, q, pl, ql: Point _ NIL;
runs: INTEGER;
   
DO

runs _ 0; first _ last _ NIL;

DO

IF in = NIL THEN EXIT;
runs _ runs+1; -- we are going to produce at least one more merged 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 in = NIL THEN
   {IF first = NIL THEN first _ p;
    last _ pl; EXIT};

q _ in;
ql _ in; in _ in.link;
WHILE in # NIL AND in.coords.x >= ql.coords.x DO
   ql _ in; in _ in.link
 ENDLOOP;

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;

AddItem: PUBLIC PROC [item: Item] =

BEGIN
   theItems _ InsertItem [item, theItems.last, theItems]
END;

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] =

{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] =

{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; 

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;

BaloonSelect: PUBLIC PROC [start: IntCoords, NextPoint: NextPointProc] =

BEGIN

temp, pl, pr: Point;
old: IntCoords _ start;
new: IntCoords;
lastPoint: BOOL _ FALSE;

Wind: PROCEDURE =

BEGIN

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;

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;

DeleteWoundItems: PUBLIC PROCEDURE = 

BEGIN

Mark: PointVisitProc = {p.mark _ TRUE};
UnMark: PointVisitProc = {p.mark _ FALSE};

EnumPoints[UnMark];

{ant, next: Item _ NIL;
 FOR item: Item _ theItems.first, next WHILE item # NIL DO
    next _ item.link;
    IF ItemIsWound[item] AND NOT item.kind IN StatePushingActionKind THEN
       {theItems _ DeleteItem[item, ant, theItems]}
    ELSE
       {EnumItemPoints[item, Mark]; ant _ item};
  ENDLOOP};

{ant, next: Point _ NIL;
 FOR p: Point _ thePoints.first, next WHILE p # NIL DO
    next _ p.link;
    IF p.wn # 0 AND NOT p.mark THEN
       {thePoints _ DeletePoint[p, ant, thePoints]; GcPoints[p, p.link]}
    ELSE
       {ant _ p};
    p.wn _ 0; p.mark _ FALSE;
  ENDLOOP}

END;

DuplicateWoundItems: PUBLIC PROCEDURE = 

BEGIN

RepByCopy: PointReplaceProc = {RETURN [IF p.copy # NIL THEN p.copy ELSE p]};

CopyArgs: PROC [args: LIST OF REF ANY] RETURNS [copy: LIST OF REF ANY] =

{RETURN[IF args = NIL THEN NIL ELSE
    Cons [WITH args.first SELECT FROM
              lst: LIST OF REF ANY => CopyArgs[lst],
              ENDCASE => args.first,
            CopyArgs[args.rest]]]};

CopyItem: PROC [item: Item] RETURNS [cCopy: Item] =

BEGIN
   cCopy _ NewItem [kind: item.kind, frame: item.frame, args: CopyArgs[item.args]];
END;


{copy, next: Point _ NIL;
 FOR p: Point _ thePoints.first, next WHILE p # NIL DO
    next _ p.link;
    IF p.wn # 0 THEN
      {copy _ NewPoint[p.coords, p.visible];
       thePoints _ InsertPoint[copy, p, thePoints]; -- insert just after p
       p.copy _ copy; copy.wn _ p.wn;
       copy.mark _ FALSE}
    ELSE
      {p.copy _ NIL}
   ENDLOOP};

{copy, next: Item _ NIL;
 copiedItems: ItemList _ [NIL, NIL];
 FOR item: Item _ theItems.first, next WHILE item # NIL DO
    next _ item.link;
    IF item.kind IN StatePushingActionKind OR ItemIsWound[item] THEN
       {copy _ CopyItem[item]; ReplaceItemPoints [copy, RepByCopy];
        copiedItems _ InsertItem[copy, copiedItems.last, copiedItems]}
  ENDLOOP;
 IF theItems.first # NIL AND copiedItems.first # NIL THEN
    {theItems.last.link _ copiedItems.first; 
     theItems _ [theItems.first, copiedItems.last]}};

{Unw: PointVisitProc = {IF p.copy # NIL THEN p.wn _ 0}; EnumPoints[Unw]}

END;

IdentifyPoints: PUBLIC PROC =

BEGIN

UnMark: PointVisitProc = {p.mark _ FALSE};

UpdateAndMark: PointReplaceProc =
       {IF p.copy # NIL THEN {p.copy.mark _ TRUE; RETURN [p.copy]}
        ELSE RETURN [p]};

IdItemArgs: ItemVisitProc = {ReplaceItemPoints[item, UpdateAndMark]};

DeleteUnreachableOriginals: PointReplaceProc =
       {new _ IF p.mark OR p.copy=NIL THEN p ELSE NIL;
        p.mark _ FALSE; p.copy _ NIL};

-- Mark copies so that we know who becomes unreachable
EnumPoints[UnMark];
-- Replace p by p.copy in all actions and constraints, whenever p.copy # NIL
EnumItems[IdItemArgs];
-- Now delete original points that have become unreachable
ReplacePoints[DeleteUnreachableOriginals]

END;  

SolveImage: PUBLIC PROC [eps: REAL] RETURNS [outcome: Solv.Outcome] =

  {-- Should display an hourglass and perhaps disable mouse/keyboard input.
   outcome _ Solv.Solve[theItems, eps];
   SortPoints[];
   -- Should turn off hourglass and re-enable mouse/keyboard input.
   };

END. 



v 
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. 

- - - - THE CURRENT IMAGE

- - - - IMAGE POINTS 
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.

Do one more pass over the entire list:

Are there any more runs?

Get the next ascending run:

If that is the only remaining run, we don't have to merge:

Get the run after that (may be empty):

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:

- - - - CONSTRAINTS

- - - - ELEMENT ENUMERATION  
Enumerates all points in a multi-level list structure
Replaces all points in a multi-level list structure. The PointReplaceproc must not return NIL.

- - - - POINT LOCATION 

- - - - BALOON SELECTION 

WARNING: while this procedure is working, the links of the image points list are not valid.

BaloonSelect works by repeatedly sampling the calling the procedure Wind for each point on the outline of the baloon:

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.

Now update winding number of point if it is above line of mouse motion.

- - - - OPERATIONS ON BALOON-SELECTED POINTS  

Reset the marks in all points:

Delete all constraints and actions whose arguments are all wound, and mark the arguments of those that are not deleted:

Now delete all wound points that belong to no action of constraint, and reset the winding numbers and marks of the others:
Copies all nodes in the list args, except the leaves (points, REF REALs, ROPES, etc
Creates a copy of itemaint item using the same points as item.
Note: the copy links of the points are not examined

Duplicate all wound points (including the wn field), and link every point to its copy (or NIL if not wound): 

Copy all constraints and actions whose arguments are all wound. Copy also all state-pushing actions, even if the they reference non-wound points:

Reset the winding numbers of the original points (but not the copies)

- - - - POINT IDENTIFICATION  

- - - - CONSTRAINT SOLVING  

Solves the image constraints for all image points that are not fixed.
�Ê˜š
œ™Jš
œJ™JJš
œ3™3Jš
œ:™:Jš
œ>™>Jš
œ<™<šœ
Ïk	˜
Jšœ(�œ�œ�œ
�œ�œ˜Š
——šœ
Ïb
œ�˜šœ
�˜Jšœ-�œ˜:—šœ
�˜Jš
œ˜——Jš
œ˜šœ
�˜šœ
�˜Jš
œJ˜J——™Jš	œ�œ�œ�œ�œ˜Dšœ
Ïn
œ�œ
�œ˜Jšœ
�œ*�œ�œ�œ)�œ�œ�œ�œ
˜”
——™šœ
Ÿœ�œ
�œ
˜#Jšœ
�œe�œ�œ
˜€
—šœ
Ÿœ�œ
�œ
˜&Jš	œ
�œ �œ:�œ(�œ
˜‘
—šœ
Ÿ
œ�œ
�œ˜Jšœ
�œG�œ
˜Q—šœ
Ÿœ�œ
�œ˜>J™Ó
šœ
�˜šœ�œ�œ�˜1Jš
œ'™'Jšœ�œ
˜šœ
�˜š
œ™Jš
œ
�œ�œ
�œ
�œÏc7˜^—š
œ™Jšœ �œ�œ
�œ�œ�œ
˜v—š
œ;™;Jšœ
�œ�œ
�œ�œ	�œ
�œ�œ˜J—š
œ'™'Jšœ �œ�œ
�œ�œ�œ
˜sJšœ%Ïrœ¡
œ
¡œ¡
œ
¡œ¡œ¡
œ
¡/œa¡œ¡œ
™‰—š
œ*™*Jš&œ
�œ œ�œ�œ�œ	�œ
�œ0�œ�œ
�œ�œ�œ	�œ
�œ�œW�œ�œ
�œ�˜ã——Jšœ�œ
˜
Jšœ
�œ
�œ
�œ˜$—Jšœ�˜	—Jšœ
�œ
˜——™šœ
Ÿœ�œ
�œ˜$Jšœ
�œ:�œ
˜D——™šœ
Ÿ
œ�œ
�œ˜1Jšœ
�œ�œ$�œ�œ
�œ	�œ
�œ˜W—šœ
Ÿ
œ�œ
�œ˜6Jš#œ
�œ�œ�œ"�œ�œ
�œ1�œ	�œq�œ�
œ
�œ�œ
�œh�œQ�œ�œ
�œ˜¢—šœ
Ÿ	œ�œ
�œ˜/Jšœ
�œ�œ(�œ�œ
�œ�œ
�œ˜a—š
œ
Ÿœ�œ�œ
�œ
�œ
�œ˜?J™5Jš#œ�œ�œ
�œ
�œ
�œ�œ�œ
�œ�œ	�œ
�œ)�œ
�œ
�œ
�œ�œ�œ˜¼
—šœ
Ÿœ�œ
�œ%˜AJšœ
�œ"�œ�œ
�œ�œ�œ
�œ�œ�œ
�œ�œ˜Ë
—š
œ
Ÿœ�œ�œ
�œ
�œ
�œ˜DJ™^Jš+œ�œ�œ
�œ
�œ
�œ�œ�œ
�œ�œ	�œ
�œ)�œ�œ
�œ
�œ�œ
�œ
�œ
�œ �œ�œ˜è
—šœ
Ÿœ�œ
�œ'˜FJšœ
�œ%�œ�œ
�œ+�œ�œ
�œ+�œ�œ
�œ'�œ˜�——™š
œ
Ÿœ�œ�œ�œ�˜6Jšœ
�œ�œ�œ�œ �œ
˜v—š
œ
Ÿ	œ�œ
�œ�œ�œ�œ˜VJšœ
�œ�œ�œ�œ$�œ�œ
�œ�œ�œ
�œ
�œ2�œ�œ0�œ
�œ
˜À——™šœ
Ÿœ�œ
�œ/˜Išœ
�˜Jš
œ\™\JšœI�œ�œ
˜VJš
œv™všœ
Ÿœ�	œ˜š
�˜JšœO¡œ¡œ™mJš	œ`¡œ¡œ-¡œ¡œI™ë
Jš
œØ™Øš 
�œ�œ ˜'š 
�œ�œ
�œ�˜+Jšœ 8œ1˜‚
Jš
œH™HJš 
�œA�œ˜_—Jšœ�˜
—šœ
�œ
�œ� ˜)š	 
œ
�œ�œ
�œ�˜,JšœK�œA�œ˜©
—Jšœ�œ˜——Jšœ
�œ
˜—šœ
Ÿœ�	œ˜Jšœ ¡ ¡ 
œ
 �
œ�
œ�œ
�œ�œ
�œ�œ9�œ˜ã
—šœ
Ÿœ�	œ˜Jšœ œ
�œ�œ
�œ8�œ˜p—Jš
œ˜Jš
œ�œ
�œ�œ�œA�œ œ˜©
Jš
œ˜—Jšœ
�œ
˜—šœ
Ÿœ�œ
�œ
�œ�œ˜-Jšœ
�œ�œ$�œ�œ
�œ�œ�œ
�œ�œ�œ�œ�œ�œ
˜ˆ
—šœ
Ðbnœ�œ
�œ�œ	�œ˜?Jšœ
�œ
žœ"�œ�œ$�œ
˜{——™/šœ
Ÿœ�œ
�	œ˜&šœ
�˜Jšžœ�œžœ�œ˜Sš
œ™Jš
œ˜—š
œx™xJšœ�œ�œ#�œ�œ
�œ�œ�œ
�œ�œ�œ9�œ4�œ˜­—š
œ{™{Jš 
œ�œ�œ"�œ�œ
�œ�œ
�œ
�œ�œN�œ*�œ�œ
˜”——Jšœ
�œ
˜—šœ
Ÿœ�œ
�	œ˜)šœ
�˜Jš
œ
ž	œ�œ�œ
�œ
�œ�œ˜Mšœ
Ÿœ�œ�œ
�œ
�œ
�œ�œ�œ
�œ
�œ
�œ˜IJ™SJšœ�œ
�œ�œ
�œ
�œ
�œ�œ�œ
�œ�œ
�œ
�œ
�œ!�œ3˜È
—šœ
¢œ�œ�œ˜4š
œ>™>J™3—Jšœ
�œU�œ˜`—š
œn™nJšœ�œ�œ"�œ�œ
�œ�œ
�œb œ9�œ�œ�œ�œ˜Ü—š
œ’
™’
Jš#œ�œ�œ�œ�œ#�œ�œ
�œ�œ�œ�œ�œŽ
�œ�œ�œ
�œ�œ
�œd˜ˆ—Jš
œF™FJš	œžœ�œ
�œ
�œ˜I—Jšœ
�œ
˜——™šœ
Ÿœ�œ
�œ˜šœ
�˜Jšœ
žœ�œ˜+Jšœ
ž
œ�œ
�œ
�œ�œ�œ�œ
�œ˜Jšœ
ž
œ;˜FJšœ
žœ#�œ�œ�œ
�œ�œ
�œ�œ�œ˜�
Jšœ
 7œ Mœ ;œ)˜”—Jšœ
�œ˜——™šœ
Ÿ
œ�œ
�œ�œ�œ˜FJš
œF™FJšœ Iœ< ?œ˜Ï
——Jšœ
�œ˜J˜—…—&:?Ê