FreeBasic's Timer

[deltarho[1859]]

That looks OK, but I'm leaving this thread now. I am unable to continue endorsing regulate() with its CPU Load enhancing Timer pooling loop as is. I've changed mine to eliminate the CPU Load.

[deltarho[1859]]

There is something I forgot to do. I wrote here some code specifically for Windows10/11.

Here is a revised regulate() to mitigate the process CPU Load.

Windows 10/11 only

Code: Select all

Function regulate(Byval MyFps As Long) As Double  '' return delay applied in milliseconds
Static As Double timervalue
Dim As Single tt = 1 / MyFps
Dim As Double tf = timervalue + tt
Dim As Double t = Timer
Dim As Single dt = (tt - (t - timervalue)) * 1000
  _setTimer
  If dt >= 3 Then Sleep dt - 3, 1
  Do ' poll Timer every millisecond - only two or three required - mitigates CPU Load
    Sleep 1,1
  Loop Until Timer >= tf
  _resetTimer
  timerValue = Timer
  Return dt
End Function

[fxm]

If we use the 'regulate()' procedure with a threshold forced to 0 ('regulate(FPS, 0)'), the regulation does not consume CPU time if the necessary additional delay is greater than 0.5 ms (which is enough most of the time).

The code becomes equivalent to:

Code: Select all

    If amount > 0.5 Then Sleep amount, 1
    Do
    Loop Until Timer >= t3

In that case ('amount > 0.5'), the Do...Loop exit is immediate because 'Sleep amount, 1' produces a waiting time always greater or equal to 'amount'.

The regulation is even a little better than yours because your Do...Loop contains 'Sleep 1, 1'
Only for a necessary additional delay < 0.5 ms, CPU load begins to increase (but the measured FPS also).

I will clarify this a bit in the last paragraph (5.) of the documentation.

[fxm]

There is something I forgot to do. I wrote here some code specifically for Windows10/11.

Here is a revised regulate() to mitigate the process CPU Load.

Windows 10/11 only

Code: Select all

Function regulate(Byval MyFps As Long) As Double  '' return delay applied in milliseconds
Static As Double timervalue
Dim As Single tt = 1 / MyFps
Dim As Double tf = timervalue + tt
Dim As Double t = Timer
Dim As Single dt = (tt - (t - timervalue)) * 1000
  _setTimer
  If dt >= 3 Then Sleep dt - 3, 1
  Do ' poll Timer every millisecond - only two or three required - mitigates CPU Load
    Sleep 1,1
  Loop Until Timer >= tf
  _resetTimer
  timerValue = Timer
  Return dt
End Function

Replace:

Code: Select all

  If dt >= 3 Then Sleep dt - 3, 1
  Do ' poll Timer every millisecond - only two or three required - mitigates CPU Load
    Sleep 1,1
  Loop Until Timer >= tf

with:

Code: Select all

  Sleep Iif(dt > 0.5, dt, 1), 1

in your code produces a better regulation.

In high resolution (Windows OS), the accuracy of 'Sleep t, 1' (for t >= 2 ms) is much better than 1 ms.
So introducing a final waiting loop containing 'Sleep 1, 1' (which has the worst accuracy) degrades the initial accuracy provided by the first 'Sleep'.

[dodicat]

Regarding my inbuilt regulator
fxm says:
I looked at it, but the instantaneous FPS regulation is very bad.
But looking again and comparing.

Code: Select all

 #define incircle(cx,cy,radius,x,y) (cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius
Function readkey(x As Long,y As Long,st As String,message As String,clr As Ulong) As String
      Static As String j,blink
      Var c=Color
      Var i=Inkey()
      If Left(i,1)=Chr(08) Then j=Mid(j,1,Len(j)-1)
      Select Case Left(i,1)
      Case Chr(0) To Chr(254)
            If Left(i,1)<>Chr(08) Then
                  j=j+Left(i,1)
            End If
      End Select
      If Frac(Timer)>.5 Then blink=" " Else blink="_"
      If Left(i,1)=Chr(27) Then j=""
      If i<>Chr(13) Then
            Locate x,y,0
            Color clr
            Print  st & j & blink 
            Color c
      Else
            j=Rtrim(j,Chr(13))
            message=j
            j=""
      End If
      Return i
End Function

Function regulate (MyFps As Long,Byref fps As long) As Double
      Dim As Double k=1/MyFps
      Static As Double timervalue
      Var c=timervalue
      Do While (Timer - TimerValue) <= k
      Loop 
      Var ans=(Timer-timervalue)
      timervalue=Timer
      fps=1/(timervalue-c)
      If Abs(Myfps-fps)>MyFps\2 Then fps=60
      Return ans*66
End Function

Function framerate() As Ulong
    '' function return : measured FPS value (for debug), in frames per second FXM
    Static As Double t1
    Dim As Double t2 = Timer
    #if Not defined(__FB_WIN32__) And Not defined(__FB_LINUX__)
    If t2 < t1 Then t1 -= 24 * 60 * 60
    #endif
    Dim As Ulong tf = 1 / (t2 - t1)
    t1 = t2
    Return tf
End Function

dim as long fps'=35
dim as string msg="35"
screen 19
dim as any ptr i=imagecreate(800,600,0)
circle i,(200,300),50,3,,,,f
draw string i,(160,300),"FPS fxm"
circle i,(500,300),50,3,,,,f
draw string i,(460,300),"FPS dod"
dim as double s
dim as long flag
dim as long mx,my,btn
dim as long toggle=1
do
    getmouse mx,my,,btn
    screenlock
    cls
put(0,0),i,pset   
if incircle(200,300,50,mx,my)  and flag=0 then
    circle(200,300),50,15
    if btn=1 then
    flag=1
    toggle=1
    end if
end if

if incircle(500,300,50,mx,my) and flag=0 then 
      circle(500,300),50,15
    if btn=1 then
    flag=1
   toggle=2 
   end if
    end if

if toggle=1 then draw string(10,30),"FPS        "+str(framerate) + "   fxm"
if toggle=2 then draw string(10,30),"FPS        "+str(fps)  +"   dod"


readkey(10,5,"enter a framerate  ",msg,15)
if val(msg)<=0 then exit do
var k=msg
draw string(10,60),"Required   "+(msg)
screenunlock
flag=btn
var s=regulate(val(msg),fps)

loop
 

Just choose a framerate and click the appropriate circle to compare.
select 0 to end.
For crazy framerates, mine will default to 0.
(I regulate by while loop only for this test)
Nothing should be in the while loop, certainly no sleep of any kind.
Things should be kept very simple, either use a while loop or a sleep (for less than about 60 fps)
If both are used then sleep if the delay >1 otherwise while loop.
Using windows resolution setter should be optional.
IMO
I have tested using crt clock() instead of timer.
It is too sluggish for high framerates, but OK otherwise.
That'll do for my contributions here.
adieu

[fxm]

Your 'regulate()' procedure is very accurate because using only a loop reading the Timer:
- The 'FPS dot' button visualizes a measured FPS from frame to frame, but measured inside 'regulate()', so measured at the precise location of the regulation.
- The 'FPS fxm' button visualizes a measured FPS from frame to frame, but measured inside a 'framerate()' procedure called elsewhere in the program loop, so at temporal distance of the regulation.

This explains that 'dot' measure is very stable because measured at the level of the regulation. It measures the intrinsic precision of the regulation.
The 'fxm' measure is executed elsewhere in the program loop, so impacted by the program execution fluctuations from frame to frame.

If 'framerate()' is called just before or after the call to 'regulate()', the displayed 'fxm' value becomes very stable, as the one for 'dot'.
Code to check it:

Code: Select all

#define incircle(cx,cy,radius,x,y) (cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius
Function readkey(x As Long,y As Long,st As String,message As String,clr As Ulong) As String
      Static As String j,blink
      Var c=Color
      Var i=Inkey()
      If Left(i,1)=Chr(08) Then j=Mid(j,1,Len(j)-1)
      Select Case Left(i,1)
      Case Chr(0) To Chr(254)
            If Left(i,1)<>Chr(08) Then
                  j=j+Left(i,1)
            End If
      End Select
      If Frac(Timer)>.5 Then blink=" " Else blink="_"
      If Left(i,1)=Chr(27) Then j=""
      If i<>Chr(13) Then
            Locate x,y,0
            Color clr
            Print  st & j & blink 
            Color c
      Else
            j=Rtrim(j,Chr(13))
            message=j
            j=""
      End If
      Return i
End Function

Function regulate (MyFps As Long,Byref fps As long) As Double
      Dim As Double k=1/MyFps
      Static As Double timervalue
      Var c=timervalue
      Do While (Timer - TimerValue) <= k
      Loop 
      Var ans=(Timer-timervalue)
      timervalue=Timer
      fps=1/(timervalue-c)
      If Abs(Myfps-fps)>MyFps\2 Then fps=60
      Return ans*66
End Function

Function framerate() As Ulong
    '' function return : measured FPS value (for debug), in frames per second FXM
    Static As Double t1
    Dim As Double t2 = Timer
    #if Not defined(__FB_WIN32__) And Not defined(__FB_LINUX__)
    If t2 < t1 Then t1 -= 24 * 60 * 60
    #endif
    Dim As Ulong tf = 1 / (t2 - t1)
    t1 = t2
    Return tf
End Function

dim as long fps'=35
dim as string msg="35"
screen 19
dim as any ptr i=imagecreate(800,600,0)
circle i,(200,300),50,3,,,,f
draw string i,(160,300),"FPS fxm"
circle i,(500,300),50,3,,,,f
draw string i,(460,300),"FPS dod"
dim as double s
dim as long flag
dim as long mx,my,btn
dim as long toggle=1
dim as long fpsfxm
do
    getmouse mx,my,,btn
    screenlock
    cls
put(0,0),i,pset   
if incircle(200,300,50,mx,my)  and flag=0 then
    circle(200,300),50,15
    if btn=1 then
    flag=1
    toggle=1
    end if
end if

if incircle(500,300,50,mx,my) and flag=0 then 
      circle(500,300),50,15
    if btn=1 then
    flag=1
   toggle=2 
   end if
    end if

if toggle=1 then draw string(10,30),"FPS        "+str(fpsfxm) + "   fxm"
if toggle=2 then draw string(10,30),"FPS        "+str(fps)  +"   dod"


readkey(10,5,"enter a framerate  ",msg,15)
if val(msg)<=0 then exit do
var k=msg
draw string(10,60),"Required   "+(msg)
screenunlock
flag=btn
var s=regulate(val(msg),fps)
fpsfxm = framerate()

loop
 

If 'framerate()' is placed right next to 'regulate()', this measures the intrinsic precision of the regulation.
if 'framerate()' is placed elsewhere in the program loop, it may be additionally impacted by program execution fluctuations from frame to frame.

[fxm]

adieu

In French, 'adieu' means a final goodbye, for people who will never see each other again. We also say 'adieu' to a dead person !
In French, we rather use 'au revoir', or even 'à bientôt' if we are to meet again soon.

[dodicat]

I think I picked the wrong word fxm. Even in English grammar it means a lasting goodbye.
I was thinking of the old Sea Shanty, ( I was a sailor most of my life).

Farewell and adieu to you fair Spanish ladies
Farewell and adieu to you ladies of Spain
Cause we've received orders for to sail for old England,
But we hope in a short time to see you again.…

[fxm]

@fxm
I am using Linux.
I get these 2 errors when I compile with #include "delay_regulate_framerate.bi"
delay_regulate_framerate.bi(11) error 9: Expected expression in '#elseif __FB_LINUX__'
delay_regulate_framerate.bi(21) error 9: Expected expression in '#elseif __FB_LINUX__'

Can you test with the below file ?

Code: Select all

'  delay_regulate_framerate.bi

#if defined(__FB_WIN32__)
Declare Function _setTimer Lib "winmm" Alias "timeBeginPeriod"(ByVal As Ulong = 1) As Long
Declare Function _resetTimer Lib "winmm" Alias "timeEndPeriod"(ByVal As Ulong = 1) As Long
_setTimer()
Declare Sub delay(ByVal amount As Single, ByVal threshold As Ulong = 2 * 1)
Declare Function regulate(ByVal MyFps As Ulong, ByVal threshold As Ulong = 2 * 1) As Double
#elseif defined(__FB_LINUX__)
Declare Sub delay(ByVal amount As Single, ByVal threshold As Ulong = 2 * 10)
Declare Function regulate(ByVal MyFps As Ulong, ByVal threshold As Ulong = 2 * 10) As Double
#elseif defined(__FB_DOS__)
Declare Sub delay(ByVal amount As Single, ByVal threshold As Ulong = 2 * 55)
Declare Function regulate(ByVal MyFps As Ulong, ByVal threshold As Ulong = 2 * 55) As Double
#else
Declare Sub delay(ByVal amount As Single, ByVal threshold As Ulong = 2 * 16)
Declare Function regulate(ByVal MyFps As Ulong, ByVal Ulong As Single = 2 * 16) As Double
#endif

Declare Function framerate() As Ulong

'------------------------------------------------------------------------------

Sub delay(ByVal amount As Single, ByVal threshold As Ulong)
    '' 'amount'  : requested temporisation to apply, in milliseconds
    '' 'thresold' : fixing threshold for fine-grain temporisation (by waiting loop), in milliseconds
    Dim As Double t1 = Timer
    Dim As Double t2
    Dim As Double t3 = t1 + amount / 1000
    If amount > threshold + 0.5 Then Sleep amount - threshold, 1
    Do
    #if Not defined(__FB_WIN32__) And Not defined(__FB_LINUX__)
        t2 = Timer
        If t2 < t1 Then t1 -= 24 * 60 * 60 : t3 -= 24 * 60 * 60
    Loop Until t2 >= t3
    #else
    Loop Until Timer >= t3
    #endif
End Sub

Function regulate(ByVal MyFps As Ulong, ByVal threshold As Ulong) As Double
    '' 'MyFps' : requested FPS value, in frames per second
    '' function return : applied delay (for debug), in milliseconds
    '' 'thresold' : fixing threshold for fine-grain temporisation (by waiting loop), in milliseconds
    Static As Double t1
    Dim As Single tf = 1 / MyFps
    Dim As Double t2 = Timer
    #if Not defined(__FB_WIN32__) And Not defined(__FB_LINUX__)
    If t2 < t1 Then t1 -= 24 * 60 * 60
    #endif
    Dim As Single dt = (tf - (t2 - t1)) * 1000
    delay(dt, threshold)
    t1 = Timer
    Return dt
End Function

Function framerate() As Ulong
    '' function return : measured FPS value (for debug), in frames per second
    Static As Double t1
    Dim As Double t2 = Timer
    #if Not defined(__FB_WIN32__) And Not defined(__FB_LINUX__)
    If t2 < t1 Then t1 -= 24 * 60 * 60
    #endif
    Dim As Ulong tf = 1 / (t2 - t1)
    t1 = t2
    Return tf
End Function

[dafhi]

works (MX Linux)

[neil]

@fxm
Works (Linux Mint)

[fxm]

For Windows platform only:
- The 'to be included' file initializes the cycle period of the OS in high resolution (1 ms) instead of default resolution.
- For those who wish to call the 'delay()' or 'regulate()' procedure more easily but in default resolution, I added two specific procedures 'delayDR()' and 'regulateDR() ' which run temporarily in default resolution for the OS cycle period and with the threshold of 2 * 16 ms.
- In any cases, any call to 'delay()' and 'regulate()' always runs in high resolution (OS cycle period = 1 ms, threshold = 2 * 1 ms).

[fxm]

For Windows platform only:
- The 'to be included' file initializes the cycle period of the OS in high resolution (1 ms) instead of default resolution.
- For those who wish to call the 'delay()' or 'regulate()' procedure more easily but in default resolution, I added two specific procedures 'delayDR()' and 'regulateDR() ' which run temporarily in default resolution for the OS cycle period and with the threshold of 2 * 16 ms.
- In any cases, any call to 'delay()' and 'regulate()' always runs in high resolution (OS cycle period = 1 ms, threshold = 2 * 1 ms).

But I wonder if it would not be better to do the opposite for the Windows platform:
- 'delay()' and 'regulate()' in default resolution,
- use 'delayHR()' and 'regulateHR()' for the high resolution.

=> Edit: It is this last choice that I finally retained (see wiki).

[deltarho[1859]]

fxm wrote the following:

Replace:

Code: Select all

If dt >= 3 Then Sleep dt - 3, 1
Do ' poll Timer every millisecond - only two or three required - mitigates CPU Load
  Sleep 1,1
Loop Until Timer >= tf

with:

Code: Select all

Sleep Iif(dt > 0.5, dt, 1), 1

I tried that but there wasn't much in it regarding regulation.

With regard 'Sleep Iif(dt > 0.5, dt, 1), 1'

Suppose dt = 0.6 then we get Sleep 0.6.

Sleep cannot handle that – we will get between 1ms and 2ms because that is the resolution of Sleep in high-resolution mode.

I will stay with my code because that cannot go wrong.

I noticed in the Wiki that regulate has been edited. At first, I thought that fxm had dispensed with the Timer pooling loop, but he hasn't. We now have incorporated in regulate() either delay(dt, threshold) or delayHR(dt, threshold). delay() or delayHR() still have the Timer pooling loop.

So, the 'Measured FPS' is still anchored to the 'Requested FPS'. It is very impressive to see the 'Measured FPS' almost immediately be the same as the 'Requested FPS' when the latter is changed, but at what cost. The cost is a large CPU Load. With my allowing the 'Measured FPS' a 'degree of freedom' by pooling Timer only every millisecond sees the CPU Load collapse. However, it does not look as impressive as the anchoring method as it now varies just below the 'Requested FPS' with a small variance.

Users may think that the anchoring method is better when in fact it isn't. Some users will have a fit to see half of their CPU's power taken by using the anchoring method. They will have another fit if they find out the CPU Load collapses if we stop anchoring.

Users with machines like hhr would be better off using dodicat's regulate.

I see we now have HR variants. I warned about user-friendly creep. I can see some users reading the latest Wiki and wondering what to do. As with Help files, we should not give users too much credit.

[fxm]

The first parameter of sleep is defined as LONG.
So the not integer argument is rounded to the closest integer.

dt = 0.6 gives as Sleep(Clng(dt), 1) => Sleep(1, 1)

Otherwise:
Sleep Iif(dt > 1, dt, 1), 1
does exactly the same thing, but perhaps more easily understood..