home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / w3dvb5 / triangl.bas < prev    next >
Encoding:
BASIC Source File  |  1997-12-22  |  5.1 KB  |  169 lines
  1. Attribute VB_Name = "TRIANGL"
  2. ' Modulo per la triangolazione di poligoni.
  3. ' Qui viene scomposta una matrice di poligoni "convessi"
  4. ' in un'altra fatta di soli triangoli.
  5.  
  6. Type Trianrs
  7.   a As Integer
  8.   b As Integer
  9.   C As Integer
  10. End Type
  11.  
  12. Function Triangul(pol() As Integer, n As Integer, nrs() As Trianrs, Ori As Integer) As Integer
  13. '/* TRIANGUL: Triangolazione di poligoni
  14. '      Triangolazione di un poligono con numeri di vertice consecutivi
  15. '      pol[0],..., pol[n-1], in senso antiorario.
  16. '      Dati tre numeri di vertice P, Q, R, la funzione orienta deve
  17. '      determinare il loro orientamento:
  18. '      Negativo = in senso orario
  19. '      Zero     = sulla stessa linea
  20. '      Positivo = in senso antiorario
  21. '      Se la triangolazione Φ possibile, i triangoli risultanti
  22. '      sono memorizzati in successione nell'array 'nrs'. Il triangolo j ha
  23. '      numeri di vertice nrs[j].A, nrs[j].B, nrs[j].C.
  24. '      Lo spazio in memoria per l'array 'nrs' deve essere fornito dalla
  25. '      funzione chiamante.
  26. '      Valore restituito:
  27. '            il numero dei triangoli trovati, oppure
  28. '            -1 se il poligono non Φ adatto o i vertici sono in senso orario.
  29. '            -2: memoria insufficiente.
  30. '*/
  31.  
  32. 'int triangul(int *pol, int n, trianrs *nrs,
  33. '             int orienta(int P, int Q, int R))
  34.    Dim Ptr() As Integer
  35.    Dim ort() As Integer
  36.    Dim q As Integer, qA As Integer, qB As Integer, qC As Integer, r As Integer '  -1 usato come 'NULL'
  37.    Dim i As Integer, i1 As Integer, i2 As Integer, j As Integer, k As Integer, m As Integer, ok As Integer, ortB As Integer, Polconvex  As Integer
  38.    Dim a As Integer, b As Integer, C As Integer, p As Integer, collinear As Integer
  39.     
  40.    r = -1
  41.    Polconvex = True
  42.     
  43.     If n < 3 Then
  44.        Triangul = -1 ' // Nessun poligono
  45.        Exit Function
  46.     End If
  47.  
  48.     If n = 3 Then
  49.       nrs(0).a = pol(0)
  50.       nrs(0).b = pol(1)
  51.       nrs(0).C = pol(2)
  52.       Triangul = 1   ' // Solo un triangolo
  53.       Exit Function
  54.     End If
  55.     
  56.     ReDim ort(n) ' // ort[i] = 1 se il vertice i Φ convesso
  57.     
  58.     Do
  59.       collinear = False
  60.        For i = 0 To n - 1
  61.           If i < n - 1 Then i1 = i + 1 Else i1 = 0
  62.           If i1 < n - 1 Then i2 = i1 + 1 Else i2 = 0
  63.           ort(i1) = orienta(pol(i), pol(i1), pol(i2))
  64.           If ort(i1) = 0 Then
  65.             collinear = True
  66.             For j = i1 To n - 1
  67.                 pol(j) = pol(j + 1)
  68.             Next j
  69.             n = n - 1
  70.             Exit For
  71.           End If
  72.           If ort(i1) < 1 Then Polconvex = False
  73.         Next i
  74.     Loop While collinear
  75.     
  76.     If n < 3 Then
  77.        Triangul = -1
  78.        Exit Function
  79.     End If
  80.  
  81.  
  82.     If Polconvex Then          '  // Usa le diagonali passanti per il vertice 0:
  83.        For j = 0 To n - 2
  84.           nrs(j).a = pol(0)
  85.           nrs(j).b = pol(j + 1)
  86.           nrs(j).C = pol(j + 2)
  87.        Next
  88.        
  89.        Erase ort
  90.        Triangul = n - 2
  91.        Exit Function
  92.     End If
  93.  
  94.     ReDim Ptr(n)
  95.  
  96.    ' // Crea una lista concatenata circolare con i numeri di vertice:
  97.     
  98.     For i = 1 To n - 1: Ptr(i - 1) = i: Next i
  99.     
  100.     Ptr(n - 1) = 0
  101.     q = 0
  102.     qA = Ptr(q)
  103.     qB = Ptr(qA)
  104.     qC = Ptr(qB)
  105.     j = 0            '  // j triangoli memorizzati fino a questo punto
  106.     
  107.     For m = n To 3 Step -1 ' // m nodi restanti nella lista circolare.
  108.       For k = 0 To m
  109.        '  // Prova con il triangolo ABC:
  110.           ortB = ort(qB)
  111.           ok = False
  112.        '   // B Φ un candidato, se Φ convesso:
  113.           If (ortB > 0) Then
  114.              a = pol(qA)
  115.              b = pol(qB)
  116.              C = pol(qC)
  117.              ok = True
  118.              r = Ptr(qC)
  119.              Do While r <> qA And ok
  120.                 p = pol(r)     ' // ABC in senso antiorario:
  121.                 ok = p = a Or p = b Or p = C Or orienta(a, b, p) < 0 Or orienta(b, C, p) < 0 Or orienta(C, a, p) < 0
  122.                 r = Ptr(r)
  123.              Loop
  124.           '   // ok significa: P coincidente con A, B o C
  125.           '   //           oppure esterno ad ABC
  126.              If ok Then
  127.                nrs(j).a = pol(qA)
  128.                nrs(j).b = pol(qB)
  129.                nrs(j).C = pol(qC)
  130.                j = j + 1
  131.              End If
  132.           End If
  133.           
  134.           If (ok Or ortB = 0) Then
  135.          ' {  // Elimina il trianglolo ABC dal poligono:
  136.              Ptr(qA) = qC
  137.              qB = qC
  138.              qC = Ptr(qC)
  139.              If ort(qA) < 1 Then ort(qA) = orienta(pol(q), pol(qA), pol(qB))
  140.              If ort(qB) < 1 Then ort(qB) = orienta(pol(qA), pol(qB), pol(qC))
  141.              Do While ort(qA) = 0 And m > 2
  142.                 Ptr(q) = qB
  143.                 qA = qB
  144.                 qB = qC
  145.                 qC = Ptr(qC)
  146.                 m = m - 1
  147.              Loop
  148.              Do While ort(qB) = 0 And m > 2
  149.                Ptr(qA) = qC
  150.                qB = qC
  151.                qC = Ptr(qC)
  152.                m = m - 1
  153.              Loop
  154.  
  155.              Exit For
  156.           
  157.           End If
  158.           
  159.           q = qA
  160.           qA = qB
  161.           qB = qC
  162.           qC = Ptr(qC)
  163.        Next
  164.    Next
  165.    Triangul = j ' // j N░ triangoli
  166.  
  167. End Function
  168.  
  169.