It is currently Sun Nov 18, 2018 6:58 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 5 posts ] 
Author Message
 Post subject: An old Torus arc mesh
PostPosted: Thu Sep 13, 2018 2:42 pm 
Offline
Addict
Addict
User avatar

Joined: Wed Jun 11, 2003 9:33 pm
Posts: 4480
Location: Spa, relaxing and thinking, and learning...
I share an old function i mede for the MP3D library, now translated to PB:
Code:
;CreateTorusArcMesh (20160204) Psychophanta
;/ 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
AntialiasingMode(#PB_AntialiasingMode_x4)
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)
;\
Structure Vector3D
  x.f:y.f:z.f:m.f
EndStructure
Macro ProductoEscalar(a,b)
  (a#\x*b#\x+a#\y*b#\y+a#\z*b#\z)
EndMacro
Macro getmodulo(v)
  (Sqr#ProductoEscalar(v#,v#))
EndMacro
Procedure.b Turn_3DVector_by_Angle_adding(*R0.Vector3D,*fi.Vector3D)
  ;Esta funcion halla un vector resultado de una rotacion en el espacio de otro vector inicial.
  ;Esta funcion admite entonces, como parametros de entrada, 2 vectores:
  ; - 'Vector radio' que se desea rotar. Este vector tiene direccion no colineal con el eje de rotación.
  ; - 'Vector angulo' ('velocidad angular' * 'tiempo'), es el angulo en el que se rota el 'Vector radio' dado.
  ;     Su modulo indica el numero de radianes a rotar, su direccion indica el angulo en el espacio en el que se rota (eje de rotación)
  ;     su sentido indica el sentido de la rotacion
  ;NOTA: la funcion devuelve el vector velocidad rectilinea (3er parametro) y el nuevo vector radio (4º parametro)
  ;       pero ambos parametros se pueden omitir haciendo que la velocidad rectilinea no se devuelva y que el nuevo radio se devuelva en el 2º parametro
  Protected Rt.Vector3D,u.Vector3D,P0.Vector3D
  *fi\m=ProductoEscalar(*fi,*fi)
  If *fi\m
    u\m=ProductoEscalar(*R0,*fi)/*fi\m
    *fi\m=Sqr(*fi\m)
    ;Rt-> = Proyeccion de *R0-> sobre *fi->:
    Rt\x=u\m**fi\x
    Rt\y=u\m**fi\y
    Rt\z=u\m**fi\z
    ;P0-> = proyeccion ortogonal de *R0-> sobre *fi->):
    P0\x=*R0\x-Rt\x
    P0\y=*R0\y-Rt\y
    P0\z=*R0\z-Rt\z
    P0\m=getmodulo(P0)
    If P0\m=0.0:ProcedureReturn 0:EndIf; <= no hay giro ya que *R0 y *fi con colineales
    ;Calcular el producto vectorial: u-> = *fi-> X P0->
    u\x=*fi\y*P0\z-*fi\z*P0\y
    u\y=*fi\z*P0\x-*fi\x*P0\z
    u\z=*fi\x*P0\y-*fi\y*P0\x
    ;ahora obtener *R0-> = (Proyeccion de *R0 sobre *fi)-> + (cos(|*fi->|)·P0-> + |P0->|/|u->|·sin(|*fi->|)·u->)->:
    *R0\x=Rt\x
    *R0\y=Rt\y
    *R0\z=Rt\z
    !mov edi,dword[p.p_fi]
    !fld dword[edi+12]; <- get *fi\m
    !fsincos
    !fstp dword[p.v_Rt]; <- Rt\x=Cos(*fi\m)
    !fstp dword[p.v_Rt+4]; <- Rt\y=Sin(*fi\m)
    ; si no se quiere usar ensamblador sustituir esas 5 lineas por: Rt\x=Cos(*fi\m):Rt\y=Sin(*fi\m)
    u\m=getmodulo(u)
    P0\m*Rt\y/u\m
    *R0\x+Rt\x*P0\x+P0\m*u\x
    *R0\y+Rt\x*P0\y+P0\m*u\y
    *R0\z+Rt\x*P0\z+P0\m*u\z
    ProcedureReturn 1
  EndIf
  ProcedureReturn 0
EndProcedure
Procedure.b KeyEdgeDetection(key.a)
  Static pka.a
  If KeyboardPushed(key);<-if current key status is PUSHED
    If pka=0:pka=key:ProcedureReturn 1:EndIf;<-if previous key status was NOT PUSHED, then assign previous state to current one, and EXIT.
  ElseIf pka=key;<-else (if previous key status was PUSHED and current key status is NOT PUSHED):
    pka=0;:ProcedureReturn -1;<-set previous key status to NOT PUSHED.
  EndIf
  ProcedureReturn 0
EndProcedure
Procedure.i CreateTorusArc(l.i=20,lt.i=20,r0.f=0.4,r1.f=0.4,rt.f=2.0,at.f=#PI,torsion.f=0.0,toffset.f=0.0,tilt.f=0.0,rtf.f=0.0,achatamiento.f=0.0,tapas.b=0,rext0.f=0.0,rext1.f=0.0)
  ; Crea el arco de un toroide (o un tubo recto). El toroide (o tubo recto) puede ser de grosor creciente o decreciente (cono recto).
  If l<1 Or lt<1 Or r0<0 Or r1<0:ProcedureReturn 0:EndIf
  If rext0=0.0:rext0=r0:EndIf
  If rext1=0.0:rext1=r1:EndIf
  Protected Mesh.i=CreateMesh(#PB_Any,#PB_Mesh_TriangleList,#PB_Mesh_Static),vert.Vector3D,ang.Vector3D,a.i,b.i,p.f,r.f,v.f,offset.i=0,initoffset.f=toffset.f
  ;l = numero de lados en la seccion (number of sides in cut area)
  ;lt = numero de segmentos (number of segments of torus)
  ;r0 = radio grosor inicial (radius of cut area at initial extreme)
  ;r1 = radio grosor final (radius of cut area at end extreme)
  ;rt = radio del toro (radius of torus). (if this parameter is 0, the function performs a tube mesh in which 'at' parameter is the heigh of the tube)
  ;at = radianes del toro (radians of the torus) (height of the tube if 'rt' parameter is 0)
  ;torsion = (torsion)
  ;toffset = (initial offset of the starting angle)
  ;tilt = indica lo que asciende toro por cada radian (para hacer una forma de muelle)
  ;rtf = radio del toro en el final de su recorrido. (NOTA: este parametro es ignorado si 'rt' es 0)
  ;achatamiento = la relación entre el ancho de y el alto de 'r0' y 'r1' (no acabado).
  ;tapas = sus 2 bit menos significativos indican si hay tapa el principio (bit 0) y/o al final (bit 1)
  ;rext0.f = para hacer secciones con polígonos en estrella en lugar de polígonos regulares; este parámetro sería el radio de los picos cortos
  ;rext1.f = para hacer secciones con polígonos en estrella en lugar de polígonos regulares; este parámetro sería el radio de los picos largos
  If rt=0; => tube
    vert\z=-at/2
    If tapas&1
      MeshVertexPosition(0,0,vert\z)
      MeshVertexTextureCoordinate(0,0.5)
      MeshVertexColor($000000)
      offset+1
      For a=0 To l
        v=2*#PI*a/l+toffset
        vert\x=r0*Cos(v)*(1+achatamiento.f)
        vert\y=r0*Sin(v)
        MeshVertexPosition(vert\x,vert\y,vert\z)
        MeshVertexTextureCoordinate(a/l,0)
        MeshVertexColor($000000)
        offset+1
      Next
      For a=1 To l
        MeshFace(a+1,a,0)
      Next
    EndIf
    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
;         vert\x=p*(Cos(torsion)*Cos(v)-Sin(torsion)*Sin(v)*achatamiento)
;         vert\y=p*(Cos(torsion)*Sin(v)*achatamiento+Sin(torsion)*Cos(v))
        ;vector del vertice 'a' en curso para confeccionar el corte de sección 'b' en curso:
        vert\x=p*Cos(v)
        vert\y=p*Sin(v)
        ;corte de sección en curso:
        vox.f=Cos(toffset-initoffset)
        voy.f=Sin(toffset-initoffset)
        ;proyeccion del vector del vertice sobre el vector inclinacion 'vo' y lo multiplico por el achatamiento
        ;y también sumo al vector del vertice 'a' ese vector proyección obtenido:
        proj.f=achatamiento.f/(vox*vox+voy*voy)
        projx.f=(vert\x*vox+vert\y*voy)*proj*vox
        projy.f=(vert\x*vox+vert\y*voy)*proj*voy
        vert\x+projx
        vert\y+projy
        MeshVertexPosition(vert\x,vert\y,vert\z)
        MeshVertexTextureCoordinate(a/l,b/lt)
        MeshVertexColor($000000)
      Next
      vert\z+at/lt
      toffset+torsion
    Next
  Else; => Torus arc
    ang\x=-tilt
    ang\z=0.0
    If rtf=0.0:rtf=rt:EndIf
    If tapas&1
      ang\y=0.0
      vert\x=rt
      vert\y=tilt*at/-2
      vert\z=0
      Turn_3DVector_by_Angle_adding(@vert,@ang)
      MeshVertexPosition(vert\x,vert\y,vert\z)
      MeshVertexTextureCoordinate(0,0.5)
      MeshVertexColor($000000)
      offset+1
      For a=0 To l
        v=2*#PI*a/l+toffset
        vert\x=rt+r0*Cos(v)
        vert\y=tilt*at/-2+r0*Cos(tilt/rt)*Sin(v)
        vert\z=-r0*Sin(tilt/rt)*Sin(v)
        Turn_3DVector_by_Angle_adding(@vert,@ang)
        MeshVertexPosition(vert\x,vert\y,vert\z)
        MeshVertexTextureCoordinate(a/l,0)
        MeshVertexColor($000000)
        offset+1
      Next
      For a=1 To l
        MeshFace(a+1,a,0)
      Next
      ;Poner aqui el id de vertice #1, no el #5 que es donde se llega
    EndIf
    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'
      r=rt+(rtf-rt)*b/lt; <- radio del toro en cada sección 'b'
      ;Inclino el corte de sección según indica 'tilt':
      ;Y voy orbitando la sección sobre el radio del toro
      ang\y=-at*b/lt; <- componente de orbitación
      For a=0 To l ; confeccionar vector del vertice 'a'
        v=2*#PI*a/l+toffset; <- angulo para el vector vertice
        vert\x=r+p*Cos(v)+(r1-r0)*b/lt/2
        vert\y=tilt*at*(b/lt-1/2)+p*Cos(tilt/r)*Sin(v)
        vert\z=-p*Sin(tilt/r)*Sin(v)
        Turn_3DVector_by_Angle_adding(@vert,@ang)
        MeshVertexPosition(vert\x,vert\y,vert\z)
        MeshVertexTextureCoordinate(a/l,b/lt)
        MeshVertexColor($000000)
      Next
      toffset+torsion
    Next
  EndIf
  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
  If tapas&2
    If rt
      ang\y=-at
      vert\x=rtf+(r1-r0)/2
      vert\y=tilt*at/2
      vert\z=0
      Turn_3DVector_by_Angle_adding(@vert,@ang)
      MeshVertexPosition(vert\x,vert\y,vert\z)
      MeshVertexTextureCoordinate(1,0.5)
      MeshVertexColor($000000)
    Else
      MeshVertexPosition(0,0,vert\z-at/lt)
      MeshVertexTextureCoordinate(1,0.5)
      MeshVertexColor($000000)
    EndIf
    offset=MeshVertexCount(Mesh,0)
    For a=offset-l To offset-1
      MeshFace(a-1,a,offset)
    Next
  EndIf
  FinishMesh(1)
  NormalizeMesh(Mesh,0)
  UpdateMeshBoundingBox(Mesh)
  ProcedureReturn Mesh
EndProcedure
luz.i=CreateLight(#PB_Any,$EEEEEE,4,4,2,#PB_Light_Point):SetLightColor(luz.i,#PB_Light_DiffuseColor,$EEEEEE):MoveLight(luz,4,4,2,#PB_Absolute)
camara.i=CreateCamera(#PB_Any,0,0,100,100):pivotcamara.i=CreateNode(#PB_Any,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)
; RotateNode(pivotcamara,90,0,0,#PB_Absolute)
Texture.i=LoadTexture(#PB_Any,"MRAMOR6X6.jpg")
material.i=CreateMaterial(#PB_Any,TextureID(Texture.i))
n.b=16
Repeat
  ExamineMouse():ExamineKeyboard()
  CursorX.f=WindowMouseX(0):CursorY.f=WindowMouseY(0)
  mdx.f=MouseDeltaX()/200:mdy.f=MouseDeltaY()/200:mdz.f=MouseWheel()/20
  If KeyEdgeDetection(#PB_Key_LeftControl); <- inicia control camara
    pasocam.f=0.01:pasocamincr.f=0.01
  ElseIf KeyboardReleased(#PB_Key_LeftControl)
  ElseIf KeyboardPushed(#PB_Key_LeftControl); <- mover el punto de vista
    ;para desplazar la camara hacia delante, atras, arriba, abajo, izq o der
    If KeyboardPushed(#PB_Key_Pad5)
      MoveCamera(camara,0,0,-pasocam,#PB_Relative)
      pasocam+pasocamincr
    ElseIf KeyboardPushed(#PB_Key_Pad0)
      MoveCamera(camara,0,0,pasocam,#PB_Relative)
      pasocam+pasocamincr
    ElseIf KeyboardPushed(#PB_Key_Pad8)
      MoveCamera(camara,0,pasocam,0,#PB_Relative)
      pasocam+pasocamincr
    ElseIf KeyboardPushed(#PB_Key_Pad2)
      MoveCamera(camara,0,-pasocam,0,#PB_Relative)
      pasocam+pasocamincr
    ElseIf KeyboardPushed(#PB_Key_Pad6)
      MoveCamera(camara,pasocam,0,0,#PB_Relative)
      pasocam+pasocamincr
    ElseIf KeyboardPushed(#PB_Key_Pad4)
      MoveCamera(camara,-pasocam,0,0,#PB_Relative)
      pasocam+pasocamincr
    ElseIf KeyboardPushed(#PB_Key_Pad1)
      RotateNode(pivotcamara,0,0.5,0,#PB_Relative)
    ElseIf KeyboardPushed(#PB_Key_Pad3)
      RotateNode(pivotcamara,0,-0.5,0,#PB_Relative)
    ElseIf mdx Or mdy Or mdz
      If MouseButton(#PB_MouseButton_Right)
        MoveNode(pivotcamara,mdx,-mdy,0,#PB_Local); o MoveCamera(0,mdx,-mdy,0,#PB_Local) o MoveCamera(0,mdx,-mdy,0,#PB_Relative)
      Else
        RotateNode(pivotcamara,-mdy*60,-mdx*60,0,#PB_Relative)
        If mdz
          MoveCamera(camara,0,0,-mdz,#PB_Relative)
        EndIf
      EndIf
    EndIf
  ElseIf na.b<>n.b
    If n.b>18:n.b=0:ElseIf n.b<0:n.b=18:EndIf
    na.b=n.b
    If IsEntity(Tor.i):FreeEntity(Tor):EndIf
    Select n.b
    Case 0:mallaTor.i=CreateTorusArc(3,200,0.4,0.0,1.8,12*#PI,0.0,-#PI/6,0.11,0.5,0,3)
    Case 1:mallaTor.i=CreateTorusArc(23,3,0.4,0,2,#PI,0,0,0,0,0,3)
    Case 2:mallaTor.i=CreateTorusArc(3,30,1,0,2,#PI/3,0,0,0,0,0,3)
    Case 3:mallaTor.i=CreateTorusArc(3,3,0.4,0.6,1.9,#PI,0,#PI,0,0,0,3)
    Case 4:mallaTor.i=CreateTorusArc(16,30,1,0,2,2.3*#PI)
    Case 5:mallaTor.i=CreateTorusArc(3,40,0.5,0.5,2,2*#PI,#PI/20)
    Case 6:mallaTor.i=CreateTorusArc(15,50,1,0,2,4.2*#PI)
    Case 7:mallaTor.i=CreateTorusArc(10,5,0.4,0.4,0,0.4,0,0,0,0,0,3)
    Case 8:mallaTor.i=CreateTorusArc(5,3,0.4,0,2,#PI,0.333,0,0,0,0,3)
    Case 9:mallaTor.i=CreateTorusArc(4,2,0.4,0.6,2,#PI,0,#PI/4,0,0,0,3)
    Case 10:mallaTor.i=CreateTorusArc(30,2,0.1,0.8,0,0.5,0,0,0,0,0,3)
    Case 11:mallaTor.i=CreateTorusArc(4,1,0.0,1,0,1,0,0,0,0,0,2)
    Case 12:mallaTor.i=CreateTorusArc(3,1,0.0,1,0,1,0,0,0,0,0,2)
    Case 13:mallaTor.i=CreateTorusArc(2,120,0.4,0.4,2,2*#PI,#PI/120)
    Case 14:mallaTor.i=CreateTorusArc(20,60,0.0,0.4,1.8,4*#PI,0.0,0.0,0.1,0.5,0,3)
    Case 15:mallaTor.i=CreateTorusArc(4,200,0.0,0.2,1.8,8*#PI,0.0,#PI/4,0.0,0.1,0,3)
    Case 16:mallaTor.i=CreateTorusArc(4,10,0.2,0.2,0,2,#PI/20,#PI/4,0,0,2,3)
    Case 17:mallaTor.i=CreateTorusArc(4,100,0.2,0.2,1,2*#PI,#PI/200,#PI/4)
    Case 18:mallaTor.i=CreateTorusArc(40,100,0.1,0.01,1,4*#PI,0,#PI/4,0.15,0.2,0,3)
    EndSelect
    Tor.i=CreateEntity(#PB_Any,MeshID(mallaTor.i),MaterialID(material.i))
  ElseIf KeyboardReleased(#PB_Key_Right):np.b=n.b:n.b+1
  ElseIf KeyboardReleased(#PB_Key_Left):np.b=n: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
  ElseIf KeyboardReleased(#PB_Key_P)
    If IsEntity(punto.i):FreeEntity(punto)
    Else
      puntomalla.i=CreateSphere(#PB_Any,0.025,10,5)
      punto.i=CreateEntity(#PB_Any,MeshID(puntomalla.i),MaterialID(0),-0.05,0,0)
    EndIf
  EndIf
  TimeSinceLastFrame.i=RenderWorld(50)
  StartDrawing(WindowOutput(0))
  DrawingMode(#PB_2DDrawing_Transparent)
  DrawText(1,1,"mesh: "+Str(n)+", vertices: "+Str(MeshVertexCount(mallaTor,0))+", triangulos: "+Str(MeshIndexCount(mallaTor,0)/3))
  StopDrawing()
  FlipBuffers():WaitWindowEvent():Delay(3)
Until KeyboardPushed(#PB_Key_Escape)


Not finished , but perfectly useful.

_________________
http://www.zeitgeistmovie.com

While world=business:world+mafia:Wend
While (world==business) {world+=mafia}


Last edited by Psychophanta on Thu Sep 13, 2018 7:52 pm, edited 1 time in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: An old Torus arc mesh
PostPosted: Thu Sep 13, 2018 3:06 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Wed Sep 21, 2011 9:11 am
Posts: 603
Location: France
Hello Psychophanta.

An error line 279
Code:
 FreeEntity(Tor)
Compiler wrote:
[16:04:59] Executable type: Windows - x64 (64bit, Unicode)
[16:04:59] Executable started.
[16:04:59] [ERROR] Line: 279
[16:04:59] [ERROR] The specified #Entity is Not initialised.

_________________

➽ Windows 10 - PB 5.45 LTS & PB 5.60

http://falsam.com & EasySprite.js
http://purebasic.chat - Code PureBasic
Image Pure Basic Francophone Community

Sorry for my bad english and the Dunning–Kruger effect.


Top
 Profile  
Reply with quote  
 Post subject: Re: An old Torus arc mesh
PostPosted: Thu Sep 13, 2018 3:40 pm 
Offline
Addict
Addict

Joined: Sun Jun 25, 2006 7:28 pm
Posts: 1327
i remember this example thanks for porting it to PB ogre
i think FreeEntity(Tor) should be in lines 302-303:
ElseIf KeyboardReleased(#PB_Key_Right):np.b=n.b:n.b+1 :FreeEntity(Tor)
ElseIf KeyboardReleased(#PB_Key_Left):np.b=n:n.b-1: FreeEntity(Tor)
since the changing of entities happened when we press Left or Right arrow key
W is for wireFrame
the mouse have no effect, so rotating the shapes is better.


Top
 Profile  
Reply with quote  
 Post subject: Re: An old Torus arc mesh
PostPosted: Thu Sep 13, 2018 3:52 pm 
Offline
Enthusiast
Enthusiast

Joined: Sat Feb 08, 2014 3:26 pm
Posts: 508
falsam wrote:
An error line 279
Code:
 FreeEntity(Tor)
Change with:
Code:
If IsEntity(Tor) : FreeEntity(Tor) : EndIf


:idea: Good coding practice: alway check (If Is...) before Free... Object/Memory/Glass of Beer


Top
 Profile  
Reply with quote  
 Post subject: Re: An old Torus arc mesh
PostPosted: Thu Sep 13, 2018 7:51 pm 
Offline
Addict
Addict
User avatar

Joined: Wed Jun 11, 2003 9:33 pm
Posts: 4480
Location: Spa, relaxing and thinking, and learning...
Thanks.

Right, damn!. Sorry :? Not tested the final revision.
It is fixed in first post.

_________________
http://www.zeitgeistmovie.com

While world=business:world+mafia:Wend
While (world==business) {world+=mafia}


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 5 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 3 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye