Ruotare un dodecaedro in una DrawingArea

Mostreremo un possibile codice per disegnare e ruotare un Dodecaedro con facce pentagonali intorno ai suoi assi X, Y e Z in una DrawingArea.

Nell'esempio che segue sarà possibile aumentare o diminuire la dimensione del disegno del Dodecaedro, cliccando rispettivamente sui tasti "+" e "-" della tastiera.

Private angleX As Float        ' Angolo di rotazione sull'asse X
Private angleY As Float        ' Angolo di rotazione sull'asse Y
Private Zoom As Float = 150    ' Fattore di ingrandimento
Private Vertices As Object[]   ' Lista di vertici 3D (Float[])
Private Faces As Object[]      ' Lista di facce (ogni faccia è un array di 5 indici)


Public Sub Form_Open()

' Impostazioni iniziali della finestra:
 Me.Title = "Dodecaedro rotante con facce pentagonali"
 Me.Move(0, 0, Screen.AvailableWidth, Screen.AvailableHeight)
 Me.Arrangement = Arrange.Fill

' Inizializza gli array:
 Vertices = New Object[]
 Faces = New Object[]

' Sezione aurea e valori derivati per la costruzione del dodecaedro:
 Dim phi As Float = (1 + Sqr(5)) / 2
 Dim a As Float = 1
 Dim b As Float = 1 / phi

' === 20 Vertici del dodecaedro ===
' I vertici sono scelti in modo simmetrico e disposti con coordinate note:
 Vertices.Push([ a,  a,  a])     '  0
 Vertices.Push([ a,  a, -a])     '  1
 Vertices.Push([ a, -a,  a])     '  2
 Vertices.Push([ a, -a, -a])     '  3
 Vertices.Push([-a,  a,  a])     '  4
 Vertices.Push([-a,  a, -a])     '  5
 Vertices.Push([-a, -a,  a])     '  6
 Vertices.Push([-a, -a, -a])     '  7
 Vertices.Push([ 0,  b,  phi])   '  8
 Vertices.Push([ 0,  b, -phi])   '  9
 Vertices.Push([ 0, -b,  phi])   ' 10
 Vertices.Push([ 0, -b, -phi])   ' 11
 Vertices.Push([ b,  phi, 0])    ' 12
 Vertices.Push([ b, -phi, 0])    ' 13
 Vertices.Push([-b, phi, 0])     ' 14
 Vertices.Push([-b, -phi, 0])    ' 15
 Vertices.Push([ phi, 0,  b])    ' 16
 Vertices.Push([ phi, 0, -b])    ' 17
 Vertices.Push([-phi, 0,  b])    ' 18
 Vertices.Push([-phi, 0, -b])    ' 19

' === 12 Facce pentagonali, ognuna con 5 indici di vertici ===
' L'ordine dei vertici garantisce facce chiuse, senza incroci:
 Faces.Push([0, 8, 10, 2, 16])
 Faces.Push([0, 16, 17, 1, 12])
 Faces.Push([0, 12, 14, 4, 8])
 Faces.Push([8, 4, 18, 6, 10])
 Faces.Push([10, 6, 15, 13, 2])
 Faces.Push([2, 13, 3, 17, 16])
 Faces.Push([1, 17, 3, 11, 9])
 Faces.Push([1, 9, 5, 14, 12])
 Faces.Push([4, 14, 5, 19, 18])
 Faces.Push([6, 18, 19, 7, 15])
 Faces.Push([3, 13, 15, 7, 11])
 Faces.Push([5, 9, 11, 7, 19])

 Timer1.Delay = 16
 Timer1.Start

End


Public Sub Timer1_Timer()

' Aggiorna gli angoli di rotazione:
 angleX += 0.02
 angleY += 0.015

 DrawingArea1.Refresh

End


Public Sub DrawingArea1_Draw()

' Centro della DrawingArea:
 Dim w As Integer = DrawingArea1.W
 Dim h As Integer = DrawingArea1.H
 Dim cx As Float = w / 2
 Dim cy As Float = h / 2

' Array dei punti proiettati 2D:
 Dim points As Object[] = New Object[]

' Sfondo bianco:
 Paint.FillRect(0, 0, w, h, Color.White)

' Proiezione 3D → 2D per ciascun vertice:
 For Each v As Float[] In Vertices
   Dim x, y, z As Float
   x = v[0]
   y = v[1]
   z = v[2]

' Rotazione sull'asse X:
   Dim y1 As Float = y * Cos(angleX) - z * Sin(angleX)
   Dim z1 As Float = y * Sin(angleX) + z * Cos(angleX)
   y = y1
   z = z1

' Rotazione sull'asse Y:
   Dim x1 As Float = x * Cos(angleY) + z * Sin(angleY)
   z1 = -x * Sin(angleY) + z * Cos(angleY)
   x = x1
   z = z1

' Proiezione prospettica (evita divisione per zero):
   If (z + 3) < 0.1 Then Continue

' Interpolazione tra prospettiva e isometria:
   Dim factor As Float = 0.3    ' 0 = isometrica, 1 = prospettiva completa
   Dim scale As Float = Zoom / (1 + factor * (z + 3))

   Dim sx As Float = cx + x * scale
   Dim sy As Float = cy - y * scale

   points.Push([sx, sy])
 Next

' Disegna ogni faccia (5 lati chiusi):
 Paint.Brush = Paint.Color(Color.Black)
 For Each f As Integer[] In Faces
   Dim i As Integer
   For i = 0 To f.Count - 1
     Dim p1 As Float[] = points[f[i]]
     Dim p2 As Float[] = points[(f[(i + 1) Mod f.Count])]
     Paint.MoveTo(p1[0], p1[1])
     Paint.LineTo(p2[0], p2[1])
     Paint.Stroke
   Next
 Next
 
End


Public Sub Form_KeyPress()

Select Case Key.Code
  Case Key["+"]
   Zoom = Min(Zoom + 25, 1000)
 Case Key["-"]
   Zoom = Max(Zoom - 25, 25)
 End Select

 DrawingArea1.Refresh

End

oppure senza effetto della prospettiva sulle facce:

Private angleX As Float
Private angleY As Float
Private Zoom As Float = 200      ' Zoom isometrico costante
Private Vertices As Object[]
Private Faces As Object[]


Public Sub Form_Open()

 Me.Title = "Dodecaedro rotante - Proiezione isometrica senza effetto prospettico"
 Me.Move(0, 0, Screen.AvailableWidth, Screen.AvailableHeight)
 Me.Arrangement = Arrange.Fill

 DrawingArea1.Background = Color.White

 Vertices = New Object[]
 Faces = New Object[]

 Dim phi As Float = (1 + Sqr(5)) / 2
 Dim a As Float = 1
 Dim b As Float = 1 / phi

' === 20 Vertici ===
 Vertices.Push([a, a, a])    ' 0
 Vertices.Push([a, a, -a])    ' 1
 Vertices.Push([a, -a, a])    ' 2
 Vertices.Push([a, -a, -a])    ' 3
 Vertices.Push([-a, a, a])    ' 4
 Vertices.Push([-a, a, -a])    ' 5
 Vertices.Push([-a, -a, a])    ' 6
 Vertices.Push([-a, -a, -a])    ' 7
 Vertices.Push([0, b, phi])  ' 8
 Vertices.Push([0, b, -phi])  ' 9
 Vertices.Push([0, -b, phi])  '10
 Vertices.Push([0, -b, -phi])  '11
 Vertices.Push([b, phi, 0])   '12
 Vertices.Push([b, -phi, 0])   '13
 Vertices.Push([-b, phi, 0])    '14
 Vertices.Push([-b, -phi, 0])   '15
 Vertices.Push([phi, 0, b])   '16
 Vertices.Push([phi, 0, -b])   '17
 Vertices.Push([-phi, 0, b])   '18
 Vertices.Push([-phi, 0, -b])   '19

' === 12 Facce pentagonali (5 vertici ciascuna) ===
 Faces.Push([0, 8, 10, 2, 16])
 Faces.Push([0, 16, 17, 1, 12])
 Faces.Push([0, 12, 14, 4, 8])
 Faces.Push([8, 4, 18, 6, 10])
 Faces.Push([10, 6, 15, 13, 2])
 Faces.Push([2, 13, 3, 17, 16])
 Faces.Push([1, 17, 3, 11, 9])
 Faces.Push([1, 9, 5, 14, 12])
 Faces.Push([4, 14, 5, 19, 18])
 Faces.Push([6, 18, 19, 7, 15])
 Faces.Push([3, 13, 15, 7, 11])
 Faces.Push([5, 9, 11, 7, 19])

 Timer1.Delay = 16
 Timer1.Start

End


Public Sub Timer1_Timer()

 angleX += 0.02
 angleY += 0.015
 DrawingArea1.Refresh

End


Public Sub DrawingArea1_Draw()

 Dim w As Integer = DrawingArea1.W
 Dim h As Integer = DrawingArea1.H
 Dim cx As Float = w / 2
 Dim cy As Float = h / 2
 Dim points As Object[] = New Object[]
 Dim rotatedZs As Float[] = New Float[Vertices.Count]      ' Per z-sorting

' === Proiezione isometrica: nessuna prospettiva ===
 For Each v As Float[] In Vertices
   Dim x, y, z As Float
   x = v[0]
   y = v[1]
   z = v[2]

' Rotazione attorno a X:
   Dim y1 As Float = y * Cos(angleX) - z * Sin(angleX)
   Dim z1 As Float = y * Sin(angleX) + z * Cos(angleX)
   y = y1
   z = z1

' Rotazione attorno a Y:
   Dim x1 As Float = x * Cos(angleY) + z * Sin(angleY)
   z1 = -x * Sin(angleY) + z * Cos(angleY)
   x = x1
   z = z1

   Dim sx As Float = cx + x * Zoom
   Dim sy As Float = cy - y * Zoom

   points.Push([sx, sy])
   rotatedZs[points.Max] = z    ' Salva profondità per z-sorting
 Next

' === Calcolo media z per ciascuna faccia ===:
 Dim FaceDepths As Float[] = New Float[Faces.Count]
 Dim i, j, tmp As Integer

 For i = 0 To Faces.Max
   Dim f As Integer[] = Faces[i]
   Dim sumZ As Float = 0
   For Each vi As Integer In f
     sumZ += rotatedZs[vi]
   Next
   FaceDepths[i] = sumZ / f.Count
 Next

' === Ordina facce dal fondo verso il fronte ===
 Dim order As Integer[] = New Integer[Faces.Count]
 For i = 0 To order.Max
   order[i] = i
 Next

 For i = 0 To order.Max - 1
   For j = i + 1 To order.Max
     If FaceDepths[order[i]] > FaceDepths[order[j]] Then
       tmp = order[i]
       order[i] = order[j]
       order[j] = tmp
     Endif
   Next
 Next

' === Disegna facce ordinate ===
 Paint.Brush = Paint.Color(Color.Black)
 For Each fi As Integer In order
    f = Faces[fi]
   For i = 0 To f.Count - 1
     Dim p1 As Float[] = points[f[i]]
     Dim p2 As Float[] = points[(f[(i + 1) Mod f.Count])]
     Paint.MoveTo(p1[0], p1[1])
     Paint.LineTo(p2[0], p2[1])
     Paint.Stroke
   Next
 Next

End


Public Sub Form_KeyPress()

 Select Case Key.Code
   Case Key["+"]
     Zoom = Min(Zoom + 25, 1000)
   Case Key["-"]
     Zoom = Max(Zoom - 25, 50)
 End Select

 DrawingArea1.Refresh

End