Sorry your browser is not supported!

;/ Open a PureBasic window
OpenWindow(0,0,0,640,480,"DarkBasic Professional - PureGDK",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)

;/ Initialize the PureGDK screen as a child of window ID 0
hDBWnd=OpenDBWnd(WindowID(0),0,0,640,480)

;/ Set the sync rate
dbSyncRate(60)

dbMakeObjectCube(1,3)

;/ Rotate the cube and update the screen
Repeat
  dbXRotateObject(1,dbObjectAngleX(1)+0.3)
  dbYRotateObject(1,dbObjectAngleY(1)+0.5)
  dbSync()
Until WaitWindowEvent(1)=#PB_Event_CloseWindow

Structure Glob_Globstruct
  RenderThreadID.i
  ProgramEnding.l
  PauseThread.l
  DefaultAspectRatio.f
  DefaultFOV.f
  MaxFOV.f
EndStructure

Global Glob_Globstruct.Glob_Globstruct

Declare WinCallback(hWnd, uMsg, wParam, lParam)
Declare D3DDeviceLost()
Declare D3DDeviceReset()
Declare GDKRenderThread(Null)

ExamineDesktops()

Procedure WinCallback(hWnd, uMsg, wParam, lParam)
  Static OldWidth.l, OldHeight.l, FirstRun
  Protected NewWidth.l, NewHeight.l
  
  If Not FirstRun
    OldWidth=WindowWidth(1)
    OldHeight=WindowHeight(1)
    FirstRun=1
  EndIf
  
  Select uMsg
    Case #WM_ERASEBKGND
      ;/ Don't erase the background to elminate resize flickering
      ProcedureReturn 1
    Case #WM_SIZING, #WM_WINDOWPOSCHANGING, #WM_SIZE, #WM_WINDOWPOSCHANGED
      dbSetWindowSize(WindowWidth(1),WindowHeight(1))
    Case #WM_EXITSIZEMOVE
      ;/ Handle window resizing
      If InterlockedCompareExchange_(@Glob_Globstruct\PauseThread,1,0)=0
        NewWidth=WindowWidth(1)
        NewHeight=WindowHeight(1)
        If ((Not NewWidth=OldWidth) Or (Not OldHeight=NewHeight)) And NewWidth>0 And NewHeight>0
          Repeat: Delay(1)
          Until Glob_Globstruct\PauseThread=2
          dbSetDisplayMode(NewWidth,NewHeight)
          D3DDeviceReset()
          OldWidth=NewWidth
          OldHeight=NewHeight
          
          ;/ Reset camera aspect ratio
          DefaultAspectRatio=Glob_Globstruct\DefaultAspectRatio
          DefaultFOV=Glob_Globstruct\DefaultFOV
          MaxFOV=Glob_Globstruct\MaxFOV
          AspectRatio.f=(NewWidth*DefaultAspectRatio)/(NewHeight*DefaultAspectRatio)
          FOV.f=MaxFOV-(AspectRatio.f*100.0)
          If FOV.f<DefaultFOV
            FOV.f=DefaultFOV
          EndIf
          If FOV.f>MaxFOV
            FOV.f=MaxFOV
          EndIf
          dbSetCameraAspect(AspectRatio.f,dbCurrentCamera())
          dbSetCameraFOV(FOV.f,dbCurrentCamera())
          
        EndIf
        ;/ Set PauseThread to 0
        InterlockedExchange_(@Glob_Globstruct\PauseThread,0)
      EndIf
  EndSelect
  ProcedureReturn #PB_ProcessPureBasicEvents 
EndProcedure 

Procedure D3DDeviceLost()
  ;/ Notify the render thread that the render device has been lost
  If Not Glob_Globstruct\PauseThread
    InterlockedExchange_(@Glob_Globstruct\PauseThread,1)
  EndIf
EndProcedure

Procedure D3DDeviceReset()
  ;/ Wait until the render thread is ready for the device to be reset
  Repeat: Delay(1)
  Until InterlockedCompareExchange_(@Glob_Globstruct\PauseThread,3,2)=2
  
  ;/ Reload project data here
  dbMakeObjectCube(1,3)
  dbScaleObject(1,88,88,88)
  dbColorBackdrop(RGB(Random(255),Random(255),Random(255)))
  
  ;/ Set PauseThread to 0
  InterlockedExchange_(@Glob_Globstruct\PauseThread,0)
EndProcedure

Procedure GDKRenderThread(Null)
  Repeat
    Delay(1) ;/ Don't use all of the cpu
    dbXRotateObject(1,dbWrapValue(dbObjectAngleX(1)+0.3))
    dbYRotateObject(1,dbWrapValue(dbObjectAngleY(1)+0.5))
    
    ;/ Render the backbuffer
    dbSync()
    
    ;/ Check for suspend notificatons
    If InterlockedCompareExchange_(@Glob_Globstruct\PauseThread,2,1)=1
      Repeat: Delay(1)
        dbSync()
      Until Not Glob_Globstruct\PauseThread
    EndIf
  Until Glob_Globstruct\ProgramEnding
EndProcedure

;/ Show the PureGDK render window
OpenWindow(0,0,0,640,480,"DarkBasic Professional - PureGDK",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
MDIGadget(0,0,0,640,480,0,0)
AddGadgetItem(0,1,"Render window",0,#PB_Window_TitleBar|#PB_Window_SizeGadget)
hDBWnd=OpenDBWnd(WindowID(1),0,0,WindowWidth(1),WindowHeight(1))

;/ Set the default aspect ratio and FOV
Glob_Globstruct\DefaultAspectRatio=640.0/480.0
Glob_Globstruct\DefaultFOV=61.9621391296 
Glob_Globstruct\MaxFOV=164.0

;/ Set the window callback for window 0
SetWindowCallback(@WinCallback(),1)

;/ Set D3D device callbacks
dbSetD3DDeviceCallback(@D3DDeviceLost(),#GDK_Callback_DeviceLost)
dbSetD3DDeviceCallback(@D3DDeviceReset(),#GDK_Callback_DeviceReset)

;/ Load media
dbMakeObjectCube(1,3)
dbScaleObject(1,88,88,88)
dbColorBackdrop(RGB(0,0,0))

;/ Create render thread
Glob_Globstruct\RenderThreadID=CreateThread(@GDKRenderThread(),0)

;/ Program loop
Repeat
  Event=WaitWindowEvent()
Until Event=#PB_Event_CloseWindow ;Or dbKeyState(#VK_ESCAPE)

;/ Cleanup
Glob_Globstruct\ProgramEnding=1
WaitThread(Glob_Globstruct\RenderThreadID)

End

Structure coord3d
  x.f
  y.f
  z.f
EndStructure

Structure fireparticle
  id.l
  pos.coord3d
  tpos.coord3d
  velocity.f
  acvelocity.f
  acangle.f
  distrad.f
  radmag.f
  tstart.l
  life.l
  fade.f
  fadestamp.l
EndStructure

Structure firepod
  pos.coord3d
  radius.f
  height.f
  avglife.l
  avgscale.f
  maxvelocity.f
EndStructure

Global NewList fireParticles.fireparticle()
Global NewList firepods.firepod()
Global totalpods.l

Global fire_IMG.l

Declare CreateFire(x.f, y.f, z.f, r.f, h.f, avglife, avgscale.f, maxvelocity.f)
Declare FirepodClear(index)
Declare BurnFire(fire)
Declare ControlFires()
Declare CreateFireParticle(pod)
Declare FindFreeObject()
Declare FindFreeImage()

Procedure CreateFire(x.f, y.f, z.f, r.f, h.f, avglife, avgscale.f, maxvelocity.f)
  AddElement(firepods())
  firepods()\pos\x.f=x.f
  firepods()\pos\y.f=y.f
  firepods()\pos\z.f=z.f
  firepods()\radius.f=r.f
  firepods()\height.f=h.f
  firepods()\avglife=avglife
  firepods()\avgscale.f=avgscale.f
  firepods()\maxvelocity.f=maxvelocity.f
  ProcedureReturn @firepods()
EndProcedure

Procedure BurnFire(FireID)
  sparks=Random(3)
  If sparks=0
    ProcedureReturn
  EndIf
  For s=0 To sparks
    CreateFireParticle(FireID)
  Next s
EndProcedure

Procedure ControlFires()
  ForEach fireParticles()
    fireParticles()\acangle.f=dbWrapValue(fireParticles()\acangle.f+fireParticles()\acvelocity.f)
    fireParticles()\distrad.f=fireParticles()\distrad.f+fireParticles()\radmag.f
    If fireParticles()\distrad.f <= 0.00
      fireParticles()\distrad.f=Abs(fireParticles()\distrad.f)
      fireParticles()\acangle.f=dbWrapValue(fireParticles()\acangle.f+180.00)
      fireParticles()\radmag.f=Abs(fireParticles()\radmag.f)
    EndIf
    fireParticles()\radmag.f-0.001
    
    fireParticles()\pos\y.f+fireParticles()\velocity.f
    fireParticles()\velocity.f-0.02
    If fireParticles()\velocity.f<=0.00
      fireParticles()\velocity.f=0.125
    EndIf
    fireParticles()\pos\x.f=(dbSin(fireParticles()\acangle.f)*fireParticles()\distrad.f)+fireParticles()\tpos\x.f
    fireParticles()\pos\z.f=(dbCos(fireParticles()\acangle.f)*fireParticles()\distrad.f)+fireParticles()\tpos\z.f
    
    If fireParticles()\id>0
      If dbObjectExist(fireParticles()\id)=1
        particleDeath=(fireParticles()\tstart+fireParticles()\life)
        If Abs(ElapsedMilliseconds()-particleDeath)<=300
          dbScaleObject(fireParticles()\id,(ElapsedMilliseconds()-particleDeath)/3,(ElapsedMilliseconds()-particleDeath)/3,(ElapsedMilliseconds()-particleDeath)/3)
        EndIf
        dbPositionObject(fireParticles()\id,fireParticles()\pos\x.f,fireParticles()\pos\y.f,fireParticles()\pos\z.f)     
        dbPointObject(fireParticles()\id,dbCameraPositionX(),dbCameraPositionY(),dbCameraPositionZ())
      EndIf
    Else
      DeleteElement(fireParticles())
    EndIf
    
    If ElapsedMilliseconds()-fireParticles()\tstart>=fireParticles()\life
      dbDeleteObject(fireParticles()\id)
      DeleteElement(fireParticles())
    EndIf
  Next
EndProcedure

Procedure CreateFireParticle(FireID)
  created=0
  
  ; Select the current fire id
  ChangeCurrentElement(firepods(),FireID)
  
  ; If the list index is invalid
  If ListIndex(fireParticles())=-1
    AddElement(fireParticles())
    created=1
  Else
    ; Otherwise reset to the first element
    FirstElement(fireParticles())
    ; If the first element already has an object id assigned to it
    If Not fireParticles()\id=0
      LastElement(fireParticles())
      AddElement(fireParticles())
    EndIf
  EndIf
    
  fireParticles()\id=FindFreeObject()
  dbMakeObjectPlain(fireParticles()\id,firepods()\avgscale.f,firepods()\avgscale.f)
  dbTextureObject(fireParticles()\id,fire_IMG)
  dbSetObjectTransparency(fireParticles()\id,4)
  dbGhostObjectOn(fireParticles()\id,0)
  dbSetObjectEmissive(fireParticles()\id,$FFFFFF)
  
  ix.f=firepods()\pos\x.f
  iy.f=firepods()\pos\y.f
  iz.f=firepods()\pos\z.f
  
  angle.f=Random(360000)
  angle.f=angle.f/1000.00
  rad.f=Random(firepods()\radius.f)
  
  fireParticles()\acangle.f=angle.f
  fireParticles()\acvelocity.f=Random(8000)-2000
  fireParticles()\acvelocity.f=fireParticles()\acvelocity.f/1000.00
  
  fireParticles()\velocity.f=Random(firepods()\maxvelocity.f*1000.00)
  fireParticles()\velocity.f=fireParticles()\velocity.f/1000.00
  
  fireParticles()\distrad.f=rad.f
  fireParticles()\radmag.f=Random(500)
  fireParticles()\radmag.f=fireParticles()\radmag.f/1000.00
  
  fireParticles()\pos\x.f=ix.f
  fireParticles()\pos\y.f=iy.f
  fireParticles()\pos\z.f=iz.f
  fireParticles()\tpos\x.f=fireParticles()\pos\x.f
  fireParticles()\tpos\y.f=fireParticles()\pos\y.f
  fireParticles()\tpos\z.f=fireParticles()\pos\z.f
  fireParticles()\pos\x.f+(dbSin(angle.f)*rad.f)
  fireParticles()\pos\y.f+Random(firepods()\height.f)
  fireParticles()\pos\z.f+(dbCos(angle.f)*rad.f)
  
  fireParticles()\tstart=ElapsedMilliseconds()
  fireParticles()\life=(Random(500)-250)+firepods()\avglife
EndProcedure

Procedure FindFreeObject()
  obj=0
  Repeat
    obj+1
  Until dbObjectExist(obj)=0
  ProcedureReturn obj
EndProcedure

Procedure FindFreeImage()
  img=0
  Repeat
    img+1
  Until dbImageExist(img)=0
  ProcedureReturn img
EndProcedure

;/ Fire Demo
;/ Derived from original source by "Image All"
;/ http://forum.thegamecreators.com/?m=forum_view&t=114092&b=6
;/ March 2008

IncludeFile("inc.fire.pb")

Structure Struct_Input
  LButtonDown.l
  RButtonDown.l
EndStructure

Enumeration
  ;/ Window Constants
  #Wnd_Main
  #Wnd_GDKWnd
  #Wnd_MDI_RenderWindow
  #Wnd_MDI_FireSettings

  ;/ Gadgets - Main Window
  #MDI_Main
  
  ;/ Gadgets - Fire Settings
  #Text_Radius
  #Text_Height
  #Text_AvgLife
  #Text_AvgScale
  #Text_MaxVelocity
  #Edit_Radius
  #Edit_Height
  #Edit_AvgLife
  #Edit_AvgScale
  #Edit_MaxVelocity
  #Frame3D_FireParameters
  #Button_Apply
  
  ;/ Menu Constants
  #Menu_FireSettings
EndEnumeration

Declare PointInClientRect(hWnd.i, x.l, y.l)

Global Glob_Input.Struct_Input

Procedure Show_FireSettings()
  SetGadgetText(#Edit_Radius,StrF(firepods()\radius,1))
  SetGadgetText(#Edit_Height,StrF(firepods()\height,1))
  SetGadgetText(#Edit_AvgLife,Str(firepods()\avglife))
  SetGadgetText(#Edit_AvgScale,StrF(firepods()\avgscale,1))
  SetGadgetText(#Edit_MaxVelocity,StrF(firepods()\maxvelocity,1))
  
  ;/ Show window
  HideWindow(#Wnd_MDI_FireSettings,0)
  
  ;/ Bring window to top
  BringWindowToTop_(WindowID(#Wnd_MDI_FireSettings))
EndProcedure

Procedure WindowCallback(hWnd, uMsg, wParam, lParam)
  Shared hDBWnd, ExitThread
  Result=#PB_ProcessPureBasicEvents
    Select hWnd
      ;/ Capture events that occur only within the render window
      Case WindowID(#Wnd_MDI_RenderWindow)
        If PointInClientRect(hDBWnd,DesktopMouseX(),DesktopMouseY())
          If GetAsyncKeyState_(#VK_LBUTTON)
            Glob_Input\LButtonDown=1
          Else
            Glob_Input\LButtonDown=0
          EndIf
          If GetAsyncKeyState_(#VK_RBUTTON)
            Glob_Input\RButtonDown=1
          Else
            Glob_Input\RButtonDown=0
          EndIf
        EndIf
    EndSelect
    Select uMsg
      ;/ The window has received a message telling it to close
      Case #WM_CLOSE
        Select hWnd
          ;/ End the program if this is the main window
          Case WindowID(#Wnd_Main)
            ExitThread=1
          ;/ Otherwise just close the window
          Default
            HideWindow(GetProp_(hWnd,"PB_WindowID")-1,1)
        EndSelect
    EndSelect
  ProcedureReturn Result
EndProcedure

If OpenWindow(0,40,40,640,480,"DarkBasic Professional - PureGDK",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  MDIGadget(#MDI_Main,0,0,0,0,1,2,#PB_MDI_AutoSize)

  HideGadget(#MDI_Main,1)
  
  ;/ Create a menu
  CreateMenu(#Wnd_Main,WindowID(#Wnd_Main))
  MenuTitle("Options")
  MenuItem(#Menu_FireSettings,"Fire Settings")
  
  ;/ Add new MDI window "Fire Settings"
  AddGadgetItem(#MDI_Main,#Wnd_MDI_FireSettings,"Fire Settings",0,#PB_Window_SystemMenu|#PB_Window_Invisible)
  ResizeWindow(#Wnd_MDI_FireSettings,0,0,190,160)
  
  ;/ Load gadget list from main window
  UseGadgetList(WindowID(#Wnd_Main))
  
  ;/ Add new MDI window "Fire Settings"
  AddGadgetItem(#MDI_Main,#Wnd_MDI_FireSettings,"Fire Settings",0,#PB_Window_SystemMenu|#PB_Window_Invisible)
  ResizeWindow(#Wnd_MDI_FireSettings,0,0,190,160)
  
  ;/ Create gadget list for fire settings window
  TextGadget(#Text_Radius,10,22,80,20,"Radius:",#PB_Text_Right)
  TextGadget(#Text_Height,10,42,80,20,"Height:",#PB_Text_Right)
  TextGadget(#Text_AvgLife,10,62,80,20,"Average Life:",#PB_Text_Right)
  TextGadget(#Text_AvgScale,10,82,80,20,"Average Scale:",#PB_Text_Right)
  TextGadget(#Text_MaxVelocity,10,102,80,20,"Max Velocity:",#PB_Text_Right)
  StringGadget(#Edit_Radius,100,20,80,20,"")
  StringGadget(#Edit_Height,100,40,80,20,"")
  StringGadget(#Edit_AvgLife,100,60,80,20,"")
  StringGadget(#Edit_AvgScale,100,80,80,20,"")
  StringGadget(#Edit_MaxVelocity,100,100,80,20,"")
  Frame3DGadget(#Frame3D_FireParameters,0,0,190,130,"Parameters")
  ButtonGadget(#Button_Apply,55,135,80,20,"Apply")
  
  ;/ Create 3D render window
  AddGadgetItem(#MDI_Main,#Wnd_MDI_RenderWindow,"Render Window",0,#PB_Window_TitleBar)
  ResizeWindow(#Wnd_MDI_RenderWindow,0,0,500,300)
  hDBWnd=OpenDBWnd(WindowID(#Wnd_MDI_RenderWindow),0,0,500,300)
  HideGadget(#MDI_Main,0)
EndIf

Procedure PointInClientRect(hWnd.i, x.l, y.l)
  Pt.POINT\x=x
  Pt.POINT\y=y
  GetClientRect_(hWnd,@Rc.RECT)
  MapWindowPoints_(hWnd,GetDesktopWindow_(),@Rc.RECT,2)
  If PtInRect_(@Rc,y<<32+x)
    ProcedureReturn #True
  Else
    ProcedureReturn #False
  EndIf
EndProcedure

SetWindowCallback(@WindowCallback())

dbSyncRate(60)
dbAutoCamOff()
RandomSeed(ElapsedMilliseconds())
dbColorBackdrop($001133)

;/ This is the image we will be using to represent the fire.
fire_IMG=FindFreeImage()
dbLoadImage("firespark.bmp",fire_IMG)

;/ Set the fire blaze for this demonstration to global
Global FireID

;/ The CreateFire() function returns a unique ID and can be used to 
;/ create multiple blazes. This unique ID can be used to control
;/ blazes individually.
FireID=CreateFire(40.00,0.00,0.00,10.00,2.00,500,40.0,2.00)

;/ Just for added effect :D
dbMakeObjectSphere(1,66,40,40)

;/ Set sphere properties
dbSetObjectAmbience(1,dbRGB(0,0,0))

;/ Position camera
dbPositionCamera(0,0,-160)
dbPointCamera(0,0,0)

Procedure ThreadDBWnd(Null)
  Shared ExitThread
  ;/ Variables local to this thread
  camang.f=180.00
  camrad.f=160.00
  fireang.f=0.00
  
  ;/ The main loop for the DarkBasic thread
  Repeat
    ;/ Uncomment this line to reduce CPU usage per loop
    Delay(10)
    
    ;/ Here are the two function calls that you're going to need in your game loop.
    ;/ You will have to call BurnFire() for every blaze that you have created.
    ;/ Or you could just set up a loop to cycle through all of the FireIDs.
    BurnFire(FireID)
    
    ;/ ControlFires() on the other hand simply controls all fire particles in the scene.
    ;/ The only way not to control fire particles outside the viewing range is to not call
    ;/ BurnFire(x) to prevent fire particles for blaze x.
    ControlFires()
    
    ;/ This demonstrates the ability to adjust blaze properties during runtime.
    ChangeCurrentElement(firepods(),FireID)
    If Glob_Input\LButtonDown
      firepods()\avglife=600
      firepods()\maxvelocity.f=6.00
    Else
      firepods()\avglife=500
      firepods()\maxvelocity.f=2.00
    EndIf

    If Not Glob_Input\RButtonDown
      fireang.f=dbWrapValue( fireang.f+1.00 )
    EndIf
    firex.f=dbSin(fireang.f)*80.00
    firey.f=dbSin(fireang.f)*50.00
    firez.f=dbCos(fireang.f)*80.00
    firepods()\pos\x.f=firex.f
    firepods()\pos\y.f=firey.f
    firepods()\pos\z.f=firez.f

    dbSetPointLight(0,firex.f+Random(2),firey.f+Random(2),firez.f+Random(2))

    dbText(5,5,"Fire polys on screen: "+Str((ListSize(fireParticles())*2)))
    dbText(5,dbScreenHeight()-25,"FPS: "+Str(dbScreenFPS()))
    dbText(dbScreenWidth()-(dbTextWidth("Leftclick to increase the blaze")+5),5,"Leftclick to increase the blaze")
    dbText(dbScreenWidth()-(dbTextWidth("Rightclick to freeze the blaze")+5),25,"Rightclick to freeze the blaze")
    
    dbSync()
  Until ExitThread
EndProcedure

;/ Create a thread dedicated to rendering
DBThreadID=CreateThread(@ThreadDBWnd(),0)

Repeat
  Event=WaitWindowEvent(1)
  Select Event
    Case #PB_Event_Menu
      Select EventMenu()
        Case #Menu_FireSettings ;/ Fire Settings
          Show_FireSettings()
      EndSelect
    Case #PB_Event_Gadget
      Select EventGadget()
        Case #Button_Apply
          ;/ Pause thread
          PauseThread(DBThreadID)
          firepods()\radius=ValF(GetGadgetText(#Edit_Radius))
          firepods()\height=ValF(GetGadgetText(#Edit_Height))
          firepods()\avglife=Val(GetGadgetText(#Edit_AvgLife))
          firepods()\avgscale=ValF(GetGadgetText(#Edit_AvgScale))
          firepods()\maxvelocity=ValF(GetGadgetText(#Edit_MaxVelocity))
          ;/ Resume thread
          ResumeThread(DBThreadID)
      EndSelect
  EndSelect
Until ExitThread

;/ The End. :)
WaitThread(DBThreadID) ;/ cleanup
End

;/ This is an example of how to create your own custom error handler for PureGDK. You
;/ can use this method for creating your own error handling routing to display error
;/ information to the user or to send it to yourself privately over email or a secure
;/ connection.
;/
;/ This example is demonstrated when compiling without the debugger.

Procedure ErrorHandler()
	Module.s=ErrorFile()
	Module.s=dbResolveErrorLine(ErrorLine(),@LineNumber)
	Description.s=ErrorMessage()
	String.s=dbGetErrorDescription(@Description.s)+#CRLF$
	String.s+"Line: "+Str(LineNumber)+#CRLF$
	String.s+"Address: "+Str(ErrorAddress())+#CRLF$
	String.s+"File: "+Module.s+#CRLF$
	MessageRequester("Custom Error",String.s)
	End
EndProcedure
OnErrorCall(@ErrorHandler())

;/ Show the PureGDK render window
OpenWindow(0,0,0,640,480,"DarkBasic Professional - PureGDK",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
hDBWnd=OpenDBWnd(WindowID(0),0,0,640,480)

;dbMakeObjectCube(1,3) ;/ Comment this line to create an error

Repeat: Delay(1)
  dbXRotateObject(1,dbObjectAngleX(1)+0.3) ;/ Error here
  dbYRotateObject(1,dbObjectAngleY(1)+0.5)
	dbSync()
Until WindowEvent()=#PB_Event_CloseWindow
End

#D3DSAMP_MAXANISOTROPY=10 ;/ DWORD maximum anisotropy
    
;/ Open a PureBasic window
OpenWindow(0,0,0,640,480,"DarkBasic Professional - PureGDK",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)

;/ Initialize the PureGDK screen as a child of window ID 0
hDBWnd=OpenDBWnd(WindowID(0),0,0,640,480)

;/ Set the sync rate
dbSyncRate(0)

;/ Load media
dbLoadImage("media/test.bmp",1)

;/ Make plain
dbMakeObjectPlain(1,100,100)
dbXRotateObject(1,270)
dbTextureObject(1,1)
dbScaleObjectTexture(1,2,2,0)
dbSetObjectFilter(1,0) ;/ Set object filter to point
dbSetObjectTexture(1,0,0,0) ;/ Set object mip mapping to none
dbSetTextFont("Arial")
dbSetTextSize(14)
AnisoLevel=16 ;/ Default anisotropy level

;/ Check hardware capapabilities
dbGetD3DCapabilities(@Result.D3DCaps)
If Not Result\AnistropicFiltering
  MessageRequester("Error","Your hardware does not support anisotropic filtering")
  End
EndIf

;/ Get the D3D render device
Lib=OpenLibrary(#PB_Any,"DBProSetupDebug.dll")
Ptr=GetFunction(Lib,"?GetDirect3DDevice@@YAPAUIDirect3DDevice9@@XZ")
*IDirect3DDevice9.IDirect3DDevice9=CallFunctionFast(Ptr)

;/ The debugger must be off to use the D3D device directly with PureGDK
If Not *IDirect3DDevice9
  MessageRequester("Error","Compile with the debugger off for this demo")
  End
EndIf

;/ Rotate the cube and update the screen
Repeat
  ;/ Movement
  dbPositionCamera(0,0,0)
  dbRotateCamera(dbCameraAngleX()+dbMouseMoveY()/4.0,dbCameraAngleY()+dbMouseMoveX()/4.0,0.0)
  dbMoveCamera(-100)
  
  ;/ Toggle filter mode
  If dbKeyState(#VK_F1)
    If Not F1KeyDown
      F1KeyDown=1
      FilterMode+1
      If FilterMode=3
        FilterMode=0
      EndIf
      If FilterMode=0 ;/ Point
        dbSetObjectFilter(1,0)
      EndIf
      If FilterMode=1 ;/ Linear
        dbSetObjectFilter(1,1)
      EndIf
      If FilterMode=2 ;/ Anisotropic
        dbSetObjectFilter(1,2)
        *IDirect3DDevice9\SetSamplerState(0,#D3DSAMP_MAXANISOTROPY,AnisoLevel)
      EndIf
    EndIf
  Else
    F1KeyDown=0
  EndIf
  
  ;/ Toggle mip-map mode
  If dbKeyState(#VK_F2)
    If Not F2KeyDown
      F2KeyDown=1
      MipMapMode+1
      If MipMapMode=3
        MipMapMode=0
      EndIf
      If MipMapMode=0 ;/ None
        dbSetObjectTexture(1,0,0,0)
      EndIf
      If MipMapMode=1 ;/ Point
        dbSetObjectTexture(1,0,1,0)
      EndIf
      If MipMapMode=2 ;/ Linear
        dbSetObjectTexture(1,0,2,0)
      EndIf
    EndIf
  Else
    F2KeyDown=0
  EndIf
  
  ;/ Increase anisotropy
  If dbKeyState(#VK_F3)
    If Not F3KeyDown
      F3KeyDown=1
      AnisoLevel+1
      *IDirect3DDevice9\SetSamplerState(0,#D3DSAMP_MAXANISOTROPY,AnisoLevel)
    EndIf
  Else
    F3KeyDown=0
  EndIf
  
  ;/ Decrease anisotropy
  If dbKeyState(#VK_F4)
    If Not F4KeyDown
      F4KeyDown=1
      AnisoLevel-1
      *IDirect3DDevice9\SetSamplerState(0,#D3DSAMP_MAXANISOTROPY,AnisoLevel)
    EndIf
  Else
    F4KeyDown=0
  EndIf
  
  ;/ FPS
  dbText(10,10,"FPS: "+Str(dbScreenFPS()))
  Select FilterMode
    Case 0
      dbText(10,30,"Filter: Point")
    Case 1
      dbText(10,30,"Filter: Linear")
    Case 2
      dbText(10,30,"Filter: Anisotropic")
   EndSelect
  Select MipMapMode
    Case 0
      dbText(10,45,"Mipmapping: None")
    Case 1
      dbText(10,45,"Mipmapping: Point")
    Case 2
      dbText(10,45,"Mipmapping: Linear")
   EndSelect
  dbText(10,60,"Anisotropic Level: "+Str(AnisoLevel))
  dbText(10,80,"Press F1 to change filter")
  dbText(10,95,"Press F2 to change mipmapping modes")
  dbText(10,110,"Press F3 to raise increase the anisotropic level")
  dbText(10,125,"Press F4 to raise decrease the anisotropic level")
  dbSync()
Until WaitWindowEvent(1)=#PB_Event_CloseWindow
End