Delta Time routine

Share your advanced knowledge/code with the community.
User avatar
MrTAToad
Posts: 291
Joined: Sun Apr 20, 2014 11:43 am
Location: Chichester, England
Contact:

Delta Time routine

Post by MrTAToad »

Up until now, I've generally been using a just a fixed-time movement system. However, with the re-write of Triority, I've changed to a fixed-time with delta spike suppression, having converted the code by Thomas Haaks.

It works well, and includes the ability to write (and display) the delta and suppressed values, along with the logic and display FPS. Display the information will take a massive FPS hit though

Code: Select all

DeclareModule DeltaTime
  Declare.b InitDeltaTimer(logicCyclesPerSec.f=75.0,numSamples.i=0)
  Declare.f Process()
  Declare.b LogicUpdateRequired()
  Declare.f GetLogicalFPS()
  Declare.f GetTween()
  Declare.b ShowSpikeSuppression(x.i,y.i)
  Declare.b ShowFPS(x.i,y.i,showUpdateFPS.b=#True,showRenderFPS.b=#True)
  Declare.b FreeDeltaTimeSprite()
  Declare.b FreeDeltaTime()
  Declare.b CreateDisplaySprite(width.i,height.i)
  Declare.b DisplayDeltaSprite()
EndDeclareModule

Module DeltaTime
  #MAX_SAMPLES  = 32
  
  Global.f newTime,oldTime,delta
  Global.b dssOn,dssIndex
  Global.i dssLenArray
  Global.f Dim dssArray.f(0)
  
  Global.f logicFPS,accumulator,tween
  Global.f fpsAccumulator
  Global.i updateCount,renderCount,updatesPerSecond,rendersPerSecond
  
  Global.i sprite=#NOT_FOUND
  
  Procedure.b InitDeltaTimer(logicCyclesPerSec.f=75.0,numSamples.i=0)
    oldTime=ElapsedMilliseconds()
    newTime=ElapsedMilliseconds()
    updateCount=0
    renderCount=0
    updatesPerSecond=0
    rendersPerSecond=0
    dssLenArray=0
    dssIndex=0
    logicFPS=0.0
    accumulator=0.0
    tween=0.0
    fpsAccumulator=0.0
    
    logicFPS=1.0/logicCyclesPerSec
    Dim dssArray(0)
    
    If numSamples>0
      If numSamples>#MAX_SAMPLES : numSamples=#MAX_SAMPLES : EndIf
      dssOn=#True
      Dim dssArray(numSamples)
      dssLenArray=numSamples
    Else
      dssOn=#False
    EndIf
    
    ProcedureReturn #True
  EndProcedure
  
  Procedure.b FreeDeltaTime()
    Dim dssArray(0)
  EndProcedure
    
  Procedure.b FreeDeltaTimeSprite()
    If IsSprite(sprite)
      FreeSprite(sprite)
      sprite=#NOT_FOUND
    EndIf
    
    ProcedureReturn #True
  EndProcedure
  
  Procedure.b CreateDisplaySprite(width.i,height.i)
    FreeDeltaTimeSprite()
    sprite=CreateSprite(#PB_Any,width,height,#PB_Sprite_AlphaBlending)
    ProcedureReturn Bool(IsSprite(sprite))
  EndProcedure
  
  Procedure.b DisplayDeltaSprite()
    If IsSprite(sprite) : DisplayTransparentSprite(sprite,0,0) : EndIf
  EndProcedure
  
  Procedure.f Process()
    Define.f smoothDelta=0.0
    Define.i i
    
    newTime=ElapsedMilliseconds()
    delta=(newTime-oldTime)*0.001
    oldTime=newTime
    
    If dssOn
      dssArray(dssIndex)=delta
      
      For i=0 To dssLenArray-1
        smoothDelta+dssArray(i)
      Next
      
      delta=smoothDelta/dssLenArray
      dssIndex+1
      If dssIndex>dssLenArray-1 : dssIndex=0 : EndIf
    EndIf
    
    accumulator+delta
    fpsAccumulator+delta
    If fpsAccumulator>1.0
      fpsAccumulator-1.0
      updatesPerSecond=updateCount
      updateCount=0
      rendersPerSecond=renderCount
      renderCount=0
    EndIf
    
    ProcedureReturn delta
  EndProcedure
    
  Procedure.b LogicUpdateRequired()
    If accumulator>logicFPS
      updateCount+1
      accumulator=logicFPS
      ProcedureReturn #True
    Else
      ProcedureReturn #False
    EndIf
  EndProcedure
  
  Procedure.f GetLogicalFPS()
    ProcedureReturn logicFPS
  EndProcedure
  
  Procedure.f GetTween()
    renderCount+1
    ProcedureReturn accumulator/logicFPS
  EndProcedure

  Procedure.b ShowSpikeSuppression(x.i,y.i)
    Define.i i
    Define.s text
    
    If IsSprite(sprite)
      If StartDrawing(SpriteOutput(sprite))
        text="Delta Spike Suppressor : "        
        DrawText(x,y,text)
        
        For i=0 To dssLenArray-1
          y+TextHeight(text)
          text=StrF(dssArray(i))
          DrawText(x,y,text)
        Next
        
        text="Final Delta : "+StrF(delta)
        DrawText(x,y,text)
        StopDrawing()
        ProcedureReturn #True
      EndIf
    EndIf
    
    ProcedureReturn #False
  EndProcedure
      
  Procedure.b ShowFPS(x.i,y.i,showUpdateFPS.b=#True,showRenderFPS.b=#True)
    Define.i ty
    Define.s text
    
    If IsSprite(sprite)
      ty=y
      If StartDrawing(SpriteOutput(sprite))
        If showUpdateFPS
          text="Logic FPS : "+StrF(updatesPerSecond)
          DrawText(x,ty,text)
          ty+TextHeight(text)
        EndIf
        
        If showRenderFPS          
          DrawText(x,ty,"Render FPS : "+StrF(rendersPerSecond))
        EndIf
        
        StopDrawing()
        ProcedureReturn #True
      EndIf
    EndIf
    
    ProcedureReturn #False
  EndProcedure
EndModule
Fred
Site Admin
Posts: 1506
Joined: Mon Feb 24, 2014 10:51 am

Re: Delta Time routine

Post by Fred »

Sounds great ! Could you post an example using your module ? Also #NOT_FOUND constant seems missing
User avatar
MrTAToad
Posts: 291
Joined: Sun Apr 20, 2014 11:43 am
Location: Chichester, England
Contact:

Re: Delta Time routine

Post by MrTAToad »

Yes, will do. Forgot #NOT_FOUND was part of the resident file. That is :

Code: Select all

#NOT_FOUND          = -1
User avatar
MrTAToad
Posts: 291
Joined: Sun Apr 20, 2014 11:43 am
Location: Chichester, England
Contact:

Re: Delta Time routine

Post by MrTAToad »

This is an example of how to use it :

Code: Select all

; ------------------------------------------------------------
;
;   SpiderBasic - Screen example file
;
;    (c) Fantaisie Software
;
; ------------------------------------------------------------
;

XIncludeFile "DeltaTime.sb"
XIncludeFile "Maths.sb"

UseModule DeltaTime
UseModule Maths

Debug "Use mouse and arrow keys to move the sprites"

OpenScreen(800, 600, 32, "Test")

Global SpriteStep
Global Init
Global nbFrames
Global.f oldX,oldY,x,y
Global.f SpriteX,SpriteY

SetFrameRate(100)

Procedure ProcessRoutine(fixedDelta.f)
  If ExamineKeyboard()
    oldX=x  : oldY=y
    If KeyboardPushed(#PB_Key_Left)
      x-4
    ElseIf KeyboardPushed(#PB_Key_Right)
      x+4
    EndIf
    
    If KeyboardPushed(#PB_Key_Up)
      y-4
    ElseIf KeyboardPushed(#PB_Key_Down)
      y+4
    EndIf
    
    
  EndIf
  
  If ExamineMouse()
    
    SpriteX = MouseX()-SpriteWidth(0)/2
    SpriteY = MouseY()-SpriteHeight(0)/2
    
    If SpritePixelCollision(0, x, y, 0, SpriteX, SpriteY)
      Debug "Pixel Collide !"
    EndIf
   
    If MouseButton(#PB_MouseButton_Left)
      Debug "Left button"
    EndIf
  EndIf
EndProcedure

Procedure Display(tween.f)
  DisplaySprite(0, Tween(oldX,x,tween),Tween(oldY,y,tween))                      ; The spider
  DisplaySprite(0, SpriteX, SpriteY)
EndProcedure

Procedure RenderFrame()
  Define.f delta
  
  ClearScreen(RGB(0, 0, 0))
  
  delta=Process()
  While LogicUpdateRequired()
    ProcessRoutine(GetLogicalFPS())
  Wend
  
  ShowSpikeSuppression(0,0)
  ShowFPS(200,0)
  
  Display(GetTween())
  DisplayDeltaSprite()
  
  FlipBuffers() ; continue the rendering
EndProcedure


Procedure Loading(Type, Filename$)
  Static NbLoadedElements
  
  NbLoadedElements+1
  If NbLoadedElements = 1 ; Finished the loading of all images and sounds, we can start the applications
    FlipBuffers() ; start the rendering
  EndIf
EndProcedure


Procedure LoadingError(Type, Filename$)
  Debug Filename$ + ": loading error"
EndProcedure

InitDeltaTimer(100.0,8)
CreateDisplaySprite(800,600)

; Register the loading event before calling any resource load command
BindEvent(#PB_Event_Loading, @Loading())
BindEvent(#PB_Event_LoadingError, @LoadingError())
BindEvent(#PB_Event_RenderFrame, @RenderFrame())

LoadSprite(0, "Spider.png", #PB_Sprite_PixelCollision)


The Maths module is :

Code: Select all

DeclareModule Maths
  EnableExplicit
  
  Declare.f Wrap(value.f,minRange.f,maxRange.f)
  Declare.f Min(v1.f,v2.f)
  Declare.f Max(v1.f,v2.f)
  Declare.f Constrain(value.f,minRange.f,maxRange.f)
  Declare.b Circoll(x1.f,y1.f,r1.f,x2.f,y2.f,r2.f)
  Declare.b BoxColl(x1.f,y1.f,w1.f,h1.f,x2.f,y2.f,w2.f,h2.f)
  Declare MOVE_ANGLE(*pos.Vector2f,speed.f,angle.f,minX.f,maxX.f,minY.f,maxY.f)
  Declare.b Zero(*vector.Vector2f) ; Set the X and Y values to 0
  Declare.b SetVector(*store.Vector2f,*read.Vector2f) ; Copies the contents of the read vector into the store vector
  Declare.b Set(*store.Vector2f,x.f=0.0,y.f=0.0)  ; Sets the X and Y values of this Vector2D 
  Declare.b SwapVector(*v1.Vector2f,*v2.Vector2f) ; Swap the X and Y values in first vector with that of the second
  Declare.b IsZero(*vector.Vector2f) ; Returns #True if X and Y in the vector are 0
  Declare.b Equals(*v1.Vector2f,*v2.Vector2f) ; Returns #True if the X and Y values in the first vector are the same as that in the second
  Declare.b Reverse(*vector.Vector2f) ; Inverts the X and Y coordinates so that vector points the opposite way
  Declare.f DotProduct(*vector1.Vector2f,*vector2.Vector2f) ; Calculate the dot product between vector 1 and 2
  Declare.f CrossProduct(*vector1.Vector2f,*vector2.Vector2f)  ; Calculate the cross product between vector 1 and 2
  Declare.b Add(*vector1.Vector2f,*vector2.Vector2f) ; Add the X and Y coordinates in vector 2 to vector 1
  Declare.b Subtract(*vector1.Vector2f,*vector2.Vector2f) ; Subtract the X and Y coordinates in vector 2 from vector 1
  Declare.b Multiply(*vector1.Vector2f,scalar.f) ; Multiple the X and Y values in vector 1 with a scalar value
  Declare.b Divide(*vector1.Vector2f,scalar.f)   ; Divide the X and Y values in vector 1 with a scalar value
  Declare.f DistSQ(*vector1.Vector2f,*vector2.Vector2f)
  Declare.f LengthSquared(*vector.Vector2f)
  Declare.f Length(*vector.Vector2f)
  Declare.s DebugString(*vector.Vector2f)
  Declare DebugVector(*vector.Vector2f)
  Declare.f Tween(oldPos.f,newPos.f,tween.f)
EndDeclareModule

Module Maths
  EnableExplicit
  
  Procedure.f Wrap(value.f,minRange.f,maxRange.f)
    Define diff.f
    
  	diff=maxRange-minRange
  	If value>=minRange
  		If value<maxRange
  			ProcedureReturn value
  		Else
  			If value<maxRange+diff
  				ProcedureReturn value-diff
  			EndIf
  		EndIf
  	Else
  		If value>=minRange-diff
  			ProcedureReturn value+diff
  		EndIf
  	EndIf
  	
  	ProcedureReturn Mod(value-minRange,diff)+minRange 
  EndProcedure
  
  Procedure.f Min(v1.f,v2.f)
    If v1<v2
      ProcedureReturn v1
    Else
      ProcedureReturn v2
    EndIf
  EndProcedure
  
  Procedure.f Max(v1.f,v2.f)
    If v1>v2
      ProcedureReturn v1
    Else
      ProcedureReturn v2
    EndIf
  EndProcedure
  
  Procedure.f Constrain(value.f,minRange.f,maxRange.f)
    ProcedureReturn max(min(maxRange, value), minRange)
  EndProcedure
  
  Procedure.b Circoll(x1.f,y1.f,r1.f,x2.f,y2.f,r2.f)
    Define distance,distX,distY,totalRadius
  
  	totalRadius=r1+r2;
  	distX=x2-x1;
  	distY=y2-y1;
  	distance=(distX*distX)+(distY*distY)
  	ProcedureReturn Bool(distance<=totalRadius*totalRadius)  
  EndProcedure
  
  Procedure.b BoxColl(x1.f,y1.f,w1.f,h1.f,x2.f,y2.f,w2.f,h2.f)
    ProcedureReturn Bool(Not(x1>x2+w2 Or y1>y2+h2 Or x2>x1+w1 Or y2>y1+h1))
  ;     ProcedureReturn #False
  ;   Else
  ;     ProcedureReturn #True
  ;   EndIf
  EndProcedure
  
  Procedure MOVE_ANGLE(*pos.Vector2f,speed.f,angle.f,minX.f,maxX.f,minY.f,maxY.f)
    *pos\x=Wrap(*pos\x+(speed*Sin(Radian(angle))),minX,maxX)
    *pos\Y=Wrap(*pos\Y+(speed*Cos(Radian(angle))),minY,maxY)
  EndProcedure
  
  Procedure.b SetVector(*store.Vector2f,*read.Vector2f)
    If *store<>#Null And *read<>#Null
      *store=*read
      ProcedureReturn #True
    Else
      ProcedureReturn #False
    EndIf  
  EndProcedure
    
  Procedure.b Set(*store.Vector2f,x.f=0.0,y.f=0.0)
    If *store<>#Null
      *store\x=x
      *store\y=y
      ProcedureReturn #True
    Else
      ProcedureReturn #False
    EndIf
  EndProcedure
    
  Procedure.b SwapVector(*v1.Vector2f,*v2.Vector2f)
    If *v1<>#Null And *v2<>#Null
      Swap *v1\x,*v2\x
      Swap *v1\y,*v2\y
      ProcedureReturn #True
    Else
      ProcedureReturn #False
    EndIf
  EndProcedure
  
  Procedure.b Zero(*vector.Vector2f)
    If *vector<>#Null
      *vector\x=0.0
      *vector\y=0.0
      ProcedureReturn #True
    Else
      ProcedureReturn #False
    EndIf
  EndProcedure
  
  Procedure.b IsZero(*vector.Vector2f)
    If *vector<>#Null
      If *vector\x=0.0 And *vector\y=0.0
        ProcedureReturn #True
      EndIf
    EndIf
    
    ProcedureReturn #False
  EndProcedure
  
  Procedure.b Equals(*v1.Vector2f,*v2.Vector2f)
    If *v1<>#Null And *v2<>#Null
      If *v1\x=*v2\x And *v1\y=*v2\y
        ProcedureReturn #True
      EndIf
    EndIf
    
    ProcedureReturn #False
  EndProcedure
  
  Procedure.b Reverse(*vector.Vector2f)
    If *vector<>#Null
      *vector\x=0.0-*vector\x
      *vector\y=0.0-*vector\y
      ProcedureReturn #True
    Else
      ProcedureReturn #False
    EndIf
  EndProcedure
  
  Procedure.f DotProduct(*vector1.Vector2f,*vector2.Vector2f)
    If *vector1<>#Null And *vector2<>#Null
      ProcedureReturn *vector1\x**vector2\x+*vector1\y**vector2\y
    Else
      ProcedureReturn 0.0
    EndIf
  EndProcedure
  
  Procedure.f CrossProduct(*vector1.Vector2f,*vector2.Vector2f)
    If *vector1<>#Null And *vector2<>#Null
      ProcedureReturn *vector1\x**vector2\y-*vector1\y**vector2\x
    Else
      ProcedureReturn 0.0
    EndIf
  EndProcedure
  
  Procedure.f Distance(*vector.Vector2f,x.f,y.f)
    If *vector<>#Null
      ProcedureReturn Sqr((*vector\x-x) * (*vector\x-x) + (*vector\y-y) * (*vector\y-y))
    Else
      ProcedureReturn 0.0
    EndIf
  EndProcedure
  
  Procedure.f DistSQ(*vector1.Vector2f,*vector2.Vector2f)
    Define.f dx,dy
    
    If *vector1<>#Null And *vector2<>#Null
      dx = *vector2\x - *vector1\x
      dy = *vector2\y - *vector1\y
      ProcedureReturn dx * dx + dy * dy
    Else
      ProcedureReturn 0.0
    EndIf
  EndProcedure
  
  Procedure.f DistanceVector(*vector1.Vector2f,*vector2.Vector2f)
    ProcedureReturn Sqr(DistSQ(*vector1,*vector2))
  EndProcedure
  
  Procedure.b Perpendicular(*new.Vector2f,*current.Vector2f)
    If *new<>#Null And *current<>#Null
      Set(*new,0.0-*current\y,*current\x)
      ProcedureReturn #True
    Else
      ProcedureReturn #False
    EndIf
  EndProcedure
  
  
  Procedure.b Add(*vector1.Vector2f,*vector2.Vector2f)
    If *vector1<>#Null And *vector2<>#Null
      *vector1\x+*vector2\x
      *vector1\y+*vector2\y
      ProcedureReturn #True
    Else
      ProcedureReturn #False
    EndIf
  EndProcedure
  
  Procedure.b Subtract(*vector1.Vector2f,*vector2.Vector2f)
    If *vector1<>#Null And *vector2<>#Null
      *vector1\x-*vector2\x
      *vector1\y-*vector2\y
      ProcedureReturn #True
    Else
      ProcedureReturn #False
    EndIf
  EndProcedure
  
  Procedure.b Multiply(*vector1.Vector2f,scalar.f)
    If *vector1<>#Null 
      *vector1\x*scalar
      *vector1\y*scalar
      ProcedureReturn #True
    Else
      ProcedureReturn #False
    EndIf
  EndProcedure
  
  Procedure.b Divide(*vector1.Vector2f,scalar.f)
    If *vector1<>#Null And scalar<>0.0
      *vector1\x/scalar
      *vector1\y/scalar
      ProcedureReturn #True
    Else
      ProcedureReturn #False
    EndIf
  EndProcedure
  
  Procedure.s DebugString(*vector.Vector2f)
    If *vector<>#Null
      ProcedureReturn "Vector2D x:"+StrF(*vector\x)+" y:"+StrF(*vector\y)
    Else
      ProcedureReturn "Vector2D is NULL"
    EndIf
  EndProcedure
  
  Procedure DebugVector(*vector.Vector2f)
    Debug DebugString(*vector)
  EndProcedure
  
  Procedure.f LengthSquared(*vector.Vector2f)
    If *vector<>#Null
      ProcedureReturn *vector\x**vector\x+*vector\y**vector\y
    Else
      ProcedureReturn 0.0
    EndIf
  EndProcedure
  
  Procedure.f Length(*vector.Vector2f)
    ProcedureReturn Sqr(LengthSquared(*vector))
  EndProcedure
  
  Procedure.f Tween(oldPos.f,newPos.f,tween.f)
    ProcedureReturn newPos*tween+oldPos*(1.0-tween)
  EndProcedure
EndModule
Post Reply