Code: Select all
;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)
Good coding practice: alway check (If Is...) before Free... Object/Memory/Glass of Beer
Not tested the final revision.