Visual Basic Graphics Programming (2nd Edition)/Visual Basic Graphics Programming 2nd Edition.iso/OldSrc/CH13/SRC/OBJPLAR.CLS

Text File | 1996-04-11 | 9.0 KB | 340 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ObjPlane"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

Private Point1 As Point3D   ' Point on plane.
Private Point2 As Point3D   ' Normal = P2 - P1.

Private HitX As Single
Private HitY As Single
Private HitZ As Single

Private Kar As Single
Private Kag As Single
Private Kab As Single

Private Kdr As Single
Private Kdg As Single
Private Kdb As Single

Private SpecN As Single
Private Ks As Single

Private Krr As Single
Private Krg As Single
Private Krb As Single

' ************************************************
' Apply a transformation matrix to the plane.
' ************************************************
Public Sub Apply(M() As Single)
    ' Transform the point and normal.
    m3Apply Point1.coord, M, Point1.trans
    m3Apply Point2.coord, M, Point2.trans
End Sub
' ************************************************
' Return the red, green, and blue components of
' the surface at the hit position.
' ************************************************
Public Sub HitColor(depth As Integer, Objects As Collection, R As Integer, G As Integer, B As Integer)
Dim nx As Single
Dim ny As Single
Dim nz As Single
Dim lx As Single
Dim ly As Single
Dim lz As Single
Dim Vx As Single
Dim Vy As Single
Dim Vz As Single
Dim rx As Single
Dim ry As Single
Dim rz As Single
Dim n_len As Single
Dim l_len As Single
Dim v_len As Single
Dim r_len As Single
Dim NdotL As Single
Dim RdotV As Single
Dim NdotV As Single
Dim r_dif As Single
Dim g_dif As Single
Dim b_dif As Single
Dim r_amb As Single
Dim g_amb As Single
Dim b_amb As Single
Dim spec As Single
Dim r_ref As Single
Dim g_ref As Single
Dim b_ref As Single
Dim r1 As Integer
Dim g1 As Integer
Dim b1 As Integer
Dim mx As Single
Dim my As Single
Dim mz As Single
Dim i As Integer
Dim dist As Single
Dim shadowed As Boolean
Dim rlng As Long
Dim glng As Long
Dim blng As Long

    ' *******************************
    ' * Compute local contributions *
    ' *******************************

    ' Find the unit vector pointing toward the light.
    lx = LightSource.trans(1) - HitX
    ly = LightSource.trans(2) - HitY
    lz = LightSource.trans(3) - HitZ
    l_len = Sqr(lx * lx + ly * ly + lz * lz)
    lx = lx / l_len
    ly = ly / l_len
    lz = lz / l_len
    ' We will use l_len later as the distance from
    ' the light to the surface.

    ' Find the surface unit normal.
    nx = Point2.trans(1) - Point1.trans(1)
    ny = Point2.trans(2) - Point1.trans(2)
    nz = Point2.trans(3) - Point1.trans(3)
    n_len = Sqr(nx * nx + ny * ny + nz * nz)
    nx = nx / n_len
    ny = ny / n_len
    nz = nz / n_len

    ' Find the vector V from the surface to the
    ' viewpoint.
    Vx = EyeX - HitX
    Vy = EyeY - HitY
    Vz = EyeZ - HitZ
    v_len = Sqr(Vx * Vx + Vy * Vy + Vz * Vz)
    Vx = Vx / v_len
    Vy = Vy / v_len
    Vz = Vz / v_len

    ' See if the light shines on the back of the
    ' plane. I.e. if the center of projection
    ' and light source lie on the same side.
    NdotL = nx * lx + ny * ly + nz * lz
    NdotV = nx * Vx + ny * Vy + nz * Vz
    shadowed = (NdotL * NdotV < 0)

    ' Treat backface planes as normal planes.
    NdotL = Abs(NdotL)

    ' Find vector R in the mirror direction.
    rx = 2 * nx * NdotL - lx
    ry = 2 * ny * NdotL - ly
    rz = 2 * nz * NdotL - lz

    ' See if the light shines directly on the surface.
    If Not shadowed Then
        For i = 1 To Objects.Count
            dist = Objects.Item(i).RayDistance( _
                LightSource.trans(1), _
                LightSource.trans(2), _
                LightSource.trans(3), _
                -lx, -ly, -lz)
            If dist < l_len - 0.1 Then Exit For
        Next i
        shadowed = (i <= Objects.Count)
    End If

    ' Calculate the part due to diffuse reflection.
    If shadowed Then
        ' The light does not hit the surface.
        r_dif = 0
        g_dif = 0
        b_dif = 0
        spec = 0
    Else
        r_dif = Kdr * NdotL
        g_dif = Kdg * NdotL
        b_dif = Kdb * NdotL

        ' Calculate the part due to specular reflection.
        RdotV = rx * Vx + ry * Vy + rz * Vz
        If RdotV < 0 Then
            spec = 0
        Else
            spec = Ks * RdotV ^ SpecN
        End If
    End If

    ' Calculate the part due to ambient light.
    r_amb = LightIar * Kar
    g_amb = LightIag * Kag
    b_amb = LightIab * Kab

    ' **********************************
    ' * Compute reflected contribution *
    ' **********************************
    ' Find vector M in the direction of reflection.
    mx = 2 * nx * NdotV - Vx
    my = 2 * ny * NdotV - Vy
    mz = 2 * nz * NdotV - Vz

    If depth > 1 Then
        TraceRay depth - 1, HitX, HitY, HitZ, mx, my, mz, r1, g1, b1
        r_ref = Krr * r1
        g_ref = Krg * g1
        b_ref = Krb * b1
    Else
        r_ref = 0
        g_ref = 0
        b_ref = 0
    End If

    ' See how intense to make the color.
    ' Some of the reflections may be close to
    ' the light source so these values can get big.
    rlng = r_amb + _
        LightIir / (l_len + LightKdist) * _
            (r_dif + spec) + _
        r_ref
    glng = g_amb + _
        LightIig / (l_len + LightKdist) * _
            (g_dif + spec) + _
        g_ref
    blng = b_amb + _
        LightIib / (l_len + LightKdist) * _
            (b_dif + spec) + _
        b_ref
    If rlng > 255 Then rlng = 255
    If glng > 255 Then glng = 255
    If blng > 255 Then blng = 255
    R = rlng
    G = glng
    B = blng
End Sub

' ************************************************
' Set constants for reflected light.
' ************************************************
Sub SetKr(R As Single, G As Single, B As Single)
    Krr = R
    Krg = G
    Krb = B
End Sub


' ************************************************
' Compute the distance from point (px, py, pz)
' along vector <vx, vy, vz> to the plane.
'
' Save the point of intersection in
' (HitX, HitY, HitZ) for later use.
' ************************************************
Public Function RayDistance(px As Single, py As Single, pz As Single, Vx As Single, Vy As Single, Vz As Single) As Single
Dim A As Single
Dim B As Single
Dim C As Single
Dim D As Single
Dim nx As Single
Dim ny As Single
Dim nz As Single
Dim denom As Single
Dim t As Single

    ' Recompute the normal vector.
    nx = Point2.trans(1) - Point1.trans(1)
    ny = Point2.trans(2) - Point1.trans(2)
    nz = Point2.trans(3) - Point1.trans(3)

    ' Compute the plane's parameters.
    A = nx
    B = ny
    C = nz
    D = -(nx * Point1.trans(1) + _
          ny * Point1.trans(2) + _
          nz * Point1.trans(3))

    ' If the denominator = 0, the ray is parallel
    ' to the plane so there's no intersection.
    denom = A * Vx + B * Vy + C * Vz
    If denom = 0 Then
        RayDistance = INFINITY
        Exit Function
    End If

    ' Solve for t.
    t = -(A * px + B * py + C * pz + D) / denom

    ' If t < 0 then the intersection is behind the
    ' center of projection so not of interest.
    If t < 0.001 Then
        RayDistance = INFINITY
        Exit Function
    End If

    ' Compute the actual hit location.
    HitX = px + t * Vx
    HitY = py + t * Vy
    HitZ = pz + t * Vz

    ' Compute the distance from (px, py, pz).
    A = px - HitX
    B = py - HitY
    C = pz - HitZ
    RayDistance = Sqr(A * A + B * B + C * C)
End Function

' ************************************************
' Set the points. Point2 = Point1 + normal vector.
' ************************************************
Public Sub Initialize(Cx As Single, Cy As Single, Cz As Single, Vx As Single, Vy As Single, Vz As Single)
    Point1.coord(1) = Cx
    Point1.coord(2) = Cy
    Point1.coord(3) = Cz
    Point1.coord(4) = 1
    Point2.coord(1) = Cx + Vx
    Point2.coord(2) = Cy + Vy
    Point2.coord(3) = Cz + Vz
    Point2.coord(4) = 1
End Sub


' ************************************************
' Set N and Ks for specular reflection.
' ************************************************
Sub SetSpec(n As Single, s As Single)
    SpecN = n
    Ks = s
End Sub

' ************************************************
' Return the latest Hit location.
' ************************************************
Public Sub HitLocation(x As Single, y As Single, z As Single)
    x = HitX
    y = HitY
    z = HitZ
End Sub

' ************************************************
' Set constants for diffuse reflection.
' ************************************************
Sub SetKd(R As Single, G As Single, B As Single)
    Kdr = R
    Kdg = G
    Kdb = B
End Sub

' ************************************************
' Set constants for ambient light.
' ************************************************
Sub SetKa(R As Single, G As Single, B As Single)
    Kar = R
    Kag = G
    Kab = B
End Sub