@Petr This is pretty great! One glitch though -- it doesn't map the whole earth, leaving a crack where some celestial giant took an axe to one side of it...
The image of the earth is included as an attachment so you can test it yourself. (Just change the path to wherever you put the earth.bmp file.)
Code: (Select All)
' Rotující texturovaná koule vykreslená pomocí _MAPTRIANGLE s backface culling
' (Rotating textured sphere rendered using _MAPTRIANGLE with backface culling)
Screen _NewImage(800, 600, 32)
myTexture = _LoadImage("z:\earth.bmp")
If myTexture = 0 Then
Print "Can not load '6.jpg'!"
End
End If
texWidth = _Width(myTexture)
texHeight = _Height(myTexture)
' (Obtaining the width and height of the loaded texture)
Const PI = 3.14159265
Const centerX = 400 ' Stred obrazovky (X) Screen middle X
Const centerY = 300 ' Stred obrazovky (Y) Screen middle Y
Const scale = 200 ' Merítko projekce Projection ratio
' (Define constants for PI, screen center coordinates, and the projection scale)
' Nastavení rozliení síte (kolik segmentu se pouije)
' (Setting the mesh resolution - how many segments to use)
Const nPhi = 40 ' Pocet delení kolem osy (azimut) Number of divisions around the axis (azimuth)
Const nTheta = 20 ' Pocet delení od pólu k pólu (polární úhel) Number of divisions from pole to pole (polar angle)
Dim stepPhi As Single, stepTheta As Single
stepPhi = 360 / nPhi
stepTheta = 180 / nTheta
' (Calculates the angular step sizes for phi (azimuth) and theta (polar angle))
' (User Defined Type with additional fields for 3D coordinates used for backface culling)
Type Vertex
sx As Integer ' Projekcní X na obrazovce Projection X on screen
sy As Integer ' Projekcní Y na obrazovce Projection Y on screen
u As Single ' Texturovací souradnice U (0 a 1) Texturing coordinate U 0 to 1
v As Single ' Texturovací souradnice V (0 a 1) Texturing coordinate V 0 to 1
x3d As Single ' Otocená 3D souradnice X rotation 3D X
y3d As Single ' Otocená 3D souradnice Y rotation 3D Y
z3d As Single ' Otocená 3D souradnice Z rotation 3D Z
End Type
' (The Vertex type stores both the 2D projected coordinates (sx, sy) and the texture coordinates (u, v),
' as well as the transformed 3D coordinates (x3d, y3d, z3d) for performing backface culling)
' Globální rotacní úhly (v°
' (Global rotation angles in degrees)
Dim rotationX As Single, rotationY As Single
rotationX = 0
rotationY = 0
Do
' Pouíváme puvodní _KeyDown hodnoty
' (Using the original _KeyDown key codes)
If _KeyDown(18432) Then rotationX = rotationX - 1 ' ipka vlevo (Left arrow decreases rotationX)
If _KeyDown(20480) Then rotationX = rotationX + 1 ' ipka vpravo (Right arrow increases rotationX)
If _KeyDown(19200) Then rotationY = rotationY - 1 ' ipka nahoru (Up arrow decreases rotationY)
If _KeyDown(19712) Then rotationY = rotationY + 1 ' ipka dolu (Down arrow increases rotationY)
Cls , 0
_PrintString (0, 0), "Rotující texturovaná koule s backface culling"
_PrintString (0, 16), "Pouijte ipky. ESC pro ukoncení."
_PrintString (0, 32), "rotationX = " + Str$(rotationX) + " rotationY = " + Str$(rotationY)
' (Clears the screen and prints the title and current rotation angles for debugging)
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
' Procházení sférickou sítí kadý segment (ctverec) rozdelíme na 2 trojúhelníky
' (Loop through the spherical mesh; each quad (square) is divided into 2 triangles)
For i = 0 To nPhi - 1
For j = 0 To nTheta - 1
phi1 = i * stepPhi
phi2 = (i + 1) * stepPhi
If phi2 >= 360 Then phi2 = phi2 - 360
theta1 = j * stepTheta
theta2 = (j + 1) * stepTheta
' Výpocet vrcholu segmentu predáváme aktuální hodnoty rotace
' (Calculate the vertices of the segment, passing the current rotation values)
GetVertex v1, phi1, theta1, rotationX, rotationY
GetVertex v2, phi2, theta1, rotationX, rotationY
GetVertex v3, phi1, theta2, rotationX, rotationY
GetVertex v4, phi2, theta2, rotationX, rotationY
' Vykreslíme pouze trojúhelníky, které jsou "front-facing"
' (Render only the triangles that are front-facing)
If IsFrontFace(v1, v2, v3) Then
_MapTriangle (v1.u * texWidth, v1.v * texHeight)-(v2.u * texWidth, v2.v * texHeight)-(v3.u * texWidth, v3.v * texHeight), myTexture To(v1.sx, v1.sy)-(v2.sx, v2.sy)-(v3.sx, v3.sy), _Smooth
End If
If IsFrontFace(v2, v4, v3) Then
_MapTriangle (v2.u * texWidth, v2.v * texHeight)-(v4.u * texWidth, v4.v * texHeight)-(v3.u * texWidth, v3.v * texHeight), myTexture To(v2.sx, v2.sy)-(v4.sx, v4.sy)-(v3.sx, v3.sy), _Smooth
End If
Next j
Next i
_Limit 30
_Display
Loop Until _KeyDown(27) ' ESC ukoncí program
' (The main loop continues until the ESC key is pressed)
'------------------------------------------------------
' SUB GetVertex
'
' Vstup:
' phi, theta: sférické úhly (v°
' rotX, rotY: aktuální hodnoty rotace (v°
, predané z hlavního programu
'
' Výstup (v):
' v.sx, v.sy: 2D projekcní souradnice
' v.u, v.v: texturovací souradnice (v rozsahu 0 a 1)
' v.x3d, v.y3d, v.z3d: otocené 3D souradnice (pro backface culling)
'
' Postup:
' 1. Vypocítá se puvodní (neotocený
bod na jednotkové kouli:
' x0 = sin(theta)*cos(phi)
' y0 = cos(theta)
' z0 = sin(theta)*sin(phi)
' 2. Z tohoto bodu se spocítají texturovací souradnice:
' u = (ATAN2(z0, x0) + PI) / (2*PI)
' v = ACOS(y0) / PI
' 3. Následne se na puvodní bod aplikuje rotace nejprve kolem osy Y, potom kolem osy X.
' 4. Výsledek se uloí do v.x3d, v.y3d, v.z3d a podle nej se spocítají 2D projekcní souradnice.
'
' Input:
' phi, theta: spherical angles (v°
' rotX, rotY: current rotation values ??(v°
, passed from the main program
'
' Output (v):
' v.sx, v.sy: 2D projection coordinates
' v.u, v.v: texturing coordinates (in the range 0 to 1)
' v.x3d, v.y3d, v.z3d: rotated 3D coordinates (for backface culling)
'
' Procedure:
' 1. The original (unrotated) point on the unit sphere is calculated:
' x0 = sin(theta)*cos(phi)
' y0 = cos(theta)
' z0 = sin(theta)*sin(phi)
' 2. The texturing coordinates are calculated from this point:
' u = (ATAN2(z0, x0) + PI) / (2*PI)
' v = ACOS(y0) / PI
' 3. Subsequently, on the original point is rotated first around the Y axis, then around the X axis.
' 4. The result is stored in v.x3d, v.y3d, v.z3d and the 2D projection coordinates are calculated based on it.
' (SUB GetVertex calculates the vertex data for a given spherical coordinate.
' It computes the original (unrotated) point on the unit sphere, derives the texture coordinates,
' then applies rotation (first around the Y-axis, then around the X-axis) and computes the 2D projection.)
'------------------------------------------------------
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)
' Puvodní (neotocený
bod na jednotkové kouli
' (Calculate the original, unrotated point on the unit sphere)
Dim x0 As Single, y0 As Single, z0 As Single
x0 = Sin(radTheta) * Cos(radPhi)
y0 = Cos(radTheta)
z0 = Sin(radTheta) * Sin(radPhi)
' Výpocet texturovacích souradnic (z neotoceného bodu)
' (Calculate texture coordinates from the unrotated point)
v.u = (_Atan2(z0, x0) + PI) / (2 * PI)
v.v = _Acos(y0) / PI
' Inicializace budeme transformovat puvodní bod
' (Initialize transformation with the original point)
Dim x As Single, y As Single, z As Single
x = x0: y = y0: z = z0
' Nejprve rotace kolem osy Y (vertikální rotace)
' (Apply rotation around the Y-axis first - vertical rotation)
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
' Poté rotace kolem osy X (horizontální rotace)
' (Then apply rotation around the X-axis - horizontal rotation)
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
' Uloení otocených 3D souradnic do vrcholu (pro pozdejí backface culling)
' (Store the rotated 3D coordinates in the vertex for later backface culling)
v.x3d = x
v.y3d = y
v.z3d = z
' Projekce do 2D (ortografická
' (Calculate the 2D orthographic projection)
v.sx = centerX + x * scale
v.sy = centerY - y * scale
End Sub
'------------------------------------------------------
' Funkce IsFrontFace
'
' Vstup: tri vrcholy trojúhelníku (v1, v2, v3) se svými 3D souradnicemi.
' Výpocet: spocítá se normála trojúhelníku a poté její dot produkt s vektorem pohledu (0,0,-1).
' Pokud je výsledek > 0 (tj. normála smeruje ke kamere), vrátí funkce true.
' V naem prípade (s ortografickou projekcí a kamerou smerující do -Z)
' platí: pokud normála má sloku z mení ne 0, trojúhelník je viditelný.
'
' (Function IsFrontFace determines whether a triangle is facing the camera.
' It calculates the cross product (normal) of two edges of the triangle and uses its Z-component,
' comparing it with the view vector (0,0,-1). If the condition is met (normal's Z-component < 0),
' the triangle is considered front-facing.)
'------------------------------------------------------
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
' Vypocítáme pouze sloku Z normály (cross product)
' (Compute only the Z component of the normal via cross product)
Dim norm_z As Single
norm_z = edge1_x * edge2_y - edge1_y * edge2_x
' Pohled: vektor (0,0,-1). Dot produkt = -norm_z.
' Trojúhelník je front-facing, pokud -norm_z > 0 <=> norm_z < 0.
' (With the view vector (0,0,-1), the dot product is -norm_z.
' The triangle is considered front-facing if -norm_z > 0, i.e., if norm_z < 0.)
If norm_z < 0 Then
IsFrontFace = -1
Else
IsFrontFace = 0
End If
End Function
The image of the earth is included as an attachment so you can test it yourself. (Just change the path to wherever you put the earth.bmp file.)

