Ruotare una sfera in una DrawingArea

Di seguito mostreremo un possibile codice per ottenere l'effetto di una sfera che ruota in senso antiorario.

' Costanti per raggio della sfera e numero di punti visibili:
Private Const SPHERE_RADIUS As Integer = 100
Private Const NUM_POINTS As Integer = 200

' Angolo di rotazione della sfera (in radianti):
Private angle As Float

' Array contenente i punti 3D generati sulla superficie della sfera
' Ogni elemento è un array [x, y, z] normalizzato:
Private spherePoints As Float[][]


Public Sub Form_Open()

 With Me
   .Title = "Sfera che ruota in senso antiorario"
   .Move(0, 0, Screen.AvailableWidth, Screen.AvailableHeight)
   .Arrangement = Arrange.Fill
 End With

Timer1.Delay = 16   ' ~60 FPS
Timer1.Start

' Inizializza l'array dei punti:
 spherePoints = New Float[][NUM_POINTS]

 Dim i As Integer
 Dim theta, phi As Float
 Dim x, y, z As Float

' Generazione casuale dei punti distribuiti sulla superficie della sfera:
 For i = 0 To NUM_POINTS - 1
   theta = Rnd(0, 2 * Pi)      ' Angolo longitudinale (orizzontale)
   phi = Acos(Rnd(-1, 1))      ' Angolo latitudinale (verticale)

' Conversione da coordinate sferiche a coordinate cartesiane:
   x = Sin(phi) * Cos(theta)
   y = Cos(phi)
   z = Sin(phi) * Sin(theta)

' Salvataggio del punto normalizzato nell'array:
   spherePoints[i] = [x, y, z]
 Next

End


Public Sub DrawingArea1_Draw()

' Coordinate del centro della sfera nella DrawingArea:
 Dim cx As Float = DrawingArea1.Width / 2
 Dim cy As Float = DrawingArea1.Height / 2
 Dim r As Float = SPHERE_RADIUS

' Variabili per il ciclo:
 Dim i As Integer
 Dim p As Float[]
 Dim x, y, z As Float
 Dim xRot, zRot As Float
 Dim sx, sy As Float

' === Disegno del disco blu di base ===
 Paint.Brush = Paint.Color(Color.RGB(0, 80, 160))
 Paint.Ellipse(cx - r, cy - r, r * 2, r * 2)        ' Cerchio centrato
 Paint.Fill()

' === Disegno dei punti bianchi "ruotati" ===
 For i = 0 To NUM_POINTS - 1

' Estrae il punto dalla lista:
   p = spherePoints[i]
   x = p[0]
   y = p[1]
   z = p[2]

' Rotazione attorno all’asse Y.
' Simula la rotazione della sfera da sinistra a destra:
   xRot = x * Cos(angle) + z * Sin(angle)
   zRot = -x * Sin(angle) + z * Cos(angle)

' Mostra solo i punti "davanti" alla sfera (zRot > 0):
   If zRot > 0 Then

' Proiezione del punto 3D sulla 2D DrawingArea:
     sx = cx + xRot * r
     sy = cy + y * r

' Disegna un piccolo punto bianco (2x2 pixel):
     Paint.Brush = Paint.Color(Color.White)
     Paint.Ellipse(sx - 1, sy - 1, 2, 2)
     Paint.Fill()

   Endif

 Next

' === Disegna il bordo della sfera ===
 Paint.Brush = Paint.Color(&H000000)  ' Nero
 Paint.Ellipse(cx - r, cy - r, r * 2, r * 2)
 Paint.Stroke()

 Paint.End

End

Caricare una mappa terrestre equirettangolare

Di seguito mostreremo un codice per adattare sulla sfera una mappa terrestre equirettangolare, al fine di far apparire la sfera come il pianeta terra in rotazione.
Il file immagine contenente i dati della mappa equirettangolare deve essere del formato PNG.
Supporremo che il file immagine della mappa sia posto nella cartella "/tmp".

' === Costanti e variabili globali ===
Private Const RAGGIO_SFERA As Integer = 100   ' Raggio della sfera da disegnare
Private angle As Float                        ' Angolo di rotazione attorno all’asse Y
Private map As Image                          ' Mappa terrestre in proiezione equirettangolare


Public Sub Form_Open()

 With Me
   .Title = "Sfera rotante con mappa terrestre in proiezione equirettangolare"
   .Move(0, 0, Screen.AvailableWidth, Screen.AvailableHeight)
   .Arrangement = Arrange.Fill
 End With

' Carica la mappa terrestre (proiezione equirettangolare):
 map = Image.Load("/tmp/Equirectangular-projection.PNG")

' Avvia il timer con ~60 fotogrammi al secondo:
 Timer1.Delay = 16
 Timer1.Start

End


Public Sub Timer1_Timer()

' Incrementa l’angolo di rotazione (in radianti):
 angle += 0.05

' Mantiene l’angolo entro 0–2π:
 If angle > 2 * Pi Then angle = 0

' Richiede il ridisegno della DrawingArea:
 DrawingArea1.Refresh

End


Public Sub DrawingArea1_Draw()

' Centro della sfera nella finestra:
 Dim cx As Float = DrawingArea1.Width / 2
 Dim cy As Float = DrawingArea1.Height / 2
 Dim r As Float = RAGGIO_SFERA

' Dimensioni dell’immagine mappa:
 Dim imgW As Integer = map.Width
 Dim imgH As Integer = map.Height

' Variabili per lat/lon, rotazione e proiezione:
 Dim u, v As Float         ' Coordinate normalizzate [0,1] su X e Y dell’immagine
 Dim lon, lat As Float     ' Coordinate geografiche in radianti
 Dim x, y, z As Float      ' Coordinate 3D
 Dim xRot, zRot As Float   ' Coordinate dopo rotazione sull’asse Y
 Dim sx, sy As Float       ' Coordinate proiettate 2D
 Dim i, j As Integer
 Dim cosA, sinA As Float
 Dim mapColor As Integer

' Calcola seno e coseno dell’angolo per ottimizzazione:
 cosA = Cos(angle)
 sinA = Sin(angle)

' Disegna sfondo blu (la sfera base):
 Paint.Brush = Paint.Color(Color.RGB(0, 80, 160))
 Paint.Ellipse(cx - r, cy - r, r * 2, r * 2)
 Paint.Fill()

' === Ciclo per proiettare l’immagine mappa sulla sfera ===
 For j = 0 To imgH Step 2
   v = j / imgH                    ' Valore normalizzato verticale (0 = nord, 1 = sud)
   lat = v * Pi                    ' Latitudine da 0 (nord) a Pi (sud)
   y = Cos(lat)                    ' Coordinate verticali (asse Y cartesiano)

   For i = 0 To imgW Step 2
     u = i / imgW                  ' Valore normalizzato orizzontale (0 = ovest, 1 = est)
     lon = Pi - u * 2 * Pi         ' Longitudine da -Pi (est) a +Pi (ovest)

' Conversione sferica → cartesiana (raggio = 1)
     x = Sin(lat) * Cos(lon)
     z = Sin(lat) * Sin(lon)

' Rotazione attorno all’asse Y (trasformazione 3D)
     xRot = x * cosA + z * sinA
     zRot = -x * sinA + z * cosA

' Disegna solo i punti "visibili", cioè con zRot > 0:
     If zRot > 0 Then
' Proiezione 2D sul piano dello schermo:
       sx = cx + xRot * r
       sy = cy - y * r              ' Invertito perché Y su schermo cresce verso il basso

' Campiona il colore dalla mappa:
       mapColor = map[i, j]

' Disegna un punto colorato (pixel 1x1):
       Paint.Brush = Paint.Color(mapColor)
       Paint.Ellipse(sx, sy, 1, 1)
       Paint.Fill()
     Endif

   Next
 Next

' Disegna bordo nero della sfera:
 Paint.Brush = Paint.Color(&H000000)
 Paint.Ellipse(cx - r, cy - r, r * 2, r * 2)
 Paint.Stroke()

 Paint.End

End