02-09-2025, 08:37 PM
If only that seam.... There was an artifact running across the planet. Sometimes. It's not there anymore. Then there was a bug in the IsFrontFace function that did really nasty things to the north and south poles after the artifact was fixed. So that's gone too. So it should be fine now.
Code: (Select All)
' Rotating textured sphere with backface culling and precise continuity between the poles and the middle band
' We use specially calculated edge vertices for the poles to ensure that the vertices used in the middle band and in the pole fans exactly match.
Screen _NewImage(800, 600, 32)
myTexture = _LoadImage("earth.bmp")
If myTexture = 0 Then
Print "Cannot load texture!"
End
End If
texWidth = _Width(myTexture)
texHeight = _Height(myTexture)
' Obtaining texture dimensions
Const PI = 3.14159265
Const centerX = 400 ' Screen center (X)
Const centerY = 300 ' Screen center (Y)
Const scale = 250 ' Projection scale
' Setting the resolution of the spherical mesh
Const nPhi = 20 ' Number of divisions around the axis (azimuth)
Const nTheta = 20 ' Number of divisions from pole to pole (polar angle)
Dim stepPhi As Single, stepTheta As Single
stepPhi = 360 / nPhi
stepTheta = 180 / nTheta
' Definition of type Vertex – contains 2D projection, texture coordinates and rotated 3D coordinates
Type Vertex
sx As Integer ' 2D projected X
sy As Integer ' 2D projected Y
u As Single ' Texture coordinate U (0 to 1)
v As Single ' Texture coordinate V (0 to 1)
x3d As Single ' Rotated 3D X (for backface culling)
y3d As Single ' Rotated 3D Y (for backface culling)
z3d As Single ' Rotated 3D Z (for backface culling)
End Type
' Global rotation angles (in degrees)
Dim rotationX As Single, rotationY As Single
rotationX = 0
rotationY = 0
Dim northInner(0 To nPhi - 1) As Vertex, northOuter(0 To nPhi - 1) As Vertex
Dim southInner(0 To nPhi - 1) As Vertex, southOuter(0 To nPhi - 1) As Vertex
Do
' Rotation control – arrow keys
If _KeyDown(18432) Then rotationX = rotationX - 3 ' Left arrow
If _KeyDown(20480) Then rotationX = rotationX + 3 ' Right arrow
If _KeyDown(19200) Then rotationY = rotationY - 3 ' Up arrow
If _KeyDown(19712) Then rotationY = rotationY + 3 ' Down arrow
Cls , 0
_PrintString (0, 0), "Rotating textured sphere with backface culling"
_PrintString (0, 16), "Use the arrow keys. ESC to exit."
_PrintString (0, 32), "rotationX = " + Str$(rotationX) + " rotationY = " + Str$(rotationY)
Dim i As Integer, j As Integer
Dim phi1 As Single, phi2 As Single, theta1 As Single, theta2 As Single
Dim v1 As Vertex, v2 As Vertex, v3 As Vertex, v4 As Vertex
Dim avg As Single
' --- Before drawing, calculate the edge vertices for the poles ---
' For the northern pole:
' inner ring (closer to the pole) = vertices with ? = stepTheta/2
' outer ring = vertices with ? = stepTheta (which is the same as the first row of the middle band)
'
' For the southern pole:
' inner ring = vertices with ? = 180 - (stepTheta/2)
' outer ring = vertices with ? = 180 - stepTheta
For i = 0 To nPhi - 1
Dim phi As Single
phi = i * stepPhi
GetVertex northInner(i), phi, stepTheta / 2, rotationX, rotationY
GetVertex northOuter(i), phi, stepTheta, rotationX, rotationY
GetVertex southInner(i), phi, 180 - stepTheta / 2, rotationX, rotationY
GetVertex southOuter(i), phi, 180 - stepTheta, rotationX, rotationY
Next i
' --- Drawing the southern pole ---
Dim vPoleSouth As Vertex
GetVertex vPoleSouth, 0, 180, rotationX, rotationY
For i = 0 To nPhi - 1
Dim nextI As Integer
nextI = (i + 1) Mod nPhi
' 1. Triangles connecting the southern pole with the inner ring
_MapTriangle (vPoleSouth.u * texWidth, vPoleSouth.v * texHeight) - _
(southInner(i).u * texWidth, southInner(i).v * texHeight) - _
(southInner(nextI).u * texWidth, southInner(nextI).v * texHeight), _
myTexture To (vPoleSouth.sx, vPoleSouth.sy) - _
(southInner(i).sx, southInner(i).sy) - _
(southInner(nextI).sx, southInner(nextI).sy),0, _Smooth
' 2. Filling the square band between the inner and outer ring (divided into two triangles)
_MapTriangle (southInner(i).u * texWidth, southInner(i).v * texHeight) - _
(southOuter(i).u * texWidth, southOuter(i).v * texHeight) - _
(southOuter(nextI).u * texWidth, southOuter(nextI).v * texHeight), _
myTexture To (southInner(i).sx, southInner(i).sy) - _
(southOuter(i).sx, southOuter(i).sy) - _
(southOuter(nextI).sx, southOuter(nextI).sy),0, _Smooth
_MapTriangle (southInner(i).u * texWidth, southInner(i).v * texHeight) - _
(southOuter(nextI).u * texWidth, southOuter(nextI).v * texHeight) - _
(southInner(nextI).u * texWidth, southInner(nextI).v * texHeight), _
myTexture To (southInner(i).sx, southInner(i).sy) - _
(southOuter(nextI).sx, southOuter(nextI).sy) - _
(southInner(nextI).sx, southInner(nextI).sy),0, _Smooth
Next i
' --- Drawing the middle bands ---
For j = 1 To nTheta - 2
For i = 0 To nPhi - 1
phi1 = i * stepPhi
phi2 = (i + 1) * stepPhi
theta1 = j * stepTheta
theta2 = (j + 1) * stepTheta
GetVertex v1, phi1, theta1, rotationX, rotationY
GetVertex v2, phi2, theta1, rotationX, rotationY
GetVertex v3, phi1, theta2, rotationX, rotationY
GetVertex v4, phi2, theta2, rotationX, rotationY
Dim tu1 As Single, tu2 As Single, tu3 As Single
tu1 = v1.u: tu2 = v2.u: tu3 = v3.u
avg = (tu1 + tu2 + tu3) / 3
tu1 = AdjustUV(tu1, avg)
tu2 = AdjustUV(tu2, avg)
tu3 = AdjustUV(tu3, avg)
If IsFrontFace(v1, v2, v3) Then
_MapTriangle (tu1 * texWidth, v1.v * texHeight) - _
(tu2 * texWidth, v2.v * texHeight) - _
(tu3 * texWidth, v3.v * texHeight), _
myTexture To (v1.sx, v1.sy) - _
(v2.sx, v2.sy) - _
(v3.sx, v3.sy), 0,_Smooth
End If
tu1 = v2.u: tu2 = v4.u: tu3 = v3.u
avg = (tu1 + tu2 + tu3) / 3
tu1 = AdjustUV(tu1, avg)
tu2 = AdjustUV(tu2, avg)
tu3 = AdjustUV(tu3, avg)
If IsFrontFace(v2, v4, v3) Then
_MapTriangle (tu1 * texWidth, v2.v * texHeight) - _
(tu2 * texWidth, v4.v * texHeight) - _
(tu3 * texWidth, v3.v * texHeight), _
myTexture To (v2.sx, v2.sy) - _
(v4.sx, v4.sy) - _
(v3.sx, v3.sy),0, _Smooth
End If
Next i
Next j
' --- Drawing the northern pole (upper fan) – drawn only if it is visible ---
Dim vPoleNorth As Vertex
GetVertex vPoleNorth, 0, 0, rotationX, rotationY
If vPoleNorth.z3d < 0 Then
For i = 0 To nPhi - 1
nextI = (i + 1) Mod nPhi
' 1. Triangles connecting the northern pole with the inner ring
_MapTriangle (vPoleNorth.u * texWidth, vPoleNorth.v * texHeight) - _
(northInner(i).u * texWidth, northInner(i).v * texHeight) - _
(northInner(nextI).u * texWidth, northInner(nextI).v * texHeight), _
myTexture To (vPoleNorth.sx, vPoleNorth.sy) - _
(northInner(i).sx, northInner(i).sy) - _
(northInner(nextI).sx, northInner(nextI).sy),0, _Smooth
' 2. Filling the band between the inner and outer ring (two triangles)
_MapTriangle (northInner(i).u * texWidth, northInner(i).v * texHeight) - _
(northOuter(i).u * texWidth, northOuter(i).v * texHeight) - _
(northOuter(nextI).u * texWidth, northOuter(nextI).v * texHeight), _
myTexture To (northInner(i).sx, northInner(i).sy) - _
(northOuter(i).sx, northOuter(i).sy) - _
(northOuter(nextI).sx, northOuter(nextI).sy),0, _Smooth
_MapTriangle (northInner(i).u * texWidth, northInner(i).v * texHeight) - _
(northOuter(nextI).u * texWidth, northOuter(nextI).v * texHeight) - _
(northInner(nextI).u * texWidth, northInner(nextI).v * texHeight), _
myTexture To (northInner(i).sx, northInner(i).sy) - _
(northOuter(nextI).sx, northOuter(nextI).sy) - _
(northInner(nextI).sx, northInner(nextI).sy), 0,_Smooth
Next i
End If
_Limit 30
_Display
Loop Until _KeyDown(27) ' ESC exits the program
'------------------------------------------------------
' Function AdjustUV
'
' If the value of u differs from the average by more than 0.5,
' it adjusts it so that there is no discontinuity in the interpolation across the seam (u = 0 and u = 1).
' This is used only for the middle bands.
'------------------------------------------------------
Function AdjustUV (u As Single, avg As Single)
If u - avg > 0.5 Then
AdjustUV = u - 1
ElseIf u - avg < -0.5 Then
AdjustUV = u + 1
Else
AdjustUV = u
End If
End Function
'------------------------------------------------------
' SUB GetVertex
'
' Calculates a point on the unit sphere, determines texture coordinates,
' performs rotation (first around the Y axis, then around the X axis) and computes the 2D projection.
'
' For values ? = 0 and ? = 180, we set u and v fixed (i.e. u = 0.5, v = 0 respectively 1),
' which guarantees a smooth texture transition at the poles.
'------------------------------------------------------
Sub GetVertex (v As Vertex, phi As Single, theta As Single, rotX As Single, rotY As Single)
Dim radPhi As Single, radTheta As Single
radPhi = phi * (PI / 180)
radTheta = theta * (PI / 180)
Dim x0 As Single, y0 As Single, z0 As Single
x0 = Sin(radTheta) * Cos(radPhi)
y0 = Cos(radTheta)
z0 = Sin(radTheta) * Sin(radPhi)
If theta = 0 Then
v.u = 0.5
v.v = 0
ElseIf theta = 180 Then
v.u = 0.5
v.v = 1
Else
v.u = (_Atan2(z0, x0) + PI) / (2 * PI)
v.v = _Acos(y0) / PI
End If
Dim x As Single, y As Single, z As Single
x = x0: y = y0: z = z0
Dim ry As Single
ry = rotY * (PI / 180)
Dim xtemp As Single, ztemp As Single
xtemp = x * Cos(ry) + z * Sin(ry)
ztemp = -x * Sin(ry) + z * Cos(ry)
x = xtemp: z = ztemp
Dim rx As Single
rx = rotX * (PI / 180)
Dim ytemp As Single
ytemp = y * Cos(rx) - z * Sin(rx)
ztemp = y * Sin(rx) + z * Cos(rx)
y = ytemp: z = ztemp
v.x3d = x
v.y3d = y
v.z3d = z
v.sx = centerX + x * scale
v.sy = centerY - y * scale
End Sub
'------------------------------------------------------
' Function IsFrontFace
'
' Calculates the Z component of the normal (cross product) and determines whether the triangle is facing the camera.
' When viewed in the -Z direction, a triangle is front-facing if the normal is < 0.
'
' This is used for the middle bands.
'------------------------------------------------------
Function IsFrontFace (v1 As Vertex, v2 As Vertex, v3 As Vertex)
Dim edge1_x As Single, edge1_y As Single, edge1_z As Single
Dim edge2_x As Single, edge2_y As Single, edge2_z As Single
edge1_x = v2.x3d - v1.x3d
edge1_y = v2.y3d - v1.y3d
edge1_z = v2.z3d - v1.z3d
edge2_x = v3.x3d - v1.x3d
edge2_y = v3.y3d - v1.y3d
edge2_z = v3.z3d - v1.z3d
Dim norm_z As Single
norm_z = edge1_x * edge2_y - edge1_y * edge2_x
If Abs(norm_z) < 0.001 Then
IsFrontFace = -1 'bug! 0 causes Nort Pole and South Pole drawing error....
Exit Function
End If
If norm_z < 0 Then
IsFrontFace = -1
Else
IsFrontFace = 0
End If
End Function