geometry.vb

一个.Net下用VB编写的用于游戏的人工智能引擎

Public Class Geometry
    '//given a plane and a ray this function determins how far along the ray 
    '//an interestion occurs. Returns negative if the ray is parallel
    Public Shared Function DistanceToRayPlaneIntersection(ByVal RayOrigin As Vector2D, ByVal RayHeading As Vector2D, ByVal PlanePoint As Vector2D, ByVal PlaneNormal As Vector2D) As Double
        Dim d As Double = -PlaneNormal.Dot(PlanePoint)
        Dim numer As Double = PlaneNormal.Dot(RayOrigin) + d
        Dim denom As Double = PlaneNormal.Dot(RayHeading)

        '// normal is parallel to vector
        If ((denom < 0.000001) And (denom > -0.000001)) Then
            Return (-1.0)
        End If

        Return -(numer / denom)

    End Function

    '//------------------------- WhereIsPoint --------------------------------------
    Public Function WhereIsPoint(ByVal point As Vector2D, ByVal PointOnPlane As Vector2D, ByVal PlaneNormal As Vector2D) As span_type
        Dim dir As Vector2D = PointOnPlane.Minus(point)

        Dim d As Double = dir.Dot(PlaneNormal)

        If (d < -0.000001) Then
            Return span_type.plane_front

        ElseIf (d > 0.000001) Then

            Return span_type.plane_backside

        End If

        Return span_type.on_plane
    End Function

    '//-------------------------- GetRayCircleIntersec -----------------------------
    Public Shared Function GetRayCircleIntersect(ByVal RayOrigin As Vector2D, ByVal RayHeading As Vector2D, ByVal CircleOrigin As Vector2D, ByVal radius As Double) As Double
        Dim ToCircle As Vector2D = CircleOrigin.Minus(RayOrigin)
        Dim length As Double = ToCircle.Length()
        Dim v As Double = ToCircle.Dot(RayHeading)
        Dim d As Double = radius * radius - (length * length - v * v)

        '// If there was no intersection, return -1
        If (d < 0.0) Then Return (-1.0)


        '// Return the distance to the [first] intersecting point
        Return (v - Math.Sqrt(d))
    End Function

    '//----------------------------- DoRayCircleIntersect --------------------------
    Public Shared Function DoRayCircleIntersect(ByVal RayOrigin As Vector2D, ByVal RayHeading As Vector2D, ByVal CircleOrigin As Vector2D, ByVal radius As Double) As Boolean
        Dim ToCircle As Vector2D = CircleOrigin.Minus(RayOrigin)
        Dim length As Double = ToCircle.Length()
        Dim v As Double = ToCircle.Dot(RayHeading)
        Dim d As Double = radius * radius - (length * length - v * v)

        '// If there was no intersection, return -1
        Return (d < 0.0)
    End Function

    '//------------------------------------------------------------------------
    '//  Given a point P and a circle of radius R centered at C this function
    '//  determines the two points on the circle that intersect with the 
    '//  tangents from P to the circle. Returns false if P is within the circle.
    '//
    '//  thanks to Dave Eberly for this one.
    '//------------------------------------------------------------------------
    Public Shared Function GetTangentPoints(ByVal C As Vector2D, ByVal R As Double, ByVal P As Vector2D, ByVal T1 As Vector2D, ByVal T2 As Vector2D) As Boolean
        Dim PmC As Vector2D = P.Minus(C)
        Dim SqrLen As Double = PmC.LengthSQ()
        Dim RSqr As Double = R * R
        If (SqrLen <= RSqr) Then
            '// P is inside or on the circle
            Return False
        End If

        Dim InvSqrLen As Double = 1 / SqrLen
        Dim Root As Double = Math.Sqrt(Math.Abs(SqrLen - RSqr))

        T1.x = C.x + R * (R * PmC.x - PmC.y * Root) * InvSqrLen
        T1.y = C.y + R * (R * PmC.y + PmC.x * Root) * InvSqrLen
        T2.x = C.x + R * (R * PmC.x + PmC.y * Root) * InvSqrLen
        T2.y = C.y + R * (R * PmC.y - PmC.x * Root) * InvSqrLen

        Return True
    End Function

    '//------------------------- DistToLineSegment ----------------------------
    '//
    '//  given a line segment AB and a point P, this function calculates the 
    '//  perpendicular distance between them
    '//------------------------------------------------------------------------
    Public Shared Function DistToLineSegment(ByVal A As Vector2D, ByVal B As Vector2D, ByVal P As Vector2D) As Double
        '//if the angle is obtuse between PA and AB is obtuse then the closest
        '//vertex must be A
        Dim dotA As Double = (P.x - A.x) * (B.x - A.x) + (P.y - A.y) * (B.y - A.y)

        If (dotA <= 0) Then Return Vector2D.Vec2DDistance(A, P)

        '//if the angle is obtuse between PB and AB is obtuse then the closest
        '//vertex must be B
        Dim dotB As Double = (P.x - B.x) * (A.x - B.x) + (P.y - B.y) * (A.y - B.y)

        If (dotB <= 0) Then Return Vector2D.Vec2DDistance(B, P)

        '//calculate the point along AB that is the closest to P
        Dim Point As Vector2D = A.Plus(B.Minus(A).Mutiply(dotA).Divided((dotA + dotB)))

        '//calculate the distance P-Point
        Return Vector2D.Vec2DDistance(P, Point)
    End Function

    '//------------------------- DistToLineSegmentSq ----------------------------
    '//
    '//  as above, but avoiding sqrt
    '//------------------------------------------------------------------------
    Public Shared Function DistToLineSegmentSq(ByVal A As Vector2D, ByVal B As Vector2D, ByVal P As Vector2D) As Double
        '//if the angle is obtuse between PA and AB is obtuse then the closest
        '//vertex must be A
        Dim dotA As Double = (P.x - A.x) * (B.x - A.x) + (P.y - A.y) * (B.y - A.y)

        If (dotA <= 0) Then Return Vector2D.Vec2DDistanceSQ(A, P)

        '//if the angle is obtuse between PB and AB is obtuse then the closest
        '//vertex must be B
        Dim dotB As Double = (P.x - B.x) * (A.x - B.x) + (P.y - B.y) * (A.y - B.y)

        If (dotB <= 0) Then Return Vector2D.Vec2DDistanceSQ(B, P)

        '//calculate the point along AB that is the closest to P
        Dim Point As Vector2D = A.Plus(B.Minus(A).Mutiply(dotA).Divided(dotA + dotB))

        '//calculate the distance P-Point
        Return Vector2D.Vec2DDistanceSQ(P, Point)
    End Function

    '//--------------------LineIntersection2D-------------------------
    '//
    '//	Given 2 lines in 2D space AB, CD this returns true if an 
    '//	intersection occurs.
    '//
    '//----------------------------------------------------------------- 

    Public Shared Function LineIntersection2D(ByVal A As Vector2D, ByVal B As Vector2D, ByVal C As Vector2D, ByVal D As Vector2D) As Boolean
        Dim rTop As Double = (A.y - C.y) * (D.x - C.x) - (A.x - C.x) * (D.y - C.y)
        Dim sTop1 As Double = (A.y - C.y) * (B.x - A.x) - (A.x - C.x) * (B.y - A.y)

        Dim Bot As Double = (B.x - A.x) * (D.y - C.y) - (B.y - A.y) * (D.x - C.x)

        If (Bot = 0) Then
            Return False
        End If

        Dim invBot As Double = 1.0 / Bot
        Dim r As Double = rTop * invBot
        Dim s As Double = sTop1 * invBot

        If ((r > 0) And (r < 1) And (s > 0) And (s < 1)) Then
            '//lines intersect
            Return True
        End If

        '//lines do not intersect
        Return False
    End Function

    '//--------------------LineIntersection2D-------------------------
    '//
    '//	Given 2 lines in 2D space AB, CD this returns true if an 
    '//	intersection occurs and sets dist to the distance the intersection
    '//  occurs along AB
    '//
    '//----------------------------------------------------------------- 

    Public Shared Function LineIntersection2D(ByVal A As Vector2D, ByVal B As Vector2D, ByVal C As Vector2D, ByVal D As Vector2D, ByVal dist As Double) As Boolean

        Dim rTop As Double = (A.y - C.y) * (D.x - C.x) - (A.x - C.x) * (D.y - C.y)
        Dim sTop1 As Double = (A.y - C.y) * (B.x - A.x) - (A.x - C.x) * (B.y - A.y)

        Dim Bot As Double = (B.x - A.x) * (D.y - C.y) - (B.y - A.y) * (D.x - C.x)


        If (Bot = 0) Then '//parallel
            If Utils.isEqual(rTop, 0) And Utils.isEqual(sTop1, 0) Then
                Return True
            End If
            Return False
        End If

        Dim r As Double = rTop / Bot
        Dim s As Double = sTop1 / Bot

        If (r > 0) And (r < 1) And (s > 0) And (s < 1) Then
            dist = Vector2D.Vec2DDistance(A, B) * r
            Return True
        Else
            dist = 0
            Return False
        End If

    End Function

    '//-------------------- LineIntersection2D-------------------------
    '//
    '//	Given 2 lines in 2D space AB, CD this returns true if an 
    '//	intersection occurs and sets dist to the distance the intersection
    '//  occurs along AB. Also sets the 2d vector point to the point of
    '//  intersection
    '//----------------------------------------------------------------- 

    Public Shared Function LineIntersection2D(ByVal A As Vector2D, ByVal B As Vector2D, ByVal C As Vector2D, ByVal D As Vector2D, ByRef dist As Double, ByRef point As Vector2D) As Boolean
        Dim rTop As Double = (A.y - C.y) * (D.x - C.x) - (A.x - C.x) * (D.y - C.y)
        Dim rBot As Double = (B.x - A.x) * (D.y - C.y) - (B.y - A.y) * (D.x - C.x)

        Dim sTop1 As Double = (A.y - C.y) * (B.x - A.x) - (A.x - C.x) * (B.y - A.y)
        Dim sBot As Double = (B.x - A.x) * (D.y - C.y) - (B.y - A.y) * (D.x - C.x)

        If (rBot = 0) Or (sBot = 0) Then
            '//lines are parallel
            Return False
        End If

        Dim r As Double = rTop / rBot
        Dim s As Double = sTop1 / sBot

        If (r > 0) And (r < 1) And (s > 0) And (s < 1) Then
            dist = Vector2D.Vec2DDistance(A, B) * r
            point = A.Plus((B.Minus(A).Mutiply(r)))
            Return True
        Else
            dist = 0

            Return False
        End If


    End Function
    '//----------------------- ObjectIntersection2D ---------------------------
    '//
    '//  tests two polygons for intersection. *Does not check for enclosure*
    '//------------------------------------------------------------------------