PureBasic Forums - English

Posted: **Tue Jul 08, 2014 6:12 pm**

EDIT: FOR PB 5.30 only. (Project removed - need space for something else)

Here the code: Use your own images.

;-----------------------------
;Torch demo   Test 3       ---
;-----------------------------
;By DK_PETER
;12-july-2014
;If you have an eye for details in flames/fire/explosions
;you'll find, that imitating real fire without some serious scripting
;is extremely difficult to do..
;It would be nice to see other fire examples.
;This time I've added randomness to 10 particle emitters
;Directions and materials are changed each time you run
;this code. It's getting there and right now it's usable.
;Onwards to test 4..

EnableExplicit

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

UseJPEGImageDecoder()
UsePNGImageDecoder()

DeclareModule tbr
  
  Declare.i SetResolution(Width.i = 1920,Height.i = 1080,Fullscreen.i = #False)
  Declare.i GameOn()
  
EndDeclareModule

Module tbr
  Structure _MESHDATA
    id.i
    mt.i
    tx.i
    ms.i
  EndStructure
  
  Declare.i Loadcave()
  Declare.i ReadyEveryting()
  Declare.i Loadcave()
  Declare.i LoadTorch()
  
  Global ca._MESHDATA,Tor._MESHDATA
  Global Dim par._MESHDATA(10)
  Global Cam.i,FS.i = #False
  Global light.i, light2.i
  
  Procedure.i SetResolution(Width.i = 1920,Height.i = 1080,Fullscreen.i = #False)
    FS = Fullscreen 
    If Fullscreen=#False
      win = OpenWindow(#PB_Any, 0, 0, Width, Height, "TBR",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
      scr = OpenWindowedScreen(WindowID(win), 0, 0, Width, Height, #False, 0, 0, #PB_Screen_SmartSynchronization)
    Else
      ;AntialiasingMode(#PB_AntialiasingMode_x6)
      scr = OpenScreen(Width, Height, 32, "TBR",#PB_Screen_SmartSynchronization, 60)
    EndIf
    Cam = CreateCamera(#PB_Any, 0, 0, 100, 100)
    WorldShadows(#PB_Shadow_TextureAdditive)
  EndProcedure
  
  Procedure.i ReadyEveryting()
    Add3DArchive("mesh",#PB_3DArchive_FileSystem)
    Add3DArchive("bitmap",#PB_3DArchive_FileSystem)
    Add3DArchive("material",#PB_3DArchive_FileSystem)
    Parse3DScripts()
  EndProcedure
  
  Procedure.f RandomF(min.f, Max.f, Res.i = 100000)
    ProcedureReturn (Min + (Max - Min) * Random(Res) / Res)
  EndProcedure
  
  Procedure.i Loadcave()
    ca\ms = LoadMesh(#PB_Any, "cave.mesh")
    ca\mt = GetScriptMaterial(#PB_Any, "cave_tex")
    ca\id = CreateEntity(#PB_Any, MeshID(ca\ms), #PB_Material_None, 0, 0, 0)
    ScaleEntity(ca\id, 1200,800,1200)
  EndProcedure
  
  Procedure.i returnDirection()
    Protected rdval.i = Random(10000,1)
    Select rdval
      Case 1 To 3333
        ProcedureReturn -1
      Case 3334 To 7000
        ProcedureReturn 0
      Default
        ProcedureReturn 1
    EndSelect
  EndProcedure
  
  Procedure.i LoadTorch()
    Protected Dim tx.i(5)
      Tor\ms = LoadMesh(#PB_Any, "torch.mesh")
      Tor\mt = GetScriptMaterial(#PB_Any, "Torchstick_tex")
      Tor\id = CreateEntity(#PB_Any, MeshID(Tor\ms),#PB_Material_None, 1, -1, -5)
      RotateEntity(Tor\id, 0,0,30)
      ScaleEntity(ca\id, 10,8,12)
      For x = 0 To 4
        tx(x) = LoadTexture(#PB_Any, Str(x+1) + ".jpg")
      Next x
      For x = 0 To 9
        par(x)\id = CreateParticleEmitter(#PB_Any, 0.4, 0.4, 0.2, #PB_Particle_Point, -0.1, 0.8, -4.6)
        ParticleEmitterDirection(par(x)\id,returnDirection(), 1, 0)
        par(x)\mt = CreateMaterial(#PB_Any, TextureID(tx(Random(4,0))))
        MaterialBlendingMode(par(x)\mt, #PB_Material_Add)
        ParticleMaterial(par(x)\id,MaterialID(par(x)\mt))
        ParticleEmissionRate(par(x)\id,Random(60,40))
        ParticleSize(par(x)\id, RandomF(1,3), Randomf(0.5,1.0))
        ParticleVelocity(par(x)\id, 0, 0.001)
        ParticleTimeToLive(par(x)\id, 0.1, 0.1)
        ParticleSpeedFactor(par(x)\id, 0.1)
      Next x
      light = CreateLight(#PB_Any, $00FFFF,-0.1, 0.8, -4.6,#PB_Light_Spot)
      LightDirection(light,0,1,0)
  EndProcedure
  
  lightms = ElapsedMilliseconds()
  Procedure.i GameOn()
    ReadyEveryting()
    Loadcave()
    LoadTorch()
    
    Repeat
      
      If FS = #False
        Repeat 
          ev = WindowEvent()
          If ev = #PB_Event_CloseWindow
            Quit = 1
          EndIf
        Until  ev=0
      EndIf
      ExamineMouse()
      mx.f = -MouseDeltaX() * 0.05
      my.f = -MouseDeltaY() * 0.05
      RotateCamera(Cam, my, mx, 0, #PB_Relative)
      ExamineKeyboard()
      RenderWorld()
      If ElapsedMilliseconds() - lightms > 80
        LightDirection(light, returnDirection(), 1, 0)
        lightms=ElapsedMilliseconds()
      EndIf
      FlipBuffers()
      
    Until KeyboardPushed(#PB_Key_Escape)
  EndProcedure
  
EndModule

tbr::SetResolution()
tbr::GameOn()

Posted: **Tue Jul 08, 2014 9:27 pm**

thats a dark surreal scene, i like it, regarding the torch, i saw in the book "PureBasic - A Beginner's Guide" http://purebasic.fr/english/viewtopic.php?f=14&t=37059
page 221 a torch in the hand of delphi. i have added it to your code it works but needs more adjustments. the book dephi torch example modified slightly (such as cameraLocate -> MoveCamera ...) to work in 5.30 can be downloaded from here
http://www.2shared.com/file/SybT72dU/221.html (click on the smaller download icon at the bottom and not the big one at the middle)

the code (needs the files in the above link)

Code: Select all

Enumeration
	#MESH
	#TEXTURE
	#MATERIAL
	#ENTITY
	#CAMERA_ONE
	#LIGHT_ONE
	#LIGHT_TWO
	#PARTICLE_ONE
EndEnumeration

;Set the width, height and bit depth of the screen
;Abbreviated variables are used here due to page width constraints :(
Global ScrW.l = 640
Global ScrH.l = 480
Global ScrD.l = 32
;Other global variables
Global Quit.b = #False

;Simple error checking procedure
Procedure HandleError(Result.l, Text.s)
	If Result = 0
		MessageRequester("Error", Text, #PB_MessageRequester_Ok)
		End
	EndIf
EndProcedure

;Convert Degrees to Radians
Procedure.f DegToRad(Angle.f)
	ProcedureReturn Angle.f * #PI / 180
EndProcedure

;Initialize environment
HandleError(InitEngine3D(), "InitEngine3D() command failed.")
HandleError(InitSprite(), "InitSprite() command failed.")
HandleError(OpenScreen(ScrW, ScrH, ScrD, ""), "Could not open screen.")
HandleError(InitKeyboard(), "InitKeyboard() command failed.")
SetFrameRate(60)

Add3DArchive("Data\", #PB_3DArchive_FileSystem)
Parse3DScripts()
CreateEntity(#ENTITY, LoadMesh(#MESH, "Statue.mesh"), #PB_Material_None)

LoadTexture(#TEXTURE, "Flame.png")
	CreateMaterial(#MATERIAL, TextureID(#TEXTURE))
	DisableMaterialLighting(#MATERIAL, 1)
	MaterialBlendingMode(#MATERIAL, #PB_Material_Add)

CreateParticleEmitter(#PARTICLE_ONE, 2, 2, 0,#PB_Particle_Point,12.9, 69, 15.7)
	ParticleSize(#PARTICLE_ONE, 5, 5)
	ParticleMaterial(#PARTICLE_ONE, MaterialID(#MATERIAL))
	ParticleEmissionRate(#PARTICLE_ONE, 50)
	ParticleTimeToLive(#PARTICLE_ONE, 0.25, 0.25)
	ParticleColorRange(#PARTICLE_ONE, RGB(255, 0, 0), RGB(255, 200, 0))
	ParticleVelocity(#PARTICLE_ONE, 1, 10)

CreateLight(#LIGHT_ONE, RGB(255,255,255))
CreateLight(#LIGHT_TWO, RGB(255, 200, 0), 12.9, 72, 15.7)
CreateCamera(#CAMERA_ONE, 0, 0, 100, 100)

;Main loop
Repeat

	Angle.f + 0.5
	PosX.f = 75 * Sin(DegToRad(Angle))
	PosY.f = (50 * Sin(DegToRad(Angle / 2))) + 65
	PosZ.f = 75 * Cos(DegToRad(Angle))
	MoveLight(#LIGHT_ONE, PosX, PosY + 100, PosZ)
	;LightColor(#LIGHT_TWO, RGB(255, Random(200), 0))
	SetLightColor(#LIGHT_TWO, #PB_Light_SpecularColor, RGB(255, Random(200), 0))
	MoveCamera(#CAMERA_ONE, PosX, PosY, PosZ, #PB_Absolute)
	CameraLookAt(#CAMERA_ONE, 0, 60, 0)
	RenderWorld()
	FlipBuffers()

	ExamineKeyboard()
	If KeyboardReleased(#PB_Key_Escape)
		Quit = #True
	EndIf
Until Quit = #True
End

Posted: **Tue Jul 08, 2014 10:01 pm**

Thank you for sharing with these two examples.

Posted: **Wed Jul 09, 2014 8:32 am**

@applePi
Thank you. Yeah, it's a good example.

@falsam
Anytime

Posted: **Sat Jul 12, 2014 2:52 pm**

First post updated..

Posted: **Sun Jul 13, 2014 9:15 am**

@DK_PETER: Looks very nice. Is it possible to add light and shadow, so that a flicker effect can be seen on the floor?

Posted: **Sun Jul 13, 2014 9:42 am**

dige wrote:@DK_PETER: Looks very nice. Is it possible to add light and shadow, so that a flicker effect can be seen on the floor?

Hey dige.

Yes, it's definately possible. I 've just been concentrating on getting my flames better for now.
Try something like this: I'll experiment with the shadows/lights some more later.

EDIT: for this code to work, you need to download TBR3.rar in the first post.

Code: Select all

EnableExplicit

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

UseJPEGImageDecoder()
UsePNGImageDecoder()

DeclareModule tbr
  
  Declare.i SetResolution(Width.i = 1920,Height.i = 1080,Fullscreen.i = #False)
  Declare.i GameOn()
  
EndDeclareModule

Module tbr
  Structure _MESHDATA
    id.i
    mt.i
    tx.i
    ms.i
  EndStructure
  
  Declare.i Loadcave()
  Declare.i ReadyEveryting()
  Declare.i Loadcave()
  Declare.i LoadTorch()
  
  Global ca._MESHDATA,Tor._MESHDATA
  Global Dim par._MESHDATA(10)
  Global Cam.i,FS.i = #False
  Global light.i
  
  Procedure.i SetResolution(Width.i = 1920,Height.i = 1080,Fullscreen.i = #False)
    FS = Fullscreen 
    If Fullscreen=#False
      win = OpenWindow(#PB_Any, 0, 0, Width, Height, "TBR",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
      scr = OpenWindowedScreen(WindowID(win), 0, 0, Width, Height, #False, 0, 0, #PB_Screen_SmartSynchronization)
    Else
      ;AntialiasingMode(#PB_AntialiasingMode_x6)
      scr = OpenScreen(Width, Height, 32, "TBR",#PB_Screen_SmartSynchronization, 60)
    EndIf
    Cam = CreateCamera(#PB_Any, 0, 0, 100, 100)
    WorldShadows(#PB_Shadow_TextureAdditive)
  EndProcedure
  
  Procedure.i ReadyEveryting()
    Add3DArchive("mesh",#PB_3DArchive_FileSystem)
    Add3DArchive("bitmap",#PB_3DArchive_FileSystem)
    Add3DArchive("material",#PB_3DArchive_FileSystem)
    Parse3DScripts()
  EndProcedure
  
  Procedure.f RandomF(min.f, Max.f, Res.i = 100000)
    ProcedureReturn (Min + (Max - Min) * Random(Res) / Res)
  EndProcedure
  
  Procedure.i Loadcave()
    ca\ms = LoadMesh(#PB_Any, "cave.mesh")
    ca\mt = GetScriptMaterial(#PB_Any, "cave_tex")
    ca\id = CreateEntity(#PB_Any, MeshID(ca\ms), #PB_Material_None, 0, 0, 0)
    ScaleEntity(ca\id, 1200,800,1200)
  EndProcedure
  
  Procedure.i returnDirection()
    Protected rdval.i = Random(10000,1)
    Select rdval
      Case 1 To 3333
        ProcedureReturn -1
      Case 3334 To 7000
        ProcedureReturn 0
      Default
        ProcedureReturn 1
    EndSelect
  EndProcedure
  
  Procedure.i LoadTorch()
    Protected Dim tx.i(5)
      Tor\ms = LoadMesh(#PB_Any, "torch.mesh")
      Tor\mt = GetScriptMaterial(#PB_Any, "Torchstick_tex")
      Tor\id = CreateEntity(#PB_Any, MeshID(Tor\ms),#PB_Material_None, 1, -1, -5)
      RotateEntity(Tor\id, 0,0,30)
      ScaleEntity(ca\id, 10,8,12)
      For x = 0 To 4
        tx(x) = LoadTexture(#PB_Any, Str(x+1) + ".jpg")
      Next x
      For x = 0 To 9
        par(x)\id = CreateParticleEmitter(#PB_Any, 0.4, 0.4, 0.2, #PB_Particle_Point, -0.1, 0.8, -4.6)
        ParticleEmitterDirection(par(x)\id,returnDirection(), 1, 0)
        par(x)\mt = CreateMaterial(#PB_Any, TextureID(tx(Random(4,0))))
        MaterialBlendingMode(par(x)\mt, #PB_Material_Add)
        ParticleMaterial(par(x)\id,MaterialID(par(x)\mt))
        ParticleEmissionRate(par(x)\id,Random(60,40))
        ParticleSize(par(x)\id, RandomF(1,3), Randomf(0.5,1.0))
        ParticleVelocity(par(x)\id, 0, 0.001)
        ParticleTimeToLive(par(x)\id, 0.1, 0.1)
        ParticleSpeedFactor(par(x)\id, 0.1)
      Next x
      light = CreateLight(#PB_Any, $00FFFF,-0.1, 0.8, -4.6,#PB_Light_Spot)  ;<-- changed color
      LightDirection(light,0,1,0)
  EndProcedure
  
  lightms = ElapsedMilliseconds()
  Procedure.i GameOn()
    ReadyEveryting()
    Loadcave()
    LoadTorch()
    
    Repeat
      
      If FS = #False
        Repeat 
          ev = WindowEvent()
          If ev = #PB_Event_CloseWindow
            Quit = 1
          EndIf
        Until  ev=0
      EndIf
      ExamineMouse()
      mx.f = -MouseDeltaX() * 0.05
      my.f = -MouseDeltaY() * 0.05
      RotateCamera(Cam, my, mx, 0, #PB_Relative)
      ExamineKeyboard()
      RenderWorld()
      If ElapsedMilliseconds() - lightms > 80  ;<--changed value from 30.. Looks much better now
        LightDirection(light, returnDirection(), 1, 0)
        lightms=ElapsedMilliseconds()
      EndIf
      FlipBuffers()
      
    Until KeyboardPushed(#PB_Key_Escape)
  EndProcedure
  
EndModule

tbr::SetResolution()
tbr::GameOn()

Posted: **Sun Jul 13, 2014 1:55 pm**

Amazing!! Thank you DK_PETER

PureBasic Forums - English

Torch demo

Torch demo

Re: Torch demo

Re: Torch demo

Re: Torch demo

Re: Torch demo

Re: Torch demo

Re: Torch demo

Re: Torch demo