<< 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]; JunoImageImpl: PROGRAM IMPORTS JunoStorage, JunoOldSolver, JunoUserEvents, IO, RealFns EXPORTS JunoImage = BEGIN OPEN JunoStorage, JunoImage, Evs: JunoUserEvents, Solv: JunoOldSolver; << - - - - 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] = <> 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; << - - - - CONSTRAINTS>> AddItem: PUBLIC PROC [item: Item] = BEGIN theItems _ InsertItem [item, theItems.last, theItems] 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] = <> {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; << - - - - 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; << - - - - OPERATIONS ON BALOON-SELECTED POINTS >> DeleteWoundItems: PUBLIC PROCEDURE = BEGIN Mark: PointVisitProc = {p.mark _ TRUE}; UnMark: PointVisitProc = {p.mark _ FALSE}; << Reset the marks in all points:>> EnumPoints[UnMark]; << Delete all constraints and actions whose arguments are all wound, and mark the arguments of those that are not deleted:>> {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}; << Now delete all wound points that belong to no action of constraint, and reset the winding numbers and marks of the others:>> {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; << Duplicate all wound points (including the wn field), and link every point to its copy (or NIL if not wound): >> {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 all constraints and actions whose arguments are all wound. Copy also all state-pushing actions, even if the they reference non-wound points:>> {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]}}; << Reset the winding numbers of the original points (but not the copies)>> {Unw: PointVisitProc = {IF p.copy # NIL THEN p.wn _ 0}; EnumPoints[Unw]} END; << - - - - POINT IDENTIFICATION >> 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; << - - - - CONSTRAINT SOLVING >> SolveImage: PUBLIC PROC [eps: REAL] RETURNS [outcome: Solv.Outcome] = << Solves the image constraints for all image points that are not fixed.>> {-- 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.