<> <> <> <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 ]; <> <<>> 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.slices = NIL AND triggerBag.intersectionPoints = NIL AND triggerBag.anchor = NIL ]; }; Problem: PUBLIC SIGNAL [msg: Rope.ROPE] = CODE; <> << [Artwork node; type 'ArtworkInterpress on' to command tool] >> <> Map: PUBLIC PROC [testPoint: Point, criticalR: REAL, alignBag: AlignBag, sceneBag: TriggerBag, ggData: GGData, useAlignBag: BOOL] RETURNS [resultPoint: Point, feature: FeatureData, hitData: REF ANY] = { <> 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] = { <> 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 { <> 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]; <> <<1) Prefer scene objects to alignment lines.>> <<2) Prefer points to lines.>> <> bestSceneObject _ -1; <> <> <> <>> <> < IF bestSceneObject = -1 THEN bestSceneObject _ i;>> <<};>> <> < {>> <= 0 THEN>> <> <> <<};>> <> 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 { <> 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.>> <> 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] = { }; <<>> <> <<>> MultiMap: PUBLIC PROC [testPoint: Point, criticalR: REAL, alignBag: AlignBag, sceneBag: TriggerBag, ggData: GGData, useAlignBag: BOOL] RETURNS [nearPointsAndCurves: NearPointsAndCurves, count: NAT] = { <> 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] = { <> 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] = { <> 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; <> <> <> <> 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]; }; }; }; <> <<[thisPoint.point, thisPoint.dist, thisPoint.hitData, success] _ outlineD.slice.class.closestPoint[outlineD, q, dTol];>> <> <> <> <> <<};>> <<};>> <<};>> <<>> sliceD: SliceDescriptor; <> 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 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; <> <> <> <> <> <> 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] = { <> <> <> <> 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]; }; }; }; <> <> <<[thisCurve.point, thisCurve.dist, thisCurve.hitData, success] _ outlineD.slice.class.closestSegment[outlineD, q, t];>> <> <> <> <> <<};>> <<};>> <<};>> <<>> line: Line; circle: Circle; sliceD: SliceDescriptor; <> featureData: FeatureData; added: BOOL _ FALSE; thisCurve: GoodPoint _ NEW[GoodPointObj]; dTol: REAL _ t; h _ BestCurvesFromPool[ggData, t, innerR]; <> 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; <> 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; <> <> <> <> <> curveCount _ h.size; IF h.overflow THEN { CodeTimer.StartInt[$CurveOverflow, $Gargoyle]; CodeTimer.StopInt[$CurveOverflow, $Gargoyle]; }; }; -- end CurvesInNeighborhoodPlus <> 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; <> 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: 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; <> 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^; <> 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; <> h.overflow _ IF newMax # h.max THEN TRUE ELSE h.overflow; h.max _ newMax; }; NoChange => { }; END; }; <> <> <> <> <> <> <<>> <> <> <> <> <> <<>> 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; <> 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: 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; <> 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] = { <> 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] = { <> 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] = { <> 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; }; <<>> <<>> <> <<>> ComputeMidpoint: PROC [curve: GoodPoint] RETURNS [midpoint: Point, success: BOOL _ TRUE] = { class: NAT; simpleCurve: REF ANY; [class, simpleCurve] _ ClassifyCurve[curve]; SELECT class FROM <<0 => {>> <> <> <> <> <> <> <> <> <<};>> <<};>> 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; }; }; < {>> <> <> <> <> <> <> <> <<};>> <<};>> 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 = { <> 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 = { <> 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 = { <> 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 = { <> 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 = { <> 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 = { <> 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 = { <> 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 = { <> 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 = { <> 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 = { <> 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]; <> <> <> iPoints _ NIL; }; <<>> <> 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.