VERSION 5.00
Begin VB.Form frmMain 
   Caption         =   "Form1"
   ClientHeight    =   3090
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3090
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Declare Function VarPtrArray Lib "msvbvm50.dll" Alias "VarPtr" (Var() As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)

Private Const PI As Single = 3.14159265358979 'Atn(1) * 4
Private Const World_Size = 200

Private Position(100) As Vector
Private Vertex_List(100) As Vector
Private Vertex_List2(100) As Vector
Private Number_Of_Vertices(100) As Long

Private Running As Boolean

Private Type Vector

    X As Single
    Y As Single

End Type

Private Function Vector_New(ByVal X As Single, ByVal Y As Single) As Vector

    Vector_New.X = X
    Vector_New.Y = Y
    
End Function

Private Function Vector_Subtract(A As Vector, B As Vector) As Vector

    Vector_Subtract.X = A.X - B.X
    Vector_Subtract.Y = A.Y - B.Y
    
End Function

Private Function Vector_Multiply(A As Vector, B As Vector) As Single

    Vector_Multiply = A.X * B.X + A.Y * B.Y

End Function

Private Function Vector_Multiply2(A As Vector, Value As Single) As Vector

    Vector_Multiply2 = Vector_New(A.X * Value, A.Y * Value)

End Function

Private Function Vector_Multiply3(Value As Single, A As Vector) As Vector

    Vector_Multiply3 = Vector_New(A.X * Value, A.Y * Value)

End Function

Private Function Randomise(Min As Vector, Max As Vector) As Vector

    Randomise.X = Rnd * (Max.X - Min.X) + Min.X
    Randomise.Y = Rnd * (Max.Y - Min.Y) + Min.Y
        
End Function

Private Function IsArrayInitialised(ByVal Array_Pointer As Long) As Boolean
    
    Dim Destination_Pointer As Long
    
    IsArrayInitialised = False
    
    CopyMemory Destination_Pointer, ByVal Array_Pointer, 4
    
    If Destination_Pointer = False Then
        
        IsArrayInitialised = False
        
    Else
    
        IsArrayInitialised = True
        
    End If
        
End Function

Private Sub Draw_Polygon(X As Single, Y As Single, Vertex_List() As Vector, Number_Of_Vertices As Long, Color As Long, Optional Rand As Boolean)
    
    Dim I As Long
    
    For I = 0 To Number_Of_Vertices - 1
    
        If Rand = True Then Color = RGB(Rnd * 255, Rnd * 255, Rnd * 255)
        
        If I < (Number_Of_Vertices - 1) Then
            
            frmMain.Line (X + Vertex_List(I).X, Y + Vertex_List(I).Y)-(X + Vertex_List(I + 1).X, Y + Vertex_List(I + 1).Y), Color
    
        ElseIf I = (Number_Of_Vertices - 1) Then
        
            frmMain.Line (X + Vertex_List(Number_Of_Vertices - 1).X, Y + Vertex_List(Number_Of_Vertices - 1).Y)-(X + Vertex_List(0).X, Y + Vertex_List(0).Y), Color
        
        End If
    
    Next I
 
End Sub


Private Sub Build_Box(Vertex_List() As Vector, Number_Of_Vertices As Long, Width As Single, Height As Single)

    Dim Vertex_List() As Vector: ReDim Vertex_List(3) As Vector
    
    Vertex_List(0) = Vector_New(-Width / 2, -Height / 2)
    Vertex_List(1) = Vector_New(Width / 2, -Height / 2)
    Vertex_List(2) = Vector_New(Width / 2, Height / 2)
    Vertex_List(3) = Vector_New(-Width / 2, Height / 2)
    
    Number_Of_Vertices = 4
    
    Dim I As Long
    
    For I = 0 To Number_Of_Vertices - 1
    
        Vertex_List(I) = Vertex_List(I)
    
    Next I
    
    
End Sub
Private Sub Build_Blob(Number_Of_Vertices As Long, Radius As Single, Vertex_List() As Vector)
    
    Dim I As Long
    
    For I = 0 To Number_Of_Vertices - 1
    
        Dim A As Single: A = 2 * PI * (I / Number_Of_Vertices - 1)
        Vertex_List(I) = Vector_Multiply2(Vector_New(Cos(A), Sin(A)), Radius)
        
    Next I
    
End Sub

Private Function Collide(A() As Vector, B() As Vector, Number_Of_VerticesA As Long, Number_Of_VerticesB As Long, Offset As Vector) As Boolean

    If IsArrayInitialised(VarPtrArray(A())) = False And IsArrayInitialised(VarPtrArray(B())) = False Then
    
        Collide = False
        Exit Function
        
    End If
    
    Dim Axis(64) As Vector
    
    Dim Number_Of_Axes As Long: Number_Of_Axes = 0
    
    Dim I As Long, J As Long
    
    Dim E0 As Vector
    Dim E1 As Vector
    Dim E As Vector
    
    J = Number_Of_VerticesA - 1
    
    For I = 0 To J
        
        E0 = A(J)
        E1 = A(I)
        
        E = Vector_Subtract(E1, E0)
        
        Axis(Number_Of_Axes).X = -E.Y
        Axis(Number_Of_Axes).Y = E.X
        
        If (Interval_Intersect(A(), B(), Number_Of_VerticesA, Number_Of_VerticesB, Axis(Number_Of_Axes), Offset)) = False Then
        
            Collide = False
            Exit Function
        
        End If
        
        Number_Of_Axes = Number_Of_Axes + 1
        
        J = I
        
    Next I
    
    J = Number_Of_VerticesB - 1
    
    For I = 0 To J
        
        E0 = B(J)
        E1 = B(I)
        
        E = Vector_Subtract(E1, E0)

        Axis(Number_Of_Axes).X = -E.Y
        Axis(Number_Of_Axes).Y = E.X
        
        If (Interval_Intersect(A(), B(), Number_Of_VerticesA, Number_Of_VerticesB, Axis(Number_Of_Axes), Offset)) = False Then
        
            Collide = False
            Exit Function
        
        End If
        
        Number_Of_Axes = Number_Of_Axes + 1
        
        J = I
        
    Next I
    
    Collide = True

End Function

Private Sub Get_Interval(Vertex_List() As Vector, Number_Of_Vertices As Long, Axis As Vector, Min As Single, Max As Single)

    Min = Vector_Multiply(Vertex_List(0), Axis)
    Max = Vector_Multiply(Vertex_List(0), Axis)
    
    Dim I As Long
    
    For I = 1 To Number_Of_Vertices - 1
    
        Dim D As Single: D = Vector_Multiply(Vertex_List(I), Axis)
    
        If (D < Min) Then
        
            Min = D
            
        ElseIf (D > Max) Then
        
            Max = D
            
        End If
    
    Next I

End Sub

Private Function Interval_Intersect(A() As Vector, B() As Vector, Number_Of_VerticesA As Long, Number_Of_VerticesB As Long, Axis As Vector, Offset As Vector) As Boolean

    Dim Min(1) As Single, Max(1) As Single
    
    Get_Interval A(), Number_Of_VerticesA, Axis, Min(0), Max(0)
    Get_Interval B(), Number_Of_VerticesB, Axis, Min(1), Max(1)
    
    Dim h As Single: h = Vector_Multiply(Offset, Axis)
    
    Min(0) = Min(0) + h
    Max(0) = Max(0) + h
    
    Dim D0 As Single: D0 = Min(0) - Max(1)
    Dim D1 As Single: D1 = Min(1) - Max(0)
    
    If ((D0 > 0) Or (D1 > 0)) Then
    
        Interval_Intersect = False
        
    Else
    
        Interval_Intersect = True
        
    End If

End Function

Private Sub Main()

    Randomize
    ScaleMode = 3
    AutoRedraw = True
    
    Dim I As Long
    
    Position(0) = Randomise(Vector_New(World_Size * 0.25, World_Size * 0.25), Vector_New(World_Size * 0.75, World_Size * 0.75))
    Position(1) = Randomise(Vector_New(World_Size * 0.25, World_Size * 0.25), Vector_New(World_Size * 0.75, World_Size * 0.75))
    
    Number_Of_Vertices(0) = (Rnd * 6 Mod 6) + 3
    Number_Of_Vertices(1) = (Rnd * 6 Mod 6) + 3
    
    Dim Radius As Single: Radius = 30

    Build_Blob Number_Of_Vertices(0), Radius, Vertex_List()
    Build_Blob Number_Of_Vertices(1), Radius, Vertex_List2()
    
    Running = True

    Game_Loop
    
End Sub

Private Sub Game_Loop()

    Do While Running = True
    
        DoEvents
        
        Cls
        
        Draw_Polygon Position(0).X, Position(0).Y, Vertex_List(), Number_Of_Vertices(0), RGB(0, 0, 0), False
        Draw_Polygon Position(1).X, Position(1).Y, Vertex_List2(), Number_Of_Vertices(1), RGB(0, 0, 0), False
        
        Caption = Collide(Vertex_List(), Vertex_List2(), Number_Of_Vertices(0), Number_Of_Vertices(1), Vector_Subtract(Position(0), Position(1)))
        
    Loop

End Sub

Private Sub Form_Activate()

    Main

End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

    If KeyCode = vbKeyLeft Then Position(0).X = Position(0).X - 1
    If KeyCode = vbKeyUp Then Position(0).Y = Position(0).Y - 1
    If KeyCode = vbKeyRight Then Position(0).X = Position(0).X + 1
    If KeyCode = vbKeyDown Then Position(0).Y = Position(0).Y + 1

End Sub

Private Sub Form_Unload(Cancel As Integer)

    Running = False
    Unload Me
    End

End Sub