PureBasic Forums - English

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

Mouse button event like PB style for 3D

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

Page 1 of 1

Mouse button event like PB style for 3D

Posted: Sat Apr 12, 2025 8:17 pm
by minimy
This is as tittle say, an easy way to control the 3 mouse buttons. Idk if this is the right way to do it.
Return 3 posible events: Left, middle and right button down and up.

Code: Select all

Global.b  sal
Global.l  renderTime
Global    camara

Procedure   control3D(camara)
  Protected.f speed=0.005, mouseSpd=0.005
  Protected.f KeyX,KeyY, MouseX,MouseY
  
  If KeyboardPushed(#PB_Key_A)
    KeyX= -speed * renderTime
  ElseIf KeyboardPushed(#PB_Key_D)
    KeyX= speed * renderTime
  Else
    KeyX= 0
  EndIf
  
  If KeyboardPushed(#PB_Key_W)
    KeyY= -speed * renderTime
  ElseIf KeyboardPushed(#PB_Key_S)
    KeyY= speed * renderTime
  Else
    KeyY= 0
  EndIf
  
  If KeyboardPushed(#PB_Key_LeftShift)
    keyY * 10
    keyX * 10
  EndIf

  MouseX = -MouseDeltaX() * mouseSpd * renderTime
  MouseY = -MouseDeltaY() * mouseSpd * renderTime
  
  RotateCamera(camara, MouseY, MouseX, 0, #PB_Relative)
  MoveCamera (camara, KeyX, 0, KeyY)
EndProcedure
Procedure   iniDX(title.s="")
  Protected w,h
  UsePNGImageDecoder()
  UseJPEGImageDecoder()
  
  InitEngine3D()
  InitSprite()
  InitKeyboard()
  InitMouse()
  OpenWindow(0,0,0,800,600,title,#PB_Window_ScreenCentered|#PB_Window_BorderLess|#PB_Window_Maximize);|#PB_Window_Invisible)
  SetWindowColor(0,$444444)
  w= WindowWidth(0):h=WindowHeight(0)
  AntialiasingMode(#PB_AntialiasingMode_None)
  OpenWindowedScreen(WindowID(0), 0, 0, w,h, 0,0,0,#PB_Screen_NoSynchronization)
  KeyboardMode(#PB_Keyboard_International)
  s=128
  WorldShadows(#PB_Shadow_Modulative, -1, RGB(s,s,s))
;   EnableWorldPhysics(1)
;   EnableWorldCollisions(1)
  suelo_tx3D=   CreateTexture(#PB_Any,250,250)
  StartDrawing(TextureOutput(suelo_tx3D))
    Box(0,0,OutputWidth(),OutputHeight(),$555555)
    Box(2,2,OutputWidth()-4,OutputHeight()-4,$bbbbbb)
  StopDrawing()
  
  suelo_mesh=   CreatePlane(#PB_Any,50,50,1,1,1,1)
  suelo_mate=   CreateMaterial(#PB_Any,TextureID(suelo_tx3D))
                ScaleMaterial(suelo_mate,1/50,1/50)
  suelo=        CreateEntity(#PB_Any, MeshID(suelo_mesh), MaterialID(suelo_mate))
  
  cubo_mesh=    CreateCube(#PB_Any,2)
  cubo_mate=    CreateMaterial(#PB_Any, #Null,$0000ff)
  cubo_enti=    CreateEntity(#PB_Any, MeshID(cubo_mesh), MaterialID(cubo_mate),0,1,0)
  luz=          CreateLight(#PB_Any,$ffffff,30,50,0,#PB_Light_Point)
  
  camara=       CreateCamera(#PB_Any,0,0,100,100)
                MoveCamera(camara,0,5,30)
                CameraBackColor(camara,$556677)
                CameraRange(camara, 0.1,1000)
EndProcedure

iniDX("Base 3D")
              
#mouseButton_Left_Down=   1
#mouseButton_Left_Up=     2
#mouseButton_Right_Down=  3
#mouseButton_Right_Up=    4
#mouseButton_Middle_Down= 5
#mouseButton_Middle_Up=   6
Procedure   mouseButtonEvent()
  Static Dim b(3)
  If MouseButton(#PB_MouseButton_Left)
    If b(#PB_MouseButton_Left)=#False
      b(#PB_MouseButton_Left)= #True: ProcedureReturn #mouseButton_Left_Down
    EndIf
  Else
    If b(#PB_MouseButton_Left)=#True
      b(#PB_MouseButton_Left)=#False: ProcedureReturn #mouseButton_Left_Up
    EndIf
  EndIf
  If MouseButton(#PB_MouseButton_Middle)
    If b(#PB_MouseButton_Middle)=#False
      b(#PB_MouseButton_Middle)= #True: ProcedureReturn #mouseButton_Middle_Down
    EndIf
  Else
    If b(#PB_MouseButton_Middle)=#True
      b(#PB_MouseButton_Middle)=#False: ProcedureReturn #mouseButton_Middle_Up
    EndIf
  EndIf
  If MouseButton(#PB_MouseButton_Right)
    If b(#PB_MouseButton_Right)=#False
      b(#PB_MouseButton_Right)= #True: ProcedureReturn #mouseButton_Right_Down
    EndIf
  Else
    If b(#PB_MouseButton_Right)=#True
      b(#PB_MouseButton_Right)=#False: ProcedureReturn #mouseButton_Right_Up
    EndIf
  EndIf
  
EndProcedure

Repeat
  Repeat : event= WindowEvent(): Until event= 0
  
  ExamineKeyboard()
  ExamineMouse()
  control3D(camara)
  If KeyboardPushed(#PB_Key_Escape)
    sal=1
  EndIf
  
  Select mouseButtonEvent()
    Case #mouseButton_Left_Down
      Debug "Clik Left"
    Case #mouseButton_Left_Up
      Debug "Up Left"
    Case #mouseButton_Middle_Down
      Debug "Clik Middle"
    Case #mouseButton_Middle_Up
      Debug "Up Middle"
    Case #mouseButton_Right_Down
      Debug "Clik Right"
    Case #mouseButton_Right_Up
      Debug "Up Right"
  EndSelect
  
  renderTime = RenderWorld()
      
  FlipBuffers()
  Delay(1)
Until sal=1

Re: Mouse button event like PB style for 3D

Posted: Sun Apr 13, 2025 7:37 pm
by SMaag
On PB6.20 Win10 it crashes in inDX (other Versions of PB I did not check!)
Why I don't know! Does not matter ASM or C-Backend.
If Debugger is on: "The debugger executable quit unexpectedly"

Re: Mouse button event like PB style for 3D

Posted: Sun Apr 13, 2025 8:07 pm
by miso
It's the shadows. Remove it. Works different with different PB versions, and does not needed in examples that not shadow related.

OK, heres the 6.20 - 6.21 beta4 compatible version (shadow requires shaders in the newest PB versions, so have to parse its scripts):

Code: Select all

Global.b  sal
Global.l  renderTime
Global    camara

Procedure   control3D(camara)
  Protected.f speed=0.005, mouseSpd=0.005
  Protected.f KeyX,KeyY, MouseX,MouseY
  
  If KeyboardPushed(#PB_Key_A)
    KeyX= -speed * renderTime
  ElseIf KeyboardPushed(#PB_Key_D)
    KeyX= speed * renderTime
  Else
    KeyX= 0
  EndIf
  
  If KeyboardPushed(#PB_Key_W)
    KeyY= -speed * renderTime
  ElseIf KeyboardPushed(#PB_Key_S)
    KeyY= speed * renderTime
  Else
    KeyY= 0
  EndIf
  
  If KeyboardPushed(#PB_Key_LeftShift)
    keyY * 10
    keyX * 10
  EndIf

  MouseX = -MouseDeltaX() * mouseSpd * renderTime
  MouseY = -MouseDeltaY() * mouseSpd * renderTime
  
  RotateCamera(camara, MouseY, MouseX, 0, #PB_Relative)
  MoveCamera (camara, KeyX, 0, KeyY)
EndProcedure
Procedure   iniDX(title.s="")
  Protected w,h
  UsePNGImageDecoder()
  UseJPEGImageDecoder()
  
  InitEngine3D()
  InitSprite()
  InitKeyboard()
  InitMouse()
  OpenWindow(0,0,0,800,600,title,#PB_Window_ScreenCentered|#PB_Window_BorderLess|#PB_Window_Maximize);|#PB_Window_Invisible)
  SetWindowColor(0,$444444)
  w= WindowWidth(0):h=WindowHeight(0)
  AntialiasingMode(#PB_AntialiasingMode_None)
  OpenWindowedScreen(WindowID(0), 0, 0, w,h, 0,0,0,#PB_Screen_NoSynchronization)
  Add3DArchive(#PB_Compiler_Home + "examples/3d/Data/Main", #PB_3DArchive_FileSystem)
  Parse3DScripts()
  
  
  KeyboardMode(#PB_Keyboard_International)
  s=128
  WorldShadows(#PB_Shadow_Modulative, -1, RGB(s,s,s))
;   EnableWorldPhysics(1)
;   EnableWorldCollisions(1)
  suelo_tx3D=   CreateTexture(#PB_Any,250,250)
  StartDrawing(TextureOutput(suelo_tx3D))
    Box(0,0,OutputWidth(),OutputHeight(),$555555)
    Box(2,2,OutputWidth()-4,OutputHeight()-4,$bbbbbb)
  StopDrawing()
  
  suelo_mesh=   CreatePlane(#PB_Any,50,50,1,1,1,1)
  suelo_mate=   CreateMaterial(#PB_Any,TextureID(suelo_tx3D))
                ScaleMaterial(suelo_mate,1/50,1/50)
  suelo=        CreateEntity(#PB_Any, MeshID(suelo_mesh), MaterialID(suelo_mate))
  
  cubo_mesh=    CreateCube(#PB_Any,2)
  cubo_mate=    CreateMaterial(#PB_Any, #Null,$0000ff)
  cubo_enti=    CreateEntity(#PB_Any, MeshID(cubo_mesh), MaterialID(cubo_mate),0,1,0)
  luz=          CreateLight(#PB_Any,$ffffff,30,50,0,#PB_Light_Point)
  
  camara=       CreateCamera(#PB_Any,0,0,100,100)
                MoveCamera(camara,0,5,30)
                CameraBackColor(camara,$556677)
                CameraRange(camara, 0.1,1000)
EndProcedure

iniDX("Base 3D")
              
#mouseButton_Left_Down=   1
#mouseButton_Left_Up=     2
#mouseButton_Right_Down=  3
#mouseButton_Right_Up=    4
#mouseButton_Middle_Down= 5
#mouseButton_Middle_Up=   6
Procedure   mouseButtonEvent()
  Static Dim b(3)
  If MouseButton(#PB_MouseButton_Left)
    If b(#PB_MouseButton_Left)=#False
      b(#PB_MouseButton_Left)= #True: ProcedureReturn #mouseButton_Left_Down
    EndIf
  Else
    If b(#PB_MouseButton_Left)=#True
      b(#PB_MouseButton_Left)=#False: ProcedureReturn #mouseButton_Left_Up
    EndIf
  EndIf
  If MouseButton(#PB_MouseButton_Middle)
    If b(#PB_MouseButton_Middle)=#False
      b(#PB_MouseButton_Middle)= #True: ProcedureReturn #mouseButton_Middle_Down
    EndIf
  Else
    If b(#PB_MouseButton_Middle)=#True
      b(#PB_MouseButton_Middle)=#False: ProcedureReturn #mouseButton_Middle_Up
    EndIf
  EndIf
  If MouseButton(#PB_MouseButton_Right)
    If b(#PB_MouseButton_Right)=#False
      b(#PB_MouseButton_Right)= #True: ProcedureReturn #mouseButton_Right_Down
    EndIf
  Else
    If b(#PB_MouseButton_Right)=#True
      b(#PB_MouseButton_Right)=#False: ProcedureReturn #mouseButton_Right_Up
    EndIf
  EndIf
  
EndProcedure

Repeat
  Repeat : event= WindowEvent(): Until event= 0
  
  ExamineKeyboard()
  ExamineMouse()
  control3D(camara)
  If KeyboardPushed(#PB_Key_Escape)
    sal=1
  EndIf
  
  Select mouseButtonEvent()
    Case #mouseButton_Left_Down
      Debug "Clik Left"
    Case #mouseButton_Left_Up
      Debug "Up Left"
    Case #mouseButton_Middle_Down
      Debug "Clik Middle"
    Case #mouseButton_Middle_Up
      Debug "Up Middle"
    Case #mouseButton_Right_Down
      Debug "Clik Right"
    Case #mouseButton_Right_Up
      Debug "Up Right"
  EndSelect
  
  renderTime = RenderWorld()
      
  FlipBuffers()
  Delay(1)
Until sal=1

Re: Mouse button event like PB style for 3D

Posted: Sun Apr 13, 2025 11:07 pm
by minimy
Hey miso, you save me again :)
Sorry, when i program in my old small laptop use pb 6.02 and forget include it.
I know,.. miso tell me it ten times :mrgreen:
Thanks again miso, i learn a lot with you and you are allways ready to help.

Shader is loaded in automatic way?
No docs talking about this in the PB help.
Add3DArchive(#PB_Compiler_Home + "examples/3d/Data/Main", #PB_3DArchive_FileSystem)

Re: Mouse button event like PB style for 3D

Posted: Sun Apr 13, 2025 11:21 pm
by miso
I belive, if you ship a compiled program, you need to ship these shaders too. Not tested this part too deeply.
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited