Another arrow mesh creation function

Everything related to 3D programming
User avatar
Psychophanta
Addict
Addict
Posts: 4975
Joined: Wed Jun 11, 2003 9:33 pm
Location: Lípetsk, Russian Federation
Contact:

Another arrow mesh creation function

Post by Psychophanta »

Another arrow mesh creation function (versatile)
With test and examples.

Code: Select all

;/ inits
If ExamineDesktops()=0:End:EndIf
Global bitplanes.a=DesktopDepth(0),FRX.u=DesktopWidth(0),FRY.u=DesktopHeight(0),RX.u=FRX,RY.u=FRY,FrecuenciadeMuestreo.u=60
If FRX<1280 Or FRY<720:RX=FRX*2/3:RY=FRY*2/3:Else:RX=1280:RY=720:EndIf
If InitEngine3D()=0
  MessageRequester("Error","The 3D Engine can't be initialized",0):End
EndIf
InitSprite():InitKeyboard():InitMouse()
OpenWindow(0,0,0,RX,RY,"cuerpo TID",#PB_Window_BorderLess|#PB_Window_ScreenCentered)
OpenWindowedScreen(WindowID(0),0,0,RX,RY,0,0,0,#PB_Screen_WaitSynchronization)
Add3DArchive(#PB_Compiler_Home + "examples/3d/Data/Textures", #PB_3DArchive_FileSystem)
luz.i=0:camara.i=0:pivotcamara.i=0:Texture.i=0:material.i=0:mallaTor.i=0:Tor.i=0
;\
Procedure.i flecha(malla.i,l.i=4,lt.i=20,r0.f=0.4,r1.f=0.4,at.f=1,torsion.f=0,toffset.f=0,posicion.f=0.5,radiocono.f=1.4,despl.f=2,desp.f=-0.05)
  Protected vertx.f,verty.f,vertz.f,a.i,b.i,p.f,v.f,offset.i=0,initoffset.f=toffset.f
  If l<1 Or lt<1 Or r0<0 Or r1<0:ProcedureReturn -2:EndIf
  CreateMesh(malla.i,#PB_Mesh_TriangleList,#PB_Mesh_Static)
  ;l = numero de lados en la seccion (number of sides in cut-area)
  ;lt = numero de segmentos
  ;r0 = radio grosor inicial (radius of cut area at initial extreme)
  ;r1 = radio grosor final (radius of cut area at end extreme)
  ;at = altura
  ;torsion = (torsion)
  ;toffset = (initial offset of the starting angle)
  radiocono*r1; <- GROSOR (radio) del CONO flecha
  despl*radiocono/at; <- DESPLAZAMIENTO LONGITUDINAL del VÉRTICE del CONO flecha (puede ponerse proporcional a la longitud 'at' y/o al grosor 'radiocono')
  desp*radiocono; <- DESPLAZAMIENTO LONGITUDINAL de la BASE del CONO flecha (puede ponerse proporcional a la longitud 'at' y/o al grosor 'radiocono')
  at.f-despl
  vertz=-at/2
  MeshVertex(0,0,vertz,0,0.5,$000000)
  offset+1
  For a=0 To l
    v=2*#PI*a/l+toffset
    vertx=r0*Cos(v)
    verty=r0*Sin(v)
    MeshVertex(vertx,verty,vertz,a/l,0,$000000)
    offset+1
  Next
  For a=1 To l
    MeshFace(a+1,a,0)
  Next
  For b=0 To lt ;confeccionar el corte de sección 'b'
    p=r0+(r1-r0)*b/lt; <- grosor (radio) de la sección 'b'
    For a=0 To l;-1 ; confeccionar vector del vertice 'a'
      v=2*#PI*a/l+toffset; <- angulo para el vector vertice
      ;vector del vertice 'a' en curso para confeccionar el corte de sección 'b' en curso:
      vertx=p*Cos(v)
      verty=p*Sin(v)
      ;corte de sección en curso:
      vox.f=Cos(toffset-initoffset)
      voy.f=Sin(toffset-initoffset)
      MeshVertex(vertx,verty,vertz,a/l,b/lt,$000000)
    Next
    vertz+at/lt
    toffset+torsion
  Next
  For b=0 To lt-1
    For a=0 To l-1
      offset+1
      MeshFace(offset+l+1,offset+l,offset)
      MeshFace(offset+l,offset-1,offset)
    Next
    offset+1
  Next
  vertz=at/2+desp
  For a=0 To l;-1 ; confeccionar vector del vertice 'a'
    v=2*#PI*a/l+toffset; <- angulo para el vector vertice
    ;vector del vertice 'a' en curso
    vertx=radiocono*Cos(v)
    verty=radiocono*Sin(v)
    ;corte de sección en curso:
    vox.f=Cos(toffset-initoffset)
    voy.f=Sin(toffset-initoffset)
    MeshVertex(vertx,verty,vertz,a/l,1.2,$000000)
  Next
  For a=0 To l-1
    offset+1
    MeshFace(offset+l+1,offset+l,offset)
    MeshFace(offset+l,offset-1,offset)
  Next
  vertz=at/2+despl
  MeshVertex(0,0,vertz,1,0.5,$000000)
  offset=MeshVertexCount(Mesh,0)
  For a=offset-l To offset-1
    MeshFace(a-1,a,offset)
  Next
  FinishMesh(#True)
  NormalizeMesh(Mesh,0)
  TransformMesh(Mesh,0,0,posicion*(-at-despl)+at/2,1,1,1,0,0,0,0)
  UpdateMeshBoundingBox(Mesh)
  ProcedureReturn Mesh
EndProcedure
CreateLight(luz.i,$EEEEEE,4,4,2,#PB_Light_Point):SetLightColor(luz.i,#PB_Light_DiffuseColor,$EEEEEE):MoveLight(luz,4,4,2,#PB_Absolute)
CreateCamera(camara,0,0,100,100):CreateNode(pivotcamara.i,0,0,0):AttachNodeObject(pivotcamara.i,CameraID(camara.i)):CameraRange(camara.i,0.1,10000):CameraBackColor(camara.i,$181911)
MoveCamera(camara,0,0,5,#PB_Absolute)
LoadTexture(Texture.i,"MRAMOR6X6.jpg")
CreateMaterial(material.i,TextureID(Texture.i))
pasocam.f=0.01:pasocamincr.f=0.01
n.b=1
Repeat
  ExamineMouse():ExamineKeyboard()
  CursorX.f=WindowMouseX(0):CursorY.f=WindowMouseY(0)
  mdx.f=MouseDeltaX()/200:mdy.f=MouseDeltaY()/200:mdz.f=MouseWheel()/20
  If mdx Or mdy Or mdz
    If MouseButton(#PB_MouseButton_Right)
      MoveCamera(0,mdx,-mdy,0,#PB_Local)
    Else
      RotateNode(pivotcamara,-mdy*60,-mdx*60,0,#PB_Relative)
      MoveCamera(camara,0,0,-mdz,#PB_Relative)
    EndIf
  EndIf
  If na.b<>n.b
    If n.b>5:n.b=0:ElseIf n.b<0:n.b=5:EndIf
    na.b=n.b
    If IsEntity(Tor.i):FreeEntity(Tor):EndIf
    Select n.b
    Case 0:flecha(mallaTor.i,26,70,0.08,0.08,1.88,0,0,0)
    Case 1:flecha(mallaTor.i,5,20,0.8,0.7,1.88,0,0,0.5)
    Case 2:flecha(mallaTor.i,13,50,0.18,0.18,1.28,0.02,0,1)
    Case 3:flecha(mallaTor.i,3,100,0.18,0.11,1.78,0.06,0,0.5)
    Case 4:flecha(mallaTor.i,2,100,0.18,0.06,1.5,0,0,0.5)
    Case 5:flecha(mallaTor.i,2,100,0.06,0.18,1.5,0,0,0.5)
    EndSelect
    CreateEntity(Tor.i,MeshID(mallaTor.i),MaterialID(material.i))
  ElseIf MouseButton(#PB_MouseButton_Left):While MouseButton(#PB_MouseButton_Left):ExamineMouse():Delay(20):Wend:np.b=n.b:n.b+1
  ElseIf KeyboardReleased(#PB_Key_W):wireframe.b!1:If wireframe.b:CameraRenderMode(camara,#PB_Camera_Wireframe):Else:CameraRenderMode(camara,#PB_Camera_Textured):EndIf
  EndIf
  RotateEntity(Tor,0,0,1,#PB_Relative)
  WaitWindowEvent()
  TimeSinceLastFrame.i=RenderWorld(50)
  FlipBuffers():Delay(13)
Until KeyboardPushed(#PB_Key_Escape)
http://www.zeitgeistmovie.com

While world=business:world+mafia:Wend
Will never leave this forum until the absolute bugfree PB :mrgreen:
User avatar
pf shadoko
Enthusiast
Enthusiast
Posts: 285
Joined: Thu Jul 09, 2015 9:07 am

Re: Another arrow mesh creation function

Post by pf shadoko »

the most beautiful arrows I've ever seen !!!
Post Reply