FreeBasic's Timer

[fxm]

@Jeff,

Can you tell me if the code below is safe (to change the default value of a procedure parameter during the program execution) ?
For my part, I would think it is !

Code: Select all

Sub test(Byval I As Integer) : Print I : End Sub
    
#undef test
Declare Sub test(Byval I As Integer = 1)
test()

#undef test
Declare Sub test(Byval I As Integer = 2)
test()

#undef test
Declare Sub test(Byval I As Integer = 3)
test()

Sleep

Anyway, this directive can only be applied for a following line explicitly calling the procedure (the default call of the procedure in a subroutine defined before will not be impacted)
So just do this:

Code: Select all

Declare Sub test(Byval I As Integer = 0)
Sub test(Byval I As Integer) : Print I : End Sub
    
' #undef test
' Declare Sub test(Byval I As Integer = 1)
test(1) ' test()

' #undef test
' Declare Sub test(Byval I As Integer = 2)
test(2) ' test()

' #undef test
' Declare Sub test(Byval I As Integer = 3)
test(3) ' test()

Sleep

[fxm]

hhr wrote: "For CPU Usage, Dodicat's feature is the winner."

My research is confirming this. dodicat's CPU usage is negligible.

This also confirms my own measurements:

My own results for 'mouse and maze':
(viewtopic.php?p=298935#p298935)

Code: Select all

CPU Usage 'mouse and maze' (I added my 'framerate()' result)

Without "timeBeginPeriod":
sleep regulate(60,fps),1:  0% and FPS a little less stable  '' default configuration
regulate(60,32)         : 21% and FPS stable
regulate(60, 3)         :  0% and FPS a little slower (50) but stable
regulate(60, 0)         :  0% and FPS slower (30) but stable

With "timeBeginPeriod":
sleep regulate(60,fps),1:  0% and FPS stable
regulate(60,32)         : 21% and FPS very stable
regulate(60, 3)         :  4% and FPS very stable  '' default configuration
regulate(60, 0)         :  1% and FPS very stable

[deltarho[1859]]

I need to examine with "timeBeginPeriod" regulate(60, 0). That I assume was on a single test. I reckon that now and then regulate(60, 0) will backfire on us.

If it is not safe, then, to my mind, the best of the bunch is with "timeBeginPeriod" regulate(60, 3); which will not backfire on us.

On my machine, that 4% will probably be less and greater with hhr's machine. Not many people are still on Win7, and they should not be going on the internet with it. That is not just a danger for their machine but every one else's machine as well; mainstream support ended on January 13, 2015.

Added: dodicat has a revised regulate here which needs checking out with 60fps. With more than 60fps the CPU load becomes a factor.

[deltarho[1859]]

For 'mouse and maze' and with "timeBeginPeriod" regulate(60, 3) CPULOad2 gave a load of 1.99 ± 0.64 with 95% confidence.

So regulate(60, 3) is not an issue on my machine.

[fxm]

There is no miracle cure. If we want to increase the accuracy, we will also have to go through an increase in the CPU load.

In the tests I did with 'mouse and maze', I added on the screen the visualization of the measured FPS (bottom right).
We can then compare the accuracy between the two types of regulation:
- the one with 'sleep regulate(60,fps),1'
- the one with 'regulate(60,?)'

For those interested, my two codes:
- 'mouse and maze' with 'sleep regulate(60,fps),1':

Code: Select all

Declare Function _setTimer Lib "winmm" Alias "timeBeginPeriod"(ByVal As Ulong = 1) As Long
_setTimer()

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

const MU = 1  'Mouse Up
const MR = 2  'Mouse Right
const MD = 3  'Mouse Down
const ML = 4  'Mouse Left
    
    
Dim As Long fps
Dim As Byte speed = 128

Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
      Static As Double timervalue,_lastsleeptime,t3,frames
      frames+=1
      If (Timer-t3)>=1 Then t3=Timer:fps=frames:frames=0
      Var sleeptime=_lastsleeptime+((1/myfps)-Timer+timervalue)*1000
      If sleeptime<1 Then sleeptime=1
      _lastsleeptime=sleeptime
      timervalue=Timer
      Return sleeptime
End Function

const MAZEW = 10
const MAZEH = 9
const TILEW = 64
const TILEH = 64
const SCRW = (MAZEW+1)*TILEW
const SCRH = (MAZEH+1)*TILEH

dim shared as integer maze(0 to MAZEW,0 to MAZEH)
'read maze
for j as integer = 0 to MAZEH
    for i as integer = 0 to MAZEW
        read maze(i,j)
    next i
next j


type MICRO_MOUSE
    as integer x    'x position in pixels
    as integer y    'y position in pixels
    as integer w    'width of image
    as integer h    'height of image
    as integer xd   'change in x direction
    as integer yd   'change in y direction
    as integer d    'direction
    as ulong   c    'color
end type

dim shared as MICRO_MOUSE mm

'STARTING VALUES
mm.x = 1*TILEW  'pixel resolution on tile center
mm.y = 1*TILEH
mm.w = TILEW
mm.h = TILEH
mm.d = MR  'mouse looking right
mm.xd = 1
mm.yd = 0
mm.c  = rgb(255,0,0)

screenres SCRW,SCRH,32
color rgb(0,0,0),rgb(255,255,255):cls  'black pen, white paper

'create four pointers
dim shared as any ptr mouseDown,mouseUp,mouseLeft,mouseRight
'create four bitmaps pointed to by each pointer
mouseDown = imagecreate(64,64)
mouseUp   = imagecreate(64,64)
mouseLeft = imagecreate(64,64)
mouseRight= imagecreate(64,64)

'read mouse image date
dim as string datum
for j as integer = 0 to 63
    read datum
    for i as integer = 0 to 63
        if mid(datum,i+1,1)="#" then
            pset mouseDown,(i,j),rgb(0,0,0)
            pset mouseUp,(i,63-j),rgb(0,0,0)
            pset mouseRight,(j,i),rgb(0,0,0)
            pset MouseLeft,(63-j,i),rgb(0,0,0)
        end if
        if mid(datum,i+1,1)="*" then
            pset mouseDown,(i,j),rgb(200,100,0)
            pset mouseUp,(i,63-j),rgb(200,100,0)
            pset mouseRight,(j,i),rgb(200,100,0)
            pset mouseLeft,(63-j,i),rgb(200,100,0)
        end if
        if mid(datum,i+1,1)="." then
            pset mouseDown,(i,j),rgb(255,0,255)
            pset mouseUp,(i,63-j),rgb(255,0,255)
            pset mouseRight,(j,i),rgb(255,0,255)
            pset mouseLeft,(63-j,i),rgb(255,0,255)
        end if
    next i
next j

dim shared as any ptr cheese
cheese = imagecreate(64,64)

'read cheese image data
for j as integer = 0 to 63
    read datum
    for i as integer = 0 to 63
        if mid(datum,i+1,1)="#" then
            pset cheese,(i,j),rgb(0,0,0)
        end if
        if mid(datum,i+1,1)="*" then
            pset cheese,(i,j),rgb(255,201,14)
        end if
        if mid(datum,i+1,1)="." then
            pset cheese,(i,j),rgb(255,242,0)
        end if
        if mid(datum,i+1,1)="@" then
            pset cheese,(i,j),rgb(255,127,39)
        end if
        if mid(datum,i+1,1)=" " then
            pset cheese,(i,j),rgb(255,0,255)
        end if
    next i
next j


sub display()
'    dim as Vector2 v2
    screenlock
    cls

    'draw maze
    for j as integer = 0 to 9
        for i as integer = 0 to 10
            if maze(i,j) = 1 then
                line (i*TILEW,j*TILEH)-(i*TILEW+TILEW-1,j*TILEH+TILEH-1),rgb(150,150,150),bf
            else
                line (i*TILEW,j*TILEH)-(i*TILEW+TILEW-1,j*TILEH+TILEH-1),rgb(255,255,255),b
            end if
            line (i*TILEW,j*TILEH)-(i*TILEW+TILEW-1,j*TILEH+TILEH-1),rgb(0,0,0),b
            
        next i
    next j

    'draw mouse
    'line (mm.x,mm.y)-(mm.x+mm.w,mm.y+mm.h),mm.c,bf
    if mm.d = MU then
        put (mm.x,mm.y),mouseUp,trans
    end if
    if mm.d = MR then
        put (mm.x,mm.y),mouseRight,trans
    end if
    if mm.d = MD then
        put (mm.x,mm.y),mouseDown,trans
    end if
    if mm.d = ML then
        put (mm.x,mm.y),mouseLeft,trans
    end if
    
    
    put (5*64,4*64),cheese,trans

    locate 3,2
    if mm.d = MU then print "UP"
    if mm.d = MR then print "RIGHT"
    if mm.d = MD then print "DOWN"
    if mm.d = ML then print "LEFT"
        
    locate 78, 85
    print framerate()

    screenunlock
end sub

function onTile(m as MICRO_MOUSE) as boolean
    if m.x = int(m.x\TILEW)*TILEW and m.y = int(m.y\TILEH)*TILEH then
        return TRUE
    else
        return FALSE
    end if
end function

sub makeMove(m as MICRO_MOUSE)
    m.x = m.x + m.xd
    m.y = m.y + m.yd
end sub


sub setVelocity(m as MICRO_MOUSE)
    if m.d = MU then m.xd=  0  :m.yd= -2   'up
    if m.d = MR then m.xd=  2  :m.yd=  0   'right
    if m.d = MD then m.xd=  0  :m.yd=  2   'dowm
    if m.d = ML then m.xd= -2  :m.yd=  0   'left
end sub


do

    display()
    'update mouse position
    makeMove(mm)

    dim as integer dd(1 to 4) 'free direction to move if =0
    dim as integer cc   'how many free sides?
    dim as integer rd   'reverse direction

    
    if onTile(mm) then
        locate 1,1
        'zero directions assume all directions free
        dd(1)=0  'up
        dd(2)=0  'right
        dd(3)=0  'down
        dd(4)=0  'left
        cc = 0  'count sides blocked
        
        'set side values
        if maze( mm.x\TILEW  , mm.y\TILEH-1) = 1 then  'UP
            dd(1)=1
            cc = cc + 1
        end if
        if maze( mm.x\TILEW+1, mm.y\TILEH)   = 1 then  'RIGHT
            dd(2)=1
            cc = cc + 1
        end if
        if maze( mm.x\TILEW  , mm.y\TILEH+1)   = 1 then  'DOWN
            dd(3)=1
            cc = cc + 1
        end if
        if maze( mm.x\TILEW-1, mm.y\TILEH)     = 1 then  'LEFT
            dd(4)=1
            cc = cc + 1
        end if
        
        'compute reverse direction
        rd = mm.d + 2
        if rd > 4 then rd = rd - 4
        
        if cc = 3 then 'then select reverse
            mm.d = rd
        else
            mm.d = int(rnd(1)*4)+1
            while dd(mm.d)=1 or mm.d = rd
                mm.d = int(rnd(1)*4)+1
            wend
        end if

        setVelocity(mm)
      
    end if
    
    sleep regulate(60,fps),1
    
loop until multikey(&H01)

'MAZE
data 1,1,1,1,1,1,1,1,1,1,1
data 1,0,0,0,0,0,1,0,0,0,1
data 1,1,1,1,1,0,0,0,1,1,1
data 1,0,1,0,1,1,1,0,1,0,1
data 1,0,1,0,0,0,1,0,1,0,1
data 1,0,1,0,1,1,1,0,1,0,1
data 1,0,0,0,0,0,0,0,0,0,1
data 1,0,1,1,1,1,1,1,1,0,1
data 1,0,1,0,0,0,0,0,0,0,1
data 1,1,1,1,1,1,1,1,1,1,1

'image mouse data
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "..............................######............................"
DATA "............................##******##.........................."
DATA "...........................#**********#........................."
DATA "..........................#************#........................"
DATA ".........................#**************#......................."
DATA ".........................#**************#......................."
DATA "........................#****************#......................"
DATA ".......................#******************#....................."
DATA ".......................#******************#....................."
DATA "......................#********************#...................."
DATA "......................#********************#...................."
DATA "......................#********************#...................."
DATA "......................#********************#...................."
DATA "......................#********************#...................."
DATA "......................#********************#...................."
DATA ".....................#**********************#..................."
DATA ".....................#**********************#..................."
DATA ".....................#**********************#..................."
DATA ".....................#**********************#..................."
DATA ".....................#**********************#..................."
DATA ".....................#**********************#..................."
DATA ".....................#**********************#..................."
DATA ".....................#**********************#..................."
DATA "....................###********************###.................."
DATA "...................####******************######................."
DATA "..................#******#**************#******#................"
DATA ".................#********#************#********#..............."
DATA ".................#********#************#********#..............."
DATA ".................#******************************#..............."
DATA ".................#******************************#..............."
DATA ".................#**********#********#**********#..............."
DATA ".................#******************************#..............."
DATA ".................#******************************#..............."
DATA ".................#******************************#..............."
DATA "..................#****************************#................"
DATA "...................#**************************#................."
DATA "....................###********************###.................."
DATA ".......................#****##******##****#....................."
DATA ".......................#***####****####***#....................."
DATA "........................#***##******##***#......................"
DATA "........................#****************#......................"
DATA ".........................#**************#......................."
DATA "..........................#************#........................"
DATA ".....................#...####**####**####...#..................."
DATA "......................###..#*#*####*#*#..###...................."
DATA "..........................###***##***###........................"
DATA ".........................#...##****##...#......................."
DATA ".......................##...#..####..#...##....................."
DATA "...........................#..........#........................."

'cheese data
DATA "                                                                "
DATA "                                     #####                      "
DATA "                                   ##.....######                "
DATA "                                 ##.............####            "
DATA "                               ##...................###         "
DATA "                              #........................##       "
DATA "                            ##.............####..........#      "
DATA "                           #..............#@@@@#..........#     "
DATA "                            #............#@@@@@@#..........#    "
DATA "                            #.............#@@@@##...........#   "
DATA "                            #..............####..............#  "
DATA "                   ###    ##..................................# "
DATA "                 ##...####.................................#### "
DATA "                #....................................######***# "
DATA "              ##..............................#######*********# "
DATA "            ##.........................#######****************# "
DATA "          ##.........#####.......######***********************# "
DATA "         #..........#@@@@@#######*****************************# "
DATA "       ##..........#@@@@@@@#**********************************# "
DATA "     ##......#######@@@@@@@#**********************************# "
DATA "   ##.#######*******#@@@@@#***********************************# "
DATA "  ####***************#####************************************# "
DATA " #*****************************************####***************# "
DATA " #****************************************#@@@@#**************# "
DATA " #***************************************#@@@@@@#*************# "
DATA " #***************************************#@@@@@@#*************# "
DATA " #****************************************#@@@@#**************# "
DATA " #*****************************************####***************# "
DATA " ##***********************************************************# "
DATA "   #****************************###***************************# "
DATA "    #*****####*****************#@@@#**************************# "
DATA "    #****#@@@@#***************#@@@@@#*************************# "
DATA "    #***#@@@@@@#**************#@@@@@#*************************# "
DATA "   #****#@@@@@@#**************#@@@@@#*******************###***# "
DATA "  #*****#@@@@@@#***************#@@@#*******************#@@#***# "
DATA " #*******#@@@@#*****************###********************#@@@#**# "
DATA " #********####*****************************************#@@@#**# "
DATA " #*****************************************************#@@@#**# "
DATA " #******************************************************###***# "
DATA " #************************************************************# "
DATA " #************************************************************# "
DATA " #************************************************************# "
DATA " ############################################################## "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "

- 'mouse and maze' with 'regulate(60,?)':

Code: Select all

#include "delay_regulate_framerate.bi"

const MU = 1  'Mouse Up
const MR = 2  'Mouse Right
const MD = 3  'Mouse Down
const ML = 4  'Mouse Left
    
    
Dim As Long fps
Dim As Byte speed = 128

'Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
'      Static As Double timervalue,_lastsleeptime,t3,frames
'      frames+=1
'      If (Timer-t3)>=1 Then t3=Timer:fps=frames:frames=0
'      Var sleeptime=_lastsleeptime+((1/myfps)-Timer+timervalue)*1000
'      If sleeptime<1 Then sleeptime=1
'      _lastsleeptime=sleeptime
'      timervalue=Timer
'      Return sleeptime
'End Function

const MAZEW = 10
const MAZEH = 9
const TILEW = 64
const TILEH = 64
const SCRW = (MAZEW+1)*TILEW
const SCRH = (MAZEH+1)*TILEH

dim shared as integer maze(0 to MAZEW,0 to MAZEH)
'read maze
for j as integer = 0 to MAZEH
    for i as integer = 0 to MAZEW
        read maze(i,j)
    next i
next j


type MICRO_MOUSE
    as integer x    'x position in pixels
    as integer y    'y position in pixels
    as integer w    'width of image
    as integer h    'height of image
    as integer xd   'change in x direction
    as integer yd   'change in y direction
    as integer d    'direction
    as ulong   c    'color
end type

dim shared as MICRO_MOUSE mm

'STARTING VALUES
mm.x = 1*TILEW  'pixel resolution on tile center
mm.y = 1*TILEH
mm.w = TILEW
mm.h = TILEH
mm.d = MR  'mouse looking right
mm.xd = 1
mm.yd = 0
mm.c  = rgb(255,0,0)

screenres SCRW,SCRH,32
color rgb(0,0,0),rgb(255,255,255):cls  'black pen, white paper

'create four pointers
dim shared as any ptr mouseDown,mouseUp,mouseLeft,mouseRight
'create four bitmaps pointed to by each pointer
mouseDown = imagecreate(64,64)
mouseUp   = imagecreate(64,64)
mouseLeft = imagecreate(64,64)
mouseRight= imagecreate(64,64)

'read mouse image date
dim as string datum
for j as integer = 0 to 63
    read datum
    for i as integer = 0 to 63
        if mid(datum,i+1,1)="#" then
            pset mouseDown,(i,j),rgb(0,0,0)
            pset mouseUp,(i,63-j),rgb(0,0,0)
            pset mouseRight,(j,i),rgb(0,0,0)
            pset MouseLeft,(63-j,i),rgb(0,0,0)
        end if
        if mid(datum,i+1,1)="*" then
            pset mouseDown,(i,j),rgb(200,100,0)
            pset mouseUp,(i,63-j),rgb(200,100,0)
            pset mouseRight,(j,i),rgb(200,100,0)
            pset mouseLeft,(63-j,i),rgb(200,100,0)
        end if
        if mid(datum,i+1,1)="." then
            pset mouseDown,(i,j),rgb(255,0,255)
            pset mouseUp,(i,63-j),rgb(255,0,255)
            pset mouseRight,(j,i),rgb(255,0,255)
            pset mouseLeft,(63-j,i),rgb(255,0,255)
        end if
    next i
next j

dim shared as any ptr cheese
cheese = imagecreate(64,64)

'read cheese image data
for j as integer = 0 to 63
    read datum
    for i as integer = 0 to 63
        if mid(datum,i+1,1)="#" then
            pset cheese,(i,j),rgb(0,0,0)
        end if
        if mid(datum,i+1,1)="*" then
            pset cheese,(i,j),rgb(255,201,14)
        end if
        if mid(datum,i+1,1)="." then
            pset cheese,(i,j),rgb(255,242,0)
        end if
        if mid(datum,i+1,1)="@" then
            pset cheese,(i,j),rgb(255,127,39)
        end if
        if mid(datum,i+1,1)=" " then
            pset cheese,(i,j),rgb(255,0,255)
        end if
    next i
next j


sub display()
'    dim as Vector2 v2
    screenlock
    cls

    'draw maze
    for j as integer = 0 to 9
        for i as integer = 0 to 10
            if maze(i,j) = 1 then
                line (i*TILEW,j*TILEH)-(i*TILEW+TILEW-1,j*TILEH+TILEH-1),rgb(150,150,150),bf
            else
                line (i*TILEW,j*TILEH)-(i*TILEW+TILEW-1,j*TILEH+TILEH-1),rgb(255,255,255),b
            end if
            line (i*TILEW,j*TILEH)-(i*TILEW+TILEW-1,j*TILEH+TILEH-1),rgb(0,0,0),b
            
        next i
    next j

    'draw mouse
    'line (mm.x,mm.y)-(mm.x+mm.w,mm.y+mm.h),mm.c,bf
    if mm.d = MU then
        put (mm.x,mm.y),mouseUp,trans
    end if
    if mm.d = MR then
        put (mm.x,mm.y),mouseRight,trans
    end if
    if mm.d = MD then
        put (mm.x,mm.y),mouseDown,trans
    end if
    if mm.d = ML then
        put (mm.x,mm.y),mouseLeft,trans
    end if
    
    
    put (5*64,4*64),cheese,trans

    locate 3,2
    if mm.d = MU then print "UP"
    if mm.d = MR then print "RIGHT"
    if mm.d = MD then print "DOWN"
    if mm.d = ML then print "LEFT"
    
    locate 78, 85
    print framerate()
        
    screenunlock
end sub

function onTile(m as MICRO_MOUSE) as boolean
    if m.x = int(m.x\TILEW)*TILEW and m.y = int(m.y\TILEH)*TILEH then
        return TRUE
    else
        return FALSE
    end if
end function

sub makeMove(m as MICRO_MOUSE)
    m.x = m.x + m.xd
    m.y = m.y + m.yd
end sub


sub setVelocity(m as MICRO_MOUSE)
    if m.d = MU then m.xd=  0  :m.yd= -2   'up
    if m.d = MR then m.xd=  2  :m.yd=  0   'right
    if m.d = MD then m.xd=  0  :m.yd=  2   'dowm
    if m.d = ML then m.xd= -2  :m.yd=  0   'left
end sub


do

    display()
    'update mouse position
    makeMove(mm)

    dim as integer dd(1 to 4) 'free direction to move if =0
    dim as integer cc   'how many free sides?
    dim as integer rd   'reverse direction

    
    if onTile(mm) then
        locate 1,1
        'zero directions assume all directions free
        dd(1)=0  'up
        dd(2)=0  'right
        dd(3)=0  'down
        dd(4)=0  'left
        cc = 0  'count sides blocked
        
        'set side values
        if maze( mm.x\TILEW  , mm.y\TILEH-1) = 1 then  'UP
            dd(1)=1
            cc = cc + 1
        end if
        if maze( mm.x\TILEW+1, mm.y\TILEH)   = 1 then  'RIGHT
            dd(2)=1
            cc = cc + 1
        end if
        if maze( mm.x\TILEW  , mm.y\TILEH+1)   = 1 then  'DOWN
            dd(3)=1
            cc = cc + 1
        end if
        if maze( mm.x\TILEW-1, mm.y\TILEH)     = 1 then  'LEFT
            dd(4)=1
            cc = cc + 1
        end if
        
        'compute reverse direction
        rd = mm.d + 2
        if rd > 4 then rd = rd - 4
        
        if cc = 3 then 'then select reverse
            mm.d = rd
        else
            mm.d = int(rnd(1)*4)+1
            while dd(mm.d)=1 or mm.d = rd
                mm.d = int(rnd(1)*4)+1
            wend
        end if

        setVelocity(mm)
      
    end if
    
    regulate(60,3)
    
loop until multikey(&H01)

'MAZE
data 1,1,1,1,1,1,1,1,1,1,1
data 1,0,0,0,0,0,1,0,0,0,1
data 1,1,1,1,1,0,0,0,1,1,1
data 1,0,1,0,1,1,1,0,1,0,1
data 1,0,1,0,0,0,1,0,1,0,1
data 1,0,1,0,1,1,1,0,1,0,1
data 1,0,0,0,0,0,0,0,0,0,1
data 1,0,1,1,1,1,1,1,1,0,1
data 1,0,1,0,0,0,0,0,0,0,1
data 1,1,1,1,1,1,1,1,1,1,1

'image mouse data
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "..............................######............................"
DATA "............................##******##.........................."
DATA "...........................#**********#........................."
DATA "..........................#************#........................"
DATA ".........................#**************#......................."
DATA ".........................#**************#......................."
DATA "........................#****************#......................"
DATA ".......................#******************#....................."
DATA ".......................#******************#....................."
DATA "......................#********************#...................."
DATA "......................#********************#...................."
DATA "......................#********************#...................."
DATA "......................#********************#...................."
DATA "......................#********************#...................."
DATA "......................#********************#...................."
DATA ".....................#**********************#..................."
DATA ".....................#**********************#..................."
DATA ".....................#**********************#..................."
DATA ".....................#**********************#..................."
DATA ".....................#**********************#..................."
DATA ".....................#**********************#..................."
DATA ".....................#**********************#..................."
DATA ".....................#**********************#..................."
DATA "....................###********************###.................."
DATA "...................####******************######................."
DATA "..................#******#**************#******#................"
DATA ".................#********#************#********#..............."
DATA ".................#********#************#********#..............."
DATA ".................#******************************#..............."
DATA ".................#******************************#..............."
DATA ".................#**********#********#**********#..............."
DATA ".................#******************************#..............."
DATA ".................#******************************#..............."
DATA ".................#******************************#..............."
DATA "..................#****************************#................"
DATA "...................#**************************#................."
DATA "....................###********************###.................."
DATA ".......................#****##******##****#....................."
DATA ".......................#***####****####***#....................."
DATA "........................#***##******##***#......................"
DATA "........................#****************#......................"
DATA ".........................#**************#......................."
DATA "..........................#************#........................"
DATA ".....................#...####**####**####...#..................."
DATA "......................###..#*#*####*#*#..###...................."
DATA "..........................###***##***###........................"
DATA ".........................#...##****##...#......................."
DATA ".......................##...#..####..#...##....................."
DATA "...........................#..........#........................."

'cheese data
DATA "                                                                "
DATA "                                     #####                      "
DATA "                                   ##.....######                "
DATA "                                 ##.............####            "
DATA "                               ##...................###         "
DATA "                              #........................##       "
DATA "                            ##.............####..........#      "
DATA "                           #..............#@@@@#..........#     "
DATA "                            #............#@@@@@@#..........#    "
DATA "                            #.............#@@@@##...........#   "
DATA "                            #..............####..............#  "
DATA "                   ###    ##..................................# "
DATA "                 ##...####.................................#### "
DATA "                #....................................######***# "
DATA "              ##..............................#######*********# "
DATA "            ##.........................#######****************# "
DATA "          ##.........#####.......######***********************# "
DATA "         #..........#@@@@@#######*****************************# "
DATA "       ##..........#@@@@@@@#**********************************# "
DATA "     ##......#######@@@@@@@#**********************************# "
DATA "   ##.#######*******#@@@@@#***********************************# "
DATA "  ####***************#####************************************# "
DATA " #*****************************************####***************# "
DATA " #****************************************#@@@@#**************# "
DATA " #***************************************#@@@@@@#*************# "
DATA " #***************************************#@@@@@@#*************# "
DATA " #****************************************#@@@@#**************# "
DATA " #*****************************************####***************# "
DATA " ##***********************************************************# "
DATA "   #****************************###***************************# "
DATA "    #*****####*****************#@@@#**************************# "
DATA "    #****#@@@@#***************#@@@@@#*************************# "
DATA "    #***#@@@@@@#**************#@@@@@#*************************# "
DATA "   #****#@@@@@@#**************#@@@@@#*******************###***# "
DATA "  #*****#@@@@@@#***************#@@@#*******************#@@#***# "
DATA " #*******#@@@@#*****************###********************#@@@#**# "
DATA " #********####*****************************************#@@@#**# "
DATA " #*****************************************************#@@@#**# "
DATA " #******************************************************###***# "
DATA " #************************************************************# "
DATA " #************************************************************# "
DATA " #************************************************************# "
DATA " ############################################################## "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "

[fxm]

Added: dodicat has a revised regulate here which needs checking out with 60fps. With more than 60fps the CPU load becomes a factor.

I looked at it, but the instantaneous FPS regulation is very bad.
It is not really visible because the movement is very slow and the average FPS is stable, but when we display its instantaneous value, it is large fluctuations.

The code with the instantaneous framerate displayed:

Code: Select all

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

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 Overload(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*60
End Function


Function Regulate(Byval MyFps As Long,Byref fps As Long,Byref gap As Double) As Double
      Static As Double timervalue,_lastsleeptime,t3,frames
      Var T=Timer
      frames+=1
      If (t-t3)>=1 Then t3=t:fps=frames:frames=0
      Var sleeptime=_lastsleeptime+((1/myfps)-T+timervalue)*1000
      If sleeptime<1 Then gap=sleeptime:sleeptime= 1
      _lastsleeptime=sleeptime
      timervalue=T
      Return sleeptime
End Function

Sub ball()
      Static  As Double x= 10
      Static  As Double y = 10
      Static  As Double dx=.5
      Static  As Double dy =.5
      x += dx : y += dy
      If x<10 Or x>=630 Then dx = -dx
      If y<10 Or y>=470 Then dy = -dy
      Circle(x,y),10,4,,,,f 
End Sub


Sub drawline(x As Long,y As Long,angle As Single,length As Long,col As Ulong)
      Var x2=x+length*Cos(angle)
      Var y2=y-length*Sin(angle)
      Line(x,y)-(x2,y2)
      Circle(x2,y2),20,6,,,,f
End Sub

Sub pendulum
      #define dmod(x,y) (y)*Frac((x)/(y)) 
      Const pi=4*Atn(1)
      Static As Single angle
      angle+=.005
      angle=dmod(angle,2*pi)
      drawline(400,100,.4*Sin(angle)-pi/2,300,4) 
End Sub

Dim As String message="50"
Dim As Long fps
Dim As Long MyChoice,flag
Dim As String LastChoice
Dim As Double gap
gap=2

'shell("start taskmgr.exe")

Screen 12

Do
      Screenlock
      Cls
      
      readkey(4,2,Ucase("Input required framerate, ESC to finish "),message,3)
      Color 7
      Locate 7,2
      Print "required framerate ";message
      Locate 10,2
      Print "actual framerate   ";fps
      Locate 13,2
      Print "instantaneous framerate "; framerate()

      Locate 16,2
      Color 5
      Print Iif(flag=true,"Regulate with sleep","Regulate with while")
      ball
      pendulum
      Screenunlock
      
      MyChoice=Valint(message)
      If Mychoice<=0 Then message=LastChoice:Continue Do
      
      If gap>1 Then '< about 60 fps
            Sleep  regulate(MyChoice,fps,gap) ,1
            flag=true
      Else
            gap=regulate(MyChoice,fps)
            flag=false
      End If
      
      
      LastChoice=message 
      
Loop Until Multikey(1)'esc

[dodicat]

I just extracted the fps from the while loop function for brevity to save an extra function.
Normally I could have used a separate framecounter.

[deltarho[1859]]

fxm referred to his regulate() as a super set of delay().

The Achilles' heel of his regulate() is the Timer polling loop.

Earlier, I wrote: “You may be surprised to learn that Timer is so fine-grained, we go through the Timer pooling loop millions of times.” On Windows 10 the default performance counter has a frequency of 10MHz a resolution of 100ns. That is great for delay() but we do not need anything like that for regulate().

With a threshold of 3ms the Timer polling loop will not cause much of a load. However, that 3ms is occurring with every frame. If we increase the fps, then we increase the load. Therein is the damage.

Suppose we do away with the Timer polling loop and simply query Timer every millisecond. With 3ms we will have three queries and not millions.

How do we do that? Simple. We set up a timer event to fire every millisecond and query Timer.

This is what a timeSetEvent regulate looks like.

Firstly, we require a couple of includes.

Code: Select all

#include "windows.bi"
#include Once "win\mmsystem.bi"

Then we require a couple of global variables and a callback function.

Code: Select all

Dim Shared As Double GetTime
Dim Shared As Ulong TimerID
Function TimerCallback(ByVal uID As Long, ByVal uMsg As Long, _
  ByVal dwUser As Long, ByVal dw1 As Long, ByVal dw2 As Long) As Long
  GetTime = Timer
  Return 0
End Function

Here is the timeSetEvent regulate.

Code: Select all

Function regulate(ByVal MyFps As Ulong, ByVal threshold As Single) 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 t3 = t1 + tf
  Dim As Double t2 = Timer
  #if Not defined(__FB_WIN32__) And Not defined(__FB_LINUX__)
  If t2 < t1 Then t1 -= 24 * 60 * 60 : t3 -= 24 * 60 * 60
  #endif
  Dim As Single dt = (tf - (t2 - t1)) * 1000
  #ifdef __FB_WIN32__
  _setTimer
  #endif
  If dt > threshold + 0.5 Then Sleep dt - threshold, 1
  #if Not defined(__FB_WIN32__) And Not defined(__FB_LINUX__)
    t2 = Timer
    If t2 < t1 Then t1 -= 24 * 60 * 60 : t3 -= 24 * 60 * 60
    TimerID = timeSetEvent( ByVal 1, 1, Cast( LPTIMECALLBACK, @TimerCallback ), ByVal 0&, ByVal %TIME_PERIODIC)
    Do
      Sleep 1
    Loop Until GetTime >= t3
    TimeKillEvent TimerID
  #else
    TimerID = timeSetEvent( ByVal 1, 1, Cast( LPTIMECALLBACK, @TimerCallback ), ByVal 0&, ByVal TIME_PERIODIC)
    Do
      Sleep 1
    Loop Until GetTime >= t3
    TimeKillEvent TimerID
  #endif
  #ifdef __FB_WIN32__
  _resetTimer
  #endif
  t1 = Timer
  Return dt
End Function

With fxm's example showing Requested FPS, Applied delay, and Measured FPS the Measured FPS is not rock solid. It varies and is a little less than the Requested FPS. The Applied delay is just about what it used to be. Visually, there is no change. Our brains will not perceive a varying Measured FPS. Regarding the 'mouse and maze' program, visually there is no difference.

Now what about the CPU Load? Regarding 'mouse and maze' regulate(60, 3) and regulate(60, 32) had the same CPU Load – ZERO.

The above regulate is a beta version which may need some tweaking. However, querying Timer only a handful of times rather than millions is clearly beneficial.

Added: I have not given any thought to Linux in the above. I am unashamedly a Windows guy and always will be. We are not getting much feedback from Linux users. Actually, we are not getting much feedback from Windows users, but I have already had a rant about that.

[fxm]

If you want to read the Timer only 1 time per millisecond (with a 'Sleep 1' waiting 1 ms), a simple loop as follows is sufficient:

Code: Select all

Do
    Sleep 1, 1
Loop Until Timer >= t3

But as the 'Sleep' has an accuracy of 1 ms, you can execute the regulation by using only 'Sleep':

Code: Select all

Function regulate(ByVal MyFps As Ulong) As Double
  '' 'MyFps' : requested FPS value, in frames per second
  '' function return : applied delay (for debug), in milliseconds
  Static As Double t1
  Dim As Single tf = 1 / MyFps
  Dim As Double t2 = Timer
  Dim As Single dt = (tf - (t2 - t1)) * 1000
  If dt >= 0.5 Then Sleep dt, 1
  t1 = Timer
  Return dt
End Function

[deltarho[1859]]

Yes!

Code: Select all

Do
  Sleep 1, 1
Loop Until Timer >= t3

has the same effect as using timeSetEvent.

The Measured FPS varies, but has a small variance, and its average is a little less than the Requested FPS.

The important thing is that the CPU load is now either zero or not worth mentioning.

By the way, a 'Sleep 1' waiting 1 ms is not strictly true. The wait will vary between one ms and two ms. This has been confirmed in an Intel blog.

Added: This what I am getting with the 'mouse and maze' and regulate(60,32)

Code: Select all

    Press ENTER to stop monitoring PID #7828
         CPU Load:  0.00
         Max Load:  0.20
         95% Conf Interval:  0.00 ± 0.08
         Session Time:  60.0 seconds

[fxm]

By the way, a 'Sleep 1' waiting 1 ms is not strictly true. The wait will vary between one ms and two ms. This has been confirmed in an Intel blog.

Yes, and that is why we have to fix the threshold for 'regulate()' by using at least a factor 2 (2*16 or 2*1).

[deltarho[1859]]

What do you mean, 'we'? I suggested 32 and 4 but then reckoned 3 was safe with 2 pushing it.

delay() and regulate() are your babies, but don't rob me of my ideas.

You have done a great job in the Wiki but don't forget it was my idea to do that.

[fxm]

I just did some tests between thresholds 2 and 3 (with the code below):
- I do not see any significant difference in terms of accuracy,
- otherwise a significant difference from the CPU load point of view.

I would be of the opinion to pass all the thresholds to a factor of 2 (2*1, 2*10, 2*55, 2*16) ?

Code: Select all

#include "delay_regulate_framerate.bi"

Dim As Double d = 6
Dim As Integer x
Dim As Integer threshold = 3

Screen 19
Print "threshold (<+> or <-> to change):"; threshold

Do
    Dim As Double t = Timer
    Delay(d, Threshold)
    t = (Timer - t) * 1000 * 1000 * 100
    If x = 0 Then
        Pset(-1, 600)
    Else
        Line -(x, 600 - (t - d * 1000 * 100))
    End If
    x = (x + 1) Mod 800
    Dim As String s = Inkey
    Select Case s
    Case "+"
        If threshold < 5 Then
            threshold += 1
            Cls
            x = 0
            Print "threshold (<+> or <-> to change):"; threshold
        End If
    Case "-"
        If threshold > 1 Then
            threshold -= 1
            Cls
            x = 0
            Print "threshold (<+> or <-> to change):"; threshold
        End If
    Case Chr(27)
        Exit Do
    End Select
Loop

Print "Graph completed"
Sleep

[deltarho[1859]]

If you want to read the Timer only 1 time per millisecond

It is not a case of want – it is imperative, otherwise regulate() is flawed by allowing a CPU Load to occur.

Without doing so, gives a rock solid Measured FPS, but we don't need that.

As I wrote above: “The Measured FPS varies, but has a small variance, and its average is a little less than the Requested FPS.”

Visually, a user will not be aware that the Measured FPS is not the same as the Requested FPS.

Allowing a 'degree of freedom' to the Measured FPS just about eliminates a CPU Load and a user will be very aware of that, as I showed above with regulate(60,32).

hhr published some horrendous CPU Loads, some greater than 50%, and yours were worse than mine. Imagine his delight to see his CPU Loads collapse just because we were not forcing Measured FPS to be the same as Requested FPS.

I am reminded of a PRNG where the author did not impose a hard-wired period and got a much greater throughput. The period could fall to 2^32, but the likelihood of that was 2^128 against. Possible, but in practice never seen.

You need to change the Wiki.

Added: The above is for regulate() and not delay(). Employing it with delay() will see the accuracy go out of the window.

[fxm]

Why not add a second, but lite regulate procedure in the file to be included ?

Code: Select all

Declare Function _setTimer Lib "winmm" Alias "timeBeginPeriod"(ByVal As Ulong = 1) As Long
_setTimer()

Function regulateLite(ByVal MyFps As Ulong) As Ulong
    '' 'MyFps' : requested FPS value, in frames per second
    '' function return : applied FPS value, in frames per second
    Static As Double t1
    Dim As Single tf = 1 / MyFps
    Dim As Double t3 = t1 + tf
    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
    Sleep Iif(dt > 0.5, dt, 1), 1
    t2 = Timer
    #if Not defined(__FB_WIN32__) And Not defined(__FB_LINUX__)
    If t2 < t1 Then t1 -= 24 * 60 * 60
    #endif
    tf = 1 / (t2 - t1)
    t1 = t2
    Return tf
End Function

Screen 12

Dim As Ulong FPS = 60

Do
    Static As Ulongint l
    Static As Ulongint tf
    Screenlock
    Cls
    Color 11
    Print Using "Requested FPS : ###"; FPS
    Print Using "Measured FPS  : ###"; tf
    Print
    Print
    Print
    Color 14
    Print "<+>         : Increase FPS"
    Print "<->         : Decrease FPS"
    Print "<other key> : Quit"
    Line (0, 48)-(639, 64), 7, B
    Line (0, 48)-(l, 64), 7, BF
    Screenunlock
    l = (l + 1) Mod 640
    Dim As String s = Inkey
    Select Case s
    Case "+"
        If FPS < 100 Then FPS += 1
    Case "-"
        If FPS > 10 Then FPS -= 1
    Case Else
        If s <> "" Then Exit Do
    End Select
    tf = regulateLite(FPS)
Loop