'Matan Cohen

Option Explicit

Public Const MaxPoints = 800
Public Const Parallel = 0
Public Const Perspective = 1
'Distance center of projection
Private Dist As Single
'Current projection
Private Projec As Byte
'Center of view origin
Private Xorg As Single
Private Yorg As Single

'Point to be used in API functions
Private Type POINTAPI
    X As Long
    Y As Long
End Type
'View of polygon
Private Poly2D(1 To MaxPoints) As POINTAPI
Private ST(1 To MaxPoints) As m3Point
'Point to be used in API functions
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, lpPoint As POINTAPI) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Private Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long
Private Declare Function Polyline Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long



'Set current projection to be Perspective
Public Sub DrSetPerspective()
    Projec = Perspective
    'Set default distance to be 600
    If Dist = 0 Then Dist = 600
End Sub

'Set current projection to be Parallel
Public Sub DrSetParallel()
    Projec = Parallel
End Sub

'Return True if current projection is Parallel
'Return False if current projection is Perspective
Public Function DrIsParallel() As Boolean
    DrIsParallel = (Projec = Parallel)
End Function

'Return distance center of projection
Public Function DrGetDistance() As Single
    DrGetDistance = Dist
End Function

'Set distance Center of projection
Public Sub DrSetDistance(ByVal New_Dist As Single)
    Dist = New_Dist
End Sub

Public Sub DrLine3D(ByRef Obj As Object, ByRef p1 As m3Point, ByRef p2 As m3Point)
    Dim x1 As Long, y1 As Long
    Dim x2 As Long, y2 As Long
    Dim pt As POINTAPI
    Dim f As Single
    Xorg = Abs(Obj.ScaleLeft)
    Yorg = Abs(Obj.ScaleTop)
    Select Case Projec
        Case Parallel
            x1 = Xorg + p1.X
            y1 = Yorg - p1.Y
            x2 = Xorg + p2.X
            y2 = Yorg - p2.Y
        Case Perspective
            f = Dist / (Dist - p1.Z)
            x1 = Xorg + f * p1.X
            y1 = Yorg - f * p1.Y
            f = Dist / (Dist - p2.Z)
            x2 = Xorg + p2.X
            y2 = Yorg - p2.Y
    End Select
    MoveToEx Obj.hdc, x1, y1, pt
    LineTo Obj.hdc, x2, y2
    SetPixel Obj.hdc, x2, y2, Obj.ForeColor
End Sub

Public Sub Poly3DDraw(ByRef Obj As Object, ByRef P As Poly3D, ByVal closed As Boolean)
    Dim i As Integer
    Dim nVerts As Integer
    Dim f As Single
    Xorg = Abs(Obj.ScaleLeft)
    Yorg = Abs(Obj.ScaleTop)
    nVerts = P.nVerts
    Select Case Projec
        Case Parallel
            For i = 1 To nVerts
                Poly2D(i).X = Xorg + P.Verts(i).X
                Poly2D(i).Y = Yorg - P.Verts(i).Y
            Next i
            
        Case Perspective
            
            For i = 1 To nVerts
                f = Dist / (Dist - P.Verts(i).Z)
                Poly2D(i).X = Xorg + f * P.Verts(i).X
                Poly2D(i).Y = Yorg - f * P.Verts(i).Y
            Next i
            
    End Select
    If closed Then
        nVerts = nVerts + 1
        Poly2D(nVerts) = Poly2D(1)
    End If
    Polyline Obj.hdc, Poly2D(1), nVerts
End Sub

Public Sub Poly3DFill(ByRef Obj As Object, ByRef P As Poly3D)
    Dim i As Integer
    Dim nVerts As Integer
    Dim f As Single
    Xorg = Abs(Obj.ScaleLeft)
    Yorg = Abs(Obj.ScaleTop)
    nVerts = P.nVerts
    Select Case Projec
        Case Parallel
            For i = 1 To nVerts
                Poly2D(i).X = Xorg + P.Verts(i).X
                Poly2D(i).Y = Yorg - P.Verts(i).Y
            Next i
            
        Case Perspective
            
            For i = 1 To nVerts
                f = Dist / (Dist - P.Verts(i).Z)
                Poly2D(i).X = Xorg + f * P.Verts(i).X
                Poly2D(i).Y = Yorg - f * P.Verts(i).Y
            Next i
            
    End Select
    Polygon Obj.hdc, Poly2D(1), P.nVerts
End Sub

Public Function PlaneIsVisible(ByRef p1 As m3Point, ByRef p2 As m3Point, ByRef P3 As m3Point) As Boolean
     Dim f As Single
     Dim v As m3Vector
     Dim u As m3Vector
     Dim W As m3Vector
     Dim pp1 As m3Point
     Dim pp2 As m3Point
     Dim pp3 As m3Point
     Select Case Projec
        Case Parallel
            pp1 = p1
            pp2 = p2
            pp3 = P3
        Case Perspective
            f = Dist / (Dist - p1.Z)
            pp1.X = f * p1.X
            pp1.Y = f * p1.Y
            pp1.Z = p1.Z
            f = Dist / (Dist - p2.Z)
            pp2.X = f * p2.X
            pp2.Y = f * p2.Y
            pp2.Z = p2.Z
            f = Dist / (Dist - P3.Z)
            pp3.X = f * P3.X
            pp3.Y = f * P3.Y
            pp3.Z = P3.Z
        End Select
        
        v = m3VectorInit(pp1, pp2)
        u = m3VectorInit(pp2, pp3)
        W = m3VectorCross(v, u)
        PlaneIsVisible = (W.Z > 0)
End Function


Public Sub Solid3DDraw(ByRef Obj As Object, ByRef S As Solid3D)
    Dim i As Integer
    Dim j As Integer
    Dim nVerts As Integer
    Dim f As Single
    Dim p1 As m3Point
    Dim p2 As m3Point
    Dim P3 As m3Point
    
    Xorg = -Obj.ScaleLeft
    Yorg = Obj.ScaleTop
    
    nVerts = S.nVerts
    Select Case Projec
        Case Parallel
            For i = 1 To nVerts
                ST(i) = S.Verts(i)
            Next i
            
        Case Perspective
            
            For i = 1 To nVerts
                f = Dist / (Dist - S.Verts(i).Z)
                ST(i).X = f * S.Verts(i).X
                ST(i).Y = f * S.Verts(i).Y
                ST(i).Z = S.Verts(i).Z
            Next i
            
    End Select
    
    For i = 1 To S.nFaces
        p1 = S.Verts(S.Faces(i).Face(1))
        p2 = S.Verts(S.Faces(i).Face(2))
        P3 = S.Verts(S.Faces(i).Face(3))
        
        If PlaneIsVisible(p1, p2, P3) Then
            For j = 1 To S.Faces(i).nVerts
                Poly2D(j).X = Xorg + ST(S.Faces(i).Face(j)).X
                Poly2D(j).Y = Yorg - ST(S.Faces(i).Face(j)).Y
            Next j
             Polygon Obj.hdc, Poly2D(1), S.Faces(i).nVerts
        End If
    Next i
    
End Sub
Public Sub Solid3DDrawFromTo(ByRef Obj As Object, ByRef S As Solid3D, ByVal FromFace As Integer, ByVal ToFace As Integer)
    Dim i As Integer
    Dim j As Integer
    Dim nVerts As Integer
    Dim f As Single
    Dim p1 As m3Point
    Dim p2 As m3Point
    Dim P3 As m3Point
    
    Xorg = -Obj.ScaleLeft
    Yorg = Obj.ScaleTop
    
    nVerts = S.nVerts
    Select Case Projec
        Case Parallel
            For i = 1 To nVerts
                ST(i) = S.Verts(i)
            Next i
            
        Case Perspective
            
            For i = 1 To nVerts
                f = Dist / (Dist - S.Verts(i).Z)
                ST(i).X = f * S.Verts(i).X
                ST(i).Y = f * S.Verts(i).Y
                ST(i).Z = S.Verts(i).Z
            Next i
            
    End Select
    
    For i = FromFace To ToFace
        p1 = S.Verts(S.Faces(i).Face(1))
        p2 = S.Verts(S.Faces(i).Face(2))
        P3 = S.Verts(S.Faces(i).Face(3))
        
        If PlaneIsVisible(p1, p2, P3) Then
            For j = 1 To S.Faces(i).nVerts
                Poly2D(j).X = Xorg + ST(S.Faces(i).Face(j)).X
                Poly2D(j).Y = Yorg - ST(S.Faces(i).Face(j)).Y
            Next j
             Polygon Obj.hdc, Poly2D(1), S.Faces(i).nVerts
        End If
    Next i
    
End Sub

'********* Light Direction ***************************
Private lightVector As m3Vector

'*********** Ambient Light is some non-directional light in the
'************environment (background light).
'Ambient Light Factor is 0.2
Private Const AmbFactor = 0.2

'//////////////////////////////////////////////////////////////

Public Sub DrSetLightVector(ByRef lVector As m3Vector)
    Dim L As Single
    L = m3VectorLen(lVector)
    If L < 0.000001 Then
        lightVector.X = 0
        lightVector.Y = 0
        lightVector.Z = 1
    Else
        lightVector.X = lVector.X / L
        lightVector.Y = lVector.Y / L
        lightVector.Z = lVector.Z / L
    End If
End Sub

Public Function DrGetLightVector() As m3Vector
    DrGetLightVector = lightVector
End Function

Public Sub DrApplyLightVector(ByRef M As m3Matrix)
    m3VectorApply lightVector, M
End Sub
'Draw the solid object width Shading on the object
Public Sub Solid3DShadingDraw(ByRef Obj As Object, ByRef S As Solid3D, ByVal Border As Boolean)
    Dim i As Integer
    Dim j As Integer
    Dim f As Single
    Dim v As m3Vector
    Dim u As m3Vector
    Dim n As m3Vector
    Dim nVerts As Integer
    Dim p1 As Integer
    Dim p2 As Integer
    Dim P3 As Integer
    
    '********** Shading Factors*******************************
    Dim color As Long
    Dim ColorTo As Long
    Dim BorderColor As Long
    Dim R As Byte
    Dim G As Byte
    Dim B As Byte
    Dim maxRGB As Byte
    Dim dot As Single
    Dim dotMax As Single
    '*************************************************************
    '********** Shading Init Factors*******************************
    color = Obj.FillColor
    BorderColor = Obj.ForeColor
    'Resolve Fill Color Into RGB Components
    R = &HFF& And color
    G = (&HFF00& And color) \ &H100&
    B = (&HFF0000 And color) \ &H10000
    'Compute Maximum Componen Of RGB Components
    maxRGB = R
    If G > maxRGB Then maxRGB = G
    If B > maxRGB Then maxRGB = B
    'Compute Maximum Factor Of RGB Components
    dotMax = maxRGB / 255
    
    'Ambient Light is some non-directional light in the environment
    ' (background light).
    ' Ambient Light Factor is 0.2
    dotMax = dotMax + AmbFactor
    If dotMax * maxRGB > 255 Then dotMax = 255 / maxRGB
    
    
    
    Xorg = Abs(Obj.ScaleLeft)
    Yorg = Abs(Obj.ScaleTop)
    Select Case Projec
    Case Parallel
        For i = 1 To S.nVerts
            ST(i) = S.Verts(i)
        Next i
    Case Perspective
        For i = 1 To S.nVerts
            f = Dist / (Dist - S.Verts(i).Z)
            ST(i).X = S.Verts(i).X * f
            ST(i).Y = S.Verts(i).Y * f
            ST(i).Z = S.Verts(i).Z
        Next i
    End Select
    
    
    For i = 1 To S.nFaces
        p1 = S.Faces(i).Face(1)
        p2 = S.Faces(i).Face(2)
        P3 = S.Faces(i).Face(3)
        v = m3VectorInit(ST(p1), ST(p2))
        u = m3VectorInit(ST(p2), ST(P3))
        n = m3VectorCross(v, u)
        nVerts = S.Faces(i).nVerts
        If n.Z > 0 Then
            For j = 1 To nVerts
                p1 = S.Faces(i).Face(j)
                Poly2D(j).X = Xorg + ST(p1).X
                Poly2D(j).Y = Yorg - ST(p1).Y
            Next j
            m3VectorSetLen 1, n
            dot = lightVector.X * n.X + lightVector.Y * n.Y + lightVector.Z * n.Z
            If dot > 0.0000001 Then
                dot = dot + AmbFactor
             Else
                dot = AmbFactor
            End If
            If dot > dotMax Then dot = dotMax
            ColorTo = RGB(dot * R, dot * G, dot * B)
            Obj.FillColor = ColorTo
            If Not Border Then
                Obj.ForeColor = ColorTo
            End If
            Polygon Obj.hdc, Poly2D(1), nVerts
            
        End If
        
    Next i
    
    ' Restore Object's Colors
    Obj.FillColor = color
    Obj.ForeColor = BorderColor
End Sub
'Aplly view of Polygon 3D to 2D
Private Sub ProjectM3Points(ByVal nVerts As Integer, ByRef P() As m3Point)
    Dim f As Single
    Dim i As Integer
    Select Case Projec
        Case Parallel
            For i = 1 To nVerts
                Poly2D(i).X = Xorg + P(i).X
                Poly2D(i).Y = Yorg - P(i).Y
            Next i
        Case Perspective
            For i = 1 To nVerts
                f = Dist / (Dist - P(i).Z)
                Poly2D(i).X = Xorg + f * P(i).X
                Poly2D(i).Y = Yorg - f * P(i).Y
            Next i
    End Select
End Sub

'Draw and fill the polygon width Shading on the object
Public Sub Poly3DShadingFill(ByRef Obj As Object, ByRef P As Poly3D, ByVal Border As Boolean)
    Dim i As Integer
    Dim p1 As m3Point
    Dim p2 As m3Point
    Dim P3 As m3Point
    Dim n As m3Vector
    Dim v As m3Vector
    Dim u As m3Vector
    Dim f As Single
    '********** Shading Factors*******************************
    Dim color As Long
    Dim ColorTo As Long
    Dim BorderColor As Long
    Dim R As Byte
    Dim G As Byte
    Dim B As Byte
    Dim maxRGB As Byte
    Dim dot As Single
    Dim dotMax As Single
    '*************************************************************
    '********** Shading Init Factors*******************************
    color = Obj.FillColor
    BorderColor = Obj.ForeColor
    'Resolve Fill Color Into RGB Components
    R = &HFF& And color
    G = (&HFF00& And color) \ &H100&
    B = (&HFF0000 And color) \ &H10000
    'Compute Maximum Componen Of RGB Components
    maxRGB = R
    If G > maxRGB Then maxRGB = G
    If B > maxRGB Then maxRGB = B
    'Compute Maximum Factor Of RGB Components
    dotMax = maxRGB / 255
    
    'Ambient Light is some non-directional light in the environment
    ' (background light).
    ' Ambient Light Factor is 0.2
    dotMax = dotMax + AmbFactor
    If dotMax * maxRGB > 255 Then dotMax = 255 / maxRGB
    
    Xorg = Abs(Obj.ScaleLeft)
    Yorg = Abs(Obj.ScaleTop)
    Select Case Projec
    Case Parallel
        p1 = P.Verts(1)
        p2 = P.Verts(2)
        P3 = P.Verts(3)
    Case Perspective
        f = Dist / (Dist - P.Verts(1).Z)
        p1.X = P.Verts(1).X * f
        p1.Y = P.Verts(1).Y * f
        p1.Z = P.Verts(1).Z
        
        f = Dist / (Dist - P.Verts(2).Z)
        p2.X = P.Verts(2).X * f
        p2.Y = P.Verts(2).Y * f
        p2.Z = P.Verts(2).Z
        
        f = Dist / (Dist - P.Verts(3).Z)
        P3.X = P.Verts(3).X * f
        P3.Y = P.Verts(3).Y * f
        P3.Z = P.Verts(3).Z
    End Select
    v = m3VectorInit(p1, p2)
    u = m3VectorInit(p2, P3)
    n = m3VectorCross(v, u)
    If n.Z < 0 Then
        n.Y = -n.Y
        n.X = -n.X
        n.Z = -n.Z
    End If
       
   
    m3VectorSetLen 1, n
    dot = lightVector.X * n.X + lightVector.Y * n.Y + lightVector.Z * n.Z
    dot = dot + AmbFactor
    If dot > dotMax Then dot = dotMax
    ColorTo = RGB(dot * R, dot * G, dot * B)
    Obj.FillColor = ColorTo
    If Not Border Then
        Obj.ForeColor = ColorTo
    End If
    ProjectM3Points P.nVerts, P.Verts
    Polygon Obj.hdc, Poly2D(1), P.nVerts

    ' Restore Object's Colors
    Obj.FillColor = color
    Obj.ForeColor = BorderColor
End Sub