PureBasic Forums - English

Code: Select all

Structure f3
  x.f
  y.f
  z.f
EndStructure

Structure PB_MeshVertexV
  p.f3
  n.f3
  t.f3
  u.f
  v.f
  color.l
EndStructure

Macro sub3D(p,p1,p2)
  p\x=p1\x-p2\x
  p\y=p1\y-p2\y
  p\z=p1\z-p2\z
EndMacro

Procedure.f lng3D(*v.f3)
  ProcedureReturn Sqr(*V\x * *V\x + *V\y * *V\y + *V\z * *V\z)
EndProcedure

Procedure Createholesurface(mesh,Array t.PB_MeshVertexv(2))
    Protected p,i,j,m,diag,nx=ArraySize(t(),2),nz=ArraySize(t(),1),n=nx+1
    Protected.f3 d1,d2
    m=CreateMesh(mesh):If mesh=-1:mesh=m:EndIf
    For j=0 To nz
        For i=0 To nx
            With t(j,i)
                MeshVertex(\p\x,\p\y,\p\z,\u,\v,\color)
            EndWith
        Next
    Next 
    For j=0 To nz-1
        For i=0 To nx-1
            p=j*(nx+1)+i
            sub3d(d1,t(j,i)\p,t(j+1,i+1)\p)
            sub3d(d2,t(j+1,i)\p,t(j,i+1)\p)
                If lng3d(d1)>lng3d(d2)
                    If t(j,i)\color And t(j+1,i)\color And t(j,i+1)\color:MeshFace(p,p+n,p+1):EndIf
                    If t(j+1,i+1)\color And t(j,i+1)\color And t(j+1,i)\color:MeshFace(p+n+1,p+1,p+n):EndIf
                Else
                    If t(j+1,i)\color And t(j+1,i+1)\color And t(j,i)\color:MeshFace(p+n,p+n+1,p):EndIf
                    If t(j,i+1)\color And t(j,i)\color And t(j+1,i+1)\color:MeshFace(p+1,p,p+n+1):EndIf
                EndIf
        Next
    Next
    FinishMesh(1)
    NormalizeMesh(mesh)
    UpdateMeshBoundingBox(mesh)
    ProcedureReturn mesh
EndProcedure

Procedure createsnail(mesh,nx,ny)
    Protected.f u,v, a=3,b=4,c=-0.1
    Dim t.PB_MeshVertexv(nx,ny)
    For j=0 To ny
        For i=0 To nx
            u=j/ny*2*#PI
            v=i/nx*2*#PI   
            
            With t(i,j)
                \u=i/nx
                \v=j/ny
                \color=$ffffff
                If (i & 7=4) And (j & 7=4):\color=0:EndIf
                u*4
                \p\x=-(a+b*Cos(v))*Exp(c*u)*Cos(u)
                \p\y=(a+b*Cos(v))*Exp(c*u)*Sin(u)
                \p\z=(3*a+b*Sin(v))*Exp(c*u)-5
                
            EndWith
        Next
    Next
    Createholesurface(mesh,t())
    NormalizeMesh(mesh)
EndProcedure

InitEngine3D():InitSprite():InitKeyboard():InitMouse()
ExamineDesktops()
ex=DesktopWidth (0)*1
ey=DesktopHeight(0)*1
OpenWindow(0, 0,0, ex,ey, "Test 3d - [F1, F2, F3, F4] - Change sample - [F12] Wireframe -  [Esc] quit",#PB_Window_ScreenCentered|#PB_Window_BorderLess)
OpenWindowedScreen(WindowID(0), 0, 0, ex, ey, 0, 0, 0)

Add3DArchive(#PB_Compiler_Home + "examples/3d/Data/Textures",#PB_3DArchive_FileSystem)
Parse3DScripts()

CreateCamera(0, 0, 0, 100, 100):MoveCamera(0,0,0,-10):CameraLookAt(0,0,0,0)
CreateLight(0,$ffffff, 10000, 10000, 0000):SetLightColor(0,#PB_Light_SpecularColor,$ffffff)
AmbientColor($777777)

LoadTexture(0, "dirt.jpg")
CreateMaterial(0,TextureID(0))
MaterialFilteringMode(0,#PB_Material_Anisotropic)
ScaleMaterial(0,0.1,0.025)

CopyMaterial(0,1)
SetMaterialColor(1,#PB_Material_DiffuseColor,$ff)
SetMaterialColor(1,#PB_Material_AmbientColor,$ff)
MaterialCullingMode(1,#PB_Material_AntiClockWiseCull) 


createsnail(0,32,256)
CreateEntity(0,MeshID(0),MaterialID(0))
CreateEntity(1,MeshID(0),MaterialID(1))
  
  Repeat     
  WindowEvent()
  ExamineMouse()
  ExamineKeyboard()
  If KeyboardReleased(#PB_Key_Space):action=0:EndIf
  If KeyboardReleased(#PB_Key_F2):dis=(dis+1)%3:vdis=2<<dis*5:EndIf
  If KeyboardReleased(#PB_Key_F1):EntityAngularFactor(0,0,0,0):EndIf
  RotateEntity(0,0.1,0.2,0.3,#PB_Relative)
  RotateEntity(1,0.1,0.2,0.3,#PB_Relative)
  yrot.f+0.5:MoveCamera(0,Cos(yrot/180*#PI)*20,10,Sin(yrot/180*#PI)*20,0)
  CameraLookAt(0,EntityX(0),EntityY(0),EntityZ(0))
  RenderWorld()
  FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)