PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

50 Sinbads on a circle

https://www.purebasic.fr/english/viewtopic.php?t=65133

Page 2 of 2

Re: 50 Sinbads on a circle

Posted: Mon Dec 24, 2018 5:29 pm
by Psychophanta
I enjoy these "cause-effect" issues.
So I've made my "2 spiral ripple nonsense tip" based on the MP3D lib examples:

Code: Select all

Global pantallacompleta.b=0,Titulo$="domino"
Select MessageRequester("Pantalla para graficos 3D:","¿Usar pantalla completa?",#PB_MessageRequester_YesNoCancel)
Case #PB_MessageRequester_Yes:pantallacompleta.b=1
Case #PB_MessageRequester_Cancel:End
EndSelect
inicio:
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 pantallacompleta
  RX=FRX:RY=FRY
Else
  If FRX<1280 Or FRY<720:RX=FRX*2/3:RY=FRY*2/3:Else:RX=1280:RY=720:EndIf
EndIf
If InitEngine3D()=0
  MessageRequester("Error","The 3D Engine can't be initialized",0):End
EndIf
AntialiasingMode(#PB_AntialiasingMode_x4)
;
InitSprite():InitKeyboard():InitMouse()
If pantallacompleta.b=2
  OpenScreen(RX,RY,bitplanes.a,Titulo$,#PB_Screen_WaitSynchronization,FrecuenciadeMuestreo.u)
Else
  OpenWindow(0,0,0,RX,RY,Titulo$,#PB_Window_BorderLess|#PB_Window_ScreenCentered)
  OpenWindowedScreen(WindowID(0),0,0,RX,RY,1,0,0,#PB_Screen_WaitSynchronization)
EndIf
Add3DArchive(#PB_Compiler_Home+"examples/3D/Data/Textures",#PB_3DArchive_FileSystem)
Add3DArchive(#PB_Compiler_Home+"examples/3D/Data/Packs/desert.zip",#PB_3DArchive_Zip)
Add3DArchive(#PB_Compiler_Home+"examples/3D/Data/Scripts",#PB_3DArchive_FileSystem)
Parse3DScripts()
; WorldGravity(-3.05333)
Global cuerpomasa.f=1.0,cuerpoElasticidad.f=0.58,cuerpoRozamientoDinamico.f=0.91

#tex=0
#SueloTextura=2
#Material=0
#SueloMaterial=2
#luz=0
#Camara=0
#Pivotcamara=500
#Suelomalla=0
#Suelo=0
#fichamalla=1
CreateLight(#luz,$EEEEEE,0,128,0)
LoadTexture(#SueloTextura,"nvidia/growth_weirdfungus-03_diffusespecular.jpg"):CreateMaterial(#SueloMaterial,TextureID(#SueloTextura))
CreatePlane(#Suelomalla,90,180,1,1,1,1):CreateEntity(#Suelo,MeshID(#Suelomalla),MaterialID(#SueloMaterial),0,0,0):MoveEntity(#Suelo,0,0,-50)
CreateEntityBody(#Suelo,#PB_Entity_StaticBody,1.0,cuerpoElasticidad,cuerpoRozamientoDinamico)
AmbientColor($E1E9FD):SkyBox("desert07.jpg")
CreateCamera(#Camara,0,0,100,100):CreateNode(#Pivotcamara,0,0,0):AttachNodeObject(#Pivotcamara,CameraID(#Camara)):CameraRange(#Camara,0.1,10000):CameraBackColor(#Camara,$181911)
MoveNode(#Pivotcamara,0,0,0,#PB_Absolute):RotateNode(#Pivotcamara,-18,0,0,#PB_Absolute)
MoveCamera(#Camara,0,0,70,#PB_Absolute)
CameraLookAt(#Camara,0,0,0)

; Texturas y Materiales:
LoadTexture(#tex,"DosCarte.png")
CreateMaterial(#Material,TextureID(#tex))
; CreateCubeMapTexture(#tex,256,256,"CubeMapTexture",$55AA99DD); <- Should be the same name than in 'CubeMap.material' file
; GetScriptMaterial(#Material,"CubeMapMaterial")                   ; <- Should be the same name than in 'CubeMap.material' file

CreateCube(#fichamalla,1):TransformMesh(#fichamalla,0,0,0,1.5,3,0.4,0,0,0):UpdateMeshBoundingBox(#fichamalla)
SetMeshMaterial(#fichamalla,MaterialID(#Material),0)
For i.i=1 To 200
  CreateEntity(i,MeshID(#fichamalla),MaterialID(#Material))
  CreateEntityBody(i,#PB_Entity_BoxBody,cuerpomasa,cuerpoElasticidad,cuerpoRozamientoDinamico)
  radius.f=1.0+i/10.0
  ugol.f+1.0/radius
  x.f=radius*Sin(ugol)*2
  z.f=-radius*Cos(ugol)*2
  MoveEntity(i,x,1.5,z,#PB_Absolute)
  RotateEntity(i,0,-Degree(ugol)-90,0,#PB_Absolute)
Next
CreateEntity(i,MeshID(CreateSphere(#PB_Any,2)),MaterialID(#Material))
ugol.f+0.5/radius
MoveEntity(i,radius*Sin(ugol)*2,10,-radius*Cos(ugol)*2,#PB_Absolute)
CreateEntityBody(i,#PB_Entity_SphereBody,cuerpomasa,cuerpoElasticidad,cuerpoRozamientoDinamico)
ugol.f=#pi
For i.i=1 To 200
  CreateEntity(i+1001,MeshID(#fichamalla),MaterialID(#Material))
  CreateEntityBody(i+1001,#PB_Entity_BoxBody,cuerpomasa,cuerpoElasticidad,cuerpoRozamientoDinamico)
  radius.f=1.0+i/10.0
  ugol.f-1.0/radius
  x.f=radius*Sin(ugol)*2
  z.f=-radius*Cos(ugol)*2
  MoveEntity(i+1001,x,1.5,z-100,#PB_Absolute)
  RotateEntity(i+1001,0,-Degree(ugol)-90,0,#PB_Absolute)
Next
For i.i=2001 To 2026
  CreateEntity(i,MeshID(#fichamalla),MaterialID(#Material))
  CreateEntityBody(i,#PB_Entity_BoxBody,cuerpomasa,cuerpoElasticidad,cuerpoRozamientoDinamico)
  MoveEntity(i,-42,1.5,z-100+(i-2000)*3,#PB_Absolute)
  RotateEntity(i,0,0,0,#PB_Absolute)
Next
Procedure.b MouseButtonEdgeDetection(mbutton.b,status.b)
  Static mb.b:Protected i.b=1<<mbutton
  If status;<-if current key status is PUSHED
    If mb&i=0:mb|i:ProcedureReturn 1:EndIf;<-if previous key status was NOT PUSHED, then assign previous state to current one, and EXIT.
  ElseIf mb&i;<-else (if previous key status was PUSHED and current key status is NOT PUSHED):
    mb!i:ProcedureReturn -1;<-set previous key status to NOT PUSHED.
  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
Macro TeclaControldecamara(tecla=LeftControl)
  If KeyEdgeDetection(#PB_Key_#tecla#); <- inicia control camara
    pasocam.f=0.01:pasocamincr.f=0.01
  ElseIf KeyboardReleased(#PB_Key_#tecla#)
  ElseIf KeyboardPushed(#PB_Key_#tecla#); <- mover el punto de vista
    ;para desplazar la camara hacia delante, atras, arriba, abajo, izq o der
    If mdx Or mdy Or mdz
      If mmb.b
        MoveNode(#Pivotcamara,mdx*30,-mdy*30,0,#PB_Local); o MoveCamera(0,mdx,-mdy,0,#PB_Local) o MoveCamera(0,mdx,-mdy,0,#PB_Relative)
      Else
        RotateNode(#Pivotcamara,-mdy*30,-mdx*30,0,#PB_Relative)
        If mdz
          MoveCamera(#Camara,0,0,-mdz*6,#PB_Relative)
        EndIf
      EndIf
    ElseIf KeyboardPushed(#PB_Key_Add)
      MoveCamera(#Camara,0,0,-pasocam,#PB_Relative)
      pasocam+pasocamincr
    ElseIf KeyboardPushed(#PB_Key_Subtract)
      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_Pad7)
      RotateNode(#Pivotcamara,0,0.5,0,#PB_Relative)
    ElseIf KeyboardPushed(#PB_Key_Pad3) Or lmb.b
      RotateNode(#Pivotcamara,0,0,-0.5,#PB_Relative)
    ElseIf KeyboardPushed(#PB_Key_Pad9) Or rmb.b
      RotateNode(#Pivotcamara,0,0,0.5,#PB_Relative)
    EndIf
EndMacro
Repeat
  ExamineMouse():ExamineKeyboard()
  WaitWindowEvent()
  CursorX.f=MouseX():CursorY.f=MouseY():lmb.b=MouseButton(#PB_MouseButton_Left):rmb.b=MouseButton(#PB_MouseButton_Right):mmb.b=MouseButton(#PB_MouseButton_Middle)
  lmbe.b=MouseButtonEdgeDetection(#PB_MouseButton_Left,lmb.b):rmbe.b=MouseButtonEdgeDetection(#PB_MouseButton_Right,rmb.b):mmbe.b=MouseButtonEdgeDetection(#PB_MouseButton_Middle,mmb.b)
  mdx.f=MouseDeltaX()/80:mdy.f=MouseDeltaY()/80:mdz.f=MouseWheel()
  TeclaControldecamara()
  EndIf
  TimeSinceLastFrame.i=RenderWorld(50)
  FlipBuffers():Delay(1)
Until KeyboardPushed(#PB_Key_Escape)
All times are UTC+01:00
Page 2 of 2

Powered by phpBB® Forum Software © phpBB Limited