GGMultiGravityImpl.mesa
Copyright © 1986 by Xerox Corporation. All rights reserved.
Last edited by Bier on June 3, 1986 2:42:42 pm PDT
Contents: Performs hit testing similar to GGGravity. Instead of returning a single nearest feature, we return the N (or fewer) nearest features which are within a given tolerance distance from the test point. The algorithm used is described in [Cyan]<Gargoyle>Documentation>MultiGravity.tioga.
DIRECTORY
AtomButtons, CodeTimer, GGBasicTypes, GGCaret, GGCircles, GGInterfaceTypes, GGModelTypes, GGMultiGravity, GGSegmentTypes, GGState, GGUtility, Lines2d, Real, RealFns, Rope, Vectors2d;
GGMultiGravityImpl: CEDAR PROGRAM
IMPORTS AtomButtons, CodeTimer, GGCaret, GGCircles, GGState, Lines2d, RealFns, Vectors2d
EXPORTS GGMultiGravity = BEGIN
AlignBag: TYPE = REF AlignBagObj;
AlignBagObj: TYPE = GGInterfaceTypes.AlignBagObj;
AlignmentCircle: TYPE = GGInterfaceTypes.AlignmentCircle;
AlignmentLine: TYPE = GGInterfaceTypes.AlignmentLine;
AlignmentPoint: TYPE = REF AlignmentPointObj;
AlignmentPointObj: TYPE = GGInterfaceTypes.AlignmentPointObj;
Arc: TYPE = GGBasicTypes.Arc;
Caret: TYPE = GGInterfaceTypes.Caret;
Circle: TYPE = GGBasicTypes.Circle;
Edge: TYPE = GGBasicTypes.Edge;
FeatureData: TYPE = REF FeatureDataObj;
FeatureDataObj: TYPE = GGModelTypes.FeatureDataObj;
GGData: TYPE = GGInterfaceTypes.GGData;
GoodPoint: TYPE = REF GoodPointObj;
GoodPointObj: TYPE = GGMultiGravity.GoodPointObj;
JointGenerator: TYPE = GGModelTypes.JointGenerator;
Line: TYPE = GGBasicTypes.Line;
NearDistances: TYPE = REF NearDistancesObj;
NearDistancesObj: TYPE = GGMultiGravity.NearDistancesObj;
NearFeatures: TYPE = REF NearFeaturesObj;
NearFeaturesObj: TYPE = GGMultiGravity.NearFeaturesObj;
NearPoints: TYPE = REF NearPointsObj;
NearPointsAndCurves: TYPE = REF NearPointsAndCurvesObj;
NearPointsAndCurvesObj: TYPE = GGMultiGravity.NearPointsAndCurvesObj;
NearPointsObj: TYPE = GGMultiGravity.NearPointsObj;
Outline: TYPE = GGModelTypes.Outline;
OutlineDescriptor: TYPE = REF OutlineDescriptorObj;
OutlineDescriptorObj: TYPE = GGModelTypes.OutlineDescriptorObj;
OutlinePointPairGenerator: TYPE = GGModelTypes.OutlinePointPairGenerator;
Point: TYPE = GGBasicTypes.Point;
PointPairAndDone: TYPE = GGModelTypes.PointPairAndDone;
PointPairGenerator: TYPE = GGModelTypes.PointPairGenerator;
Segment: TYPE = GGSegmentTypes.Segment;
SegmentGenerator: TYPE = GGModelTypes.SegmentGenerator;
Sequence: TYPE = GGModelTypes.Sequence;
Slice: TYPE = GGModelTypes.Slice;
SliceDescriptor: TYPE = GGModelTypes.SliceDescriptor;
TriggerBag: TYPE = REF TriggerBagObj;
TriggerBagObj: TYPE = GGInterfaceTypes.TriggerBagObj;
BestPoints: TYPE = REF BestPointsObj;
BestPointsObj:
TYPE =
RECORD [
size: NAT,
max, min: REAL,
bestTossed: REAL, -- the distance of the closest object that has been thrown away
dTol: REAL, -- min + s
innerR: REAL, -- find all curves within this radius even if they are not neighbors of the nearest
s: REAL, -- the size of neighborhoods. BestPoints should contain all objects that have been seen such that min <= dist(o, q) <= min+s, unless BestPoints overflows.
overflow: BOOL,
points: SEQUENCE len: NAT OF GoodPoint];
MultiGravityPool:
TYPE =
REF MultiGravityPoolObj;
MultiGravityPoolObj:
TYPE =
RECORD [
distances: NearDistances,
features: NearFeatures,
bestpoints: BestPoints,
bestcurves: BestPoints
];
Shared with GGGravityImpl
EmptyBag:
PROC [alignBag: AlignBag]
RETURNS [
BOOL] = {
RETURN[
alignBag.slopeLines = NIL AND
alignBag.angleLines = NIL AND
alignBag.radiiCircles = NIL AND
alignBag.distanceLines = NIL AND
alignBag.midpoints = NIL AND
alignBag.intersectionPoints = NIL AND
alignBag.anchor = NIL];
};
EmptyTriggers:
PROC [triggerBag: TriggerBag]
RETURNS [
BOOL] = {
RETURN[
triggerBag.outlines = NIL AND
triggerBag.slices = NIL AND
triggerBag.intersectionPoints = NIL AND
triggerBag.anchor = NIL
];
};
Problem: PUBLIC SIGNAL [msg: Rope.ROPE] = CODE;
Arbitration
[Artwork node; type 'ArtworkInterpress on' to command tool]
We arbitrate between those points which are within an epsilon-width ring of the nearest point.
Map:
PUBLIC
PROC [testPoint: Point, criticalR:
REAL, alignBag: AlignBag, sceneBag: TriggerBag, ggData: GGData, useAlignBag:
BOOL]
RETURNS [resultPoint: Point, feature: FeatureData, hitData:
REF
ANY] = {
Dispatches to StrictDistance, PointsPreferred, or does nothing depending on the currently selected gravity type. If useAlignBag is TRUE, compute the intersections of the objects that are in the bags.
ENABLE UNWIND => ggData.multiGravityPool ← NewMultiGravityPool[]; -- in case an ABORT happened while pool was in use
CodeTimer.StartInt[$MultiMap, $Gargoyle];
IF GGState.Gravity[ggData]
THEN {
SELECT ggData.hitTest.gravityType
FROM
strictDistance =>
[resultPoint, feature, hitData] ← StrictDistance[testPoint, criticalR, alignBag, sceneBag, ggData];
innerCircle =>
[resultPoint, feature, hitData] ← PointsPreferred[testPoint, criticalR, ggData.hitTest.innerR, alignBag, sceneBag, ggData, useAlignBag];
ENDCASE => ERROR;
}
ELSE {
resultPoint ← testPoint;
feature ← NIL;
};
CodeTimer.StopInt[$MultiMap, $Gargoyle];
};
StrictDistance:
PUBLIC
PROC [testPoint: Point, criticalR:
REAL, alignBag: AlignBag, sceneBag: TriggerBag, ggData: GGData]
RETURNS [resultPoint: Point, feature: FeatureData, hitData:
REF
ANY] = {
Someday, GoodPoint and GoodPoint should become a single variant record and distances will be unnecessary.
nearPointsAndCurves: NearPointsAndCurves;
count: NAT;
[nearPointsAndCurves, count] ← MultiStrictDistance[testPoint, criticalR, alignBag, sceneBag, ggData];
IF count = 0 THEN RETURN [testPoint, NIL, NIL];
IF count = 1 THEN RETURN PrepareWinner[nearPointsAndCurves, 0]
ELSE {
Otherwise, let's do arbitration.
mgp: MultiGravityPool ← NARROW[ggData.multiGravityPool, MultiGravityPool];
distances: NearDistances ← mgp.distances;
features: NearFeatures ← mgp.features;
nearestDist: REAL ← -1;
bestSceneObject: INT ← -1;
neighborCount: NAT ← 1;
s: REAL = 0.072; -- 1/1000 inches
FOR i:
NAT
IN [0..count)
DO
goodPoint: GoodPoint ← nearPointsAndCurves[i];
distances[i] ← goodPoint.dist;
features[i] ← goodPoint.featureData;
ENDLOOP;
nearestDist ← distances[0];
FOR i:
NAT
IN [1..count)
DO
IF distances[i] - nearestDist < s THEN neighborCount ← neighborCount + 1;
ENDLOOP;
IF neighborCount = 1
THEN
RETURN PrepareWinner[nearPointsAndCurves, 0];
We have more than one "equally close" features. Now we choose on the following basis:
1) Prefer scene objects to alignment lines.
2) Prefer points to lines.
Later, we will prefer objects that say the testpoint is "inside" them to those that don't.
bestSceneObject ← -1;
FOR i: NAT IN [0..neighborCount) DO
IF features[i].type = outline OR features[i].type = slice THEN {
SELECT features[i].resultType FROM
joint, controlPoint, intersectionPoint =>
RETURN PrepareWinner[nearPointsAndCurves, i];
ENDCASE => IF bestSceneObject = -1 THEN bestSceneObject ← i;
};
REPEAT
FINISHED => {
IF bestSceneObject >= 0 THEN
RETURN PrepareWinner[nearPointsAndCurves, bestSceneObject]
ELSE RETURN PrepareWinner[nearPointsAndCurves, 0];
};
ENDLOOP;
RETURN PrepareWinner[nearPointsAndCurves, 0];
};
};
PointsPreferred:
PUBLIC
PROC [testPoint: Point, criticalR:
REAL, innerR:
REAL, alignBag: AlignBag, sceneBag: TriggerBag, ggData: GGData, useAlignBag:
BOOL]
RETURNS [resultPoint: Point, feature: FeatureData, hitData:
REF
ANY] = {
count: NAT;
nearPointsAndCurves: NearPointsAndCurves;
[nearPointsAndCurves, count] ← MultiPointsPreferred[testPoint, criticalR, innerR, alignBag, sceneBag, ggData, useAlignBag];
IF count = 0 THEN RETURN [testPoint, NIL, NIL];
IF count = 1 THEN RETURN PrepareWinner[nearPointsAndCurves, 0]
ELSE {
Otherwise, let's do arbitration.
mgp: MultiGravityPool ← NARROW[ggData.multiGravityPool, MultiGravityPool];
distances: NearDistances ← mgp.distances;
features: NearFeatures ← mgp.features;
neighborCount: NAT ← 1;
s: REAL = 0.072; -- 1/1000 inches
nearestDist: REAL ← -1;
FOR i:
NAT
IN [0..count)
DO
goodPoint: GoodPoint ← nearPointsAndCurves[i];
distances[i] ← goodPoint.dist;
features[i] ← goodPoint.featureData;
ENDLOOP;
nearestDist ← distances[0];
FOR i:
NAT
IN [1..count)
DO
IF distances[i] - nearestDist < s THEN neighborCount ← neighborCount + 1;
ENDLOOP;
IF neighborCount = 1 THEN RETURN PrepareWinner[nearPointsAndCurves, 0];
1) Prefer scene objects to alignment lines.
Later, we will prefer objects that say the testpoint is "inside" them to those that don't.
FOR i:
NAT
IN [0..neighborCount)
DO
IF features[i].type = outline
OR features[i].type = slice
THEN {
RETURN PrepareWinner[nearPointsAndCurves, i];
};
REPEAT
FINISHED => RETURN PrepareWinner[nearPointsAndCurves, 0];
ENDLOOP;
};
};
PrepareWinner:
PROC [nearPointsAndCurves: NearPointsAndCurves, index:
NAT]
RETURNS [resultPoint: Point, feature: FeatureData, hitData:
REF
ANY] = {
goodPoint: GoodPoint ← nearPointsAndCurves[index];
resultPoint ← goodPoint.point;
feature ← goodPoint.featureData;
hitData ← goodPoint.hitData;
};
NearestNeighborsPlusSome:
PROC [q: Point, initialD:
REAL, alignBag: AlignBag, sceneBag: TriggerBag, anchor: Caret, ggData: GGData, distinguishedPointsOnly:
BOOL ← FALSE]
RETURNS [g: NearPointsAndCurves, count:
NAT] = {
};
Multi-Gravity Routines
MultiMap:
PUBLIC
PROC [testPoint: Point, criticalR:
REAL, alignBag: AlignBag, sceneBag: TriggerBag, ggData: GGData, useAlignBag:
BOOL]
RETURNS [nearPointsAndCurves: NearPointsAndCurves, count:
NAT] = {
Dispatches to MultiStrictDistance or MultiPointsPreferred as appropriate.
ENABLE UNWIND => ggData.multiGravityPool ← NewMultiGravityPool[]; -- in case an ABORT happened while pool was in use
CodeTimer.StartInt[$MultiMap, $Gargoyle];
SELECT AtomButtons.GetButtonState[ggData.hitTest.gravButton]
FROM
on =>
SELECT ggData.hitTest.gravityType
FROM
strictDistance =>
[nearPointsAndCurves, count] ← MultiStrictDistance[testPoint, criticalR, alignBag, sceneBag, ggData];
innerCircle =>
[nearPointsAndCurves, count] ← MultiPointsPreferred[testPoint, criticalR, ggData.hitTest.innerR, alignBag, sceneBag, ggData, useAlignBag];
ENDCASE => ERROR;
off => {
nearPointsAndCurves ← NIL;
count ← 0;
};
ENDCASE => ERROR;
CodeTimer.StopInt[$MultiMap, $Gargoyle];
};
MultiStrictDistance:
PUBLIC
PROC [testPoint: Point, criticalR:
REAL, alignBag: AlignBag, sceneBag: TriggerBag, ggData: GGData]
RETURNS [nearPointsAndCurves: NearPointsAndCurves, count:
NAT] = {
Returns up to MaxFeatures closest features, their closest points, and their distances from the testpoint. Features outside of the critical radius, criticalR, will not be included. The results will be located in nearPointsAndCurves[0] .. nearPointsAndCurves[count-1].
bestCurves: BestPoints;
bestPoints: BestPoints;
pointCount, curveCount: NAT;
IF EmptyBag[alignBag]
AND EmptyTriggers[sceneBag]
THEN
RETURN[NIL, 0];
[bestCurves, curveCount] ← CurvesInNeighborhoodPlus[alignBag, sceneBag, testPoint, ggData, criticalR, 0];
SortCurves[bestCurves, curveCount];
[bestPoints, pointCount] ← PointsInNeighborhoodPlus[bestCurves, curveCount, alignBag, sceneBag, testPoint, criticalR, ggData, FALSE];
SortPoints[bestPoints, pointCount];
count ← MIN[pointCount + curveCount, MaxFeatures];
nearPointsAndCurves ← NEW[NearPointsAndCurvesObj[count]];
MergePointsAndCurves[bestPoints, pointCount, bestCurves, curveCount, nearPointsAndCurves, count];
};
MultiPointsPreferred:
PUBLIC
PROC [testPoint: Point, criticalR:
REAL, innerR:
REAL, alignBag: AlignBag, sceneBag: TriggerBag, ggData: GGData, useAlignBag:
BOOL]
RETURNS [nearPointsAndCurves: NearPointsAndCurves, count:
NAT] = {
Returns up to MaxFeatures closest features, their closest points, and their distances from the testpoint. Features outside of criticalR, will not be included. The results will be located in nearPointsAndCurves[0] .. nearPointsAndCurves[count-1]. If any points are within the inner radius innerR, then only points (e.g. vertices, control points, and intersection points) will be mentioned. Otherwise, nearPointsAndCurves may consist of a mixture of points and curves.
bestCurves: BestPoints;
bestPoints: BestPoints;
pointCount, curveCount: NAT;
IF EmptyBag[alignBag] AND EmptyTriggers[sceneBag] THEN RETURN[NIL, 0];
[bestCurves, curveCount] ← CurvesInNeighborhoodPlus[alignBag, sceneBag, testPoint, ggData, criticalR, innerR];
SortCurves[bestCurves, curveCount];
[bestPoints, pointCount] ← PointsInNeighborhoodPlus[bestCurves, curveCount, alignBag, sceneBag, testPoint, criticalR, ggData, useAlignBag];
SortPoints[bestPoints, pointCount];
IF pointCount > 0
AND bestPoints[0].dist < innerR
THEN {
count ← pointCount;
nearPointsAndCurves ← NEW[NearPointsAndCurvesObj[count]];
NearPointsFromPoints[bestPoints, pointCount, nearPointsAndCurves];
}
ELSE {
count ← MIN[pointCount + curveCount, MaxFeatures];
nearPointsAndCurves ← NEW[NearPointsAndCurvesObj[count]];
MergePointsAndCurves[bestPoints, pointCount, bestCurves, curveCount, nearPointsAndCurves, count];
};
};
PointsInNeighborhoodPlus:
PROC [bestCurves: BestPoints, curveCount:
NAT, alignBag: AlignBag, sceneBag: TriggerBag,
q: Point,
t:
REAL, ggData: GGData, useAlignBag:
BOOL]
RETURNS [h: BestPoints, pointCount:
NAT] = {
thisPoint: GoodPoint;
For each gravity active point, find its distance from the testpoint. Package this information up into the thisPoint record. Then call MergeObject, which will add this point to the list of best points, if appropriate.
When PointsInNeighborhoodPlus returns, h will contain a set of up to MaxFeatures points all of which are within a distance t of q.
If h.overflow is FALSE, h contains the nearest point in the scene (distance h.min from q) and all other points o such that dist(o, q) <= h.min + h.s, and dist(o, q) <= t.
If h.overflow is TRUE, there were more than MaxFeatures such points. In this case, h includes the nearest n such points n = MaxFeatures.
ProcessPoint:
PROC [thisPoint: GoodPoint, featureData: FeatureData] = {
-- used for the anchor
dSquared: REAL;
dTolSquared: REAL ← dTol*dTol;
dSquared ← Vectors2d.DistanceSquared[thisPoint.point, q];
thisPoint.hitData ← NIL;
IF dSquared < dTolSquared
THEN {
thisPoint.dist ← RealFns.SqRt[dSquared];
thisPoint.featureData ← featureData;
dTol ← MergePoint[thisPoint, h, dTol];
};
};
ProcessSlice:
PROC [sliceD: SliceDescriptor, thisPoint: GoodPoint, featureData: FeatureData] = {
[thisPoint.point, thisPoint.dist, thisPoint.hitData, success] ← sliceD.slice.class.closestPoint[sliceD, q, dTol];
IF success
THEN {
IF thisPoint.dist < dTol
THEN {
thisPoint.featureData ← featureData;
dTol ← MergePoint[thisPoint, h, dTol];
};
};
};
ProcessOutline: PROC [outlineD: OutlineDescriptor, thisPoint: GoodPoint, featureData: FeatureData] = {
[thisPoint.point, thisPoint.dist, thisPoint.hitData, success] ← outlineD.slice.class.closestPoint[outlineD, q, dTol];
IF success THEN {
IF thisPoint.dist < dTol THEN {
thisPoint.featureData ← featureData;
dTol ← MergePoint[thisPoint, h, dTol];
};
};
};
sliceD: SliceDescriptor;
outlineD: OutlineDescriptor;
featureData: FeatureData;
success: BOOL ← FALSE;
dTol: REAL ← t;
midpoints: BOOL ← GGState.Midpoints[ggData];
thisPoint ← NEW[GoodPointObj];
h ← BestPointsFromPool[ggData, t];
IF useAlignBag
THEN
dTol ← FindIntersections[bestCurves, curveCount, thisPoint, q, dTol, h];
IF useAlignBag
AND midpoints
THEN
dTol ← FindMidpoints[bestCurves, curveCount, thisPoint, q, dTol, h];
FOR midpoints: LIST OF FeatureData ← alignBag.midpoints, midpoints.rest UNTIL midpoints = NIL DO
featureData ← midpoints.first;
thisPoint.point ← NARROW[featureData.shape, AlignmentPoint].point;
ProcessPoint[thisPoint, featureData];
ENDLOOP;
FOR
slices:
LIST
OF FeatureData ← sceneBag.slices, slices.rest
UNTIL slices =
NIL
DO
featureData ← slices.first;
sliceD ← NARROW[featureData.shape, SliceDescriptor];
ProcessSlice[sliceD, thisPoint, featureData];
ENDLOOP;
FOR outlines: LIST OF FeatureData ← sceneBag.outlines, outlines.rest UNTIL outlines = NIL DO
featureData ← outlines.first;
outlineD ← NARROW[featureData.shape];
ProcessOutline[outlineD, thisPoint, featureData];
ENDLOOP;
Handle the anchor.
featureData ← alignBag.anchor;
IF featureData #
NIL
THEN {
anchor: Caret ← NARROW[featureData.shape];
IF NOT GGCaret.Exists[anchor] THEN ERROR;
thisPoint.point ← GGCaret.GetPoint[anchor];
ProcessPoint[thisPoint, featureData];
};
pointCount ← h.size;
IF h.overflow
THEN {
CodeTimer.StartInt[$PointOverflow, $Gargoyle];
CodeTimer.StopInt[$PointOverflow, $Gargoyle];
};
};
FindIntersections:
PROC [bestCurves: BestPoints, curveCount:
NAT, thisPoint: GoodPoint, q: Point, tolerance:
REAL, h: BestPoints]
RETURNS [dTol:
REAL] = {
curveI, curveJ: GoodPoint;
theseIPoints: LIST OF Point;
thisTangency, tangentList: LIST OF BOOL;
success: BOOL;
dTol ← tolerance;
FOR i:
NAT
IN [0..curveCount)
DO
curveI ← bestCurves[i];
FOR j:
NAT
IN [i+1..curveCount)
DO
curveJ ← bestCurves[j];
[theseIPoints, thisTangency] ← CurveMeetsCurve[curveI, curveJ];
tangentList ← thisTangency;
FOR list:
LIST
OF Point ← theseIPoints, list.rest
UNTIL list =
NIL
DO
thisPoint.point ← list.first;
thisPoint.dist ← Vectors2d.Distance[thisPoint.point, q];
success ← thisPoint.dist <= tolerance;
IF success
THEN {
featureData: FeatureData ← NEW[FeatureDataObj];
alignmentPoint: AlignmentPoint ←
NEW[AlignmentPointObj ← [
point: thisPoint.point,
tangent: tangentList.first,
curve1: curveI.featureData,
curve2: curveJ.featureData]];
featureData.type ← intersectionPoint;
featureData.shape ← alignmentPoint;
thisPoint.featureData ← featureData;
IF curveI.featureData.type = outline
OR curveI.featureData.type = slice
THEN {
thisPoint.hitData ← curveI.hitData;
}
ELSE
IF curveJ.featureData.type = outline
OR curveJ.featureData.type = slice
THEN {
thisPoint.hitData ← curveJ.hitData;
}
ELSE thisPoint.hitData ← NIL;
dTol ← MergePoint[thisPoint, h, dTol];
};
tangentList ← tangentList.rest;
ENDLOOP;
ENDLOOP;
ENDLOOP;
};
FindMidpoints:
PROC [bestCurves: BestPoints, curveCount:
NAT, thisPoint: GoodPoint, q: Point, tolerance:
REAL, h: BestPoints]
RETURNS [dTol:
REAL] = {
curve: GoodPoint;
midpoint: Point;
success: BOOL;
dTol ← tolerance;
FOR i:
NAT
IN [0..curveCount)
DO
curve ← bestCurves[i];
IF curve.featureData.type # outline AND curve.featureData.type # slice THEN LOOP;
[midpoint, success] ← ComputeMidpoint[curve];
IF NOT success THEN LOOP;
thisPoint.point ← midpoint;
thisPoint.dist ← Vectors2d.Distance[thisPoint.point, q];
success ← thisPoint.dist <= tolerance;
IF success
THEN {
featureData: FeatureData ← NEW[FeatureDataObj];
alignmentPoint: AlignmentPoint ←
NEW[AlignmentPointObj ← [
point: thisPoint.point,
tangent: FALSE,
curve1: curve.featureData,
curve2: NIL]];
featureData.type ← midpoint;
featureData.shape ← alignmentPoint;
thisPoint.featureData ← featureData;
thisPoint.hitData ← curve.hitData;
dTol ← MergePoint[thisPoint, h, dTol];
};
ENDLOOP;
};
CurvesInNeighborhoodPlus:
PROC [alignBag: AlignBag, sceneBag: TriggerBag, q: Point, ggData: GGData, t:
REAL, innerR:
REAL]
RETURNS [h: BestPoints, curveCount:
NAT] = {
For each gravity active object, find the distance of the gravity active object from the testpoint. Package this information up into the thisCurve record. Then call MergeObject, which will add this curve to the list of best curves, if appropriate.
When CurvesInNeighborhood returns, h should contain some number of curves such that they are all within t of q.
If h.overflow is FALSE, then h contains the closest curve (at distance h.min) and all other curves o such that dist(o, q) < MAX[h.min + h.s, innerR] and dist(o, q) < t.
If h.overflow is TRUE then it wasn't possible to include all such curves. h contains the closest n such curves (where n = MaxFeatures).
ProcessLine:
PROC [line: Line, thisCurve: GoodPoint, featureData: FeatureData] = {
thisCurve.dist ← Lines2d.LineDistance[q, line];
IF thisCurve.dist < t
THEN
{
thisCurve.featureData ← featureData;
thisCurve.point ← Lines2d.DropPerpendicular[q, line];
thisCurve.hitData ← NIL;
dTol ← MergeCurve[thisCurve, h, dTol];
}
};
ProcessCircle:
PROC [circle: Circle, thisCurve: GoodPoint, featureData: FeatureData] = {
thisCurve.dist ← GGCircles.CircleDistance[q, circle];
IF thisCurve.dist < t
THEN {
thisCurve.featureData ← featureData;
thisCurve.point ← GGCircles.PointProjectedOntoCircle[q, circle];
thisCurve.hitData ← NIL;
dTol ← MergeCurve[thisCurve, h, dTol];
};
};
ProcessSlice:
PROC [sliceD: SliceDescriptor, thisCurve: GoodPoint, featureData: FeatureData] = {
success: BOOL;
[thisCurve.point, thisCurve.dist, thisCurve.hitData, success] ← sliceD.slice.class.closestSegment[sliceD, q, t];
IF success
THEN {
IF thisCurve.dist < t
THEN {
thisCurve.featureData ← featureData;
dTol ← MergeCurve[thisCurve, h, dTol];
};
};
};
ProcessOutline: PROC [outlineD: OutlineDescriptor, thisCurve: GoodPoint, featureData: FeatureData] = {
success: BOOL;
[thisCurve.point, thisCurve.dist, thisCurve.hitData, success] ← outlineD.slice.class.closestSegment[outlineD, q, t];
IF success THEN {
IF thisCurve.dist < t THEN {
thisCurve.featureData ← featureData;
dTol ← MergeCurve[thisCurve, h, dTol];
};
};
};
line: Line;
circle: Circle;
sliceD: SliceDescriptor;
outlineD: OutlineDescriptor;
featureData: FeatureData;
added: BOOL ← FALSE;
thisCurve: GoodPoint ← NEW[GoodPointObj];
dTol: REAL ← t;
h ← BestCurvesFromPool[ggData, t, innerR];
Align Bag
FOR
slopeLines:
LIST
OF FeatureData ← alignBag.slopeLines, slopeLines.rest
UNTIL slopeLines =
NIL
DO
featureData ← slopeLines.first;
line ← NARROW[featureData.shape, AlignmentLine].line;
ProcessLine[line, thisCurve, featureData];
ENDLOOP;
FOR
angleLines:
LIST
OF FeatureData ← alignBag.angleLines, angleLines.rest
UNTIL angleLines =
NIL
DO
featureData ← angleLines.first;
line ← NARROW[featureData.shape, AlignmentLine].line;
ProcessLine[line, thisCurve, featureData];
ENDLOOP;
FOR
dLines:
LIST
OF FeatureData ← alignBag.distanceLines, dLines.rest
UNTIL dLines =
NIL
DO
featureData ← dLines.first;
line ← NARROW[featureData.shape];
ProcessLine[line, thisCurve, featureData];
ENDLOOP;
FOR
circles:
LIST
OF FeatureData ← alignBag.radiiCircles, circles.rest
UNTIL circles =
NIL
DO
featureData ← circles.first;
circle ← NARROW[featureData.shape, AlignmentCircle].circle;
ProcessCircle[circle, thisCurve, featureData];
ENDLOOP;
Scene Bag.
FOR
slices:
LIST
OF FeatureData ← sceneBag.slices, slices.rest
UNTIL slices =
NIL
DO
featureData ← slices.first;
sliceD ← NARROW[featureData.shape, SliceDescriptor];
ProcessSlice[sliceD, thisCurve, featureData];
ENDLOOP;
FOR outlines: LIST OF FeatureData ← sceneBag.outlines, outlines.rest UNTIL outlines = NIL DO
featureData ← outlines.first;
outlineD ← NARROW[featureData.shape, OutlineDescriptor];
ProcessOutline[outlineD, thisCurve, featureData];
ENDLOOP;
curveCount ← h.size;
IF h.overflow
THEN {
CodeTimer.StartInt[$CurveOverflow, $Gargoyle];
CodeTimer.StopInt[$CurveOverflow, $Gargoyle];
};
}; -- end CurvesInNeighborhoodPlus
Maintaining the Nearest-Neighbor Structure
MaxFeatures: NAT ← 20;
BestCurvesFromPool:
PROC [ggData: GGData, t:
REAL, innerR:
REAL]
RETURNS [h: BestPoints] = {
h ← NARROW[ggData.multiGravityPool, MultiGravityPool].bestcurves;
h.size ← 0;
h.max ← 0;
h.min ← Real.LargestNumber;
h.dTol ← t;
h.innerR ← innerR;
h.s ← 0.072; -- 1/1000 inches
h.bestTossed ← Real.LargestNumber;
h.overflow ← FALSE;
FOR i:
NAT
IN [0..MaxFeatures-1]
DO
h[i].dist ← Real.LargestNumber;
h[i].featureData ← NIL;
ENDLOOP;
};
BestPointsFromPool:
PROC [ggData: GGData, t:
REAL]
RETURNS [h: BestPoints] = {
h ← NARROW[ggData.multiGravityPool, MultiGravityPool].bestpoints;
h.size ← 0;
h.max ← 0;
h.min ← Real.LargestNumber;
h.dTol ← t;
h.s ← 0.072; -- 1/1000 inches
h.bestTossed ← Real.LargestNumber;
h.overflow ← FALSE;
FOR i:
NAT
IN [0..MaxFeatures-1]
DO
h[i].dist ← Real.LargestNumber;
h[i].featureData ← NIL;
ENDLOOP;
};
useNewMerge: BOOL ← TRUE;
Alias useNewMerge ← GGMultiGravityImpl.useNewMerge ← TRUE;
MergePoint:
PROC [thisPoint: GoodPoint, h: BestPoints, t:
REAL]
RETURNS [dTol:
REAL] = {
IF useNewMerge THEN RETURN NewMergePoint[thisPoint, h]
ELSE RETURN OldMergeObject[thisPoint, h, t];
};
MergeCurve:
PROC [thisPoint: GoodPoint, h: BestPoints, t:
REAL]
RETURNS [dTol:
REAL] = {
IF useNewMerge THEN RETURN NewMergeCurve[thisPoint, h]
ELSE RETURN OldMergeObject[thisPoint, h, t];
};
OldMergeObject maintains these invariants: There is valid data in h[0] up to h[size-1]. Call these the Elements of h. All other components of h have dist = infinity. h.min is the minimum value of dist(q, x) for x element of h. h.max is the maximum value of dist(q, x) for x element of h.
If overflow is FALSE, then h contains at least one representative of the objects at the farthest distance from q, and all representatives of closer distances.
OldMergeObject:
PROC [thisPoint: GoodPoint, h: BestPoints, t:
REAL]
RETURNS [dTol:
REAL] = {
d: REAL ← thisPoint.dist;
n: NAT = MaxFeatures;
dTol ← t;
BEGIN
SELECT
TRUE
FROM
h.size < n => GOTO Add;
d < h.max AND h.size = n => GOTO AddAndComputeNewMax;
d > h.max AND h.size = n => GOTO NoChange; -- we already have n and this is no better
d = h.max AND h.size = n => {h.overflow ← TRUE; GOTO NoChange};
ENDCASE => SIGNAL Problem[msg: "Impossible case."];
EXITS
Add => {
h[h.size]^ ← thisPoint^;
h.size ← h.size + 1;
h.min ← MIN[h.min, d];
h.max ← MAX[h.max, d];
};
AddAndComputeNewMax => {
iMax: NAT;
newMax: REAL ← 0.0;
bestDist: REAL;
Replace the worst element with the new one.
iMax ← 0; bestDist ← 0.0;
FOR i:
NAT
IN [0..MaxFeatures-1]
DO
IF h[i].dist > bestDist THEN {iMax ← i; bestDist ← h[i].dist};
ENDLOOP;
h[iMax].dist ← d;
h[iMax]^ ← thisPoint^;
Find the new worst element.
iMax ← 0; bestDist ← 0.0;
FOR i:
NAT
IN [0..MaxFeatures-1]
DO
IF h[i].dist > bestDist THEN {iMax ← i; bestDist ← h[i].dist};
ENDLOOP;
newMax ← h[iMax].dist;
If the new worst element isn't so bad as before, then we have had to throw away all elements at some distance. This is overflow.
h.overflow ← IF newMax # h.max THEN TRUE ELSE h.overflow;
h.max ← newMax;
};
END;
};
BestPointsObj: TYPE = RECORD [
size: NAT,
max, min: REAL,
s: REAL, -- the size of neighborhoods. BestPoints should contain all objects that have been seen such that min <= dist(o, q) <= min+s, unless BestPoints overflows.
overflow: BOOL,
points: SEQUENCE len: NAT OF GoodPoint];
NewMergeObject maintains these invariants: There is valid data in h[0] up to h[size-1]. Call these the Elements of h. All other components of h have dist = infinity. h.min is the minimum value of dist(q, x) for x element of h.
If overflow is FALSE, then h contains all objects o, seen so far, such that h.min <= dist(o, q) <= h.min+h.s. h may contain other objects as well.
If overflow is TRUE, all objects in h satisfy h.min <= dist(o, q) <= h.min+h.s but there are one or more objects that satisfy this property that are not in h. Those objects that are not included are at least as far from q as the farthest object in h.
dTol is a hint to the caller that the caller need not pass in objects that are more than dTol units away from q, since NewMergePoint is just going to throw them away.
When NewMergePoint returns, h.dTol = t if h.size = 0, h.dTol = h.min + h.s otherwise.
NewMergePoint:
PROC [thisPoint: GoodPoint, h: BestPoints]
RETURNS [dTol:
REAL] = {
d: REAL ← thisPoint.dist;
n: NAT = MaxFeatures;
BEGIN
SELECT
TRUE
FROM
h.size < n => GOTO Add;
h.size = n AND d <= h.dTol => GOTO ReplaceOrOverflow;
h.size = n AND d > h.dTol => GOTO Toss; -- the caller is not taking our hints and is passing us trash
ENDCASE => SIGNAL Problem[msg: "Impossible case."];
EXITS
Add => {
h[h.size]^ ← thisPoint^;
h.size ← h.size + 1;
h.min ← MIN[h.min, d];
dTol ← h.dTol ← h.min+h.s;
};
ReplaceOrOverflow => {
iWorst: NAT;
worstDist: REAL ← 0.0;
Replace the worst element with the new one if the new is better.
iWorst ← 0; worstDist ← 0.0;
FOR i:
NAT
IN [0..MaxFeatures-1]
DO
IF h[i].dist > worstDist THEN {iWorst ← i; worstDist ← h[i].dist};
ENDLOOP;
IF d < worstDist
THEN {
-- do the replace
h[iWorst].dist ← d;
h[iWorst]^ ← thisPoint^;
h.bestTossed ← MIN[h.bestTossed, worstDist];
h.min ← MIN[h.min, d];
dTol ← h.dTol ← h.min+h.s;
h.overflow ← h.bestTossed <= dTol;
}
ELSE {
-- toss the new item
dTol ← h.dTol;
h.bestTossed ← MIN[h.bestTossed, d];
h.overflow ← TRUE;
};
};
Toss => {
dTol ← h.dTol;
h.bestTossed ← MIN[h.bestTossed, d];
h.overflow ← h.bestTossed <= dTol;
};
END;
};
NewMergeCurve maintains these invariants: There is valid data in h[0] up to h[size-1]. Call these the Elements of h. All other components of h have dist = infinity. h.min is the minimum value of dist(q, x) for x element of h.
If overflow is FALSE, then h contains all objects o, seen so far, such that h.min <= dist(o, q) <= MAX[h.min+h.s, innerR]. h may contain other objects as well.
If overflow is TRUE, all objects in h satisfy h.min <= dist(o, q) <= MAX[h.min+h.s, innerR] but there are one or more objects that satisfy this property that are not in h. Those objects that are not included are at least as far from q as the farthest object in h.
dTol is a hint to the caller that the caller need not pass in objects that are more than dTol units away from q, since NewMergeCurve is just going to throw them away.
When NewMergeCurve returns, h.dTol = t if h.size = 0, h.dTol = MAX[h.min+h.s, innerR] otherwise.
NewMergeCurve:
PROC [thisPoint: GoodPoint, h: BestPoints]
RETURNS [dTol:
REAL] = {
d: REAL ← thisPoint.dist;
n: NAT = MaxFeatures;
BEGIN
SELECT
TRUE
FROM
h.size < n => GOTO Add;
h.size = n AND d <= h.dTol => GOTO ReplaceOrOverflow;
h.size = n AND d > h.dTol => GOTO Toss; -- the caller is not taking our hints and is passing us trash
ENDCASE => SIGNAL Problem[msg: "Impossible case."];
EXITS
Add => {
h[h.size]^ ← thisPoint^;
h.size ← h.size + 1;
h.min ← MIN[h.min, d];
dTol ← h.dTol ← MAX[h.min+h.s, h.innerR];
};
ReplaceOrOverflow => {
iWorst: NAT;
worstDist: REAL ← 0.0;
Replace the worst element with the new one if the new is better.
iWorst ← 0; worstDist ← 0.0;
FOR i:
NAT
IN [0..MaxFeatures-1]
DO
IF h[i].dist > worstDist THEN {iWorst ← i; worstDist ← h[i].dist};
ENDLOOP;
IF d < worstDist
THEN {
-- do the replace
h[iWorst].dist ← d;
h[iWorst]^ ← thisPoint^;
h.bestTossed ← MIN[h.bestTossed, worstDist];
h.min ← MIN[h.min, d];
dTol ← h.dTol ← MAX[h.min+h.s, h.innerR];
h.overflow ← h.bestTossed <= dTol;
}
ELSE {
-- toss the new item
dTol ← h.dTol;
h.bestTossed ← MIN[h.bestTossed, d];
h.overflow ← TRUE;
};
};
Toss => {
dTol ← h.dTol;
h.bestTossed ← MIN[h.bestTossed, d];
h.overflow ← h.bestTossed <= dTol;
};
END;
};
NearPointsFromPoints:
PROC [bestPoints: BestPoints, pointCount:
NAT, nearPointsAndCurves: NearPointsAndCurves] = {
FOR i:
NAT
IN [0..pointCount-1]
DO
nearPointsAndCurves[i] ← bestPoints[i];
ENDLOOP;
};
MergePointsAndCurves:
PROC [bestPoints: BestPoints, pointCount:
NAT, bestCurves: BestPoints, curveCount:
NAT, nearPointsAndCurves: NearPointsAndCurves, count:
NAT] = {
Merge the bestPoints and the bestCurves. There will be count elements in the result.
pointIndex, curveIndex: NAT;
pointDist, curveDist: REAL;
pointIndex ← 0;
curveIndex ← 0;
FOR i:
NAT
IN [0..count-1]
DO
IF pointIndex >= pointCount THEN GOTO NoMorePoints;
IF curveIndex >= curveCount THEN GOTO NoMoreCurves;
pointDist ← bestPoints[i].dist;
curveDist ← bestCurves[i].dist;
IF pointDist <= curveDist
THEN {
nearPointsAndCurves[i] ← bestPoints[pointIndex];
pointIndex ← pointIndex + 1;
}
ELSE {
nearPointsAndCurves[i] ← bestCurves[curveIndex];
curveIndex ← curveIndex + 1;
};
REPEAT
NoMorePoints => { -- finish up with Curves data
FOR k:
NAT ← i, k+1
UNTIL k >= count
DO
nearPointsAndCurves[k] ← bestCurves[curveIndex];
curveIndex ← curveIndex + 1;
ENDLOOP};
NoMoreCurves => { -- finish up with points data
FOR k:
NAT ← i, k+1
UNTIL k >= count
DO
nearPointsAndCurves[k] ← bestPoints[pointIndex];
pointIndex ← pointIndex + 1;
ENDLOOP};
ENDLOOP;
};
SortPoints:
PROC [bestPoints: BestPoints, pointCount:
NAT] = {
Sort the points in order of increasing distance. Since n is likely to be small, bubble sort is sensible:
temp: GoodPointObj;
FOR i:
NAT
IN [0..pointCount-2]
DO
FOR j:
NAT
IN [1..pointCount-i-1]
DO
IF bestPoints[j-1].dist > bestPoints[j].dist
THEN {
temp ← bestPoints[j]^;
bestPoints[j]^ ← bestPoints[j-1]^;
bestPoints[j-1]^ ← temp;
};
ENDLOOP;
ENDLOOP;
SortCurves:
PROC [bestCurves: BestPoints, curveCount:
NAT] = {
Sort the curves in order of increasing distance. Since n is likely to be small, bubble sort is sensible:
temp: GoodPointObj;
FOR i:
NAT
IN [0..curveCount-2]
DO
FOR j:
NAT
IN [1..curveCount-i-1]
DO
IF bestCurves[j-1].dist > bestCurves[j].dist
THEN {
temp ← bestCurves[j]^;
bestCurves[j]^ ← bestCurves[j-1]^;
bestCurves[j-1]^ ← temp;
};
ENDLOOP;
ENDLOOP;
};
Computing Intersections
ComputeMidpoint:
PROC [curve: GoodPoint]
RETURNS [midpoint: Point, success:
BOOL ←
TRUE] = {
class: NAT;
simpleCurve: REF ANY;
[class, simpleCurve] ← ClassifyCurve[curve];
SELECT class
FROM
0 => {
pointPairGen: OutlinePointPairGenerator;
segmentD: OutlineDescriptor ← NARROW[simpleCurve];
pointPairGen ← segmentD.slice.class.pointPairsInDescriptor[segmentD];
ppAndDone ← segmentD.slice.class.nextPointPair[pointPairGen];
IF ppAndDone.done THEN RETURN[[0,0], FALSE]
ELSE {
midpoint ← Vectors2d.Scale[Vectors2d.Add[ppAndDone.lo, ppAndDone.hi], 0.5];
success ← TRUE;
};
};
3 => { -- edge
edge: Edge ← NARROW[simpleCurve];
midpoint ← Vectors2d.Scale[Vectors2d.Add[edge.start, edge.end], 0.5];
success ← TRUE;
};
4 => { -- arc
arc: Arc ← NARROW[simpleCurve];
midpoint ← Vectors2d.Scale[Vectors2d.Add[arc.p0, arc.p2], 0.5];
success ← TRUE;
};
ENDCASE => RETURN[[0,0], FALSE];
};
ClassifyCurve:
PROC [curve: GoodPoint]
RETURNS [class:
NAT, simpleCurve:
REF
ANY] = {
feature: FeatureData ← curve.featureData;
SELECT feature.type
FROM
outline, slice => {
sliceD: SliceDescriptor ← NARROW[feature.shape];
hitData: REF ANY ← curve.hitData;
simpleCurve ← sliceD.slice.class.hitDataAsSimpleCurve[sliceD.slice, hitData];
IF simpleCurve =
NIL
THEN {
simpleCurve ← sliceD;
class ← 5;
RETURN;
};
};
outline => {
The asymmetry here is OK.
sliceD: OutlineDescriptor ← NARROW[feature.shape];
hitData: REF ANY ← curve.hitData;
simpleCurve ← sliceD.slice.class.hitDataAsSimpleCurve[sliceD.slice, hitData];
IF simpleCurve = NIL THEN {
class ← 0;
RETURN;
};
};
radiiCircle => {
class ← 2;
simpleCurve ← NARROW[feature.shape, AlignmentCircle].circle;
RETURN;
};
slopeLine, angleLine => {
class ← 1;
simpleCurve ← NARROW[feature.shape, AlignmentLine].line;
RETURN;
};
distanceLine => {
class ← 1;
simpleCurve ← NARROW[feature.shape, Line];
RETURN;
};
ENDCASE => {class ← 0; simpleCurve ← NIL; RETURN};
WITH simpleCurve
SELECT
FROM
circle: Circle => class ← 2;
edge: Edge => class ← 3;
arc: Arc => class ← 4;
ENDCASE => ERROR;
};
CurveMeetsCurve:
PROC [c1, c2: GoodPoint]
RETURNS [iPoints:
LIST
OF Point, tangency:
LIST
OF
BOOL] = {
typeOfCurve1, typeOfCurve2: NAT;
simpleCurve1, simpleCurve2: REF ANY;
[typeOfCurve1, simpleCurve1] ← ClassifyCurve[c1];
[typeOfCurve2, simpleCurve2] ← ClassifyCurve[c2];
IF typeOfCurve1 >= typeOfCurve2
THEN
[iPoints, tangency] ← ComputeIntersection[typeOfCurve1][typeOfCurve2][simpleCurve1, simpleCurve2]
ELSE
[iPoints, tangency] ← ComputeIntersection[typeOfCurve2][typeOfCurve1][simpleCurve2, simpleCurve1]
};
IntersectionProc: TYPE = PROC [c1, c2: REF ANY] RETURNS [iPoints: LIST OF Point, tangency: LIST OF BOOL];
ComputeIntersection:
ARRAY [0..5]
OF
ARRAY [0..5]
OF IntersectionProc = [
0) NoOp 1) Line 2) Circle 3) Edge 4) Arc 5) Slice
[NoOpI, NIL, NIL, NIL, NIL, NIL], -- 0) NoOp
[NoOpI, LinLinI, NIL, NIL, NIL, NIL], -- 1) Line
[NoOpI, CirLinI, CirCirI, NIL, NIL, NIL], -- 2) Circle
[NoOpI, EdgLinI, EdgCirI, EdgEdgI, NIL, NIL], -- 3) Edge
[NoOpI, ArcLinI, ArcCirI, ArcEdgI, ArcArcI, NIL], -- 4) Arc
[NoOpI, SlcLinI, SlcCirI, NoOpI, NoOpI, NoOpI] -- 5) Slice
];
NoOpI: IntersectionProc = {
iPoints ← NIL;
tangency ← NIL;
};
LinLinI: IntersectionProc = {
IntersectionProc: TYPE = PROC [c1, c2: REF ANY] RETURNS [iPoints: LIST OF Point, tangency: LIST OF BOOL];
l1: Line ← NARROW[c1];
l2: Line ← NARROW[c2];
point: Point;
parallel: BOOL;
[point, parallel] ← Lines2d.LineMeetsLine[l1, l2];
IF NOT parallel THEN {iPoints ← LIST[point]; tangency ← LIST[FALSE]}
ELSE {iPoints ← NIL; tangency ← NIL};
};
CirLinI: IntersectionProc = {
IntersectionProc: TYPE = PROC [c1, c2: REF ANY] RETURNS [iPoints: LIST OF Point, tangency: LIST OF BOOL];
circle: Circle ← NARROW[c1];
line: Line ← NARROW[c2];
points: ARRAY [1..2] OF Point;
hitCount: [0..2];
tangent: BOOL;
[points, hitCount, tangent] ← GGCircles.CircleMeetsLine[circle, line];
FOR i:
NAT
IN [1..hitCount]
DO
iPoints ← CONS[points[i], iPoints];
tangency ← CONS[tangent, tangency];
ENDLOOP;
};
CirCirI: IntersectionProc = {
IntersectionProc: TYPE = PROC [c1, c2: REF ANY] RETURNS [iPoints: LIST OF Point, tangency: LIST OF BOOL];
circle1: Circle ← NARROW[c1];
circle2: Circle ← NARROW[c2];
points: ARRAY [1..2] OF Point;
hitCount: [0..2];
tangent: BOOL;
[points, hitCount, tangent] ← GGCircles.CircleMeetsCircle[circle1, circle2];
FOR i:
NAT
IN [1..hitCount]
DO
iPoints ← CONS[points[i], iPoints];
tangency ← CONS[tangent, tangency];
ENDLOOP;
};
EdgLinI: IntersectionProc = {
IntersectionProc: TYPE = PROC [c1, c2: REF ANY] RETURNS [iPoints: LIST OF Point, tangency: LIST OF BOOL];
edge: Edge ← NARROW[c1];
line: Line ← NARROW[c2];
point: Point;
noHit: BOOL;
[point, noHit] ← Lines2d.LineMeetsEdge[line, edge];
IF NOT noHit THEN {iPoints ← LIST[point]; tangency ← LIST[FALSE]}
ELSE {iPoints ← NIL; tangency ← NIL};
};
EdgCirI: IntersectionProc = {
IntersectionProc: TYPE = PROC [c1, c2: REF ANY] RETURNS [iPoints: LIST OF Point, tangency: LIST OF BOOL];
edge: Edge ← NARROW[c1];
circle: Circle ← NARROW[c2];
points: ARRAY [1..2] OF Point;
hitCount: [0..2];
tangent: BOOL;
[points, hitCount, tangent] ← GGCircles.CircleMeetsEdge[circle, edge];
FOR i:
NAT
IN [1..hitCount]
DO
iPoints ← CONS[points[i], iPoints];
tangency ← CONS[tangent, tangency];
ENDLOOP;
};
EdgEdgI: IntersectionProc = {
IntersectionProc: TYPE = PROC [c1, c2: REF ANY] RETURNS [iPoints: LIST OF Point, tangency: LIST OF BOOL];
e1: Edge ← NARROW[c1];
e2: Edge ← NARROW[c2];
point: Point;
noHit: BOOL;
[point, noHit] ← Lines2d.EdgeMeetsEdge[e1, e2];
IF NOT noHit THEN {iPoints ← LIST[point]; tangency ← LIST[FALSE]}
ELSE {iPoints ← NIL; tangency ← NIL};
};
ArcLinI: IntersectionProc = {
IntersectionProc: TYPE = PROC [c1, c2: REF ANY] RETURNS [iPoints: LIST OF Point, tangency: LIST OF BOOL];
arc: Arc ← NARROW[c1];
line: Line ← NARROW[c2];
points: ARRAY [1..2] OF Point;
hitCount: [0..2];
tangent: BOOL;
[points, hitCount, tangent] ← GGCircles.ArcMeetsLine[arc, line];
FOR i:
NAT
IN [1..hitCount]
DO
iPoints ← CONS[points[i], iPoints];
tangency ← CONS[tangent, tangency];
ENDLOOP;
};
ArcCirI: IntersectionProc = {
IntersectionProc: TYPE = PROC [c1, c2: REF ANY] RETURNS [iPoints: LIST OF Point, tangency: LIST OF BOOL];
arc: Arc ← NARROW[c1];
circle: Circle ← NARROW[c2];
points: ARRAY [1..2] OF Point;
hitCount: [0..2];
tangent: BOOL;
[points, hitCount, tangent] ← GGCircles.CircleMeetsArc[circle, arc];
FOR i:
NAT
IN [1..hitCount]
DO
iPoints ← CONS[points[i], iPoints];
tangency ← CONS[tangent, tangency];
ENDLOOP;
};
ArcEdgI: IntersectionProc = {
IntersectionProc: TYPE = PROC [c1, c2: REF ANY] RETURNS [iPoints: LIST OF Point, tangency: LIST OF BOOL];
arc: Arc ← NARROW[c1];
edge: Edge ← NARROW[c2];
points: ARRAY [1..2] OF Point;
hitCount: [0..2];
tangent: BOOL;
[points, hitCount, tangent] ← GGCircles.ArcMeetsEdge[arc, edge];
FOR i:
NAT
IN [1..hitCount]
DO
iPoints ← CONS[points[i], iPoints];
tangency ← CONS[tangent, tangency];
ENDLOOP;
};
ArcArcI: IntersectionProc = {
IntersectionProc: TYPE = PROC [c1, c2: REF ANY] RETURNS [iPoints: LIST OF Point, tangency: LIST OF BOOL];
arc1: Arc ← NARROW[c1];
arc2: Arc ← NARROW[c2];
points: ARRAY [1..2] OF Point;
hitCount: [0..2];
tangent: BOOL;
[points, hitCount] ← GGCircles.ArcMeetsArc[arc1, arc2];
FOR i:
NAT
IN [1..hitCount]
DO
iPoints ← CONS[points[i], iPoints];
tangency ← CONS[tangent, tangency];
ENDLOOP;
};
SlcLinI: IntersectionProc = {
sliceD: SliceDescriptor ← NARROW[c1];
line: Line ← NARROW[c2];
[iPoints, ----] ← sliceD.slice.class.lineIntersection[sliceD, line];
FOR list:
LIST
OF Point ← iPoints, list.rest
UNTIL list =
NIL
DO
tangency ← CONS[FALSE, tangency];
ENDLOOP;
};
SlcCirI: IntersectionProc = {
sliceD: SliceDescriptor ← NARROW[c1];
circle: Circle ← NARROW[c2];
[iPoints, ----] ← sliceD.slice.class.circleIntersection[sliceD, circle];
FOR list:
LIST
OF Point ← iPoints, list.rest
UNTIL list =
NIL
DO
tangency ← CONS[FALSE, tangency];
ENDLOOP;
};
SeqLineI: IntersectionProc = {
outlineD: OutlineDescriptor ← NARROW[c1];
line: Line ← NARROW[c2];
[iPoints, ----] ← outlineD.slice.class.lineIntersection[outlineD, line];
FOR list:
LIST
OF Point ← iPoints, list.rest
UNTIL list =
NIL
DO
tangency ← CONS[FALSE, tangency];
ENDLOOP;
};
SeqCircleI: IntersectionProc = {
outlineD: OutlineDescriptor ← NARROW[c1];
circle: Circle ← NARROW[c2];
[iPoints, ----] ← outlineD.slice.class.circleIntersection[outlineD, circle];
FOR list:
LIST
OF Point ← iPoints, list.rest
UNTIL list =
NIL
DO
tangency ← CONS[FALSE, tangency];
ENDLOOP;
};
SeqSeqI: IntersectionProc = {
od1: OutlineDescriptor ← NARROW[c1];
od2: OutlineDescriptor ← NARROW[c2];
simpleCurve1, simpleCurve2: REF ANY;
simpleCurve1 ← od1.slice.class.hitDataAsSimpleCurve[od1.slice, hitData1];
simpleCurve2 ← od2.slice.class.hitDataAsSimpleCurve[od2.slice, hitData2];
iPoints ← NIL;
};
Utilities
NewMultiGravityPool:
PUBLIC PROC []
RETURNS [
REF]= {
-- reuseable storage for BestPointAndCurve proc to avoid NEWs
pool: MultiGravityPool ← NEW[MultiGravityPoolObj];
pool.distances ← NEW[NearDistancesObj[MaxFeatures]];
pool.features ← NEW[NearFeaturesObj[MaxFeatures]];
pool.bestpoints ← NEW[BestPointsObj[MaxFeatures]];
pool.bestcurves ← NEW[BestPointsObj[MaxFeatures]];
FOR i:
NAT
IN [0..MaxFeatures)
DO
pool.bestpoints[i] ← NEW[GoodPointObj];
pool.bestcurves[i] ← NEW[GoodPointObj];
ENDLOOP;
RETURN[pool];
};
InitStats:
PROC [] = {
interval: CodeTimer.Interval;
interval ← CodeTimer.CreateInterval[$MultiMap];
CodeTimer.AddInt[interval, $Gargoyle];
interval ← CodeTimer.CreateInterval[$CurveOverflow];
CodeTimer.AddInt[interval, $Gargoyle]; -- counting break
interval ← CodeTimer.CreateInterval[$PointOverflow];
CodeTimer.AddInt[interval, $Gargoyle]; -- counting break
};
InitStats[];
END.