;; ----------------------------------------------------------------------------
;; Irrlicht Wrapper For Imperative Languages - Purebasic Examples
;; IrrlichtWrapper and FreeBasic-Example by Frank Dodd (2006)
;; Improved IrrlichtWrapper and PureBasicExample by Michael Taupitz (2006)
;; ----------------------------------------------------------------------------
;; Example 07: Particle System
;; This example creates a couple of simple particle systems To demonstrate
;; particle system effects
;; ----------------------------------------------------------------------------

;; ////////////////////////////////////////////////////////////////////////////
;; Include the Irr3D-Requester
XIncludeFile "Irr3DRequester.pb"

Structure sAnimator
  type.l
EndStructure

Structure sColor 
  Alpha.l
  Red.l
  Green.l
  Blue.l 
EndStructure

Structure sAffector
  fadeOutColor.sColor 
  gravity.IRR_VECTOR
  fadeOutTime.l
  timeForceLost.l 
EndStructure


; a structure to hold a Dimension in Floats
Structure IRR_DIM2DF
  width.f;
  Height.f
EndStructure
  

Structure sMParticle
  pos.IRR_VECTOR
  size.IRR_DIM2DF 
  scale.IRR_VECTOR
  mat_type.l
  texture.s
EndStructure
  

Structure sEmitter
  properties.IRR_PARTICLE_EMITTER
  affector.sAffector
  particle.sMParticle
EndStructure


Procedure _readEmitterXML(*Node,*em.IRR_PARTICLE_EMITTER) 
  Define childnum.l
  Define xname.s
  Define *child.l
  
  For childnum = 1 To XMLChildCount(*Node)
    *child = ChildXMLNode(*Node, childnum)    
    If XMLNodeType(*child) = #PB_XML_Normal
      xname = GetXMLNodeName(*child)
      
      If xname = "emitterBox"
        *em\min_box_x = 0 
        *em\min_box_y = 0
        *em\min_box_z = 0
        *em\max_box_x = ValF(GetXMLAttribute(*child,"w"))
        *em\max_box_y = ValF(GetXMLAttribute(*child,"h"))
        *em\max_box_z = ValF(GetXMLAttribute(*child,"l"))
        Debug("EmitterBox x="+StrF(*em\max_box_x)+", y="+StrF(*em\max_box_y)+", z="+StrF(*em\max_box_z) )
      ElseIf xname = "direction"      
        *em\direction_x = ValF(GetXMLAttribute(*child,"x"))
        *em\direction_y = ValF(GetXMLAttribute(*child,"y"))
        *em\direction_z = ValF(GetXMLAttribute(*child,"z"))
        Debug("Direction x="+StrF(*em\direction_x)+", y="+StrF(*em\direction_y)+", z="+StrF(*em\direction_z) )
      ElseIf xname = "rate"      
        *em\min_paritlcles_per_second = Val(GetXMLAttribute(*child,"min"))
        *em\max_paritlcles_per_second = Val(GetXMLAttribute(*child,"max"))
        Debug("ParticlePerSecond min="+Str(*em\min_paritlcles_per_second)+", max="+Str(*em\max_paritlcles_per_second)) 
      ElseIf xname = "minStartColor"      
        *em\min_start_color_red = Val(GetXMLAttribute(*child,"r"))
        *em\min_start_color_green = Val(GetXMLAttribute(*child,"g"))
        *em\min_start_color_blue = Val(GetXMLAttribute(*child,"b"))
      ElseIf xname = "maxStartColor"      
        *em\max_start_color_red = Val(GetXMLAttribute(*child,"r"))
        *em\max_start_color_green = Val(GetXMLAttribute(*child,"g"))
        *em\max_start_color_blue = Val(GetXMLAttribute(*child,"b"))
      ElseIf xname = "life"      
        *em\min_lifetime = Val(GetXMLAttribute(*child,"min"))
        *em\max_lifetime = Val(GetXMLAttribute(*child,"max"))
      ElseIf xname = "maxAngle"                    
        *em\max_angle_degrees = ValF(GetXMLAttribute(*child,"degrees"))
      EndIf
                  
    EndIf
    
  Next childnum  
; ProcedureReturn 
EndProcedure


Procedure _readParticleXML(*Node, *pat.sMParticle) 
  Define childnum.l
  Define xname.s
  Define *child.l
  
  For childnum = 1 To XMLChildCount(*Node)
    *child = ChildXMLNode(*Node, childnum)    
    If XMLNodeType(*child) = #PB_XML_Normal
      xname = GetXMLNodeName(*child)
      
      If xname = "position"
        *pat\pos\x = ValF(GetXMLAttribute(*child,"x"))
        *pat\pos\y = ValF(GetXMLAttribute(*child,"y"))
        *pat\pos\z = ValF(GetXMLAttribute(*child,"z"))
      ElseIf xname = "scale"      
        *pat\scale\x = ValF(GetXMLAttribute(*child,"x"))
        *pat\scale\y = ValF(GetXMLAttribute(*child,"y"))
        *pat\scale\z = ValF(GetXMLAttribute(*child,"z"))
      ElseIf xname = "material"      
        *pat\mat_type = Val(GetXMLAttribute(*child,"type"))
      ElseIf xname = "size"      
        *pat\size\width = ValF(GetXMLAttribute(*child,"width"))
        *pat\size\height = ValF(GetXMLAttribute(*child,"height"))
      ElseIf xname = "texture"      
        *pat\texture = GetXMLAttribute(*child,"name")
      EndIf
    EndIf
    
  Next childnum  
; ProcedureReturn 
EndProcedure


Procedure _readAffectorXML(*Node, *af.sAffector) 
  Define childnum.l
  Define xname.s
  Define *child.l
  
  For childnum = 1 To XMLChildCount(*Node)
    *child = ChildXMLNode(*Node, childnum)    
    If XMLNodeType(*child) = #PB_XML_Normal
      xname = GetXMLNodeName(*child)
      
      If xname = "targetColor"
        *af\fadeOutColor\alpha = Val(GetXMLAttribute(*child,"a"))
        *af\fadeOutColor\red = Val(GetXMLAttribute(*child,"r"))
        *af\fadeOutColor\green = Val(GetXMLAttribute(*child,"g"))
        *af\fadeOutColor\blue = Val(GetXMLAttribute(*child,"b"))
      ElseIf xname = "fadeOutTime"      
        *af\fadeOutTime = ValF(GetXMLAttribute(*child,"time"))
      ElseIf xname = "gravity"      
        *af\gravity\x = ValF(GetXMLAttribute(*child,"x"))
        *af\gravity\y = ValF(GetXMLAttribute(*child,"y"))
        *af\gravity\z = ValF(GetXMLAttribute(*child,"z"))
      ElseIf xname = "timeForceLost"      
        *af\timeForceLost = Val(GetXMLAttribute(*child,"time"))
      EndIf
    EndIf
  Next childnum  

EndProcedure





Procedure _readEffectXML(*Node,*preset.sEmitter)
 Define childnum.l
  Define xname.s
  Define *child.l
  
  For childnum = 1 To XMLChildCount(*Node)
    *child = ChildXMLNode(*Node, childnum)    
    If XMLNodeType(*child) = #PB_XML_Normal
      xname = GetXMLNodeName(*child)
           
      If xname="emitter"
        *em.IRR_PARTICLE_EMITTER = _readEmitterXML(*child,*preset\properties)
      ElseIf xname="particle"
        *particle.sMParticle = _readParticleXML(*child,*preset\particle)
      ElseIf xname="Affector"
        *affector.sAffector = _readAffectorXML(*child,*preset\affector)
      EndIf 
    EndIf
    
  Next childnum    
  ProcedureReturn @preset
EndProcedure 

Procedure initParticleFromXML(filename.s,emittername.s,*preset.sEmitter,basedir.s="")


 Define childnum.l
  Define xname.s,xname2.s
  Define *child.l

  If FileSize(filename) > 0
    tree = 0
    If LoadXML(tree, filename)
      Debug "Tree = "+Str(tree)
      Status = XMLStatus(tree)
      Debug "Status = "+Str(Status)    
      

          If Status=0
        *Node = MainXMLNode(tree)
        While *Node  
          xname.s = GetXMLNodeName(*Node)
          Debug(GetXMLNodeName(*Node))
          If xname="particled"
    
  
            For childnum = 1 To XMLChildCount(*Node)
              *child = ChildXMLNode(*Node, childnum)    
              If XMLNodeType(*child) = #PB_XML_Normal
                xname2 = GetXMLNodeName(*child)
                If xname2="effect"  And GetXMLAttribute(*child,"name") = emittername
                  Debug("Read Preset "+emittername)
                  ProcedureReturn _readEffectXML(*child,*preset)
                EndIf
              EndIf
            Next
            
          EndIf
          *Node = NextXMLNode(*Node)
        Wend
      Else 
        MessageRequester("Error in XML-File","Error (line "+Str(XMLErrorLine(tree))+") ="+XMLError(tree) +Chr(10) +"File="+filename)
      EndIf
      FreeXML(tree)
    EndIf
  EndIf     
  
EndProcedure 




Procedure readPresetnamesFromXML(filename.s,combobox.l)

 Define childnum.l
  Define xname.s,xname2.s
  Define *child.l

  If FileSize(filename) > 0
    tree = 0
    If LoadXML(tree, filename)
      Debug "Tree = "+Str(tree)
      Status = XMLStatus(tree)
      Debug "Status = "+Str(Status)    
      

          If Status=0
        *Node = MainXMLNode(tree)
        While *Node  
          xname.s = GetXMLNodeName(*Node)
          Debug(GetXMLNodeName(*Node))
          If xname="particled"
    
  
            For childnum = 1 To XMLChildCount(*Node)
              *child = ChildXMLNode(*Node, childnum)    
              If XMLNodeType(*child) = #PB_XML_Normal
                xname2 = GetXMLNodeName(*child)
                If xname2="effect"             
                  AddGadgetItem(combobox, -1, GetXMLAttribute(*child,"name"))                       
                EndIf
              EndIf
            Next
          EndIf
          *Node = NextXMLNode(*Node)
        Wend
      Else 
        MessageRequester("Error in XML-File","Error (line "+Str(XMLErrorLine(tree))+") ="+XMLError(tree) +Chr(10) +"File="+filename)
      EndIf
      FreeXML(tree)
    EndIf
  EndIf     
  
EndProcedure 


Procedure dumpy(*preset.sEmitter)
  Debug("Preset")
  Debug("Particle: Texture ="+ *preset\particle\texture)
EndProcedure 



Procedure InitParticleSystem(*preset.sEmitter)

      *ParticlesNode = IrrAddParticleSystemToScene( #IRR_NO_EMITTER ) 
      *em.l = IrrAddParticleEmitter( *ParticlesNode, *preset\properties )
      
      IrrSetParticleSize( *ParticlesNode, *preset\particle\size\width, *preset\particle\size\height)
      
      IrrAddFadeOutParticleAffector( *ParticlesNode )
      
;       box = ReadPreferenceString("affector_gravity","0.0,0.03,0.0")
;       Debug("affector_gravity="+box)
      IrrAddGravityParticleAffector ( *ParticlesNode, *preset\affector\gravity\x, *preset\affector\gravity\y, *preset\affector\gravity\z)
      
      *ParticleTexture = IrrGetTexture( *preset\particle\texture )  
      IrrSetNodeMaterialTexture( *ParticlesNode, *ParticleTexture, 0 ) 
      IrrSetNodeMaterialFlag( *ParticlesNode, #IRR_EMF_LIGHTING, #IRR_OFF )
      IrrSetNodeMaterialType ( *ParticlesNode, *preset\particle\mat_type)
      ClosePreferences()
      ProcedureReturn *ParticlesNode
EndProcedure 
    




Procedure.l initParticleFromFile(filename.s,emittername.s,basedir.s="")
  Define *ParticlesNode.irr_node
  Define *ParticleTexture.irr_texture
  Define Emitter.IRR_PARTICLE_EMITTER
  Define box.s,op.l,*em.l
  
  If Len(basedir)=0 
    basedir = GetPathPart(filename)
  EndIf
  
  
  op.l = OpenPreferences(filename)
  If op
    If PreferenceGroup(emittername)
      box = ReadPreferenceString("emitterBox","0,0,0")
      Debug("emitterBox="+box)
      Emitter\min_box_x = 0 
      Emitter\min_box_y = 0
      Emitter\min_box_z = 0
      Emitter\max_box_x = ValF(Trim(StringField(box,1,",")))
      Emitter\max_box_y = ValF(Trim(StringField(box,2,",")))
      Emitter\max_box_z = ValF(Trim(StringField(box,3,",")))
      
      box = ReadPreferenceString("direction","0,0,0")
      Debug("direction="+box)
      Emitter\direction_x = ValF(Trim(StringField(box,1,",")))
      Emitter\direction_y = ValF(Trim(StringField(box,2,",")))
      Emitter\direction_z = ValF(Trim(StringField(box,3,",")))
      
      
      Emitter\min_paritlcles_per_second = ReadPreferenceLong("min_rate",80)
      Emitter\max_paritlcles_per_second = ReadPreferenceLong("max_rate",100)
      
      box = ReadPreferenceString("min_startcolor","0,0,0,0")
      Debug("min_startcolor="+box)
      Emitter\min_start_color_red = Val(Trim(StringField(box,2,",")))
      Emitter\min_start_color_green = Val(Trim(StringField(box,3,",")))
      Emitter\min_start_color_blue = Val(Trim(StringField(box,4,",")))
      
      box = ReadPreferenceString("max_startcolor","0,0,0,0")
      Debug("max_startcolor="+box)
      Emitter\max_start_color_red = Val(Trim(StringField(box,2,",")))
      Emitter\max_start_color_green = Val(Trim(StringField(box,3,",")))
      Emitter\max_start_color_blue = Val(Trim(StringField(box,4,",")))
      
      Emitter\min_lifetime = ReadPreferenceLong("min_life",800)
      Emitter\max_lifetime = ReadPreferenceLong("max_life",2000)
      
      Emitter\max_angle_degrees = ReadPreferenceFloat("min_angle",0.0)
      
      
      *ParticlesNode = IrrAddParticleSystemToScene( #IRR_NO_EMITTER ) 
      *em.l = IrrAddParticleEmitter( *ParticlesNode, @Emitter )
      
      box = ReadPreferenceString("particle_width","3.0000,3.0000")
      Debug("particle_width="+box)
      IrrSetParticleSize( *ParticlesNode, ValF(Trim(StringField(box,1,","))),ValF(Trim(StringField(box,2,","))))
      
      IrrAddFadeOutParticleAffector( *ParticlesNode )
      
      box = ReadPreferenceString("affector_gravity","0.0,0.03,0.0")
      Debug("affector_gravity="+box)
      IrrAddGravityParticleAffector ( *ParticlesNode, ValF(Trim(StringField(box,1,","))),ValF(Trim(StringField(box,2,","))),ValF(Trim(StringField(box,3,","))))
      
      box = ReadPreferenceString("particle_texture","missing_in_ini")
      Debug("particle_texture="+box)
      *ParticleTexture = IrrGetTexture( basedir + "\" + box )  
      IrrSetNodeMaterialTexture( *ParticlesNode, *ParticleTexture, 0 ) 
      IrrSetNodeMaterialFlag( *ParticlesNode, #IRR_EMF_LIGHTING, #IRR_OFF )
      IrrSetNodeMaterialType ( *ParticlesNode, ReadPreferenceLong("particle_type",15))
      ClosePreferences()
      ProcedureReturn *ParticlesNode
      
    EndIf
    ClosePreferences() 
  EndIf
  
  ProcedureReturn #Null
  
EndProcedure

;- Start


; -----------------------------------------------------------------------------
; To Start the Irrlicht-Device we use the Irr3DRequester, to make it more comfortable
; for the Users, and also easier to test different resolutions and devices.
If Irr3DRequester(#False)  ;#False say, we have to create the IrrlichtDevice 
  
  ;; Open a Window with a Button Gadgets
  winID.l=OpenWindow(#PB_Any,0,0,640,480,"24 Example - Irrlicht Embedded", #PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_WindowCentered)
  
  ; Create the Button and the ImageGadget
  If CreateGadgetList(WindowID(winID)) 
    button = ButtonGadget(#PB_Any,10,10,80,20,"IrrLicht")
    igIrrlicht = ImageGadget(#PB_Any,100,20,480,360,0) 
    DisableGadget(igIrrlicht,#True);    
    combobox = ComboBoxGadget(#PB_Any, 10,40,80,200)
;     If OpenPreferences("../media/particles.ini")
;       If ExaminePreferenceGroups() 
;         While NextPreferenceGroup()
;           AddGadgetItem(combobox, -1, PreferenceGroupName()) 
;         Wend
;       EndIf
;       ClosePreferences()
;     EndIf
  readPresetnamesFromXML("presets.xml", combobox)
    
    
  EndIf
  
  
  myMenu.l = CreateMenu(0,WindowID(winID)    )
  MenuTitle("Main")
  MenuItem(0,"Info")
  MenuItem(0,"Quit")
  
  If IrrStartEx(irr3DRequesterSetting\device,400,200,#False, irr3DRequesterSetting\stencilshadows,#True, irr3DRequesterSetting\videomode\depth, irr3DRequesterSetting\antialiasing, irr3DRequesterSetting\useFPu,irr3DRequesterSetting\vsync,GadgetID(igIrrlicht) )      
    
    
    ; add a fixed position camera to the scene so we can view the particle system.
    ; the first three parameters are the cameras location, the second three
    ; parameters are where the camera is looking at
    *camera = IrrAddCamera( 80,30,0, 70,30,0 )
;    *camera = IrrAddFPSCamera()
    ;  ParticleFire()
    Define *nodus.l
    Define preset.sEmitter
    
    initParticleFromXML("presets.xml","Amoeba", @preset)
    *nodus.l =  initParticleSystem(@preset)
    If *nodus
      IrrSetNodePosition(*nodus,70,30,0)
;      IrrAddFlyCircleAnimator(*nodus,50,30,0,2, 0.01)
    EndIf

    *back.irr_texture = IrrGetTexture(".\grid.tga")
    Dim *textures.irr_texture(6)
    
    *SkyBox = IrrAddSkyBoxToScene( *back,*back,*back,*back,*back,*back)      
    
    ; -----------------------------------------------------------------------------
    ; here is the Window-Mainloop
    Repeat
      Event.l = WindowEvent()
      If EventWindow() = winID
        Select Event
          Case #PB_Event_Gadget
            Select EventGadget()                
              Case button
                MessageRequester("Test","Uh a Button")
              Case combobox              
                 If *nodus <> #Null
                   IrrRemoveNode(*nodus)
                 EndIf
                 *nodus = initParticleFromXML("presets.xml",GetGadgetText(combobox),@preset)
                  *nodus.l =  initParticleSystem(@preset)
                 IrrSetNodePosition(*nodus,70,30,0)
            EndSelect
            
        EndSelect
      EndIf
      
      ;This is the main-Irrlicht Loop  
      If IrrRunning()
        IrrBeginScene( 0,0,0)
        ; draw the scene
        IrrDrawScene()      
        ; draw the GUI
        IrrDrawGUI()
        ; end drawing the scene and render it
        IrrEndScene()
      EndIf
      
      
      Delay(20)     
    Until Event = #PB_Event_CloseWindow 
    
    
    ; -----------------------------------------------------------------------------
    ; Stop the irrlicht engine and release resources
    IrrStop()
  EndIf
  
  ; -----------------------------------------------------------------------------
  ; Close the Window after stopped the Engine
  CloseWindow(winID)
EndIf

End


; jaPBe Version=3.7.2.629
; Build=0
; FirstLine=126
; CursorPosition=133
; ExecutableFormat=Windows
; DontSaveDeclare
; IDE Options = PureBasic 4.10 Beta 3 (Windows - x86)
; ExecutableFormat = Console
; CursorPosition = 427
; FirstLine = 410
; Folding = --