<> <> <> <> <> <<>> DIRECTORY BiScrollers, GGBasicTypes, AtomButtons, GGCaret, GGCircles, GGCircleCache, GGLines, GGGravity, GGMultiGravity, GGModelTypes, GGInterfaceTypes, GGShapes, GGSegmentTypes, GGSequence, GGStatistics, GGTraj, GGVector, Imager, ImagerBackdoor, ImagerTransformation, Process, Real, RealFns, Rope; GGGravityImpl: CEDAR PROGRAM IMPORTS BiScrollers, AtomButtons, GGCaret, GGCircles, GGCircleCache, GGLines, GGMultiGravity, GGSequence, GGShapes, GGStatistics, GGTraj, GGVector, Imager, ImagerBackdoor, Process, RealFns EXPORTS GGGravity = BEGIN AlignmentCircle: TYPE = REF AlignmentCircleObj; AlignmentCircleObj: TYPE = GGInterfaceTypes.AlignmentCircleObj; AlignmentLine: TYPE = REF AlignmentLineObj; AlignmentLineObj: TYPE = GGInterfaceTypes.AlignmentLineObj; AlignmentPoint: TYPE = REF AlignmentPointObj; AlignmentPointObj: TYPE = GGInterfaceTypes.AlignmentPointObj; Angle: TYPE = GGBasicTypes.Angle; BoundBox: TYPE = GGModelTypes.BoundBox; Caret: TYPE = GGInterfaceTypes.Caret; Circle: TYPE = GGBasicTypes.Circle; Edge: TYPE = GGBasicTypes.Edge; FeatureData: TYPE = REF FeatureDataObj; FeatureDataObj: TYPE = GGModelTypes.FeatureDataObj; GargoyleData: TYPE = GGInterfaceTypes.GargoyleData; JointGenerator: TYPE = GGModelTypes.JointGenerator; Line: TYPE = GGBasicTypes.Line; 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 = REF SliceDescriptorObj; SliceDescriptorObj: TYPE = GGModelTypes.SliceDescriptorObj; SliceParts: TYPE = GGModelTypes.SliceParts; Traj: TYPE = GGModelTypes.Traj; TriggerBag: TYPE = GGInterfaceTypes.TriggerBag; Vector: TYPE = GGBasicTypes.Vector; Problem: PUBLIC SIGNAL [msg: Rope.ROPE] = CODE; <> maxDistance: REAL = 99999.0; noPoint: Point = [0.0, 0.0]; noJoint: NAT = 9999; noCP: NAT = 8888; noSeg: NAT = 7777; <> FeatureFromOutline: PUBLIC PROC [outline: Outline, parts: SliceParts _ NIL] RETURNS [feature: FeatureData] = { sliceParts: SliceParts _ IF parts=NIL THEN outline.class.newParts[outline, NIL, slice] ELSE parts; outlineD: OutlineDescriptor _ NEW[OutlineDescriptorObj _ [slice: outline, parts: sliceParts]]; feature _ NEW[FeatureDataObj]; feature.type _ outline; feature.shape _ outlineD; }; FeatureFromSlice: PUBLIC PROC [slice: Slice, parts: SliceParts _ NIL] RETURNS [feature: FeatureData] = { sliceParts: SliceParts _ IF parts=NIL THEN slice.class.newParts[slice, NIL, slice] ELSE parts; -- may get a descriptor of the whole slice sliceD: SliceDescriptor _ NEW[SliceDescriptorObj _ [slice: slice, parts: sliceParts]]; feature _ NEW[FeatureDataObj]; feature.type _ slice; feature.shape _ sliceD; }; FeatureFromAnchor: PUBLIC PROC [anchor: Caret] RETURNS [feature: FeatureData] = { feature _ NEW[FeatureDataObj]; feature.type _ anchor; -- that is, anchor => the member of the enumerated type feature.shape _ anchor; -- that is, anchor => the parameter }; <> CreateObjectBag: PUBLIC PROC [] RETURNS [objectBag: ObjectBag] = { objectBag _ NEW[ObjectBagObj _ [ slopeLines: NIL, angleLines: NIL, radiiCircles: NIL, distanceLines: NIL, midpoints: NIL, intersectionPoints: NIL ]]; }; FlushObjectBag: PUBLIC PROC [objectBag: ObjectBag] = { objectBag.slopeLines _ NIL; objectBag.angleLines _ NIL; objectBag.radiiCircles _ NIL; objectBag.distanceLines _ NIL; objectBag.midpoints _ NIL; objectBag.intersectionPoints _ NIL; }; JointAddSlopeLine: PUBLIC PROC [degrees: REAL, direction: Vector, point: Point, objectBag: ObjectBag] RETURNS [feature: FeatureData] = { <> <> line: Line; coincident: FeatureData _ LineThru[point, degrees, objectBag.slopeLines]; IF coincident # NIL THEN { alignmentLine: AlignmentLine _ NARROW[coincident.shape]; alignmentLine.triggerPoints _ CONS[point, alignmentLine.triggerPoints]; feature _ NIL; } ELSE { alignmentLine: AlignmentLine; line _ GGLines.LineFromPointAndVector[point, direction]; alignmentLine _ NEW[AlignmentLineObj _ [line: line, degrees: degrees, triggerPoints: CONS[point, NIL]]]; feature _ NEW[FeatureDataObj]; feature.type _ slopeLine; feature.shape _ alignmentLine; AddFeature[feature, objectBag]; }; }; JointAddCircle: PUBLIC PROC [radius: REAL, point: Point, objectBag: ObjectBag] RETURNS [feature: FeatureData] = { <> <> circle: Circle; coincident: FeatureData; coincident _ SameCircle[point, radius, objectBag.radiiCircles]; IF coincident # NIL THEN { alignmentCircle: AlignmentCircle _ NARROW[coincident.shape]; alignmentCircle.triggerPoints _ CONS[point, alignmentCircle.triggerPoints]; feature _ NIL; } ELSE { alignmentCircle: AlignmentCircle; circle _ GGCircles.CircleFromPointAndRadius[point, radius]; alignmentCircle _ NEW[AlignmentCircleObj _ [circle: circle, triggerPoints: CONS[point, NIL]]]; feature _ NEW[FeatureDataObj]; feature.type _ radiiCircle; feature.shape _ alignmentCircle; AddFeature[feature, objectBag]; }; }; SameCircle: PRIVATE PROC [point: Point, radius: REAL, list: LIST OF FeatureData] RETURNS [coincident: FeatureData] = { circle: Circle; FOR l: LIST OF FeatureData _ list, l.rest UNTIL l = NIL DO circle _ NARROW[l.first.shape, AlignmentCircle].circle; <> IF RealFns.AlmostEqual[circle.origin.x, point.x, -10] AND RealFns.AlmostEqual[circle.origin.y, point.y, -10] AND RealFns.AlmostEqual[circle.radius, radius, -10] THEN RETURN[l.first]; ENDLOOP; RETURN[NIL]; }; LineThru: PRIVATE PROC [point: Point, degrees: REAL, list: LIST OF FeatureData] RETURNS [coincident: FeatureData] = { epsilon: REAL = 1.0e-5; line: Line; FOR l: LIST OF FeatureData _ list, l.rest UNTIL l = NIL DO line _ NARROW[l.first.shape, AlignmentLine].line; IF NARROW[l.first.shape, AlignmentLine].degrees = degrees AND GGLines.LineDistance[point, line] < epsilon THEN RETURN[l.first]; ENDLOOP; RETURN[NIL]; }; SegmentAddTwoAngleLines: PUBLIC PROC [degrees: REAL, segNum: NAT, lo, hi: Point, objectBag: ObjectBag] RETURNS [line1, line2: FeatureData] = { loLine: Line _ GGLines.LineFromPointAndAngle[pt: lo, degrees: GGVector.AngleFromVector[[x: hi.x-lo.x, y: hi.y-lo.y]]+degrees]; hiLine: Line _ GGLines.LineFromPointAndAngle[pt: hi, degrees: GGVector.AngleFromVector[[x: lo.x-hi.x, y: lo.y-hi.y]]+degrees]; line1 _ NEW[FeatureDataObj]; line1.type _ angleLine; line1.shape _ NEW[AlignmentLineObj _ [line: loLine, degrees: degrees, triggerPoints: NIL]]; <> AddFeature[line1, objectBag]; line2 _ NEW[FeatureDataObj]; line2.type _ angleLine; line2.shape _ NEW[AlignmentLineObj _ [line: hiLine, degrees: degrees, triggerPoints: NIL]]; <> AddFeature[line2, objectBag]; }; SegmentAddDistanceLines: PUBLIC PROC [distance: REAL, segNum: NAT, lo, hi: Point, objectBag: ObjectBag] RETURNS [line1, line2: FeatureData] = { <> line, leftLine, rightLine: Line; line _ GGLines.LineFromPoints[lo, hi]; leftLine _ GGLines.LineLeftOfLine[line, distance]; line1 _ NEW[FeatureDataObj]; line1.type _ distanceLine; line1.shape _ leftLine; <> AddFeature[line1, objectBag]; IF ABS[distance] > 0.0 THEN { rightLine _ GGLines.LineRightOfLine[line, distance]; line2 _ NEW[FeatureDataObj]; line2.type _ distanceLine; line2.shape _ rightLine; <> AddFeature[line2, objectBag]; } ELSE line2 _ NIL; }; SegmentAddMidpoint: PUBLIC PROC [segNum: NAT, lo, hi: Point, objectBag: ObjectBag] RETURNS [feature: FeatureData] = { <> midpoint: Point; alignmentPoint: AlignmentPoint; midpoint _ GGVector.Scale[GGVector.Add[lo, hi], 0.5]; alignmentPoint _ NEW[AlignmentPointObj _ [point: midpoint, tangent: FALSE]]; feature _ NEW[FeatureDataObj]; feature.type _ midpoint; feature.shape _ alignmentPoint; feature.hitPart _ NEW[GGInterfaceTypes.SequencePartObj _ [segNum, -1, -1]]; AddFeature[feature, objectBag]; }; AddFeature: PRIVATE PROC [featureData: FeatureData, objectBag: ObjectBag] = { Process.CheckForAbort[]; <> <> < {};>> < AddLineIntersections[featureData, objectBag];>> < AddLineIntersections[featureData, objectBag];>> < AddLineIntersections[featureData, objectBag];>> < AddCircleIntersections[featureData, objectBag];>> < SIGNAL Problem[msg: "Unimplemented feature type"];>> <> SELECT featureData.type FROM midpoint => objectBag.midpoints _ CONS[featureData, objectBag.midpoints]; distanceLine => objectBag.distanceLines _ CONS[featureData, objectBag.distanceLines]; slopeLine => objectBag.slopeLines _ CONS[featureData, objectBag.slopeLines]; angleLine => objectBag.angleLines _ CONS[featureData, objectBag.angleLines]; radiiCircle => objectBag.radiiCircles _ CONS[featureData, objectBag.radiiCircles]; intersectionPoint => objectBag.intersectionPoints _ CONS[featureData, objectBag.intersectionPoints]; ENDCASE => SIGNAL Problem[msg: "Unimplemented feature type"]; }; <> <> <> <> <> <> <> < line _ l;>> < line _ aL.line;>> < ERROR Problem[msg: "Broken Invariant"];>> <> <<[iPoint, parallel] _ GGLines.LineMeetsLine[NARROW[lineList.first.shape, AlignmentLine].line, line];>> <> <> <<};>> <> <> <<[iPoint, parallel] _ GGLines.LineMeetsLine[NARROW[lineList.first.shape, AlignmentLine].line, line];>> <> <> <<};>> <> <> <<[iPoint, parallel] _ GGLines.LineMeetsLine[NARROW[dlineList.first.shape], line];>> <> <> <<};>> <> <> <<[points, hitCount] _ GGCircles.LineMeetsCircle[line, NARROW[circleList.first.shape, AlignmentCircle].circle];>> <> <> <> <> <<};>> <<>> <> <> <> <> <> <<[points, hitCount] _ GGCircles.LineMeetsCircle[NARROW[lineList.first.shape, AlignmentLine].line, circle];>> <> <> <> <> <> <<[points, hitCount] _ GGCircles.LineMeetsCircle[NARROW[lineList.first.shape, AlignmentLine].line, circle];>> <> <> <> <> <> <<[points, hitCount] _ GGCircles.LineMeetsCircle[NARROW[dlineList.first.shape], circle];>> <> <> <> <> <> <<[points, hitCount] _ GGCircles.CircleMeetsCircle[NARROW[circleList.first.shape, AlignmentCircle].circle, circle];>> <> <> <> <> <<};>> <<>> <> <> <> <> <> <> <> <> <<};>> <<>> <> <<>> <> alignmentColor: Imager.Color _ ImagerBackdoor.MakeStipple[145065B]; checkerColor: Imager.Color _ ImagerBackdoor.MakeStipple[122645B]; <> <> useCache: BOOL _ TRUE; DrawFeatureList: PUBLIC PROC [dc: Imager.Context, alignObjects: LIST OF FeatureData, gargoyleData: GargoyleData] = { DrawLineAux: PROC [line: Line] = { IF ABS[line.theta] < 1.0 OR ABS[line.theta - 90.0] < 1.0 THEN { Imager.SetColor[dc, checkerColor]; GGShapes.DrawLine[dc, line, rect, 0.0]; -- 0 width lines go fast Imager.SetColor[dc, alignmentColor]; } ELSE GGShapes.DrawLine[dc, line, rect, 0.0]; -- 0 width lines go fast }; DrawCircleAux: PROC [circle: Circle] = { -- uses GGCircleCache cachedCircle: GGCircleCache.CachedCircle; IF (cachedCircle _ GGCircleCache.Lookup[gargoyleData.hitTest.radiusCircleCache, circle.radius])#NIL THEN GGCircleCache.DrawCachedCircle[dc, circle.origin, cachedCircle] -- cache hit ELSE { -- cache miss. Attempt a cache entry and retry GGCircleCache.Insert[gargoyleData.hitTest.radiusCircleCache, circle.radius]; IF (cachedCircle _ GGCircleCache.Lookup[gargoyleData.hitTest.radiusCircleCache, circle.radius])#NIL THEN GGCircleCache.DrawCachedCircle[dc, circle.origin, cachedCircle] ELSE GGShapes.DrawCircle[dc, circle]; }; }; rect: ImagerTransformation.Rectangle _ BiScrollers.ViewportBox[gargoyleData.biScroller]; Imager.SetStrokeWidth[dc, 1.0]; Imager.SetColor[dc, alignmentColor]; FOR list: LIST OF FeatureData _ alignObjects, list.rest UNTIL list = NIL DO WITH list.first.shape SELECT FROM slopeLine: AlignmentLine => DrawLineAux[slopeLine.line]; angleLine: AlignmentLine => DrawLineAux[angleLine.line]; circle: AlignmentCircle => IF useCache THEN DrawCircleAux[circle.circle] ELSE GGShapes.DrawCircle[dc, circle.circle]; distanceLine: GGBasicTypes.Line => GGShapes.DrawLine[dc, distanceLine, rect]; ENDCASE => ERROR; ENDLOOP; }; DrawObjectBagRegardless: PUBLIC PROC [dc: Imager.Context, objectBag: ObjectBag, gargoyleData: GargoyleData] = { <> IF objectBag = NIL THEN RETURN; DrawFeatureList[dc, objectBag.slopeLines, gargoyleData]; DrawFeatureList[dc, objectBag.angleLines, gargoyleData]; DrawFeatureList[dc, objectBag.radiiCircles, gargoyleData]; DrawFeatureList[dc, objectBag.distanceLines, gargoyleData]; }; <> <<>> GoodCurve: TYPE = REF GoodCurveObj; GoodCurveObj: TYPE = RECORD [ dist: REAL _ maxDistance, -- the distance from point to testPoint segNum: NAT _ noSeg, -- the best segment of this curve (if it is a trajectory) point: Point, -- the best point on this curve featureData: FeatureData _ NIL, -- this curve hitData: REF ANY ]; GoodPointType: TYPE = {joint, controlPoint, slice, intersectionPoint, midpoint, none}; GoodPoint: TYPE = REF GoodPointObj; GoodPointObj: TYPE = RECORD [ type: GoodPointType _ none, dist: REAL _ maxDistance, point: Point _ noPoint, joint: NAT _ noJoint, -- the joint of the trajectory mentioned in FeatureData (if this is a joint) controlPoint: NAT _ noCP, -- the control point number (if this is a control point) segNum: NAT _ noSeg, -- the segment to which the control point belongs featureData: FeatureData _ NIL, -- this point hitData: REF ANY ]; <<>> UniMap: PUBLIC PROC [testPoint: Point, criticalR: REAL, currentObjects: ObjectBag, activeObjects: TriggerBag, gargoyleData: GargoyleData, intersections: BOOL] RETURNS [resultPoint: Point, feature: FeatureData] = { ENABLE UNWIND => gargoyleData.gravityPool _ NewGravityPool[]; -- in case an ABORT happened while pool was in use <> GGStatistics.StartInterval[$UniMap, GGStatistics.GlobalTable[]]; SELECT AtomButtons.GetButtonState[gargoyleData.hitTest.gravButton] FROM on => SELECT gargoyleData.hitTest.gravityType FROM strictDistance => [resultPoint, feature] _ StrictDistance[testPoint, criticalR, currentObjects, activeObjects, gargoyleData, intersections]; innerCircle => [resultPoint, feature] _ InnerCircle[testPoint, criticalR, gargoyleData.hitTest.innerR, currentObjects, activeObjects, gargoyleData, intersections]; ENDCASE => ERROR; off => { resultPoint _ testPoint; feature _ NIL; }; ENDCASE => ERROR; GGStatistics.StopInterval[$UniMap, GGStatistics.GlobalTable[]]; }; Map: PUBLIC PROC [testPoint: Point, criticalR: REAL, currentObjects: ObjectBag, activeObjects: TriggerBag, gargoyleData: GargoyleData, intersections: BOOL] RETURNS [resultPoint: Point, feature: FeatureData] = { ENABLE UNWIND => gargoyleData.gravityPool _ NewGravityPool[]; -- in case an ABORT happened while pool was in use [resultPoint, feature] _ GGMultiGravity.Map[testPoint, criticalR, currentObjects, activeObjects, gargoyleData, intersections]; }; <<>> StrictDistance: PROC [testPoint: Point, criticalR: REAL, currentObjects: ObjectBag, activeObjects: TriggerBag, gargoyleData: GargoyleData, intersections: BOOL] RETURNS [resultPoint: Point, feature: FeatureData] = { <> thisCurve, bestCurve: GoodCurve; thisPoint, bestPoint: GoodPoint; IF EmptyBag[currentObjects] AND EmptyTriggers[activeObjects] AND NOT (intersections AND GGCaret.Exists[gargoyleData.anchor]) THEN { resultPoint _ testPoint; feature _ NIL; RETURN; }; [thisPoint, bestPoint, thisCurve, bestCurve] _ BestPointAndCurve[currentObjects, activeObjects, testPoint, criticalR, gargoyleData.anchor, intersections, gargoyleData]; <> IF bestPoint.type = none AND bestCurve.dist = maxDistance THEN { feature _ NIL; resultPoint _ testPoint; ReturnPointsToPool[thisPoint, bestPoint, gargoyleData]; ReturnCurvesToPool[thisCurve, bestCurve, gargoyleData]; RETURN}; IF (NOT bestPoint.type = none) AND bestPoint.dist < criticalR AND bestPoint.dist <= bestCurve.dist THEN { -- use the best point feature _ bestPoint.featureData; ExtractResultFromPoint[bestPoint, feature]; resultPoint _ bestPoint.point; } ELSE IF bestCurve.dist < criticalR THEN { feature _ bestCurve.featureData; ExtractResultFromCurve[bestCurve, feature]; resultPoint _ bestCurve.point; } ELSE { feature _ NIL; resultPoint _ testPoint; }; ReturnPointsToPool[thisPoint, bestPoint, gargoyleData]; ReturnCurvesToPool[thisCurve, bestCurve, gargoyleData]; }; -- StrictDistance InnerCircle: PROC [testPoint: Point, criticalR: REAL, innerR: REAL, currentObjects: ObjectBag, activeObjects: TriggerBag, gargoyleData: GargoyleData, intersections: BOOL] RETURNS [resultPoint: Point, feature: FeatureData] = { <> thisCurve, bestCurve: GoodCurve; thisPoint, bestPoint: GoodPoint; IF EmptyBag[currentObjects] AND EmptyTriggers[activeObjects] AND NOT (intersections AND GGCaret.Exists[gargoyleData.anchor]) THEN { resultPoint _ testPoint; feature _ NIL; RETURN; }; [thisPoint, bestPoint, thisCurve, bestCurve] _ BestPointAndCurve[currentObjects, activeObjects, testPoint, criticalR, gargoyleData.anchor, intersections, gargoyleData]; <> IF bestPoint.type = none AND bestCurve.dist = maxDistance THEN { feature _ NIL; resultPoint _ testPoint; ReturnPointsToPool[thisPoint, bestPoint, gargoyleData]; ReturnCurvesToPool[thisCurve, bestCurve, gargoyleData]; RETURN}; IF (NOT bestPoint.type = none) AND (bestPoint.dist < innerR OR (bestPoint.dist < criticalR AND bestPoint.dist <= bestCurve.dist)) THEN { -- use the best point feature _ bestPoint.featureData; ExtractResultFromPoint[bestPoint, feature]; resultPoint _ bestPoint.point; } ELSE IF bestCurve.dist < criticalR THEN { feature _ bestCurve.featureData; ExtractResultFromCurve[bestCurve, feature]; resultPoint _ bestCurve.point; } ELSE { feature _ NIL; resultPoint _ testPoint; }; ReturnPointsToPool[thisPoint, bestPoint, gargoyleData]; ReturnCurvesToPool[thisCurve, bestCurve, gargoyleData]; }; -- InnerCircle <<>> <> <<>> BestPointAndCurve: PROC [currentObjects: ObjectBag, sceneObjects: TriggerBag, testPoint: Point, tolerance: REAL, anchor: Caret, intersections: BOOL, gargoyleData: GargoyleData] RETURNS [thisPoint, bestPoint: GoodPoint, thisCurve, bestCurve: GoodCurve] = { <> epsilon: REAL = 1.0e-3; line: Line; circle: Circle; sliceD: SliceDescriptor; outlineD: OutlineDescriptor; success: BOOL _ FALSE; featureData: FeatureData; [thisPoint, bestPoint] _ GetPointsFromPool[gargoyleData]; [thisCurve, bestCurve] _ GetCurvesFromPool[gargoyleData]; bestCurve^ _ [maxDistance, noSeg, noPoint, NIL]; -- magic values for debugging bestPoint^ _ [none, maxDistance, noPoint, noJoint, noCP, noSeg, NIL]; -- magic values for debugging <> FOR slopeLines: LIST OF FeatureData _ currentObjects.slopeLines, slopeLines.rest UNTIL slopeLines = NIL DO featureData _ slopeLines.first; line _ NARROW[featureData.shape, AlignmentLine].line; thisCurve.dist _ GGLines.LineDistance[testPoint, line]; success _ thisCurve.dist < tolerance; IF success AND thisCurve.dist < bestCurve.dist THEN { thisCurve.point _ GGLines.PointProjectedOntoLine[testPoint, line]; thisCurve.featureData _ featureData; thisCurve.hitData _ NIL; UpdateBestCurve[thisCurve, bestCurve]; }; ENDLOOP; FOR angleLines: LIST OF FeatureData _ currentObjects.angleLines, angleLines.rest UNTIL angleLines = NIL DO featureData _ angleLines.first; line _ NARROW[featureData.shape, AlignmentLine].line; thisCurve.dist _ GGLines.LineDistance[testPoint, line]; success _ thisCurve.dist < tolerance; IF success AND thisCurve.dist < bestCurve.dist THEN { thisCurve.point _ GGLines.PointProjectedOntoLine[testPoint, line]; thisCurve.featureData _ featureData; thisCurve.hitData _ NIL; UpdateBestCurve[thisCurve, bestCurve]; }; ENDLOOP; FOR dLines: LIST OF FeatureData _ currentObjects.distanceLines, dLines.rest UNTIL dLines = NIL DO featureData _ dLines.first; thisCurve.dist _ GGLines.LineDistance[testPoint, (line _ NARROW[featureData.shape])]; success _ thisCurve.dist < tolerance; IF success AND thisCurve.dist < bestCurve.dist THEN { thisCurve.point _ GGLines.PointProjectedOntoLine[testPoint, line]; thisCurve.featureData _ featureData; thisCurve.hitData _ NIL; UpdateBestCurve[thisCurve, bestCurve]; }; ENDLOOP; FOR iPoints: LIST OF FeatureData _ currentObjects.intersectionPoints, iPoints.rest UNTIL iPoints = NIL DO featureData _ iPoints.first; thisPoint.type _ intersectionPoint; thisPoint.dist _ GGVector.Distance[NARROW[featureData.shape, AlignmentPoint].point, testPoint]; success _ thisPoint.dist < tolerance; IF success AND thisPoint.dist < bestPoint.dist THEN { thisPoint.point _ NARROW[featureData.shape, AlignmentPoint].point; thisPoint.featureData _ featureData; thisPoint.hitData _ NIL; UpdateBestPoint[thisPoint, bestPoint]; }; ENDLOOP; FOR midpoints: LIST OF FeatureData _ currentObjects.midpoints, midpoints.rest UNTIL midpoints = NIL DO featureData _ midpoints.first; thisPoint.type _ midpoint; thisPoint.dist _ GGVector.Distance[NARROW[featureData.shape, AlignmentPoint].point, testPoint]; success _ thisPoint.dist < tolerance; IF success AND thisPoint.dist < bestPoint.dist THEN { thisPoint.point _ NARROW[featureData.shape, AlignmentPoint].point; thisPoint.featureData _ featureData; thisPoint.hitData _ NIL; UpdateBestPoint[thisPoint, bestPoint]; }; ENDLOOP; FOR circles: LIST OF FeatureData _ currentObjects.radiiCircles, circles.rest UNTIL circles = NIL DO featureData _ circles.first; circle _ NARROW[featureData.shape, AlignmentCircle].circle; thisCurve.dist _ GGCircles.CircleDistance[testPoint, circle]; success _ thisCurve.dist < tolerance; IF success AND thisCurve.dist < bestCurve.dist THEN { thisCurve.point _ GGCircles.PointProjectedOntoCircle[testPoint, circle]; thisCurve.featureData _ featureData; thisCurve.hitData _ NIL; UpdateBestCurve[thisCurve, bestCurve]; }; ENDLOOP; <> FOR slices: LIST OF FeatureData _ sceneObjects.slices, slices.rest UNTIL slices = NIL DO featureData _ slices.first; sliceD _ NARROW[featureData.shape, SliceDescriptor]; [thisCurve.point, thisCurve.dist, thisCurve.hitData, success] _ sliceD.slice.class.closestSegment[sliceD, testPoint, tolerance]; IF success AND (thisCurve.dist - epsilon <= bestCurve.dist) THEN { -- so segments are preferred to slopelines bestCurve.dist _ thisCurve.dist; bestCurve.segNum _ thisCurve.segNum; bestCurve.point _ thisCurve.point; bestCurve.hitData _ thisCurve.hitData; bestCurve.featureData _ featureData; }; [thisPoint.point, thisPoint.dist, thisPoint.hitData, success] _ sliceD.slice.class.closestPoint[sliceD, testPoint, tolerance]; IF success AND (thisPoint.dist - epsilon <= bestPoint.dist) THEN { bestPoint.type _ slice; bestPoint.dist _ thisPoint.dist; bestPoint.point _ thisPoint.point; bestPoint.hitData _ thisPoint.hitData; bestPoint.joint _ 999; bestPoint.featureData _ featureData; }; ENDLOOP; FOR outlines: LIST OF FeatureData _ sceneObjects.outlines, outlines.rest UNTIL outlines = NIL DO featureData _ outlines.first; outlineD _ NARROW[featureData.shape, OutlineDescriptor]; [thisCurve.point, thisCurve.dist, thisCurve.hitData, success] _ outlineD.slice.class.closestSegment[outlineD, testPoint, tolerance]; IF success AND (thisCurve.dist - epsilon <= bestCurve.dist) THEN { -- so segments are preferred to slopelines bestCurve.dist _ thisCurve.dist; bestCurve.segNum _ thisCurve.segNum; bestCurve.point _ thisCurve.point; bestCurve.hitData _ thisCurve.hitData; bestCurve.featureData _ featureData; }; [thisPoint.point, thisPoint.dist, thisPoint.hitData, success] _ outlineD.slice.class.closestPoint[outlineD, testPoint, tolerance]; IF success AND (thisPoint.dist - epsilon <= bestPoint.dist) THEN { bestPoint.type _ joint; bestPoint.dist _ thisPoint.dist; bestPoint.point _ thisPoint.point; bestPoint.hitData _ thisPoint.hitData; bestPoint.joint _ 999; bestPoint.featureData _ featureData; }; ENDLOOP; <> IF intersections THEN { point: Point; anchor: Caret; featureData _ sceneObjects.anchor; IF featureData # NIL THEN { anchor _ NARROW[featureData.shape]; IF NOT GGCaret.Exists[anchor] THEN ERROR; thisPoint.type _ intersectionPoint; -- REALLY CARETPOINT thisPoint.point _ GGCaret.GetPoint[anchor]; thisPoint.dist _ GGVector.Distance[point, testPoint]; thisPoint.hitData _ NIL; IF thisPoint.dist < tolerance AND thisPoint.dist < bestPoint.dist THEN { thisPoint.featureData _ featureData; UpdateBestPoint[thisPoint, bestPoint]; }; }; }; }; UpdateBestCurve: PROC [thisCurve, bestCurve: GoodCurve] = { bestCurve.dist _ thisCurve.dist; bestCurve.segNum _ noSeg; -- magic number for debugging bestCurve.point _ thisCurve.point; bestCurve.featureData _ thisCurve.featureData; }; UpdateBestPoint: PROC [thisPoint, bestPoint: GoodPoint] = { bestPoint.type _ thisPoint.type; bestPoint.dist _ thisPoint.dist; bestPoint.point _ thisPoint.point; bestPoint.joint _ noSeg; -- magic number for debugging bestPoint.featureData _ thisPoint.featureData; }; 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 joint, controlPoint => { 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; }; ENDCASE => SIGNAL Problem [msg: "Unimplemented result type."]; }; 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 ]; }; <> <<>> useBBox: BOOL _ TRUE; PointIsInBox: PROC [test: Point, box: GGBasicTypes.BoundBoxObj] RETURNS [BOOL] = { RETURN[ NOT (test.x < box.loX OR test.x > box.hiX OR test.y < box.loY OR test.y > box.hiY) ]; }; NearestSegment: PROC [testPoint: Point, seq: Sequence, tolerance: REAL] RETURNS [bestDist: REAL, bestSeg: NAT, bestPoint: Point, success: BOOL] = { thisDist2, bestDist2: REAL; thisPoint: Point; segGen: SegmentGenerator; thisSuccess: BOOL; next: GGSequence.SegAndIndex; bigBox: GGBasicTypes.BoundBoxObj; success _ FALSE; IF useBBox THEN { bigBox _ [seq.boundBox.loX-tolerance, seq.boundBox.loY-tolerance, seq.boundBox.hiX+tolerance, seq.boundBox.hiY+tolerance, FALSE, FALSE]; IF NOT PointIsInBox[testPoint, bigBox] THEN RETURN; -- success=FALSE }; segGen _ GGSequence.SegmentsInSequence[seq]; next _ GGSequence.NextSegmentAndIndex[segGen]; IF next.seg = NIL THEN { -- The sequence is a single joint bestDist _ maxDistance; -- magic number for debugging bestSeg _ noSeg; -- magic number meaning no segment bestPoint _ [-1.0, -1.0]; RETURN; }; [bestPoint, thisSuccess] _ next.seg.class.closestPoint[next.seg, testPoint, tolerance]; IF NOT thisSuccess THEN { bestDist2 _ maxDistance; bestSeg _ noSeg; bestPoint _ [-1.0, -1.0]; } ELSE { bestDist2 _ GGVector.DistanceSquared[bestPoint, testPoint]; bestSeg _ next.index; success _ TRUE; }; FOR next _ GGSequence.NextSegmentAndIndex[segGen], GGSequence.NextSegmentAndIndex[segGen] UNTIL next.seg = NIL DO [thisPoint, thisSuccess] _ next.seg.class.closestPoint[next.seg, testPoint, tolerance]; IF NOT thisSuccess THEN { thisDist2 _ maxDistance; thisPoint _ [-1.0, -1.0]; } ELSE { thisDist2 _ GGVector.DistanceSquared[thisPoint, testPoint]; success _ TRUE; }; IF success AND thisDist2 < bestDist2 THEN { bestDist2 _ thisDist2; bestSeg _ next.index; bestPoint _ thisPoint; }; ENDLOOP; bestDist _ RealFns.SqRt[bestDist2]; }; NearestJoint: PROC [testPoint: Point, seq: Sequence, tolerance: REAL] RETURNS [bestDist: REAL, bestJoint: NAT, bestPoint: Point, success: BOOL] = { <> tolerance2: REAL _ tolerance*tolerance; thisDist2, bestDist2: REAL; thisPoint: Point; jointGen: JointGenerator; index: INT; bigBox: GGBasicTypes.BoundBoxObj; success _ FALSE; IF useBBox THEN { bigBox _ [seq.boundBox.loX-tolerance, seq.boundBox.loY-tolerance, seq.boundBox.hiX+tolerance, seq.boundBox.hiY+tolerance, FALSE, FALSE]; IF NOT PointIsInBox[testPoint, bigBox] THEN RETURN; -- success=FALSE }; jointGen _ GGSequence.JointsInSequence[seq]; index _ GGSequence.NextJoint[jointGen]; IF index = -1 THEN { bestDist _ maxDistance; bestJoint _ noJoint; bestPoint _ [-1.0, -1.0]; RETURN; }; bestPoint _ GGTraj.FetchJointPos[seq.traj, index]; bestDist2 _ GGVector.DistanceSquared[bestPoint, testPoint]; bestJoint _ index; IF bestDist2 < tolerance2 THEN success _ TRUE; FOR index _ GGSequence.NextJoint[jointGen], GGSequence.NextJoint[jointGen] UNTIL index = -1 DO thisPoint _ GGTraj.FetchJointPos[seq.traj, index]; thisDist2 _ GGVector.DistanceSquared[thisPoint, testPoint]; IF thisDist2 < tolerance2 THEN success _ TRUE; IF success AND thisDist2 < bestDist2 THEN { bestDist2 _ thisDist2; bestJoint _ index; bestPoint _ thisPoint; }; ENDLOOP; bestDist _ RealFns.SqRt[bestDist2]; }; NearestControlPoint: PROC [testPoint: Point, seq: Sequence, tolerance: REAL] RETURNS [bestDist: REAL, bestSeg: NAT, bestControlPoint: NAT, bestPoint: Point, success: BOOL] = { <> SomeCP: PROC [i: NAT] RETURNS [BOOL] = { cpCount: NAT _ seq.controlPoints[i].len; FOR j: NAT IN [0..cpCount) DO IF seq.controlPoints[i][j] THEN RETURN[TRUE]; ENDLOOP; RETURN[FALSE]; }; tolerance2: REAL _ tolerance*tolerance; thisDist2, bestDist2: REAL; thisControlPoint: NAT; thisPoint: Point; segGen: SegmentGenerator; thisSuccess: BOOL; next: GGSequence.SegAndIndex; bigBox: GGBasicTypes.BoundBoxObj; success _ FALSE; IF useBBox THEN { bigBox _ [seq.boundBox.loX-tolerance, seq.boundBox.loY-tolerance, seq.boundBox.hiX+tolerance, seq.boundBox.hiY+tolerance, FALSE, FALSE]; IF NOT PointIsInBox[testPoint, bigBox] THEN RETURN; -- success=FALSE }; segGen _ GGSequence.SegmentsInSequence[seq]; next _ GGSequence.NextSegmentAndIndex[segGen]; WHILE next.seg#NIL AND NOT SomeCP[next.index] DO next _ GGSequence.NextSegmentAndIndex[segGen]; ENDLOOP; IF next.seg = NIL THEN { -- The sequence has no control points bestDist _ maxDistance; -- magic number meaning no segment bestControlPoint _ noCP; -- magic number meaning no CP bestPoint _ [-1.0, -1.0]; RETURN; }; [bestPoint, thisControlPoint, thisSuccess] _ next.seg.class.closestControlPoint[next.seg, testPoint, tolerance]; IF NOT thisSuccess THEN { bestDist2 _ maxDistance; bestSeg _ noSeg; bestControlPoint _ noCP; bestPoint _ [-1.0, -1.0]; } ELSE { bestDist2 _ GGVector.DistanceSquared[bestPoint, testPoint]; bestSeg _ next.index; bestControlPoint _ thisControlPoint; success _ TRUE; }; FOR next _ GGSequence.NextSegmentAndIndex[segGen], GGSequence.NextSegmentAndIndex[segGen] UNTIL next.seg = NIL DO IF SomeCP[next.index] THEN { [thisPoint, thisControlPoint, thisSuccess] _ next.seg.class.closestControlPoint[next.seg, testPoint, tolerance]; IF NOT thisSuccess THEN { thisDist2 _ maxDistance; thisPoint _ [-1.0, -1.0]; } ELSE { thisDist2 _ GGVector.DistanceSquared[thisPoint, testPoint]; success _ TRUE; }; IF success AND thisDist2 < bestDist2 THEN { bestDist2 _ thisDist2; bestSeg _ next.index; bestControlPoint _ thisControlPoint; bestPoint _ thisPoint; }; }; ENDLOOP; bestDist _ RealFns.SqRt[bestDist2]; }; <> maxPoints: NAT = 6; maxCurves: NAT = 6; GravityPool: TYPE = REF GravityPoolObj; GravityPoolObj: TYPE = RECORD [ pointPoolIndex: NAT _ 0, pointPool: ARRAY [0..maxPoints) OF GoodPoint, curvePoolIndex: NAT _ 0, curvePool: ARRAY [0..maxCurves) OF GoodCurve ]; GetPointsFromPool: PROC [gargoyleData: GargoyleData] RETURNS [p1, p2: GoodPoint] = { <> pool: GravityPool _ NARROW[gargoyleData.gravityPool]; IF pool.pointPoolIndex >= maxPoints THEN ERROR; p1 _ pool.pointPool[pool.pointPoolIndex]; p2 _ pool.pointPool[pool.pointPoolIndex+1]; pool.pointPoolIndex _ pool.pointPoolIndex + 2; }; ReturnPointsToPool: PROC [p1, p2: GoodPoint, gargoyleData: GargoyleData] = { pool: GravityPool _ NARROW[gargoyleData.gravityPool]; IF pool.pointPoolIndex<2 THEN ERROR; pool.pointPoolIndex _ pool.pointPoolIndex - 1; pool.pointPool[pool.pointPoolIndex] _ p1; pool.pointPoolIndex _ pool.pointPoolIndex - 1; pool.pointPool[pool.pointPoolIndex] _ p2; }; GetCurvesFromPool: PROC [gargoyleData: GargoyleData] RETURNS [c1, c2: GoodCurve] = { <> pool: GravityPool _ NARROW[gargoyleData.gravityPool]; IF pool.curvePoolIndex >= maxCurves THEN ERROR; c1 _ pool.curvePool[pool.curvePoolIndex]; c2 _ pool.curvePool[pool.curvePoolIndex+1]; pool.curvePoolIndex _ pool.curvePoolIndex + 2; }; ReturnCurvesToPool: PROC [c1, c2: GoodCurve, gargoyleData: GargoyleData] = { pool: GravityPool _ NARROW[gargoyleData.gravityPool]; IF pool.curvePoolIndex<2 THEN ERROR; pool.curvePoolIndex _ pool.curvePoolIndex - 1; pool.curvePool[pool.curvePoolIndex] _ c1; pool.curvePoolIndex _ pool.curvePoolIndex - 1; pool.curvePool[pool.curvePoolIndex] _ c2; }; NewGravityPool: PUBLIC PROC [] RETURNS [REF] = { -- reuseable storage for BestPointAndCurve proc to avoid NEWs pool: GravityPool _ NEW[GravityPoolObj]; -- indices are automatically made =0 FOR i: NAT IN [0..maxPoints) DO pool.pointPool[i] _ NEW[GoodPointObj]; ENDLOOP; FOR i: NAT IN [0..maxCurves) DO pool.curvePool[i] _ NEW[GoodCurveObj]; ENDLOOP; RETURN[pool]; }; InitStats: PROC [] = { interval: GGStatistics.Interval; interval _ GGStatistics.CreateInterval[$UniMap]; GGStatistics.AddInterval[interval, GGStatistics.GlobalTable[]]; }; emptyObjectBag: PUBLIC ObjectBag; Init: PROC [] = { emptyObjectBag _ CreateObjectBag[]; }; InitStats[]; Init[]; END. <> <> <> <> <> <> <> <> <<>>