Code archives/3D Graphics - Mesh/weld routine performance improvement
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
Some usefull technics to optmize search vertex. See function "findvert" in the code for more details | |||||
;-------------------------------------------------------------------------------------------------------- ;-------------------------------------------------------------------------------------------------------- ; ID: 433 ; Author: TeraBit ; Date: 2002-09-20 06:39:22 ; Title: PaintTriangle ; Description: A Function to Paint Individual Triangles ; Paint Triangle Function ; By Lee Page ; TeraBit Software ; PaintTriangle(Mesh, Surface, TriangleIndex, Brush) ; Mesh Must be UnWelded using the Unweld(Mesh) function. Type TRIS Field x0# Field y0# Field z0# Field u0# Field v0# Field U20# Field V20# Field x1# Field y1# Field z1# Field u1# Field v1# Field U21# Field V21# Field x2# Field y2# Field z2# Field u2# Field v2# Field U22# Field V22# Field surface End Type Dim b(2) Dim txv(3) Dim vt(1) ; this array stores the x,y,z values of each vertex just to check if the vertex exists or not Graphics3D 640,480,0,2 cam = CreateCamera() PositionEntity cam,0,0,-5 sph = CreateSphere(64) EntityColor sph,128,128,128 RotateMesh sph,45,45,0 EntityFX sph,16 EntityPickMode sph,2 lit = CreateLight(1) PositionEntity lit,5,-5,3 ;*********************************** ;b(0) = LoadBrush ("media\b3dlogo.jpg") ; *Substitute your own ones* ;b(1) = LoadBrush ("media\MossyGround.BMP") ; *Substitute your own ones* ;b(2) = LoadBrush ("media\sky.bmp") ; *Substitute your own ones* b(0) = CreateBrush(255,0,0) b(1) = CreateBrush(0,255,0) b(2) = CreateBrush(0,0,255) ;*********************************** weld = True : weldtext$ = "weld" Gosub count While Not KeyDown(1) If KeyHit(78) And bno<2 Then bno=bno + 1 If KeyHit(74) And bno >0 Then bno=bno - 1 If MouseHit(1) Then psf = CameraPick(cam,MouseX(),MouseY()) If psf<>0 Then psf = PickedSurface() ind = PickedTriangle() PaintTriangle(sph,psf,ind,b(bno)) EndIf weld = False : : weldtext = "unweld" Gosub count EndIf If MouseHit(2) = 1 If weld = True Then unweld(sph) : weld = False : weldtext = "unweld" Else t1 = MilliSecs() weld(sph) : weld = True : weldtext = "weld" temps = MilliSecs() - t1 EndIf Gosub count EndIf TurnEntity sph,0,0.1,0 UpdateWorld RenderWorld Color 0,0,255 Oval MouseX(),MouseY(),5,5,False Color 255,255,255 Text 10,0, "Brush : "+bno+" of 2." Text 10,15, "Use + or - on Keypad : Change Brush" Text 10,30, "click mouse left button : color with brush on triangle" Text 10,45, "click mouse right button : weld/unweld" Text 10,60, "weld/unweld status : " + weldtext Text 10,80, "statistics : surf = " + surf + " vetrices = " + ver + " triangles = " + tri Text 10,100,"weld computation time : " + temps Flip Wend End .count ver = 0 tri = 0 surf = CountSurfaces(sph) For i = 1 To surf su = GetSurface(sph,i) ver = ver + CountVertices( su) tri = tri + CountTriangles( su) Next UpdateNormals sph Return Function unWeld(mish) For vq.tris = Each tris Delete vq Next For nsurf = 1 To CountSurfaces(mish) su=GetSurface(mish,nsurf) For tq = 0 To CountTriangles(su)-1 txv0 = TriangleVertex(su,tq,0) txv1 = TriangleVertex(su,tq,1) txv2 = TriangleVertex(su,tq,2) vq.TRIS = New TRIS vq\x0# = VertexX(su,txv0) vq\y0# = VertexY(su,txv0) vq\z0# = VertexZ(su,txv0) vq\u0# = VertexU(su,txv0,0) vq\v0# = VertexV(su,txv0,0) vq\u20# = VertexU(su,txv0,1) vq\v20# = VertexV(su,txv0,1) vq\x1# = VertexX(su,txv1) vq\y1# = VertexY(su,txv1) vq\z1# = VertexZ(su,txv1) vq\u1# = VertexU(su,txv1,0) vq\v1# = VertexV(su,txv1,0) vq\u21# = VertexU(su,txv1,1) vq\v21# = VertexV(su,txv1,1) vq\x2# = VertexX(su,txv2) vq\y2# = VertexY(su,txv2) vq\z2# = VertexZ(su,txv2) vq\u2# = VertexU(su,txv2,0) vq\v2# = VertexV(su,txv2,0) vq\u22# = VertexU(su,txv2,1) vq\v22# = VertexV(su,txv2,1) Next ClearSurface su For vq.tris = Each tris AddVertex su,vq\x0#,vq\y0#,vq\z0#,vq\u0#,vq\v0# VertexTexCoords su,mycount,vq\u20#,vq\v20#,0,1 mycount = mycount +1 AddVertex su,vq\x1#,vq\y1#,vq\z1#,vq\u1#,vq\v1# VertexTexCoords su,mycount,vq\u21#,vq\v21#,0,1 mycount = mycount +1 AddVertex su,vq\x2#,vq\y2#,vq\z2#,vq\u2#,vq\v2# VertexTexCoords su,mycount,vq\u22#,vq\v22#,0,1 mycount = mycount +1 AddTriangle su,mycount-3,mycount-2,mycount-1 Next For vq.tris = Each tris Delete vq Next mycount=0 Next End Function Function PaintTriangle(PMesh, Surfhand, Trindex, Pbrush) dest = FindSurface(pmesh,pbrush) If dest = 0 Then dest = CreateSurface(pmesh,pbrush) vertind = CountVertices(dest) For p=0 To 2 vx# = VertexX(Surfhand,TriangleVertex(Surfhand,trindex,p)) vy# = VertexY(Surfhand,TriangleVertex(Surfhand,trindex,p)) vZ# = VertexZ(Surfhand,TriangleVertex(Surfhand,trindex,p)) u# = VertexU(Surfhand,TriangleVertex(surfhand,trindex,p),0) V# = VertexV(Surfhand,TriangleVertex(surfhand,trindex,p),0) lmu# = VertexU(Surfhand,TriangleVertex(Surfhand,trindex,p),1) lmV# = VertexV(Surfhand,TriangleVertex(Surfhand,trindex,p),1) AddVertex dest,vx#,vy#,vz# VertexTexCoords dest,vertind+p,U#,v#,0,0 VertexTexCoords dest,vertind+p,lmu#,lmv#,0,1 Next vertind = CountVertices(dest)-3 AddTriangle dest,vertind,vertind+1,vertind+2 removetri(Surfhand,trindex) UpdateNormals pmesh End Function Function RemoveTRI(su,TRIGONE) For vq.tris = Each tris Delete vq Next For tq = 0 To CountTriangles(su)-1 txv0 = TriangleVertex(su,tq,0) txv1 = TriangleVertex(su,tq,1) txv2 = TriangleVertex(su,tq,2) If tq <> TRIGONE Then vq.TRIS = New TRIS vq\x0# = VertexX(su,txv0) vq\y0# = VertexY(su,txv0) vq\z0# = VertexZ(su,txv0) vq\u0# = VertexU(su,txv0,0) vq\v0# = VertexV(su,txv0,0) vq\u20# = VertexU(su,txv0,1) vq\v20# = VertexV(su,txv0,1) vq\x1# = VertexX(su,txv1) vq\y1# = VertexY(su,txv1) vq\z1# = VertexZ(su,txv1) vq\u1# = VertexU(su,txv1,0) vq\v1# = VertexV(su,txv1,0) vq\u21# = VertexU(su,txv1,1) vq\v21# = VertexV(su,txv1,1) vq\x2# = VertexX(su,txv2) vq\y2# = VertexY(su,txv2) vq\z2# = VertexZ(su,txv2) vq\u2# = VertexU(su,txv2,0) vq\v2# = VertexV(su,txv2,0) vq\u22# = VertexU(su,txv2,1) vq\v22# = VertexV(su,txv2,1) EndIf Next ClearSurface su For vq.tris = Each tris AddVertex su,vq\x0#,vq\y0#,vq\z0#,vq\u0#,vq\v0# VertexTexCoords su,mycount,vq\u20#,vq\v20#,0,1 mycount = mycount +1 AddVertex su,vq\x1#,vq\y1#,vq\z1#,vq\u1#,vq\v1# VertexTexCoords su,mycount,vq\u21#,vq\v21#,0,1 mycount = mycount +1 AddVertex su,vq\x2#,vq\y2#,vq\z2#,vq\u2#,vq\v2# VertexTexCoords su,mycount,vq\u22#,vq\v22#,0,1 mycount = mycount +1 AddTriangle su,mycount-3,mycount-2,mycount-1 Next For vq.tris = Each tris Delete vq Next End Function ; ID: 454 ; Author: TeraBit ; Date: 2002-10-09 10:11:10 ; Title: Weld() ; Description: Weld a mesh's Vertices Function Weld(mish) RenderWorld : Text GraphicsWidth()/2,GraphicsHeight()/2,"Optimising Please Wait..",True,True : Flip nbSurf = CountSurfaces(mish) For nsurf = 1 To nbSurf For vq.tris = Each tris Delete vq Next su=GetSurface(mish,nsurf) ntris = CountTriangles(su) Dim vt((ntris)*3) ntris = ntris-1 For tq = 0 To ntris txv0 = TriangleVertex(su,tq,0) txv1 = TriangleVertex(su,tq,1) txv2 = TriangleVertex(su,tq,2) vq.TRIS = New TRIS vq\x0# = VertexX(su,txv0) vq\y0# = VertexY(su,txv0) vq\z0# = VertexZ(su,txv0) vq\u0# = VertexU(su,txv0,0) vq\v0# = VertexV(su,txv0,0) vq\u20# = VertexU(su,txv0,1) vq\v20# = VertexV(su,txv0,1) vq\x1# = VertexX(su,txv1) vq\y1# = VertexY(su,txv1) vq\z1# = VertexZ(su,txv1) vq\u1# = VertexU(su,txv1,0) vq\v1# = VertexV(su,txv1,0) vq\u21# = VertexU(su,txv1,1) vq\v21# = VertexV(su,txv1,1) vq\x2# = VertexX(su,txv2) vq\y2# = VertexY(su,txv2) vq\z2# = VertexZ(su,txv2) vq\u2# = VertexU(su,txv2,0) vq\v2# = VertexV(su,txv2,0) vq\u22# = VertexU(su,txv2,1) vq\v22# = VertexV(su,txv2,1) Next ClearSurface su mycount=0 For vq.tris = Each tris vt1=Findvert(vq\x0#,vq\y0#,vq\z0#,mycount) If vt1=-1 Then vt(mycount) = vq\x0#*1000 + vq\y0#*1000000 + vq\z0#*1000000000 ; storage of real values as 1 integer value AddVertex su,vq\x0#,vq\y0#,vq\z0#,vq\u0#,vq\v0# VertexTexCoords su,mycount,vq\u20#,vq\v20#,0,1 vt1 = mycount mycount = mycount +1 EndIf vt2=Findvert(vq\x1#,vq\y1#,vq\z1#,mycount) If Vt2=-1 Then vt(mycount) = vq\x1#*1000 + vq\y1#*1000000 + vq\z1#*1000000000 ; storage of real values as 1 integer value AddVertex su,vq\x1#,vq\y1#,vq\z1#,vq\u1#,vq\v1# VertexTexCoords su,mycount,vq\u21#,vq\v21#,0,1 vt2 = mycount mycount = mycount +1 EndIf vt3=Findvert(vq\x2#,vq\y2#,vq\z2#,mycount) If vt3=-1 Then vt(mycount) = vq\x2#*1000 + vq\y2#*1000000 + vq\z2#*1000000000 ; storage of real values as 1 integer value AddVertex su,vq\x2#,vq\y2#,vq\z2#,vq\u2#,vq\v2# VertexTexCoords su,mycount,vq\u22#,vq\v22#,0,1 vt3 = mycount mycount = mycount +1 EndIf AddTriangle su,vt1,vt2,vt3 Next Next Dim vt(1) For vq.tris = Each tris Delete vq Next End Function ; Some usefull technics to optmize saerch in vertex ; ; The control needed is only on x,y,z because it is the position of vertex which is the most important ; The value are stored into an array insted of search it into the 3d model. ; It saves : 22881 ms => 4571 ms ; ; The search is better if you don't follow the sequence order : but search as described in the function ; It is seems that the ramdom is better than the sequence !!! ; it saves : 4571 ms => 2900 ms ; ; an integer array is used : comparison of integer value is faster than comparison between real value in the array ; it saves : 2900 ms => 1565 ms Function findvert(x#,y#,z#,max) xx = x# * 1000 + y# * 1000000 + z# * 1000000000 For j = 0 To 9 For t=j To max Step 10 If vt(t)=xx Then Return t EndIf Next Next Return -1 End Function |
Comments
None.
Code Archives Forum