<> <<>> <> <> <> <> DIRECTORY HerculesStorage, RealFns USING [SqRt], HerculesImage, HerculesAlgebra USING [Value, Matrix, Frame, PointVisitProc, EnumPointsInValue, ComputeSomeTransform, ReplacePointsInValue, TransformPoint]; HerculesImageImpl: PROGRAM IMPORTS HerculesStorage, HerculesAlgebra, RealFns EXPORTS HerculesImage = BEGIN OPEN HerculesStorage, HerculesImage, Alg: HerculesAlgebra; <<- - - - THE CURRENT IMAGE >> image: PUBLIC Image _ [points: NIL, constrs: NIL, actions: [first: NIL, last: NIL]]; -- The current image AddPoint: PUBLIC PROC [p: PointPtr] = BEGIN nex: PointPtr _ image.points; ant: PointPtr _ NIL; WHILE nex # NIL AND (nex.x < p.x OR (nex.x = p.x AND nex.y < p.y)) DO nex _ nex.link ENDLOOP; image.points _ InsertPoint[p, ant, image.points] END; SortPoints: PUBLIC PROC = BEGIN p, q: PointList; r, rant, t: PointPtr; p _ NIL; q _ image.points; image.points _ NIL; UNTIL q = NIL DO t _ q; q _ t.link; t.link _ NIL; r _ p; rant _ NIL; WHILE r # NIL AND (t.x < r.x OR (t.x = r.x AND t.y < r.y)) DO rant _ r; r _ r.link; ENDLOOP; p _ InsertPoint [t, rant, p]; ENDLOOP; -- Now reverse the list by moving backwards through it: UNTIL p = NIL DO t _ p.link; p.link _ image.points; image.points _ p; p _ t ENDLOOP END; AddConstr: PUBLIC PROC [c: ConstrPtr] = BEGIN image.constrs _ InsertConstr [c, NIL, image.constrs] END; AddAction: PUBLIC PROC [a: ActionPtr] = BEGIN image.actions _ InsertAction [a, image.actions.last, image.actions] END; <<- - - - IMAGE SAVE AND RESTORE >> imageStack: LIST OF REF Image _ NIL; PushImage: PUBLIC PROC = BEGIN imageStack _ CONS [NEW[Image _ image], imageStack]; PurgeImage[]; END; PopImage: PUBLIC PROC = BEGIN PurgeImage[]; image _ imageStack.first^; imageStack _ imageStack.rest END; PurgeImage: PUBLIC PROC = BEGIN -- test the cedar collector:... image _ [points: NIL, constrs: NIL, actions: [NIL, NIL]] END; <<- - - - IMAGE ELEMENT ENUMERATION >> EnumeratePoints: PUBLIC PROC [Op: PointOp] = BEGIN p, pAnt, pNex: PointPtr; p _ image.points; pAnt _ NIL; UNTIL p = NIL DO pNex _ p.link; Op[p, pAnt]; p _ pNex ENDLOOP END; EnumerateConstrs: PUBLIC PROC [Op: ConstrOp] = BEGIN c, cAnt, cNex: ConstrPtr; c _ image.constrs; cAnt _ NIL; UNTIL c = NIL DO cNex _ c.link; Op[c, cAnt]; c _ cNex ENDLOOP END; EnumerateActions: PUBLIC PROC [Op: ActionOp] = BEGIN a, aAnt, aNex: ActionPtr; a _ image.actions.first; aAnt _ NIL; UNTIL a = NIL DO aNex _ a.link; Op[a, aAnt]; a _ aNex ENDLOOP END; <<- - - - POINT LOCATION >> Distance: PROC [a,b,c,d:REAL] RETURNS [REAL] = INLINE BEGIN RETURN[RealFns.SqRt[(a-c)*(a-c)+(b-d)*(b-d)]] END; FindPoint: PUBLIC PROC [x, y: REAL, wound: BOOL _ FALSE] RETURNS [champ: PointPtr] = BEGIN p: PointPtr _ image.points; champdistance, pdistance: REAL; champ _ NIL; champdistance _ 1.0E+30; WHILE p # NIL DO IF wound AND p.wn = 0 THEN LOOP; pdistance _ Distance[p.x, p.y, x, y]; IF pdistance < champdistance THEN {champ _ p; champdistance _ pdistance}; p _ p.link; ENDLOOP END; <<- - - - BALOON SELECTION >> BaloonSelect: PUBLIC PROC [xS, yS: INTEGER, NextPoint: NextPointProc] = BEGIN -- WARNING: while this procedure is working, the links in the image.points list -- are not valid. temp, pl, pr: PointPtr; oldx, oldy, newx, newy: INTEGER; lastPoint: BOOL _ FALSE; -- BaloonSelect works by repeatedly sampling the mouse coordinates and -- calling the procedure Wind: Wind: PROCEDURE = BEGIN -- The effect of Wind is to compute the winding number of the small segment -- from (oldx,oldy) to (newx,newy) around every point. The winding -- number of the segment around the point (px, py) is zero unless px is in -- the range [oldx, newx) and the point p is above the line through old -- and new. If non-zero, it is 1 or -1 according as newx > oldx or newx < oldx. -- To rapidly find the points (px,py) such that px is in [oldx, newx), -- we arrange that (a) the points pl, link[pl], link[link[pl]] ... -- are exactly those points whose -- x coordinates are less than oldx, and the points are listed -- in decreasing order of their x coordinates, and (b) the points -- pr, link[pr], link[link[pr]], ... -- are exactly those points whose x coordinates are greater than or -- equal to oldx, and the points are listed in increasing order of -- their x coordinates. IF oldx < newx THEN -- move right: WHILE pr # NIL AND pr.x < newx DO -- 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 (pl.y - oldy) * (newx - oldx) > (newy - oldy) * (pl.x - oldx) THEN pl.wn _ pl.wn + 1 ENDLOOP ELSE IF oldx > newx THEN-- move left: WHILE pl # NIL AND pl.x >= newx DO temp _ pl.link; pl.link _ pr; pr _ pl; pl _ temp; IF (pr.y - newy) * (oldx - newx) > (oldy - newy) * (pr.x - newx) THEN pr.wn _ pr.wn - 1 ENDLOOP; END; oldx _ xS; oldy _ yS; pl _ NIL; -- initialize linked lists pl and pr: pr _ image.points; WHILE pr # NIL AND pr.x < xS DO temp _ pr.link; pr.link _ pl; pl _ pr; pr _ temp ENDLOOP; UNTIL lastPoint DO [newx, newy, lastPoint] _ NextPoint[]; Wind; oldx _ newx; oldy _ newy; ENDLOOP; newx _ xS; newy _ yS; Wind; -- now the winding numbers have been computed for all points. Must reset the -- linked list of points. WHILE pl # NIL DO temp _ pl.link; pl.link _ pr; pr _ pl; pl _ temp ENDLOOP; END; AnyWoundPoints: PUBLIC PROC RETURNS [BOOL] = BEGIN p: PointPtr _ image.points; WHILE p # NIL DO IF p.wn#0 THEN RETURN [TRUE]; p _ p.link ENDLOOP; RETURN [FALSE] END; <<- - - - OPERATIONS ON BALOON-SELECTED ITEMS >> ConstrIsWound: PUBLIC PROC [c: ConstrPtr] RETURNS [wound: BOOL] = BEGIN wound _ WITH c SELECT FROM cc: HorPtr => cc.i.wn # 0 AND cc.j.wn # 0, cc: VerPtr => cc.i.wn # 0 AND cc.j.wn # 0, cc: CongPtr => cc.i.wn # 0 AND cc.j.wn # 0 AND cc.k.wn # 0 AND cc.l.wn # 0, cc: ParaPtr => cc.i.wn # 0 AND cc.j.wn # 0 AND cc.k.wn # 0 AND cc.l.wn # 0, cc: PerpPtr => cc.i.wn # 0 AND cc.j.wn # 0 AND cc.k.wn # 0 AND cc.l.wn # 0, cc: AtPtr => cc.p.wn # 0, cc: CcwPtr => cc.i.wn # 0 AND cc.j.wn # 0 AND cc.k.wn # 0, ENDCASE => ERROR; wound _ wound AND (c.frame.org = NIL OR c.frame.org.wn # 0) AND (c.frame.xP = NIL OR c.frame.xP.wn # 0) AND (c.frame.yP = NIL OR c.frame.yP.wn # 0) END; ActionIsWound: PUBLIC PROC [a: ActionPtr] RETURNS [wound: BOOL] = BEGIN TestPoint: Alg.PointVisitProc = {IF p.wn = 0 THEN wound _ FALSE}; wound _ TRUE; Alg.EnumPointsInValue[a.arg, TestPoint]; END; MarkConstrArgs: PROC [c: ConstrPtr] = -- Marks all points that enter into the constraint c. BEGIN WITH c SELECT FROM cc: HorPtr => {cc.i.mark _ TRUE; cc.j.mark _ TRUE}; cc: VerPtr => {cc.i.mark _ TRUE; cc.j.mark _ TRUE}; cc: CongPtr => {cc.i.mark _ TRUE; cc.j.mark _ TRUE; cc.k.mark _ TRUE; cc.l.mark _ TRUE}; cc: ParaPtr => {cc.i.mark _ TRUE; cc.j.mark _ TRUE; cc.k.mark _ TRUE; cc.l.mark _ TRUE}; cc: PerpPtr => {cc.i.mark _ TRUE; cc.j.mark _ TRUE; cc.k.mark _ TRUE; cc.l.mark _ TRUE}; cc: AtPtr => {cc.p.mark _ TRUE}; cc: CcwPtr => {cc.i.mark _ TRUE; cc.j.mark _ TRUE; cc.k.mark _ TRUE}; ENDCASE => ERROR; IF c.frame.org # NIL THEN c.frame.org.mark _ TRUE; IF c.frame.xP # NIL THEN c.frame.xP.mark _ TRUE; IF c.frame.yP # NIL THEN c.frame.yP.mark _ TRUE END; MarkActionArgs: PROC [a: ActionPtr] = -- Marks all points that are arguments to the action a. BEGIN MarkPoint: Alg.PointVisitProc = {p.mark _ TRUE}; Alg.EnumPointsInValue[a.arg, MarkPoint]; END; DeleteWoundItems: PUBLIC PROCEDURE = BEGIN DeleteConstrIfWound: ConstrOp = BEGIN IF ConstrIsWound[c] THEN {image.constrs _ DeleteConstr[c, cAnt, image.constrs]; GcConstr[c]} ELSE {MarkConstrArgs[c]} END; DeleteActionIfWound: ActionOp = BEGIN IF ActionIsWound[a] THEN {image.actions _ DeleteAction[a, aAnt, image.actions]; GcAction[a]} ELSE {MarkActionArgs[a]} END; DeletePointIfWoundAndUnMarked: PointOp = BEGIN IF p.wn # 0 AND NOT p.mark THEN {image.points _ DeletePoint[p, pAnt, image.points]; GcPoint[p]}; p.mark _ FALSE; p.wn _ 0 END; -- Delete all constraints and actions whose arguments are all wound, -- and mark the arguments of those that are not deleted EnumerateConstrs[DeleteConstrIfWound]; EnumerateActions[DeleteActionIfWound]; -- Now delete all wound points that belong to no action of constraint, -- and reset the winding numbers and marks of the others: EnumeratePoints[DeletePointIfWoundAndUnMarked] END; mat: REF Alg.Matrix _ NEW [Alg.Matrix]; -- Used by MoveWoundPoints MoveWoundPoints: PUBLIC PROC [source, dest: Alg.Frame] RETURNS [singular: BOOL]= BEGIN [mat, singular] _ Alg.ComputeSomeTransform[source, dest, mat]; -- Transform the coordinates of points in baloon TransformWoundPoints[mat]; -- Replace all occurences of source frame points in actions and constraints by the -- corresponding points of the destination frame source.org.copy _ dest.org; IF source.xP # NIL THEN source.xP.copy _ dest.xP; IF source.yP # NIL THEN source.yP.copy _ dest.yP; IdentifyPoints[]; END; CopyConstr: PROC [c: ConstrPtr] RETURNS [cCopy: ConstrPtr] = -- Creates a copy of constraint c using the copies of all points entering into c. BEGIN cCopy _ WITH c SELECT FROM cc: HorPtr => NewHor[cc.i.copy, cc.j.copy], cc: VerPtr => NewHor[cc.i.copy, cc.j.copy], cc: CongPtr => NewCong[cc.i.copy, cc.j.copy, cc.k.copy, cc.l.copy], cc: ParaPtr => NewPara[cc.i.copy, cc.j.copy, cc.k.copy, cc.l.copy], cc: PerpPtr => NewPerp[cc.i.copy, cc.j.copy, cc.k.copy, cc.l.copy], cc: AtPtr => NewAt[cc.p.copy, cc.x, cc.y], cc: CcwPtr => NewCcw[cc.i.copy, cc.j.copy, cc.k.copy], ENDCASE => ERROR; IF c.frame.org # NIL THEN cCopy.frame.org _ c.frame.org.copy; IF c.frame.xP # NIL THEN cCopy.frame.xP _ c.frame.xP.copy; IF c.frame.yP # NIL THEN cCopy.frame.yP _ c.frame.yP.copy END; CopyAction: PROC [a: ActionPtr] RETURNS [aCopy: ActionPtr] = -- Creates a copy of action a using the copies of all points that are arguments of a. BEGIN GetPointCopy: Alg.PointVisitProc = {RETURN [IF p.copy # NIL THEN p.copy ELSE p]}; aCopy _ NewAction[op: a.op, arg: Alg.ReplacePointsInValue [a.arg, GetPointCopy]]; END; CopyWoundItems: PUBLIC PROCEDURE = BEGIN pCopy: PointPtr; copiedActions: ActionList _ [NIL, NIL]; CopyPointIfWound: PointOp = BEGIN IF p.wn # 0 THEN {pCopy _ NewPoint[p.x, p.y]; image.points _ InsertPoint[pCopy, pAnt, image.points]; p.copy _ pCopy; pCopy.wn _ p.wn} END; CopyConstrIfWound: ConstrOp = BEGIN IF ConstrIsWound[c] THEN {image.constrs _ InsertConstr[CopyConstr[c], cAnt, image.constrs]} END; CopyActionIfWound: ActionOp = BEGIN IF ActionIsWound[a] THEN {copiedActions _ InsertAction[CopyAction[a], aAnt, copiedActions]} END; UnwindIfOriginal: PointOp = BEGIN IF p.copy # NIL THEN {p.wn _ 0} END; -- Make a copy of all wound points EnumeratePoints[CopyPointIfWound]; -- Copy all constraints and actions whose arguments are all wound EnumerateConstrs[CopyConstrIfWound]; EnumerateActions[CopyActionIfWound]; -- Append copied actions at the end of image IF image.actions = [NIL, NIL] THEN {image.actions _ copiedActions} -- superfluous, but... ELSE IF copiedActions # [NIL, NIL] THEN {image.actions.last.link _ copiedActions.first; image.actions.last _ copiedActions.last}; -- Reset the winding numbers of the originals EnumeratePoints[UnwindIfOriginal] END; TransformWoundPoints: PUBLIC PROC[mat: REF Alg.Matrix] = BEGIN p: PointPtr _ image.points; WHILE p # NIL DO IF p.wn # 0 THEN {[p.x, p.y] _ Alg.TransformPoint[p.x, p.y, mat]; p.wn _ 0}; p _ p.link; ENDLOOP END; IdentifyConstrArgs: PROC [c: ConstrPtr] = -- Replaces p by p.copy (if the latter is not NIL) for all points entering into constraint c. BEGIN WITH c SELECT FROM cc: HorPtr => {IF cc.i.copy # NIL THEN cc.i _ cc.i.copy; IF cc.j.copy # NIL THEN cc.j _ cc.j.copy}; cc: VerPtr => {IF cc.i.copy # NIL THEN cc.i _ cc.i.copy; IF cc.j.copy # NIL THEN cc.j _ cc.j.copy}; cc: CongPtr => {IF cc.i.copy # NIL THEN cc.i _ cc.i.copy; IF cc.j.copy # NIL THEN cc.j _ cc.j.copy; IF cc.k.copy # NIL THEN cc.k _ cc.k.copy; IF cc.l.copy # NIL THEN cc.l _ cc.l.copy}; cc: ParaPtr => {IF cc.i.copy # NIL THEN cc.i _ cc.i.copy; IF cc.j.copy # NIL THEN cc.j _ cc.j.copy; IF cc.k.copy # NIL THEN cc.k _ cc.k.copy; IF cc.l.copy # NIL THEN cc.l _ cc.l.copy}; cc: PerpPtr => {IF cc.i.copy # NIL THEN cc.i _ cc.i.copy; IF cc.j.copy # NIL THEN cc.j _ cc.j.copy; IF cc.k.copy # NIL THEN cc.k _ cc.k.copy; IF cc.l.copy # NIL THEN cc.l _ cc.l.copy}; cc: AtPtr => {IF cc.p.copy # NIL THEN cc.p _ cc.p.copy}; cc: CcwPtr => {IF cc.i.copy # NIL THEN cc.i _ cc.i.copy; IF cc.j.copy # NIL THEN cc.j _ cc.j.copy; IF cc.k.copy # NIL THEN cc.k _ cc.k.copy}; ENDCASE => ERROR; IF c.frame.org # NIL AND c.frame.org.copy # NIL THEN c.frame.org _ c.frame.org.copy; IF c.frame.xP # NIL AND c.frame.xP.copy # NIL THEN c.frame.xP _ c.frame.xP.copy; IF c.frame.yP # NIL AND c.frame.yP.copy # NIL THEN c.frame.yP _ c.frame.yP.copy END; IdentifyActionArgs: PROC [a: ActionPtr] = -- Replaces p by p.copy (if the latter is not NIL) for all points that are arguments to action a. BEGIN GetPointCopy: Alg.PointVisitProc = {RETURN [IF p.copy # NIL THEN p.copy ELSE p]}; a.arg _ Alg.ReplacePointsInValue [a.arg, GetPointCopy] END; IdentifyPoints: PUBLIC PROC = BEGIN MarkCopies: PointOp = {IF p.copy # NIL THEN p.copy.mark _ TRUE}; IdConstrArgs: ConstrOp = {IdentifyConstrArgs[c]}; IdActionArgs: ActionOp = {IdentifyActionArgs[a]}; DeleteUnreachableOriginals: PointOp = {IF p.copy # NIL AND NOT p.mark THEN {-- p should be unreachable by now image.points _ DeletePoint[p, pAnt, image.points]; GcPoint[p]}; p.mark _ FALSE; p.copy _ NIL; p.wn _ 0}; -- Mark copies so that we know who becomes unreachable EnumeratePoints[MarkCopies]; -- Replace p by p.copy in all actions and constraints, whenever p.copy # NIL EnumerateConstrs[IdConstrArgs]; EnumerateActions[IdActionArgs]; -- Now delete original points that have become unreachable EnumeratePoints[DeleteUnreachableOriginals] END; END. <> <> <> <> <> <> <> <>