[Cyan]<PreISLCedar>Stolfi>Hercules>HerculesImageImpl.mesa!1

HerculesImageImpl.mesa (pieces of JunoStorageImpl.mesa), coded June 81 by Greg Nelson.

The current (unnamed) image and related procedures.

To do: Keep constraints in symbolic expression form (February 13, 1984 10:52 pm)

Last Edited by: GNelson, September 14, 1982 4: 38 pm

Last Edited by: Stolfi, February 22, 1984 6:49 am

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.

Edited on February 4, 1984 4:23 am, by Stolfi

changes to: imagePoints, imageConstraints, imageActions, procedures (replace pointLpad, pointRpad, itemLpad, itemRpad, lambdaAlist), AddPoint, AddHor, AddVer, AddPara, AddPerp, AddCong, AddAt, AddCcw, AddEdge, AddArc, AddString, AddAppl (argument changes), HasDef (deleted (never defined?)), AddDef (replaced by AddProcDef; parameter change), GetBody, GetLocals (replaced by GetProcDef), PushImage, PopImage, PurgeImage (replace PushState, PopState, ResetJunoStorage), imageStack (replaces saveStateList), InsertPoint, SortPoints (moved here from JunoBody) AddPoint (inserts in sorted order, added visible parameter)

Edited on February 6, 1984 7:29 pm, by Stolfi

changes to: imagePoints, imageConstraints, imageActions, procedures (deleted), imageLastAction (new), Image, PointList, ActionList, ConstrList (new), AddConstr, (new - replace AddHor, AddVer, AddPara, AddPerp, AddCong, AddAt, AddCcw; require constraint to be created outside), AddAction (new - replace AddEdge, AddArc, AddString, AddAppl; require action to be created outside; adds actions in chronological order), AddPoint (requires point to be created outside), EnumerateConstrs, EnumerateActions, (copyed from ItemOperation, EnumerateItems of JunoBody, split in two), PointOp, EnumeratePoints (new), InsertPoint, DeletePoint, DeleteConstr, InsertConstr, DeleteAction, InsertAction (new), DeleteWoundItems, TransformWoundPoints, CopyWoundItems, IdentifyPoints (copied from Delete, TransformPoints, Copy, Identify of JunoBody), ConstrIsWound, ActionIsWound, UnwindConstrArgs, UnwindActionArgs (new), DeleteWoundItems, CopyConstr, CopyAction, CopyWoundItems, TransformWoundPoints, IdentifyConstrArgs, IdentifyActionArgs, IdentifyPoints (new - replace Copy, TransformPoints, Identify, Delete, ListOfCopies, AllHaveCopies, SetCopiesToNil, DeleteOriginals from old JunoBodyImpl)

Edited on February 8, 1984 6:12 pm, by Stolfi

changes to: mat, MoveWoundPoints (new - part of MovePointsInBaloon from HerculesTop), GetProcDef (replaced by GetDef of HerculesStorage), DeletePoint, InsertPoint, DeleteConstr, InsertConstr, DeleteAction, InsertAction, Image (moved to HerculesStorage), procedures (type is Alist), BaloonSelect (new - piece of HerculesTop.TrackBlueBaloon), AnyWoundPoints (moved here from HerculesTop.AnyPointsInBaloon), FindPoint (moved here from HerculesTop), AddPoint, SortPoints, AddConstr, AddAction (deleted list parameter and result, now operate only on current image), AddProcDef (moved to HerculesAlgebra),

Edited on February 13, 1984 11:22 pm, by Stolfi

changes to: ActionIsWound, MarkActionArgs, CopyAction, IdentifyActionArgs (now actions are all applications),