<> <> <> <Documentation>MultiGravity.tioga.>> <<>> DIRECTORY GGBasicTypes, AtomButtons, GGCaret, GGCircles, GGLines, GGInterfaceTypes, GGModelTypes, GGMultiGravity, GGSegmentTypes, GGStatistics, GGUtility, GGVector, RealFns, Rope; GGMultiGravityImpl: CEDAR PROGRAM IMPORTS AtomButtons, GGCaret, GGCircles, GGLines, GGStatistics, GGVector, RealFns EXPORTS GGMultiGravity = BEGIN Arc: TYPE = GGBasicTypes.Arc; AlignmentCircle: TYPE = GGInterfaceTypes.AlignmentCircle; AlignmentLine: TYPE = GGInterfaceTypes.AlignmentLine; AlignmentPoint: TYPE = REF AlignmentPointObj; AlignmentPointObj: TYPE = GGInterfaceTypes.AlignmentPointObj; Caret: TYPE = GGInterfaceTypes.Caret; Circle: TYPE = GGBasicTypes.Circle; Edge: TYPE = GGBasicTypes.Edge; FeatureData: TYPE = REF FeatureDataObj; FeatureDataObj: TYPE = GGModelTypes.FeatureDataObj; GargoyleData: TYPE = GGInterfaceTypes.GargoyleData; GoodCurve: TYPE = REF GoodCurveObj; GoodCurveObj: TYPE = GGMultiGravity.GoodCurveObj; GoodPoint: TYPE = REF GoodPointObj; GoodPointObj: TYPE = GGMultiGravity.GoodPointObj; GoodPointType: TYPE = GGMultiGravity.GoodPointType; 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; ObjectBag: TYPE = REF ObjectBagObj; ObjectBagObj: TYPE = GGInterfaceTypes.ObjectBagObj; Outline: TYPE = GGModelTypes.Outline; OutlineDescriptor: TYPE = REF OutlineDescriptorObj; OutlineDescriptorObj: TYPE = GGModelTypes.OutlineDescriptorObj; Point: TYPE = GGBasicTypes.Point; 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; MultiGravityPool: TYPE = REF MultiGravityPoolObj; MultiGravityPoolObj: TYPE = RECORD [ distances: NearDistances, features: NearFeatures, bestpoints: BestPoints, bestcurves: BestCurves ]; BestCurves: TYPE = REF BestCurvesObj; BestCurvesObj: TYPE = RECORD [ size: NAT, max, min: REAL, overflow: BOOL, curves: SEQUENCE len: NAT OF GoodCurve]; BestPoints: TYPE = REF BestPointsObj; BestPointsObj: TYPE = RECORD [ size: NAT, max, min: REAL, overflow: BOOL, points: SEQUENCE len: NAT OF GoodPoint]; <> <<>> EmptyBag: PROC [objectBag: ObjectBag] RETURNS [BOOL] = { RETURN[ objectBag.slopeLines = NIL AND objectBag.angleLines = NIL AND objectBag.radiiCircles = NIL AND objectBag.distanceLines = NIL AND objectBag.midpoints = NIL AND objectBag.intersectionPoints = 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; <> << [Artwork node; type 'ArtworkInterpress on' to command tool] >> <> Map: PUBLIC PROC [testPoint: Point, criticalR: REAL, currentObjects: ObjectBag, activeObjects: TriggerBag, gargoyleData: GargoyleData, intersections: BOOL] RETURNS [resultPoint: Point, feature: FeatureData] = { <> ENABLE UNWIND => gargoyleData.multiGravityPool _ NewMultiGravityPool[]; -- in case an ABORT happened while pool was in use GGStatistics.StartInterval[$MultiMap, GGStatistics.GlobalTable[]]; SELECT AtomButtons.GetButtonState[gargoyleData.hitTest.gravButton] FROM on => SELECT gargoyleData.hitTest.gravityType FROM strictDistance => [resultPoint, feature] _ StrictDistance[testPoint, criticalR, currentObjects, activeObjects, gargoyleData]; innerCircle => [resultPoint, feature] _ InnerCircle[testPoint, criticalR, gargoyleData.hitTest.innerR, currentObjects, activeObjects, gargoyleData, intersections]; ENDCASE => ERROR; off => { resultPoint _ testPoint; feature _ NIL; }; ENDCASE => ERROR; GGStatistics.StopInterval[$MultiMap, GGStatistics.GlobalTable[]]; }; <<>> PrepareWinner: PROC [nearPointsAndCurves: NearPointsAndCurves, index: NAT] RETURNS [resultPoint: Point, feature: FeatureData] = { WITH nearPointsAndCurves[index] SELECT FROM goodPoint: GoodPoint => { resultPoint _ goodPoint.point; ExtractResultFromPoint[goodPoint, goodPoint.featureData]; -- stuffs hit info into featureData feature _ goodPoint.featureData; }; goodCurve: GoodCurve => { resultPoint _ goodCurve.point; ExtractResultFromCurve[goodCurve, goodCurve.featureData]; -- stuffs hit info into featureData feature _ goodCurve.featureData; }; ENDCASE => ERROR; }; StrictDistance: PUBLIC PROC [testPoint: Point, criticalR: REAL, objectBag: ObjectBag, sceneBag: TriggerBag, gargoyleData: GargoyleData] RETURNS [resultPoint: Point, feature: FeatureData] = { <> nearPointsAndCurves: NearPointsAndCurves; count: NAT; [nearPointsAndCurves, count] _ MultiStrictDistance[testPoint, criticalR, objectBag, sceneBag, gargoyleData]; IF count = 0 THEN RETURN [testPoint, NIL]; IF count = 1 THEN RETURN PrepareWinner[nearPointsAndCurves, 0] ELSE { <> distances: NearDistances _ NARROW[gargoyleData.multiGravityPool, MultiGravityPool].distances; features: NearFeatures _ NARROW[gargoyleData.multiGravityPool, MultiGravityPool].features; nearestDist: REAL; bestSceneObject: INT; neighborCount: NAT _ 1; s: REAL = 0.072; -- 1/1000 inches FOR i: NAT IN [0..count) DO WITH nearPointsAndCurves[i] SELECT FROM goodPoint: GoodPoint => { distances[i] _ goodPoint.dist; features[i] _ goodPoint.featureData}; goodCurve: GoodCurve => { distances[i] _ goodCurve.dist; features[i] _ goodCurve.featureData;}; ENDCASE => ERROR; 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]; }; }; <> InnerCircle: PUBLIC PROC [testPoint: Point, criticalR: REAL, innerR: REAL, currentObjects: ObjectBag, activeObjects: TriggerBag, gargoyleData: GargoyleData, intersections: BOOL] RETURNS [resultPoint: Point, feature: FeatureData] = { count: NAT; nearPointsAndCurves: NearPointsAndCurves; [nearPointsAndCurves, count] _ MultiInnerCircle[testPoint, criticalR, innerR, currentObjects, activeObjects, gargoyleData, intersections]; IF count = 0 THEN RETURN [testPoint, NIL]; IF count = 1 THEN RETURN PrepareWinner[nearPointsAndCurves, 0] ELSE { <> distances: NearDistances _ NARROW[gargoyleData.multiGravityPool, MultiGravityPool].distances; features: NearFeatures _ NARROW[gargoyleData.multiGravityPool, MultiGravityPool].features; neighborCount: NAT _ 1; s: REAL = 0.072; -- 1/1000 inches nearestDist: REAL; FOR i: NAT IN [0..count) DO WITH nearPointsAndCurves[i] SELECT FROM goodPoint: GoodPoint => { distances[i] _ goodPoint.dist; features[i] _ goodPoint.featureData}; goodCurve: GoodCurve => { distances[i] _ goodCurve.dist; features[i] _ goodCurve.featureData;}; ENDCASE => ERROR; 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; }; }; <<>> <<>> NearestNeighborsPlusSome: PROC [q: Point, initialD: REAL, currentObjects: ObjectBag, activeObjects: TriggerBag, anchor: Caret, gargoyleData: GargoyleData, distinguishedPointsOnly: BOOL _ FALSE] RETURNS [g: NearPointsAndCurves, count: NAT] = { }; <> <<>> MultiMap: PUBLIC PROC [testPoint: Point, criticalR: REAL, currentObjects: ObjectBag, activeObjects: TriggerBag, gargoyleData: GargoyleData, intersections: BOOL] RETURNS [nearPointsAndCurves: NearPointsAndCurves, count: NAT] = { <> ENABLE UNWIND => gargoyleData.multiGravityPool _ NewMultiGravityPool[]; -- in case an ABORT happened while pool was in use GGStatistics.StartInterval[$MultiMap, GGStatistics.GlobalTable[]]; SELECT AtomButtons.GetButtonState[gargoyleData.hitTest.gravButton] FROM on => SELECT gargoyleData.hitTest.gravityType FROM strictDistance => [nearPointsAndCurves, count] _ MultiStrictDistance[testPoint, criticalR, currentObjects, activeObjects, gargoyleData]; innerCircle => [nearPointsAndCurves, count] _ MultiInnerCircle[testPoint, criticalR, gargoyleData.hitTest.innerR, currentObjects, activeObjects, gargoyleData, intersections]; ENDCASE => ERROR; off => { nearPointsAndCurves _ NIL; count _ 0; }; ENDCASE => ERROR; GGStatistics.StopInterval[$MultiMap, GGStatistics.GlobalTable[]]; }; MultiStrictDistance: PUBLIC PROC [testPoint: Point, criticalR: REAL, currentObjects: ObjectBag, activeObjects: TriggerBag, gargoyleData: GargoyleData] RETURNS [nearPointsAndCurves: NearPointsAndCurves, count: NAT] = { <> bestCurves: BestCurves; bestPoints: BestPoints; pointCount, curveCount: NAT; IF EmptyBag[currentObjects] AND EmptyTriggers[activeObjects] THEN RETURN[NIL, 0]; [bestCurves, curveCount] _ CurvesInTolerance[currentObjects, activeObjects, testPoint, gargoyleData, criticalR]; SortCurves[bestCurves, curveCount]; [bestPoints, pointCount] _ PointsInTolerance[bestCurves, curveCount, currentObjects, activeObjects, testPoint, criticalR, gargoyleData, FALSE]; SortPoints[bestPoints, pointCount]; count _ MIN[pointCount + curveCount, MaxFeatures]; nearPointsAndCurves _ NEW[NearPointsAndCurvesObj[count]]; MergePointsAndCurves[bestPoints, pointCount, bestCurves, curveCount, nearPointsAndCurves, count]; }; MultiInnerCircle: PUBLIC PROC [testPoint: Point, criticalR: REAL, innerR: REAL, currentObjects: ObjectBag, activeObjects: TriggerBag, gargoyleData: GargoyleData, intersections: BOOL] RETURNS [nearPointsAndCurves: NearPointsAndCurves, count: NAT] = { <> bestCurves: BestCurves; bestPoints: BestPoints; pointCount, curveCount: NAT; IF EmptyBag[currentObjects] AND EmptyTriggers[activeObjects] THEN RETURN[NIL, 0]; [bestCurves, curveCount] _ CurvesInTolerance[currentObjects, activeObjects, testPoint, gargoyleData, criticalR]; SortCurves[bestCurves, curveCount]; [bestPoints, pointCount] _ PointsInTolerance[bestCurves, curveCount, currentObjects, activeObjects, testPoint, criticalR, gargoyleData, intersections]; 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]; }; }; ExtractResultFromCurve: PROC [curve: GoodCurve, feature: FeatureData] = { SELECT feature.type FROM outline => { feature.hitPart _ curve.hitData; feature.resultType _ outline; }; slice => { feature.hitPart _ curve.hitData; feature.resultType _ slice; }; slopeLine => feature.resultType _ slopeLine; angleLine => feature.resultType _ angleLine; radiiCircle => feature.resultType _ radiiCircle; distanceLine => feature.resultType _ distanceLine; ENDCASE => SIGNAL Problem[msg: "Unimplemented result type."]; }; ExtractResultFromPoint: PROC [goodPoint: GoodPoint, feature: FeatureData] = { SELECT goodPoint.type FROM outline => { feature.hitPart _ goodPoint.hitData; feature.resultType _ outline; }; slice => { feature.hitPart _ goodPoint.hitData; feature.resultType _ slice; }; intersectionPoint => { feature.hitPart _ NIL; feature.resultType _ intersectionPoint; }; midpoint => { <> feature.resultType _ midpoint; }; anchor => { <> feature.resultType _ anchor; }; ENDCASE => SIGNAL Problem [msg: "Unimplemented result type."]; }; FindIntersections: PROC [bestCurves: BestCurves, curveCount: NAT, thisPoint: GoodPoint, q: Point, tolerance: REAL, h: BestPoints] = { curveI, curveJ: GoodCurve; theseIPoints: LIST OF Point; thisTangency, tangentList: LIST OF BOOL; success: BOOL; 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.type _ intersectionPoint; thisPoint.dist _ GGVector.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; MergePoint[thisPoint, h]; }; tangentList _ tangentList.rest; ENDLOOP; ENDLOOP; ENDLOOP; }; PointsInTolerance: PROC [bestCurves: BestCurves, curveCount: NAT, objectBag: ObjectBag, sceneObjects: TriggerBag, q: Point, t: REAL, gargoyleData: GargoyleData, intersections: BOOL] RETURNS [h: BestPoints, pointCount: NAT] = { thisPoint: GoodPoint; <> ProcessPoint: PROC [thisPoint: GoodPoint, featureData: FeatureData] = { dSquared: REAL; dSquared _ GGVector.DistanceSquared[thisPoint.point, q]; thisPoint.hitData _ NIL; IF dSquared < tSquared THEN { thisPoint.dist _ RealFns.SqRt[dSquared]; thisPoint.featureData _ featureData; MergePoint[thisPoint, h]; }; }; ProcessSlice: PROC [sliceD: SliceDescriptor, thisPoint: GoodPoint, featureData: FeatureData] = { [thisPoint.point, thisPoint.dist, thisPoint.hitData, success] _ sliceD.slice.class.closestPoint[sliceD, q, t]; IF success THEN { IF thisPoint.dist < t THEN { thisPoint.featureData _ featureData; MergePoint[thisPoint, h]; }; }; }; ProcessOutline: PROC [outlineD: OutlineDescriptor, thisPoint: GoodPoint, featureData: FeatureData] = { [thisPoint.point, thisPoint.dist, thisPoint.hitData, success] _ outlineD.slice.class.closestPoint[outlineD, q, t]; IF success THEN { IF thisPoint.dist < t THEN { thisPoint.featureData _ featureData; MergePoint[thisPoint, h]; }; }; }; sliceD: SliceDescriptor; outlineD: OutlineDescriptor; featureData: FeatureData; success: BOOL; tSquared: REAL _ t*t; thisPoint _ NEW[GoodPointObj]; h _ BestPointsFromPool[gargoyleData]; IF intersections THEN FindIntersections[bestCurves, curveCount, thisPoint, q, t, h]; <> <> <> <> <> <> FOR midpoints: LIST OF FeatureData _ objectBag.midpoints, midpoints.rest UNTIL midpoints = NIL DO featureData _ midpoints.first; thisPoint.type _ midpoint; thisPoint.point _ NARROW[featureData.shape, AlignmentPoint].point; ProcessPoint[thisPoint, featureData]; ENDLOOP; FOR slices: LIST OF FeatureData _ sceneObjects.slices, slices.rest UNTIL slices = NIL DO featureData _ slices.first; thisPoint.type _ slice; sliceD _ NARROW[featureData.shape, SliceDescriptor]; ProcessSlice[sliceD, thisPoint, featureData]; ENDLOOP; FOR outlines: LIST OF FeatureData _ sceneObjects.outlines, outlines.rest UNTIL outlines = NIL DO featureData _ outlines.first; thisPoint.type _ outline; outlineD _ NARROW[featureData.shape]; ProcessOutline[outlineD, thisPoint, featureData]; ENDLOOP; <> featureData _ sceneObjects.anchor; IF featureData # NIL THEN { anchor: Caret; anchor _ NARROW[featureData.shape]; IF NOT GGCaret.Exists[anchor] THEN ERROR; thisPoint.type _ anchor; thisPoint.point _ GGCaret.GetPoint[anchor]; ProcessPoint[thisPoint, featureData]; }; pointCount _ h.size; }; <<>> CurvesInTolerance: PROC [objectBag: ObjectBag, sceneObjects: TriggerBag, q: Point, gargoyleData: GargoyleData, t: REAL] RETURNS [h: BestCurves, curveCount: NAT] = { <> ProcessLine: PROC [line: Line, thisCurve: GoodCurve, featureData: FeatureData] = { thisCurve.dist _ GGLines.LineDistance[q, line]; IF thisCurve.dist < t THEN { thisCurve.featureData _ featureData; thisCurve.point _ GGLines.PointProjectedOntoLine[q, line]; thisCurve.hitData _ NIL; added _ MergeCurve[thisCurve, h]; } }; ProcessCircle: PROC [circle: Circle, thisCurve: GoodCurve, 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; added _ MergeCurve[thisCurve, h]; }; }; ProcessSlice: PROC [sliceD: SliceDescriptor, thisCurve: GoodCurve, 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; added _ MergeCurve[thisCurve, h]; }; }; }; ProcessOutline: PROC [outlineD: OutlineDescriptor, thisCurve: GoodCurve, 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; added _ MergeCurve[thisCurve, h]; }; }; }; line: Line; circle: Circle; sliceD: SliceDescriptor; outlineD: OutlineDescriptor; featureData: FeatureData; added: BOOL; thisCurve: GoodCurve _ NEW[GoodCurveObj]; h _ BestCurvesFromPool[gargoyleData]; FOR slopeLines: LIST OF FeatureData _ objectBag.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 _ objectBag.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 _ objectBag.distanceLines, dLines.rest UNTIL dLines = NIL DO featureData _ dLines.first; line _ NARROW[featureData.shape]; ProcessLine[line, thisCurve, featureData]; ENDLOOP; FOR circles: LIST OF FeatureData _ objectBag.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 _ sceneObjects.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 _ sceneObjects.outlines, outlines.rest UNTIL outlines = NIL DO featureData _ outlines.first; outlineD _ NARROW[featureData.shape, OutlineDescriptor]; ProcessOutline[outlineD, thisCurve, featureData]; ENDLOOP; curveCount _ h.size; }; -- end CurvesInTolerance MergePoint: PROC [thisPoint: GoodPoint, h: BestPoints] = { d: REAL _ thisPoint.dist; n: NAT = MaxFeatures; SELECT TRUE FROM d > h.max AND h.size < n => {h.max _ d; GOTO Add}; d <= h.max AND 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 => { d: REAL _ thisPoint.dist; h[h.size]^ _ thisPoint^; h.size _ h.size + 1; h.min _ IF d < h.min THEN d ELSE h.min; }; AddAndComputeNewMax => { d: REAL _ thisPoint.dist; newMax: REAL; iMax: NAT; 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 FALSE; h.max _ newMax; }; NoChange => { }; }; MergeCurve: PROC [thisCurve: GoodCurve, h: BestCurves] RETURNS [added: BOOL] = { d: REAL _ thisCurve.dist; n: NAT _ MaxFeatures; SELECT TRUE FROM d > h.max AND h.size < n => {h.max _ d; GOTO Add}; d <= h.max AND 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 => { d: REAL _ thisCurve.dist; h[h.size]^ _ thisCurve^; h.size _ h.size + 1; h.min _ IF d < h.min THEN d ELSE h.min; added _ TRUE; }; AddAndComputeNewMax => { d: REAL _ thisCurve.dist; newMax: REAL; iMax: NAT; 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]^ _ thisCurve^; 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 FALSE; h.max _ newMax; added _ TRUE; }; NoChange => { added _ FALSE; }; }; 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: BestCurves, 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: BestCurves, curveCount: NAT] = { <> temp: GoodCurveObj; 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; }; <<>> <<>> <> <<>> <> ClassifyCurve: PROC [curve: GoodCurve] RETURNS [class: NAT, simpleCurve: REF ANY] = { feature: FeatureData _ curve.featureData; SELECT feature.type FROM 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 => { <> 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: GoodCurve] 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] _ GGLines.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] _ GGLines.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] _ GGLines.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; }; <> MaxFeatures: NAT = 20; BestCurvesFromPool: PROC [gargoyleData: GargoyleData] RETURNS [h: BestCurves] = { h _ NARROW[gargoyleData.multiGravityPool, MultiGravityPool].bestcurves; h.size _ 0; h.max _ 0; h.min _ GGUtility.plusInfinity; h.overflow _ FALSE; FOR i: NAT IN [0..MaxFeatures-1] DO h[i].dist _ GGUtility.plusInfinity; h[i].featureData _ NIL; ENDLOOP; }; BestPointsFromPool: PROC [gargoyleData: GargoyleData] RETURNS [h: BestPoints] = { h _ NARROW[gargoyleData.multiGravityPool, MultiGravityPool].bestpoints; h.size _ 0; h.max _ 0; h.min _ GGUtility.plusInfinity; h.overflow _ FALSE; FOR i: NAT IN [0..MaxFeatures-1] DO h[i].dist _ GGUtility.plusInfinity; h[i].featureData _ NIL; ENDLOOP; }; 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[BestCurvesObj[MaxFeatures]]; FOR i: NAT IN [0..MaxFeatures) DO pool.bestpoints[i] _ NEW[GoodPointObj]; pool.bestcurves[i] _ NEW[GoodCurveObj]; ENDLOOP; RETURN[pool]; }; InitStats: PROC [] = { interval: GGStatistics.Interval; interval _ GGStatistics.CreateInterval[$MultiMap]; GGStatistics.AddInterval[interval, GGStatistics.GlobalTable[]]; }; InitStats[]; END.