i'm searching an algo to link points each other

BlitzMax Forums/BlitzMax Beginners Area/i'm searching an algo to link points each other

hub (Posted 2010) [#1]

i've several points (x,y). But now how to determine and automatically draw only these white lines ? Thanks ! Last edited 2010

GW (Posted 2010) [#2]

Try this

Samichan (Posted 2010) [#3]

It's kinda huge but it works SuperStrict Graphics 800, 600 Local pointsarr:Float[] pointsarr:+[100.0, 100.0] pointsarr:+[300.0, 300.0] pointsarr:+[200.0, 400.0] pointsarr:+[600.0, 300.0] pointsarr:+[400.0, 100.0] pointsarr:+[450.0, 500.0] Local trianglearr:Float[] Local lastdttime:Int = MilliSecs() trianglearr = DelaunayTriangulate(pointsarr) lastdttime = (MilliSecs() - lastdttime) While Not (KeyDown(KEY_ESCAPE) Or AppTerminate()) Cls If MouseHit(1) pointsarr:+[Float(MouseX()), Float(MouseY())] lastdttime = MilliSecs() trianglearr = DelaunayTriangulate(pointsarr) lastdttime = (MilliSecs() - lastdttime) End If For Local I:Int = 0 To trianglearr.Length - 6 Step 6 drawpolyborder(trianglearr[I..][..6]) Next For Local I:Int = 0 To pointsarr.Length - 2 Step 2 DrawOval pointsarr[I] - 5, pointsarr[I + 1] - 5, 10, 10 Next DrawText "Click to add points", 5, 5 DrawText "Last triangulation took " + lastdttime + " ms", 5, 25 DrawText "Points count=" + Int(pointsarr.Length * 0.5), 5, 45 DrawText "Triangles count=" + Int(trianglearr.Length / 6), 5, 65 Flip Wend Function drawpolyborder(tri:Float[]) For Local I:Int = 0 To tri.Length - 3 Step 2 DrawLine tri[I], tri[I + 1], tri[I + 2], tri[I + 3] Next DrawLine tri[tri.Length - 2], tri[tri.Length - 1], tri[0], tri[1] End Function Function DelaunayTriangulate:Float[] (points:Float[]) Local vertcount:Int = points.Length * 0.5 Local vert_x:Float[vertcount] Local vert_y:Float[vertcount] Local tri_x1:Float[vertcount * 100] Local tri_y1:Float[tri_x1.Length] Local tri_x2:Float[tri_x1.Length] Local tri_y2:Float[tri_x1.Length] Local tri_x3:Float[tri_x1.Length] Local tri_y3:Float[tri_x1.Length] Local tri_alive:Float[tri_x1.Length] Local tri_cc_x:Float[tri_x1.Length] Local tri_cc_y:Float[tri_x1.Length] Local tri_cc_rad:Float[tri_x1.Length] Local counter_tri:Int = 1 For Local I:Int = 0 To vertcount - 1 vert_x[I] = points[I * 2] vert_y[I] = points[I * 2 + 1] Next Local minx:Float = 20000000 Local miny:Float = 20000000 Local maxx:Float = -20000000 Local maxy:Float = -20000000 For Local I:Int = 0 To vertcount - 1 If vert_x[I] < minx Then minx = vert_x[I] If vert_x[I] > maxx Then maxx = vert_x[I] If vert_y[I] < miny Then miny = vert_y[I] If vert_y[I] > maxy Then maxy = vert_y[I] Next Local midx:Float = minx + (maxx - minx) * 0.5 Local midy:Float = miny + (maxy - miny) * 0.5 minx = minx - midx maxx = maxx - midx miny = miny - midy maxy = maxy - midy Local supertriscale:Float = 1.1 minx:*supertriscale maxx:*supertriscale miny:*supertriscale maxy:*supertriscale Local supertrimaxy:Float = midy + miny - maxx * 1.7320508075688767 Local supertriminy:Float = midy + maxy Local supertrixmod:Float = ((midy + maxy) - supertrimaxy) * 0.57735026918962595 tri_x1[0] = midx tri_y1[0] = supertrimaxy tri_x2[0] = midx + supertrixmod tri_y2[0] = supertriminy tri_x3[0] = midx - supertrixmod tri_y3[0] = supertriminy tri_alive[0] = 1 GetTriangleCircumcenter(tri_x1[0], tri_y1[0], tri_x2[0], tri_y2[0], tri_x3[0], tri_y3[0], tri_cc_x[0], tri_cc_y[0]) tri_cc_rad[0] = Sqr((tri_x1[0] - tri_cc_x[0]) * (tri_x1[0] - tri_cc_x[0]) + (tri_y1[0] - tri_cc_y[0]) * (tri_y1[0] - tri_cc_y[0])) For Local I:Int = 0 To vert_x.Length - 1 Local killtricount:Int For Local K:Int = 0 To tri_x1.Length - 1 If tri_alive[K] If tri_alive[K] = 1 If Sqr((tri_cc_x[K] - vert_x[I]) * (tri_cc_x[K] - vert_x[I]) + (tri_cc_y[K] - vert_y[I]) * (tri_cc_y[K] - vert_y[I])) < tri_cc_rad[K] tri_alive[K] = 2 killtricount:+1 End If End If Else Exit End If Next Local bvertx:Float[killtricount * 3] Local bverty:Float[killtricount * 3] Local bvertcounter:Int Local bvertdouble:Byte For Local K:Int = 0 To tri_x1.Length - 1 If tri_alive[K] = 2 tri_alive[K] = 3 bvertdouble = 1 For Local A:Int = 0 To bvertcounter If (bvertx[A] = tri_x1[K]) And (bverty[A] = tri_y1[K]) Then bvertdouble = 0 Next If bvertdouble bvertx[bvertcounter] = tri_x1[K] bverty[bvertcounter] = tri_y1[K] bvertcounter:+1 End If bvertdouble = 1 For Local A:Int = 0 To bvertcounter If (bvertx[A] = tri_x2[K]) And (bverty[A] = tri_y2[K]) Then bvertdouble = 0 Next If bvertdouble bvertx[bvertcounter] = tri_x2[K] bverty[bvertcounter] = tri_y2[K] bvertcounter:+1 End If bvertdouble = 1 For Local A:Int = 0 To bvertcounter If (bvertx[A] = tri_x3[K]) And (bverty[A] = tri_y3[K]) Then bvertdouble = 0 Next If bvertdouble bvertx[bvertcounter] = tri_x3[K] bverty[bvertcounter] = tri_y3[K] bvertcounter:+1 End If End If Next Local tempxarr:Float[bvertcounter] Local tempyarr:Float[bvertcounter] For Local K:Int = 0 To bvertcounter - 1 tempxarr[K] = bvertx[K] tempyarr[K] = bverty[K] Next bvertx = tempxarr bverty = tempyarr Local anglesarr:Float[bvertcounter] For Local K:Int = 0 To bvertcounter - 1 anglesarr[K] = GetDirection(vert_x[I], vert_y[I], bvertx[K], bverty[K]) Next bvertx = sortarrbyarr_f_f(bvertx, anglesarr) bverty = sortarrbyarr_f_f(bverty, anglesarr) For Local K:Int = 0 To bvertcounter - 1 tri_x1[counter_tri] = vert_x[I] tri_y1[counter_tri] = vert_y[I] tri_x2[counter_tri] = bvertx[K] tri_y2[counter_tri] = bverty[K] If K = (bvertcounter - 1) tri_x3[counter_tri] = bvertx[0] tri_y3[counter_tri] = bverty[0] Else tri_x3[counter_tri] = bvertx[K + 1] tri_y3[counter_tri] = bverty[K + 1] End If tri_alive[counter_tri] = 1 GetTriangleCircumcenter(tri_x1[counter_tri], tri_y1[counter_tri], tri_x2[counter_tri], tri_y2[counter_tri], tri_x3[counter_tri], tri_y3[counter_tri], tri_cc_x[counter_tri], tri_cc_y[counter_tri]) tri_cc_rad[counter_tri] = Sqr((tri_x1[counter_tri] - tri_cc_x[counter_tri]) * (tri_x1[counter_tri] - tri_cc_x[counter_tri]) + (tri_y1[counter_tri] - tri_cc_y[counter_tri]) * (tri_y1[counter_tri] - tri_cc_y[counter_tri])) counter_tri:+1 Next Next For Local I:Int = 1 To tri_x1.Length - 1 If (tri_x1[I] = tri_x1[0]) And (tri_y1[I] = tri_y1[0]) Then tri_alive[I] = 3 If (tri_x2[I] = tri_x1[0]) And (tri_y2[I] = tri_y1[0]) Then tri_alive[I] = 3 If (tri_x3[I] = tri_x1[0]) And (tri_y3[I] = tri_y1[0]) Then tri_alive[I] = 3 If (tri_x1[I] = tri_x2[0]) And (tri_y1[I] = tri_y2[0]) Then tri_alive[I] = 3 If (tri_x2[I] = tri_x2[0]) And (tri_y2[I] = tri_y2[0]) Then tri_alive[I] = 3 If (tri_x3[I] = tri_x2[0]) And (tri_y3[I] = tri_y2[0]) Then tri_alive[I] = 3 If (tri_x1[I] = tri_x3[0]) And (tri_y1[I] = tri_y3[0]) Then tri_alive[I] = 3 If (tri_x2[I] = tri_x3[0]) And (tri_y2[I] = tri_y3[0]) Then tri_alive[I] = 3 If (tri_x3[I] = tri_x3[0]) And (tri_y3[I] = tri_y3[0]) Then tri_alive[I] = 3 Next Local finaltricount:Int For Local I:Int = 0 To tri_x1.Length - 1 If tri_alive[I] If tri_alive[I] = 1 finaltricount:+1 EndIf Else Exit End If Next Local finaltriarr:Float[finaltricount * 6] finaltricount = 0 For Local I:Int = 0 To tri_x1.Length - 1 If tri_alive[I] If tri_alive[I] = 1 finaltriarr[finaltricount] = tri_x1[I] finaltriarr[finaltricount + 1] = tri_y1[I] finaltriarr[finaltricount + 2] = tri_x2[I] finaltriarr[finaltricount + 3] = tri_y2[I] finaltriarr[finaltricount + 4] = tri_x3[I] finaltriarr[finaltricount + 5] = tri_y3[I] finaltricount:+6 EndIf Else Exit End If Next Return finaltriarr End Function Function GetTriangleCircumcenter(x1:Float, y1:Float, x2:Float, y2:Float, x3:Float, y3:Float, VERTX:Float var, VERTY:Float var) If y1 = y2 If x2 = x3 VERTX = x1 + (x2 - x1) * 0.5 VERTY = y2 + (y3 - y2) * 0.5 Else VERTX = x1 + (x2 - x1) * 0.5 Local line2_m:Float = -1.0 / ((y3 - y2) / (x3 - x2)) Local line2_c:Float = -(x2 + (x3 - x2) * 0.5) * line2_m + y2 + (y3 - y2) * 0.5 VERTY = line2_c + line2_m * VERTX End If ElseIf y2 = y3 If x1 = x2 VERTX = x2 + (x3 - x2) * 0.5 VERTY = y1 + (y2 - y1) * 0.5 Else VERTX = x2 + (x3 - x2) * 0.5 Local line1_m:Float = -1.0 / ((y2 - y1) / (x2 - x1)) Local line1_c:Float = -(x1 + (x2 - x1) * 0.5) * line1_m + y1 + (y2 - y1) * 0.5 VERTY = line1_c + line1_m * VERTX End If Else Local line1_m:Float = -1.0 / ((y2 - y1) / (x2 - x1)) Local line2_m:Float = -1.0 / ((y3 - y2) / (x3 - x2)) Local line1_c:Float = -(x1 + (x2 - x1) * 0.5) * line1_m + y1 + (y2 - y1) * 0.5 Local line2_c:Float = -(x2 + (x3 - x2) * 0.5) * line2_m + y2 + (y3 - y2) * 0.5 lineintersectpoint(line1_m, line1_c, line2_m, line2_c, VERTX, VERTY) End If End Function Function GetDirection:Float(fromx:Float, fromy:Float, tox:Float, toy:Float) Local angle:Float = ATan2(toy - fromy, tox - fromx) If angle < 0 Then angle:+360.0 Return angle End Function Function sortarrbyarr_f_f:Float[] (iarr:Float[], farr:Float[], bigtosmall:Byte = 0) If iarr If farr If iarr.Length > 1 If iarr.Length = farr.Length If bigtosmall Local usedarr:Byte[iarr.Length] Local retarr:Float[iarr.Length] For Local I:Int = 0 To iarr.Length - 1 Local maxval:Float = -20000000.0 Local maxspot:Int For Local K:Int = 0 To iarr.Length - 1 If Not usedarr[K] If farr[K] > maxval maxval = farr[K] maxspot = K End If End If Next usedarr[maxspot] = 1 retarr[I] = iarr[maxspot] Next Return retarr Else Local usedarr:Byte[iarr.Length] Local retarr:Float[iarr.Length] For Local I:Int = 0 To iarr.Length - 1 Local minval:Float = 20000000.0 Local minspot:Int For Local K:Int = 0 To iarr.Length - 1 If Not usedarr[K] If farr[K] < minval minval = farr[K] minspot = K End If End If Next usedarr[minspot] = 1 retarr[I] = iarr[minspot] Next Return retarr End If End If End If End If End If Return iarr End Function Function lineintersectpoint(l1m:Float, l1c:Float, l2m:Float, l2c:Float, px:Float var, py:Float var) If l1m = l2m Then Return px = (l2c - l1c) / (l1m - l2m) py = l1m * px + l1c End Function

hub (Posted 2010) [#4]

Many thanks for this GW and Samichan this is my try but not work (from a vb french program) !!! Strict Graphics 1024, 768 'Points 3D(Sommets) Type Tpoint Field x# Field y# End Type 'Triangles, S# sont les sommets du triangle (3) Type dTriangle Field S#[2+1] End Type 'Definis le nombre maxi de triangles et sommets Const MaxSommets = 500 Const MaxTriangles = 1000 'Nos points Global Sommet:Tpoint[MaxSommets+1] ' Nombre de points definis par "click" dans le controle picture BOX Global tPoints:Int 'Tableau contenat les triangles crees Global Triangle:dTriangle[MaxTriangles+1] For Local n=0 To MaxTriangles Triangle[n] = New dTriangle ' For Local m=0 To 2 ' TRiangle[n].s[m] = 0 'New TFloat ' Next Next For Local n=0 To MaxSommets Sommet[n] = New Tpoint Next ' programme. SeedRnd MilliSecs() tPoints= 5 Sommet[1].x = Rand (0,500) Sommet[1].y = Rand (0,500) Sommet[2].x = Rand (0,500) Sommet[2].y = Rand (0,500) Sommet[3].x = Rand (0,500) Sommet[3].y = Rand (0,500) Sommet[4].x = Rand (0,500) Sommet[4].y = Rand (0,500) Sommet[5].x = Rand (0,500) Sommet[5].y = Rand (0,500) Local tTriangles tTriangles = Triangulation(tPoints) Notify tTriangles While Not KeyDown (Key_ESCAPE) For Local I = 1 To tTriangles SetColor 255,255,255 DrawLine Sommet[Triangle[I].S[0]].x, Sommet[Triangle[I].S[0]].y ,Sommet[Triangle[I].S[1]].x, Sommet[Triangle[I].S[1]].y DrawLine Sommet[Triangle[I].S[1]].x, Sommet[Triangle[I].S[1]].y ,Sommet[Triangle[I].S[2]].x, Sommet[Triangle[I].S[2]].y DrawLine Sommet[Triangle[I].S[0]].x, Sommet[Triangle[I].S[0]].y ,Sommet[Triangle[I].S[2]].x, Sommet[Triangle[I].S[2]].y Next For Local i=1 To tPoints SetColor 255,0,0 Plot Sommet[i].x, Sommet[i].y Next Flip Wend Function DansLeCercle:Int(Pp:Tpoint, P1:Tpoint, P2:Tpoint, P3:Tpoint, Pc:Tpoint Var , R# Var ) 'Retourne True si le point Pp est inscrit dans le cercle definis par 'les points P1, P2,P3 'le centre du cercle circonscrit ansi que son rayon (r) et retourne par la fonction (Pc) 'NOTE: un point sur un sommet est dans le cercle circonscrit Local eps# Local m1# Local m2# Local mx1# Local mx2# Local my1# Local my2# Local Dx# Local Dy# Local rsqr# Local drsqr# ' distance mini entre points eps = 0.000001 ' controle distance mini If Abs(P1.y - P2.y) < eps And Abs(P2.y - P3.y) < eps Then Notify "INCIRCUM - F - Points are coincident !!" End End If If Abs(P2.y - P1.y) < eps Then m2 = -(P3.x - P2.x) / (P3.y - P2.y) mx2 = (P2.x + P3.x) / 2 my2 = (P2.y + P3.y) / 2 Pc.x = (P2.x + P1.x) / 2 Pc.y = m2 * (Pc.x - mx2) + my2 ElseIf Abs(P3.y - P2.y) < eps Then m1 = -(P2.x - P1.x) / (P2.y - P1.y) mx1 = (P1.x + P2.x) / 2 my1 = (P1.y + P2.y) / 2 Pc.x = (P3.x + P2.x) / 2 Pc.y = m1 * (Pc.x - mx1) + my1 Else m1 = -(P2.x - P1.x) / (P2.y - P1.y) m2 = -(P3.x - P2.x) / (P3.y - P2.y) mx1 = (P1.x + P2.x) / 2 mx2 = (P2.x + P3.x) / 2 my1 = (P1.y + P2.y) / 2 my2 = (P2.y + P3.y) / 2 Pc.x = (m1 * mx1 - m2 * mx2 + my2 - my1) / (m1 - m2) Pc.y = m1 * (Pc.x - mx1) + my1 End If Dx = P2.x - Pc.x Dy = P2.y - Pc.y rsqr = Dx * Dx + Dy * Dy R = Sqr(rsqr) Dx = Pp.x - Pc.x Dy = Pp.y - Pc.y drsqr = Dx ^ 2 + Dy ^ 2 If drsqr <= rsqr Then Return True Else Return False End If End Function Function Triangulation:Int(NSommet:Int) 'Utilise le tableau Sommet definis en public 'Retourne le nombre de triangles cree ' Les triangles sont stocke dans le tableau Triangle(). Local Traite:Int [MaxTriangles] Local Aretes:Float [2+1, MaxTriangles * 3+1] Local NArete# 'Pour le Super Triangle Local PMin:Tpoint Local PMax:Tpoint Local PMil:Tpoint Local Dx# 'Distance X Local Dy# 'Distance Y Local Dmax# ' DistanceMax 'Varialbles generales Local I:Int Local J:Int Local K:Int Local Ntri:Int Local Pc:Tpoint ' point de centre Local R# ' Rayon Pc:Tpoint = New Tpoint 'Cherche les sommets maxi et mini PMin:Tpoint = New Tpoint PMin.x = Sommet[1].x PMin.y = Sommet[1].y Pmax:Tpoint = New Tpoint PMax.x = PMin.x PMax.y = PMin.y For I = 2 To NSommet If Sommet[I].x < PMin.x Then PMin.x = Sommet[I].x If Sommet[I].x > PMax.x Then PMax.x = Sommet[I].x If Sommet[I].y < PMin.y Then PMin.y = Sommet[I].y If Sommet[I].y > PMax.y Then PMax.y = Sommet[I].y Next 'I ' Calcul des dimenssion de la boite Maxi Dx = PMax.x - PMin.x Dy = PMax.y - PMin.y If Dx > Dy Then Dmax = Dx Else Dmax = Dy End If ' calcul du point milieu pMil:Tpoint = New Tpoint PMil.x = (PMax.x + PMin.x) / 2 PMil.y = (PMax.y + PMin.y) / 2 ' Creation du Super Triangle ' Le Super triangle est le triangle qui englobe tous les points ' Les sommets du SuperTriangle sont ajoutes à la fin de la liste des sommets. ' Le Supertrinagle est le premier triangle dans la liste des triangles. Sommet[NSommet + 1].x = PMil.x - 2 * Dmax Sommet[NSommet + 1].y = PMil.y - Dmax Sommet[NSommet + 2].x = PMil.x Sommet[NSommet + 2].y = PMil.y + 2 * Dmax Sommet[NSommet + 3].x = PMil.x + 2 * Dmax Sommet[NSommet + 3].y = PMil.y - Dmax Triangle[1].S[0] = NSommet + 1 Triangle[1].S[1] = NSommet + 2 Triangle[1].S[2] = NSommet + 3 Traite[1] = False Ntri = 1 'Ajout chaque point dans le maillage existant For I = 1 To NSommet NArete = 0 'Creation du tableau de traitement des aretes. 'Si le point (Sommet(i)) se trouve à l'interieur à l'interieur du cercle passant 'par les sommets du triangle alors 3 arretes sont ajoute dans la liste des arretes J = 0 Repeat J = J + 1 If Traite[J] <> True Then If DansLeCercle(Sommet[I], Sommet[Triangle[J].S[0]], Sommet[Triangle[J].S[1]], Sommet[Triangle[J].S[2]], Pc, R) Then Aretes[1, NArete + 1] = Triangle[J].S[0] Aretes[2, NArete + 1] = Triangle[J].S[1] Aretes[1, NArete + 2] = Triangle[J].S[1] Aretes[2, NArete + 2] = Triangle[J].S[2] Aretes[1, NArete + 3] = Triangle[J].S[2] Aretes[2, NArete + 3] = Triangle[J].S[0] NArete = NArete + 3 Triangle[J].S[0] = Triangle[Ntri].S[0] Triangle[J].S[1] = Triangle[Ntri].S[1] Triangle[J].S[2] = Triangle[Ntri].S[2] Traite[J] = Traite[Ntri] J = J - 1 Ntri = Ntri - 1 End If End If Until J < Ntri +1 'Supression des aretes double For J = 1 To NArete - 1 If Not Aretes[1, J] = 0 And Not Aretes[2, J] = 0 Then For K = J + 1 To NArete If Not Aretes[1, K] = 0 And Not Aretes[2, K] = 0 Then If Aretes[1, J] = Aretes[2, K] Then If Aretes[2, J] = Aretes[1, K] Then Aretes[1, J] = 0 Aretes[2, J] = 0 Aretes[1, K] = 0 Aretes[2, K] = 0 End If End If End If Next 'K End If Next 'J 'Creation de nouveaux triangles pour le point courant 'en filtrant les aretes nul For J = 1 To NArete If Not Aretes[1, J] = 0 And Not Aretes[2, J] = 0 Then Ntri = Ntri + 1 Triangle[Ntri].S[0] = Aretes[1, J] Triangle[Ntri].S[1] = Aretes[2, J] Triangle[Ntri].S[2] = I End If Next 'J Next 'I 'Enleve les trinagles qui ont un sommet commun avec le Supertriangle 'Ce sont les triangles qui ont un indice de sommet superieur a NSommet I = 0 Repeat I = I + 1 If Triangle[I].S[0] > NSommet Or Triangle[I].S[1] > NSommet Or Triangle[I].S[2] > NSommet Then Triangle[I].S[0] = Triangle[Ntri].S[0] Triangle[I].S[1] = Triangle[Ntri].S[1] Triangle[I].S[2] = Triangle[Ntri].S[2] I = I - 1 Ntri = Ntri - 1 End If Until I < Ntri + 1 Return NTri End Function Last edited 2010

hub (Posted 2010) [#5]

yes !