geometry.vb

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

    Public Shared Function ObjectIntersection2D(ByVal object1 As ArrayList, ByVal object2 As ArrayList) As Boolean
        '//test each line segment of object1 against each segment of object2
        Dim r, t As Integer
        For r = 0 To object1.Count - 1
            For t = 0 To object2.Count - 1
                If (LineIntersection2D(object2(t), object2(t + 1), object1(r), object1(r + 1))) Then
                    Return True
                End If
            Next
        Next

        Return False
    End Function

    '//----------------------- SegmentObjectIntersection2D --------------------
    '//
    '//  tests a line segment against a polygon for intersection
    '//  *Does not check for enclosure*
    '//------------------------------------------------------------------------
    Public Shared Function SegmentObjectIntersection2D(ByRef A As Vector2D, ByRef B As Vector2D, ByVal object1 As ArrayList) As Boolean
        '//test AB against each segment of object
        Dim r As Integer
        For r = 0 To object1.Count - 1
            If (LineIntersection2D(A, B, object1(r), object1(r + 1))) Then
                Return True
            End If
        Next
        Return False
    End Function

    '//----------------------------- TwoCirclesOverlapped ---------------------
    '//
    '//  Returns true if the two circles overlap
    '//------------------------------------------------------------------------
    Public Shared Function TwoCirclesOverlapped(ByVal x1 As Double, ByVal y1 As Double, ByVal r1 As Double, ByVal x2 As Double, ByVal y2 As Double, ByVal r2 As Double) As Boolean
        Dim DistBetweenCenters As Double = Math.Sqrt((x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2))

        If (DistBetweenCenters < (r1 + r2)) Or (DistBetweenCenters < Math.Abs(r1 - r2)) Then Return True
  
        Return False
    End Function

    '//----------------------------- TwoCirclesOverlapped ---------------------
    '//
    '//  Returns true if the two circles overlap
    '//------------------------------------------------------------------------
    Public Shared Function TwoCirclesOverlapped(ByVal c1 As Vector2D, ByVal r1 As Double, ByVal c2 As Vector2D, ByVal r2 As Double) As Boolean
        Dim DistBetweenCenters As Double = Math.Sqrt((c1.x - c2.x) * (c1.x - c2.x) + (c1.y - c2.y) * (c1.y - c2.y))

        If (DistBetweenCenters < (r1 + r2)) Or (DistBetweenCenters < Math.Abs(r1 - r2)) Then
            Return True
        End If

        Return False

    End Function

    '//--------------------------- TwoCirclesEnclosed ---------------------------
    '//
    '//  returns true if one circle encloses the other
    '//-------------------------------------------------------------------------
    Public Shared Function TwoCirclesEnclosed(ByVal x1 As Boolean, ByVal y1 As Double, ByVal r1 As Double, ByVal x2 As Double, ByVal y2 As Double, ByVal r2 As Double) As Boolean
        Dim DistBetweenCenters As Double = Math.Sqrt((x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2))

        If DistBetweenCenters < Math.Abs(r1 - r2) Then Return True
  
        Return False
    End Function

    '//------------------------ TwoCirclesIntersectionPoints ------------------
    '//
    '//  Given two circles this function calculates the intersection points
    '//  of any overlap.
    '//
    '//  returns false if no overlap found
    '//
    '// see http://astronomy.swin.edu.au/~pbourke/geometry/2circle/
    '//------------------------------------------------------------------------ 

    Public Shared Function TwoCirclesIntersectionPoints(ByVal x1 As Double, ByVal y1 As Double, ByVal r1 As Double, ByVal x2 As Double, ByVal y2 As Double, ByVal r2 As Double, ByRef p3X As Double, ByRef p3Y As Double, ByRef p4X As Double, ByRef p4Y As Double) As Boolean
        '//first check to see if they overlap
        If Not TwoCirclesOverlapped(x1, y1, r1, x2, y2, r2) Then Return False

        '//calculate the distance between the circle centers
        Dim d As Double = Math.Sqrt((x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2))

        '//Now calculate the distance from the center of each circle to the center
        '//of the line which connects the intersection points.
        Dim a As Double = (r1 - r2 + (d * d)) / (2 * d)
        Dim b As Double = (r2 - r1 + (d * d)) / (2 * d)


        '//MAYBE A TEST FOR EXACT OVERLAP? 

        '//calculate the point P2 which is the center of the line which 
        '//connects the intersection points
        Dim p2X, p2Y As Double

        p2X = x1 + a * (x2 - x1) / d
        p2Y = y1 + a * (y2 - y1) / d

        '//calculate first point
        Dim h1 As Double = Math.Sqrt((r1 * r1) - (a * a))

        p3X = p2X - h1 * (y2 - y1) / d
        p3Y = p2Y + h1 * (x2 - x1) / d


        '//calculate second point
        Dim h2 As Double = Math.Sqrt((r2 * r2) - (a * a))

        p4X = p2X + h2 * (y2 - y1) / d
        p4Y = p2Y - h2 * (x2 - x1) / d

        Return True

    End Function

    '//------------------------ TwoCirclesIntersectionArea --------------------
    '//
    '//  Tests to see if two circles overlap and if so calculates the area
    '//  defined by the union
    '//
    '// see http://mathforum.org/library/drmath/view/54785.html
    '//-----------------------------------------------------------------------
    Public Shared Function TwoCirclesIntersectionArea(ByVal x1 As Double, ByVal y1 As Double, ByVal r1 As Double, ByVal x2 As Double, ByVal y2 As Double, ByVal r2 As Double) As Double
        '//first calculate the intersection points
        Dim iX1, iY1, iX2, iY2 As Double

        If Not TwoCirclesIntersectionPoints(x1, y1, r1, x2, y2, r2, iX1, iY1, iX2, iY2) Then Return 0.0 '//no overlap

        '//calculate the distance between the circle centers
        Dim d As Double = Math.Sqrt((x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2))

        '//find the angles given that A and B are the two circle centers
        '//and C and D are the intersection points
        Dim CBD As Double = 2 * Math.Acos((r2 * r2 + d * d - r1 * r1) / (r2 * d * 2))

        Dim CAD As Double = 2 * Math.Acos((r1 * r1 + d * d - r2 * r2) / (r1 * d * 2))

        '//Then we find the segment of each of the circles cut off by the 
        '//chord CD, by taking the area of the sector of the circle BCD and
        '//subtracting the area of triangle BCD. Similarly we find the area
        '//of the sector ACD and subtract the area of triangle ACD.

        Dim area As Double = 0.5F * CBD * r2 * r2 - 0.5F * r2 * r2 * Math.Sin(CBD) + 0.5F * CAD * r1 * r1 - 0.5F * r1 * r1 * Math.Sin(CAD)

        Return area
    End Function

    '//-------------------------------- CircleArea ---------------------------
    '//
    '//  given the radius, calculates the area of a circle
    '//-----------------------------------------------------------------------
    Public Shared Function CircleArea(ByVal radius As Double) As Double
        Return Math.PI * radius * radius
    End Function

    '//----------------------- PointInCircle ----------------------------------
    '//
    '//  returns true if the point p is within the radius of the given circle
    '//------------------------------------------------------------------------
    Public Shared Function PointInCircle(ByVal Pos As Vector2D, ByVal radius As Double, ByVal p As Vector2D) As Boolean
        Dim DistFromCenterSquared As Double = p.Minus(Pos).LengthSQ()

        If DistFromCenterSquared < (radius * radius) Then Return True

        Return False
    End Function

    '//--------------------- LineSegmentCircleIntersection ---------------------------
    '//
    '//  returns true if the line segemnt AB intersects with a circle at
    '//  position P with radius radius
    '//------------------------------------------------------------------------
    Public Shared Function LineSegmentCircleIntersection(ByVal A As Vector2D, ByVal B As Vector2D, ByVal P As Vector2D, ByVal radius As Double) As Boolean
        '//first determine the distance from the center of the circle to
        '//the line segment (working in distance squared space)
        Dim DistToLineSq As Double = DistToLineSegmentSq(A, B, P)

        If (DistToLineSq < radius * radius) Then Return True

        Return False

    End Function

    '//------------------- GetLineSegmentCircleClosestIntersectionPoint ------------
    '//
    '//  given a line segment AB and a circle position and radius, this function
    '//  determines if there is an intersection and stores the position of the 
    '//  closest intersection in the reference IntersectionPoint
    '//
    '//  returns false if no intersection point is found
    '//-----------------------------------------------------------------------------
    Public Shared Function GetLineSegmentCircleClosestIntersectionPoint(ByVal A As Vector2D, ByVal B As Vector2D, ByVal pos As Vector2D, ByVal radius As Double, ByRef IntersectionPoint As Vector2D) As Boolean
        Dim toBNorm As Vector2D = Vector2D.Vec2DNormalize(B.Minus(A))

        '//move the circle into the local space defined by the vector B-A with origin
        '//at A
        Dim LocalPos As Vector2D = Transformations.PointToLocalSpace(pos, toBNorm, toBNorm.Perp(), A)

        Dim ipFound As Boolean = False

        '//if the local position + the radius is negative then the circle lays behind
        '//point A so there is no intersection possible. If the local x pos minus the 
        '//radius is greater than length A-B then the circle cannot intersect the 
        '//line segment
        If (LocalPos.x + radius >= 0) And ((LocalPos.x - radius) * (LocalPos.x - radius) <= Vector2D.Vec2DDistanceSQ(B, A)) Then
            '//if the distance from the x axis to the object's position is less
            '//than its radius then there is a potential intersection.
            If (Math.Abs(LocalPos.y) < radius) Then
                '//now to do a line/circle intersection test. The center of the 
                '//circle is represented by A, B. The intersection points are 
                '//given by the formulae x = A +/-sqrt(r^2-B^2), y=0. We only 
                '//need to look at the smallest positive value of x.
                Dim a1 As Double = LocalPos.x
                Dim b1 As Double = LocalPos.y

                Dim ip As Double = a1 - Math.Sqrt(radius * radius - b1 * b1)

                If (ip <= 0) Then ip = a1 + Math.Sqrt(radius * radius - b1 * b1)

                ipFound = True

                IntersectionPoint = A.Plus(toBNorm.Mutiply(ip))

            End If

        End If

        Return ipFound

    End Function
End Class

Public Enum span_type
    plane_backside
    plane_front
    on_plane
End Enum