Public Sub RayTraceable_CullScanline(ByVal px As Single, ByVal py As Single, ByVal pz As Single, ByVal Nx As Single, ByVal Ny As Single, ByVal Nz As Single)
Dim Dx As Single
Dim Dy As Single
Dim Dz As Single
Dim Dist As Single
' Don't run this sub if we are culled forever
If ForeverCulled Then
ScanlineDone = True
Exit Sub
End If
' We have not had a hit already
HadHit = False
' Find the distance from the center of the
' sphere to the scanline plane.
' Get the vector from our center to the point.
With Center
Dx = .Trans(1) - px
Dy = .Trans(2) - py
Dz = .Trans(3) - pz
End With
' Take the dot product of this and the normal.
' If the resulting distance > Radius, cull.
ScanlineDone = (Abs(Dx * Nx + Dy * Ny + Dz * Nz) > Radius)
' See if we will be culled in the future.
If ScanlineDone Then
' We were not culled on a previous scanline
' but we are now. We will be culled on
' all later scanlines.
If HadHitPrev Then ForeverCulled = True
Else
' We are not culled
HadHitPrev = True
End If
End Sub
Public Function RayTraceable_FindT(DirectC As Boolean, 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 B24AC As Single
Dim t1 As Single
Dim t2 As Single
Dim Cx As Single
Dim Cy As Single
Dim Cz As Single
' Check if we are culled
If DirectC And ScanlineDone Then
RayTraceable_FindT = -1
Exit Function
End If
' Create values for the center of the sphere
Cx = Center.Trans(1)
Cy = Center.Trans(2)
Cz = Center.Trans(3)
' Get coefficients for the quadratic
A = Vx * Vx + Vy * Vy + Vz * Vz
B = 2 * Vx * (px - Cx) + _
2 * Vy * (py - Cy) + _
2 * Vz * (pz - Cz)
C = Cx * Cx + Cy * Cy + Cz * Cz + _
px * px + py * py + pz * pz - _
2 * (Cx * px + Cy * py + Cz * pz) - _
Radius * Radius
' Solve the quadratic A * t ^ 2 + B * t + C = 0
B24AC = B * B - 4 * A * C
' Check intersections
If B24AC < 0 Then
' No real intersection
If HadHit And DirectC Then ScanlineDone = True
RayTraceable_FindT = -1
Exit Function
ElseIf B24AC = 0 Then
' One intersection
t1 = -B / 2 / A
Else
' Two intersections
B24AC = Sqr(B24AC)
t1 = (-B + B24AC) / 2 / A
t2 = (-B - B24AC) / 2 / A
' Use only positive values for t
If t1 < 0.01 Then t1 = t2
If t2 < 0.01 Then t2 = t1
' Use the smallest one
If t1 > t2 Then t1 = t2
End If
' If there's no positive value, there's no intersection
If t1 < 0.01 Then
If HadHit And DirectC Then ScanlineDone = True
RayTraceable_FindT = -1
Exit Function
End If
' If the function reaches this line, we had a hit
If DirectC Then HadHit = True
RayTraceable_FindT = t1
End Function
Public Sub RayTraceable_FindHitColor(Objects As Collection, _
ByVal eyeX As Single, ByVal eyeY As Single, ByVal eyeZ As Single, _
ByVal px As Single, ByVal py As Single, ByVal pz As Single, _
ByRef R As Integer, ByRef G As Integer, ByRef B As Integer)
