Demo 3D - Repulsion

Everything related to 3D programming
User avatar
pf shadoko
Enthusiast
Enthusiast
Posts: 289
Joined: Thu Jul 09, 2015 9:07 am

Demo 3D - Repulsion

Post by pf shadoko »

Hi coders

a quick demo
wait a few seconds, you'll see filaments forming
reminiscent of the cosmic web (https://www.cnrs.fr/fr/presse/les-premi ... ies-naines)
perhaps a repulsive force is at the root of these patterns (negative gravity...)

use mouse to move around
[Space] or RMB to Pause

remove debugger
if that's not enough, compile with the C backend with optimization

Code: Select all

;  ----------------------------------------------------------------------------------------------------------
;   Demo 3D - Répulsion - Pf Shadoko - 2023
; ----------------------------------------------------------------------------------------------------------
;{ ============================= biblio
Macro f3:vector3:EndMacro

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

Procedure vector3(*v.f3,vx.f,vy.f,vz.f)
  *v\x=vx
  *v\y=vy
  *v\z=vz
EndProcedure

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

Macro add3d(p,p1,p2)
  p\x=p1\x+p2\x
  p\y=p1\y+p2\y
  p\z=p1\z+p2\z
EndMacro

Macro mul3d(p,r)
  p\x*r
  p\y*r
  p\z*r
EndMacro

Macro lng3D(V)
  Sqr(V\x*V\x + V\y*V\y + V\z*V\z)
EndMacro

Procedure.f POM(v.f)
  ProcedureReturn (Random(v*1000)-v*500)/500
EndProcedure

Macro Mod3d(p,m)
  p\x=Mod(p\x+m*10,m)
  p\y=Mod(p\y+m*10,m)
  p\z=Mod(p\z+m*10,m)
EndMacro
;}

#nf=20000
#nr=5
#rv=0.9

InitEngine3D():InitSprite():InitKeyboard():InitMouse()

ExamineDesktops()
OpenWindow(0, 0,0, DesktopWidth(0),DesktopHeight(0), "demo 3d - [Esc] quit",#PB_Window_ScreenCentered|#PB_Window_BorderLess)
OpenWindowedScreen(WindowID(0), 0, 0, WindowWidth(0), WindowHeight(0), 0, 0, 0)

CreateCamera(0, 0, 0, 100, 100):MoveCamera(0,100,100,0):CameraLookAt(0,100,100,100)
CreateLight(0,$ffffff, -10000, 10000, 0)
Fog(0,1,0,400)

Define.s vert_pg,frag_pg
vert_pg="%#version 130%%uniform mat4 P20;//+20%uniform mat4 P12;//+12%uniform vec4 P108;//+108%uniform vec4 P31;//+31%uniform float size;//-1%%varying vec4 ocolor;%varying float ofogf;%%void main(void)%{%gl_Position=ftransform();%float vsize;if(size<0)vsize=gl_MultiTexCoord0.x;else vsize=size;%vec4 wv_pos=P20*gl_Vertex;%vec4 projVoxel=P12*vec4(vsize,vsize,wv_pos.z,wv_pos.w);%vec2 projSize=P108.xy*projVoxel.xy/projVoxel.w;%gl_PointSize=0.5*projSize.x;%%ocolor=gl_Color;%ofogf=P31.z>0?min(abs(gl_Position.z)*P31.w,1):0;%}"
frag_pg="%#version 130%%varying vec4 ocolor;%varying float ofogf;%%void main(void)%{%vec2 pc=gl_PointCoord*2-1;%float r=dot(pc,pc);%if(r>1)discard;%float v=1-r;v*=v;%gl_FragColor=vec4(v,v,v,0)*ocolor*(1-ofogf);%}"

CreateShader(0,vert_pg,frag_pg)
CreateShaderMaterial(0,0)
SetMaterialAttribute(0,#PB_Material_PointSprite,1)
MaterialBlendingMode(0,#PB_Material_Add)

CreateMesh(0,#PB_Mesh_PointList):For i=0 To #nf:MeshVertex(Random(200),Random(200),Random(200),1, 0,$226688):Next:FinishMesh(1)
CreateMesh(1,#PB_Mesh_PointList):For i=0 To #nr:MeshVertex(Random(200),Random(200),Random(200),20,0,$ff0000):Next:FinishMesh(1)
For i=-2 To 2
  For j=-2 To 2
    For k=-2 To 2
      CreateEntity(-1,MeshID(0),MaterialID(0),i*200,j*200,k*200)
      CreateEntity(-1,MeshID(1),MaterialID(0),i*200,j*200,k*200)
    Next
  Next
Next

Global Dim f.MeshVertexV(#nf)
Global Dim r.MeshVertexV(#nr)
For i=0 To #nf
  f3(f(i)\p,Random(200),Random(200),Random(200))
Next
For i=0 To #nr
  f3(r(i)\p,Random(200),Random(200),Random(200))
  f3(r(i)\n,pom(#rv),pom(#rv),pom(#rv))
Next

Define.f MouseX,Mousey,depx,depz,dist,d,rv
Define.f3 *p,*r,*v,v,sv,r,po:f3(po,100,100,100)

Repeat
  ExamineKeyboard()
  ExamineMouse()
  depx=(-Bool(KeyboardPushed(#PB_Key_Left))+Bool(KeyboardPushed(#PB_Key_Right)))*2
  depz=(-Bool(KeyboardPushed(#PB_Key_Down))+Bool(KeyboardPushed(#PB_Key_Up   ))+MouseButton(1))*2+MouseWheel()*20
  MouseX = -MouseDeltaX() *  0.05
  MouseY = -MouseDeltaY() *  0.05
  RotateCamera(0, MouseY, MouseX, 0, #PB_Relative)
  dist+(depz-dist)*0.05:MoveCamera  (0, depX, 0, -dist)
  MoveCamera(0,Mod(CameraX(0)+200,200),Mod(CameraY(0)+200,200),Mod(CameraZ(0)+200,200),0)
  amouseb2=mouseb2:mouseb2=MouseButton(2)
  If KeyboardReleased(#PB_Key_Space) Or (mouseb2 And amouseb2=0):pause=1-pause:EndIf
  
  If pause=0
    For i=0 To #nr
      add3d(r(i)\p,r(i)\p,r(i)\n)
      Mod3d(r(i)\p,200)
    Next
    
    For i=0 To #nf
      *p=f(i)\p
      *v=f(i)\n
      For j=0 To #nr
        sub3D(v,r(j)\p,*p)
        add3d(v,v,po):Mod3d(v,200):sub3D(v,v,po)
        d=lng3D(v)
        rv=-2/(d*d*d)
        mul3d(v,rv)
        add3d(*v,*v,v)
      Next
      add3d(*p,*p,*v)
      mul3D(*v,0.98)
      Mod3d(*p,200)
    Next
    SetMeshData(0,0,f(),#PB_Mesh_Vertex,0,#nf)
    SetMeshData(1,0,r(),#PB_Mesh_Vertex,0,#nr)
  EndIf
  RenderWorld()
  FlipBuffers()    
  While WindowEvent():Wend
Until KeyboardReleased(#PB_Key_Escape) Or MouseButton(3)
User avatar
jacdelad
Addict
Addict
Posts: 1473
Joined: Wed Feb 03, 2021 12:46 pm
Location: Planet Riesa
Contact:

Re: Demo 3D - Repulsion

Post by jacdelad »

Another 3D shadoko demo?
Image
I am quite convinced to know a thing or two about programming, especially PureBasic. But 3D is still a box of mystery for me.

This one is really cool, as always!!!

One suggestion: A key to destroy the structures and drift it into a state, similar to what it was at the beginning.
PureBasic 6.04/XProfan X4a/Embarcadero RAD Studio 11/Perl 5.2/Python 3.10
Windows 11/Ryzen 5800X/32GB RAM/Radeon 7770 OC/3TB SSD/11TB HDD
Synology DS1821+/36GB RAM/130TB
Synology DS920+/20GB RAM/54TB
Synology DS916+ii/8GB RAM/12TB
User avatar
SPH
Enthusiast
Enthusiast
Posts: 268
Joined: Tue Jan 04, 2011 6:21 pm

Re: Demo 3D - Repulsion

Post by SPH »

Incredible ! Because the code is short !!! 🥰
http://HexaScrabble.com/
!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Portable LENOVO ideapad 110-17ACL 64 bits
Version de PB : 5.73LTS - 32 bits
BarryG
Addict
Addict
Posts: 3315
Joined: Thu Apr 18, 2019 8:17 am

Re: Demo 3D - Repulsion

Post by BarryG »

Nice! BTW, I have a special folder on my PC just for your demos. They're so good!
User avatar
Caronte3D
Addict
Addict
Posts: 1047
Joined: Fri Jan 22, 2016 5:33 pm
Location: Some Universe

Re: Demo 3D - Repulsion

Post by Caronte3D »

WoW! :shock:
You should make a tutorial about shaders and that things :wink:
User avatar
jacdelad
Addict
Addict
Posts: 1473
Joined: Wed Feb 03, 2021 12:46 pm
Location: Planet Riesa
Contact:

Re: Demo 3D - Repulsion

Post by jacdelad »

Can't wait for Kwais reaction to this. :mrgreen:
PureBasic 6.04/XProfan X4a/Embarcadero RAD Studio 11/Perl 5.2/Python 3.10
Windows 11/Ryzen 5800X/32GB RAM/Radeon 7770 OC/3TB SSD/11TB HDD
Synology DS1821+/36GB RAM/130TB
Synology DS920+/20GB RAM/54TB
Synology DS916+ii/8GB RAM/12TB
User avatar
skinkairewalker
Enthusiast
Enthusiast
Posts: 630
Joined: Fri Dec 04, 2015 9:26 pm

Re: Demo 3D - Repulsion

Post by skinkairewalker »

Awesome bro
User avatar
pf shadoko
Enthusiast
Enthusiast
Posts: 289
Joined: Thu Jul 09, 2015 9:07 am

Re: Demo 3D - Repulsion

Post by pf shadoko »

thanks for the compliments :oops:

@Caronte3D :
i already made a doc for shaders, but it wasn't integrated to the doc
see: https://www.purebasic.fr/english/viewtopic.php?t=79409
note: in this demo the shader wasn't necessary
instead, I could have used a standard material with a texture representing a diffuse disk
the specificity of this demo is the use of sprite points :
CreateMesh(...,#PB_Mesh_PointList)
SetMaterialAttribute(0,#PB_Material_PointSprite,...)
User avatar
minimy
Enthusiast
Enthusiast
Posts: 349
Joined: Mon Jul 08, 2013 8:43 pm

Re: Demo 3D - Repulsion

Post by minimy »

Simply amazing!!
Beautyful demo!
Thanks pf shadoko and happy 2024!
If translation=Error: reply="Sorry, Im Spanish": Endif
Lebostein
Addict
Addict
Posts: 807
Joined: Fri Jun 11, 2004 7:07 am

Re: Demo 3D - Repulsion

Post by Lebostein »

With Mac OS this looks completely different and faulty. The stars are simply white dots and the screen section is also limited to 1/4....
Post Reply