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

Delta Time routine

by MrTAToad Mon Aug 07, 2017 11:12 am

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: 1011
Joined: Mon Feb 24, 2014 10:51 am

Re: Delta Time routine

by Fred Wed Aug 16, 2017 3:53 pm

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

Re: Delta Time routine

by MrTAToad Wed Aug 16, 2017 8:39 pm

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

Re: Delta Time routine

by MrTAToad Thu Aug 17, 2017 4:44 pm

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
Return to Tricks 'n' Tips

Who is online

Users browsing this forum: No registered users and 1 guest