FreeBasic's Timer

General FreeBASIC programming questions.
Post Reply
fxm
Moderator
Posts: 11926
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: FreeBasic's Timer

Post by fxm »

fxm wrote: Jun 06, 2023 21:39 After reflection, I think there is everything you need in the 'regulateLite()' procedure body (provided you buffer 2 additional data.) to measure (with the Timer) the real waiting time in relation to the command of the previous occurrence.

It is OK for this.
fxm
Moderator
Posts: 11926
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: FreeBasic's Timer

Post by fxm »

fxm wrote: Jun 06, 2023 21:39 After reflection, I think there is everything you need in the 'regulateLite()' procedure body (provided you buffer 2 additional data.) to measure (with the Timer) the real waiting time in relation to the command of the previous occurrence.

If the time measured is much greater than the time ordered, this probably means that there is an error compared to the resolution measured on initialization, and we can then restart another resolution measurement (with some 'Sleep 1, 1').
Example: requested time = 4 µs, but measured time = 16 µs, probably because the resolution was changed (lowered) while program running.

If the time measured is a little different from the time ordered, the differences are averaged to try to correct the average bias of the SLEEP keyword.

I will try to code this.

It is now OK for all of this.
Updated code (beta):
+ self-calibration of waiting time accuracy,
+ self detection of a High resolution -> Basic resolution transition for the OS cycle, which restarts a resolution calibration (as for the first call).

[edit]
After last tests to shake the code with a quick saw-tooth FPS command, few final crashes/bugs fixed.
I think the version below is now quite reliable.

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 Single tos
    Static As Single bias
    If tos = 0 Then
        Dim As Double t = Timer
        For I As Integer = 1 To 10
            Sleep 1, 1
        Next I
        tos = (Timer - t) / 10 * 1000
        bias = tos / 2
    End If
    Static As Long N
    Static As Long k
    Static As Single tf
    If N = 1 Then
        k = Int(MyFps / 240 * tos)
        If k = 0 Then k = 1
        tf = 1 / MyFps
    End If    
    Static As Double t0
    Static As Double t1
    Static As Double t3
    Static As Single dt0
    Static As Long start
    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
    If Start > 10 And N = 1 Then
        If Abs((t1 - t3) * 1000 - dt0) > 3 * tos Then
            tos = 0
            start = 0
            Exit Function
        End If
        bias += 0.01 * Sgn((t1 - t3) * 1000 - dt0)
    Elseif N = 1 Then
        Start += 1
    End If
    t3 = t2
    If N >= K Then
        Dim As Single dt = (k * tf - (t2 - t1)) * 1000 - bias
        If dt < 0 Then dt = 0
        dt0 = dt + bias
        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
        t0 = k / (t2 - t1)
        t1 = t2
        N = 1
    Else
        N += 1
    End If
    Return t0
End Function

Screen 12
Dim As Ulong MyFPS = 60

Do
    Static As Ulongint l
    Static As Double dt
    Static As Ulong fps
    Screenlock
    Cls
    Color 11
    Print "Called procedure : regulateLite ( " & MyFPS & " )"
    Print
    Print Using "Measured FPS (skipped images excluded) : ###"; fps
    Print Using "Applied delay (when no skipped image)  : ###.### ms"; dt
    Print
    Print
    Print
    Color 14
    Print "<+>      : Increase FPS"
    Print "<->      : Decrease FPS"
    Print "<escape> : Quit"
    Line (0, 80)-(639, 96), 7, B
    Line (0, 80)-(l, 96), 7, BF
    Screenunlock
    l = (l + 1) Mod 640
    Dim As String s = Inkey
    Select Case s
    Case "+"
        If MyFPS < 500 Then MyFPS += 1
    Case "-"
        If MyFPS > 5 Then MyFPS -= 1
    Case Chr(27)
        Exit Do
    End Select
    dt = Timer
    fps = regulateLite(MyFPS)
    dt = (Timer - dt) * 1000
Loop
Last edited by fxm on Jun 08, 2023 8:49, edited 10 times in total.
Reason: Almost final code.
fxm
Moderator
Posts: 11926
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: FreeBasic's Timer

Post by fxm »

Code: Select all

CPU load test for "delay_regulate_framerate.bi" (code in wiki), FPS = 60:
    Basic resolution : 21 %
    High resolution  :  3 %

CPU load test for "regulateLite()" (the last just above), FPS = 60:
    Basic resolution :  0 %
    High resolution  :  1 %
deltarho[1859]
Posts: 4158
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: FreeBasic's Timer

Post by deltarho[1859] »

My CPULoad2 has had an update and I will be posting the latest version later today.

The following just about confirms fxm's regulateLite() test.

The 'CPU Load' should be ignored when taking a snapshot – that is the current load at the end of the session.

Code: Select all

Basic resolution

    Press ENTER to stop monitoring PID #19688

            CPU Load:  0.00
            Ave Session Load:  0.02
            99% Conf Limit: <= 0.04
            Max Load:  1.17
            Session Time:  120.0 seconds
            
High resolution

    Press ENTER to stop monitoring PID #20212

            CPU Load:  0.79
            Ave Session Load:  0.56
            99% Conf Limit: <= 0.61
            Max Load:  1.58
            Session Time:  120.0 seconds
fxm
Moderator
Posts: 11926
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: FreeBasic's Timer

Post by fxm »

Looking at the near-final code of 'regulateLite()' and what it does, I now think the 'Lite' suffix is no longer relevant.

This code:
- does not require any other parameter than the desired FPS,
- adapts to the resolution of the 'Sleep()' keyword (depending on the OS cycle period),
- self-calibrates while running to improve accuracy of applied FPS.
In short, it does everything on its own!

I would suggest using instead 'Easy' (my preference) or 'Smart' suffix for the name of this procedure.

Any other suffixes to suggest ?
(and any other advice on this function)
dodicat
Posts: 7919
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: FreeBasic's Timer

Post by dodicat »

Try three regulates with heavy duty graphics (some old code I have)
I would like to get the maximum speed.
I optimistically set 30 fps.
Each regulator can be tested, one at a time of course.
The cpu usage is brought up to see.

Code: Select all

#cmdline "-gen gcc -O 3"
Shell "start taskmgr"
Function Regulate(Byval MyFps As Long,Byref fps As Long=0) As Long
    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 sleeptime=1
    _lastsleeptime=sleeptime
    timervalue=T
    Return sleeptime
End Function

Function regulateW(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=0
    Return ans*60
End Function

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 Single tos
    Static As Single bias
    If tos = 0 Then
        Dim As Double t = Timer
        For I As Integer = 1 To 10
            Sleep 1, 1
        Next I
        tos = (Timer - t) / 10 * 1000
        bias = tos / 2
    End If
    Static As Long N
    Static As Long k
    Static As Single tf
    If N = 1 Then
        k = Int(MyFps / 240 * tos)
        If k = 0 Then k = 1
        tf = 1 / MyFps
    End If    
    Static As Double t0
    Static As Double t1
    Static As Double t3
    Static As Single dt0
    Static As Long start
    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
    If Start > 10 And N = 1 Then
        If Abs((t1 - t3) * 1000 - dt0) > 3 * tos Then
            tos = 0
            start = 0
            Exit Function
        End If
        bias += 0.01 * Sgn((t1 - t3) * 1000 - dt0)
    Elseif N = 1 Then
        Start += 1
    End If
    t3 = t2
    If N >= K Then
        Dim As Single dt = (k * tf - (t2 - t1)) * 1000 - bias
        If dt < 0 Then dt = 0
        dt0 = dt + bias
        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
        t0 = k / (t2 - t1)
        t1 = t2
        N = 1
    Else
        N += 1
    End If
    Return t0
End Function


Type v3
    As Single x,y,z
    As Ulong col
    flag As Long
    Declare Function length As Single
    Declare Function unit As v3
End Type

Type Line
    As v3 v1,v2
End Type
#define cross ^
#define dot *
Operator + (Byref v1 As v3,Byref v2 As v3) As v3
Return Type(v1.x+v2.x,v1.y+v2.y,v1.z+v2.z)
End Operator
Operator -(Byref v1 As v3,Byref v2 As v3) As v3
Return Type(v1.x-v2.x,v1.y-v2.y,v1.z-v2.z)
End Operator
Operator * (Byval f As Single,Byref v1 As v3) As v3
Return Type(f*v1.x,f*v1.y,f*v1.z)
End Operator
Operator * (Byref v1 As v3,Byref v2 As v3) As Single 
Return v1.x*v2.x+v1.y*v2.y+v1.z*v2.z
End Operator
Operator ^ (Byref v1 As v3,Byref v2 As v3) As v3 
Return Type(v1.y*v2.z-v2.y*v1.z,-(v1.x*v2.z-v2.x*v1.z),v1.x*v2.y-v2.x*v1.y)
End Operator
Operator <>(Byref v1 As V3,Byref v2 As V3) As Integer
Return (v1.x<>v2.x) Or (v1.y<>v2.y)
End Operator

Function v3.length As Single
    Return Sqr(x*x+y*y+z*z)
End Function

Function v3.unit As v3
    Dim n As Single=length
    If n=0 Then n=1e-20
    Return Type(x/n,y/n,z/n)
End Function

Type _float As V3

Dim Shared As Const v3 eyepoint=Type(512,768\2,500)
#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
#define incircle(cx,cy,radius,x,y) (cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius
'<><><><><><><><><><><> Quick SORT <><><><><><><><><><>
#define up <,>
#define down >,<
#macro SetQsort(datatype,fname,b1,b2,dot)
Sub fname(array() As datatype,begin As Long,Finish As Ulong)
    Dim As Long i=begin,j=finish 
    Dim As datatype x =array(((I+J)\2))
    While  I <= J
        While array(I)dot b1 X dot:I+=1:Wend
            While array(J)dot b2 X dot:J-=1:Wend
                If I<=J Then Swap array(I),array(J): I+=1:J-=1
            Wend
            If J > begin Then fname(array(),begin,J)
            If I < Finish Then fname(array(),I,Finish)
        End Sub
        #endmacro    
        
        Sub GetCircle(xm As Single, ym As Single,zm As Single, r As Integer,p() As v3)
            #define CIRC(r)  ( ( Int( (r)*(1 + Sqr(2)) ) - (r) ) Shl 2 )
            Dim As Long x = -r, y = 0, e = 2 - r Shl 1,count
            Redim p(1 To CIRC(r)+4 )
            Do
                count+=1:p(count)=Type<v3>(xm-x, ym+y,zm)
                count+=1:p(count)=Type<v3>(xm-y, ym-x,zm)
                count+=1:p(count)=Type<v3>(xm+x, ym-y,zm)
                count+=1:p(count)=Type<v3>(xm+y, ym+x,zm)
                r = e
                If r<=y Then
                    y+=1
                    e+=y Shl 1+1
                End If
                If r>x Or e>y Then
                    x+=1
                    e+=x Shl 1+1
                End If
            Loop While x<0
            Redim Preserve p(1 To count-1)
        End Sub
        
        
        
        Sub RotateArray(wa() As V3,result() As V3,angle As _float,centre As V3,flag As Long=0)
            Dim As Single dx,dy,dz,w
            Dim As Single SinAX=Sin(angle.x)
            Dim As Single SinAY=Sin(angle.y)
            Dim As Single SinAZ=Sin(angle.z)
            Dim As Single CosAX=Cos(angle.x)
            Dim As Single CosAY=Cos(angle.y)
            Dim As Single CosAZ=Cos(angle.z)
            Redim result(Lbound(wa) To Ubound(wa))
            For z As Long=Lbound(wa) To Ubound(wa)
                dx=wa(z).x-centre.x
                dy=wa(z).y-centre.y
                dz=wa(z).z-centre.z
                Result(z).x=((Cosay*Cosaz)*dx+(-Cosax*Sinaz+Sinax*Sinay*Cosaz)*dy+(Sinax*Sinaz+Cosax*Sinay*Cosaz)*dz)+centre.x
                result(z).y=((Cosay*Sinaz)*dx+(Cosax*Cosaz+Sinax*Sinay*Sinaz)*dy+(-Sinax*Cosaz+Cosax*Sinay*Sinaz)*dz)+centre.y
                result(z).z=((-Sinay)*dx+(Sinax*Cosay)*dy+(Cosax*Cosay)*dz)+centre.z
                #macro perspective()
                w = 1 + (result(z).z/eyepoint.z)
                result(z).x = (result(z).x-eyepoint.x)/w+eyepoint.x 
                result(z).y = (result(z).y-eyepoint.y)/w+eyepoint.y
                result(z).z = (result(z).z-eyepoint.z)/w+eyepoint.z
                #endmacro
                If flag Then: perspective():End If
                result(z).col=wa(z).col
                result(z).flag=wa(z).flag
            Next z
        End Sub
        
        Sub inc(a() As v3,b() As v3,clr As Ulong) 'increment an array
            Var u=Ubound(a)
            Redim Preserve a(1 To u+ Ubound(b)) 
            For n As Long=1 To Ubound(b)
                b(n).col=clr
                a(u+n)= b(n)
            Next n
        End Sub
        
        Sub createdisc(xc As Single,yc As Single,zc As Single,rad As Long,d() As v3)'ends
            Redim d(1 To 4*rad^2)
            Dim As Long ctr
            For x As Long=xc-rad To xc+rad
                For y As Long=yc-rad To yc+rad  
                    If incircle(xc,yc,rad,x,y) Then
                        ctr+=1
                        d(ctr)=Type(x,y,zc,0,1)
                    End If
                Next y
            Next x
            Redim Preserve d(1 To ctr)     
        End Sub
        
        Sub createplate(xc As Single,yc As Single,zc As Single,lngth As Long,bth As Long,d() As v3,flag As Long)
            Dim As Long ctr
            Redim d(1 To lngth*bth*5)
            For x As Long=xc-lngth To xc+lngth
                For y As Long=yc-bth To yc+bth
                    ctr+=1
                    d(ctr)=Type(x,y,zc,0,flag)
                Next y
            Next x
            Redim Preserve d(1 To ctr)
        End Sub
        
        Function segment_distance( l As Line, p As v3, ip As v3=Type(0,0,0)) As Single
            Var s=l.v1,f=l.v2
            Dim As Single linelength=(s-f).length
            Dim As Single dist= ((1/linelength)*((s-f) cross (p-s))).length
            Dim As Single lpf=(p-f).length,lps=(p-s).length
            If lps >= lpf Then
                Var temp=Sqr(lps*lps-dist*dist)/linelength
                If temp>=1 Then temp=1:dist=lpf
                ip=s+(temp)*(f-s)
                Return dist
            Else
                Var temp=Sqr(lpf*lpf-dist*dist)/linelength
                If temp>=1 Then temp=1:dist=lps
                ip=f+(temp)*(s-f)
                Return dist
            End If
            Return dist
        End Function
        
        
        
        
        Sub star(starX As Single,starY As Single,size As Single,col As Ulong,num As Long=5,rot As Single=0,cut As Single=.4,i As Any Ptr=0)
            Var count=0,rad=0.0,_px=0.0,_py=0.0,pi=4*Atn(1),prime=Rgb(255,254,253)
            For x As Long=1 To 2
                For z As Single=0+.28 +rot To 2*pi+.1+.28 +rot Step 2*pi/(2*num)
                    count=count+1
                    If count Mod 2=0 Then rad=size Else rad=cut*size
                    _px=starx+rad*Cos(z)
                    _py=stary+rad*Sin(z)
                    If count=1 Then Pset i,(_px,_py)Else Line i, -(_px,_py),prime
                Next z
                Paint i,(starx,stary),prime,prime
                count=0:prime=col
            Next x
        End Sub
        
        Function perspective(p As v3,eyepoint As v3) As v3
            Dim As Single   w=1+(p.z/eyepoint.z)
            Return Type((p.x-eyepoint.x)/w+eyepoint.x,_
            (p.y-eyepoint.y)/w+eyepoint.y,_
            (p.z-eyepoint.z)/w+eyepoint.z)
        End Function
        
        Function onsphere(S As v3,P As V3) As Long
            Return (S.x-P.x)*(S.x-P.x)+(S.y-P.y)*(S.y-P.y)+(S.z-P.z)*(S.z-P.z) <= S.col*S.col Andalso _
            (S.x-P.x)*(S.x-P.x)+(S.y-P.y)*(S.y-P.y)+(S.z-P.z)*(S.z-P.z) > (S.col-1)*(S.col-1)
        End Function
        
        Sub getsphere(a() As V3,pt As V3,rad As Long,col As Ulong=0,flag As Integer=0)
            Dim As Any Ptr i=Imagecreate (500,500,0)
            Dim As Long rd=10,gr=150,bl=250,kr=3,kg=3,kb=3,x=3
            For n As Long=1 To 500
                rd+=kr
                gr+=kg
                bl+=kb
                If rd<x Or rd>255-x Then kr=-kr
                If gr<x Or gr>255-x Then kg=-kg
                If bl<x Or bl>255-x Then kb=-kb
                Line i,(0,n)-(500,n),Rgb(rd,gr,bl)
            Next n
            Var g=750
            Redim a(1 To 172060)
            Dim As Long xx=Pt.x,yy=Pt.y,zz=Pt.z,r=rad,counter
            Dim As v3 sp=Type(xx,yy,zz,r)
            For x As Long= xx+r+1 -g To xx+r+1 Step 1
                For y As Long=yy-r+1  To yy-r+1+g Step 1
                    For z As Long= zz+r+1-1000 To zz+r+1 Step 2
                        If onsphere(sp,Type<V3>(x,y,z)) Then
                            counter+=1
                            Var xp=map((xx+r+1 -g),(xx+r+1),x,0,500)
                            Var yp=map((yy-r+1),(yy-r+1+g),y,0,500)
                            a(counter)=Type<V3>(x,y,z,Point(xp,yp,i))
                        End If
                    Next z
                Next y
            Next x
            Imagedestroy i
            Redim Preserve a(1 To counter)
        End Sub
        
        Sub filter(i As Any Ptr,n As Long)
            Dim As Integer ix,iy
            Imageinfo i,ix,iy
            Dim As Long p(0 To 4)
            For k As Long=1 To n
                For x As Long=1 To ix-2
                    For y As Long=1 To iy-2
                        Var r=0
                        Var g=0
                        Var b=0
                        p(0)=Point(x,y,i)
                        p(1)=Point(x,y-1,i)
                        p(2)=Point(x+1,y,i)
                        p(3)=Point(x,y+1,i)
                        p(4)=Point(x-1,y,i)
                        For n As Long=0 To 4
                            r+=Cast(Ubyte Ptr,@p(n))[2]
                            g+=Cast(Ubyte Ptr,@p(n))[1]
                            b+=Cast(Ubyte Ptr,@p(n))[0]
                        Next
                        r/=5
                        g/=5
                        b/=5
                        Pset i,(x,y),Rgb(r,g,b)
                    Next y
                Next x
            Next k
        End Sub
        
        Function fade(fore As Ulong,f As Single) As Ulong
            Dim As Ubyte fr=Cast(Ubyte Ptr,@fore)[2],fg=Cast(Ubyte Ptr,@fore)[1],fb=Cast(Ubyte Ptr,@fore)[0]
            Return Rgb(f*fr,f*fg,f*fb)
        End Function
        
        '======================== set up ============= 
        
        Screen 20,32,,64
        Locate 20,20
        Print "Please wait . . ."
        '==== background ====
        Dim As Any Ptr i=Imagecreate(1024,768,0)
        Dim As v3 pt(1 To 100)
        Dim As Single xx,yy
        For n As Long=1 To 100
            Do
                xx=Rnd*1024:yy=Rnd*768
            Loop Until incircle((-1000),(768+1000),1600,xx,yy)=0
            pt(n)=Type(xx,yy)
            star(xx,yy,2+Rnd,Rgb(200,200,200+Rnd*55),5,Rnd,.4,i)
        Next
        
        For kk As Long=1 To 30
            Var r=map(0,30,kk,0,200)
            Var g=map(0,30,kk,0,200)
            Var b=map(0,30,kk,0,255)
            Circle i,((-650),1418),1110-kk,Rgb(r,g,b),,,,f
        Next kk
        
        
        Redim As V3 sphere()
        getsphere(sphere(),Type<v3>(-1000,1768,0),2000-400-20)
        For n As Long=Lbound(sphere) To Ubound(sphere)
            Var p=perspective(sphere(n),Type(-1000,1768,900))
            Circle i,(p.x+70+40+370,p.y-70-40-370),3,fade(sphere(n).col,.75)
        Next n
        Redim sphere(0)
        filter(i,1)
        
        ' === build the craft ===
        Redim As v3 e1(),e2() 'ends
        Redim As v3 c(),a(0)  'cylinder
        Dim As Long tail=40,wing=100
        For z As Long=-200 To 200 'fill cylinder
            getcircle(512,768\2,z,20,c())
            inc(a(),c(),Rgb(0,200,0))
        Next
        Dim As Single pi=4*Atn(1)
        createdisc(512,768\2,-201,18,e1()) 'ends
        createdisc(512,768\2, 201,18,e2())
        inc(a(),e1(),Rgb(155,50,0))  'add them to the array
        inc(a(),e2(),Rgb(0,50,155))
        
        
        Redim As v3 p(),p2()
        createplate(412+20,768\2-wing,0,30,wing,p(),2)
        RotateArray(p(),p2(),Type<_float>(0,pi/2,0),Type(512,768/2,0),0)'main stbd
        For n As Long=Lbound(p) To Ubound(p)
            p(n)=p2(n)
        Next n
        inc(a(),p(),Rgb(0,100,200))
        
        createplate(412+20,768\2-wing,1,30,wing,p(),3)
        RotateArray(p(),p2(),Type<_float>(0,pi/2,0),Type(512,768/2,0),0)'main stbd
        For n As Long=Lbound(p) To Ubound(p)
            p(n)=p2(n)
        Next n
        inc(a(),p(),Rgb(0,100,200))
        
        createplate(412+20,768\2+wing,0,30,wing,p(),3)
        RotateArray(p(),p2(),Type<_float>(0,pi/2,0),Type(512,768/2,0),0)'main port
        For n As Long=Lbound(p) To Ubound(p)
            p(n)=p2(n)
        Next n
        inc(a(),p(),Rgb(0,100,200))
        
        createplate(412+20,768\2+wing,1,30,wing,p(),2)
        RotateArray(p(),p2(),Type<_float>(0,pi/2,0),Type(512,768/2,0),0)'main port
        For n As Long=Lbound(p) To Ubound(p)
            p(n)=p2(n)
        Next n
        inc(a(),p(),Rgb(0,100,200))
        
        createplate(412+235,768\2+tail,0,20,tail,p(),3)
        RotateArray(p(),p2(),Type<_float>(0,pi/2,0),Type(512,768/2,0),0)'tail port
        For n As Long=Lbound(p) To Ubound(p)
            p(n)=p2(n)
        Next n
        inc(a(),p(),Rgb(0,100,200))
        
        createplate(412+235,768\2+tail,1,20,tail,p(),2)
        RotateArray(p(),p2(),Type<_float>(0,pi/2,0),Type(512,768/2,0),0)'tail port
        For n As Long=Lbound(p) To Ubound(p)
            p(n)=p2(n)
        Next n
        inc(a(),p(),Rgb(0,100,200))
        
        createplate(412+235,768\2-tail,0,20,tail,p(),2)
        RotateArray(p(),p2(),Type<_float>(0,pi/2,0),Type(512,768/2,0),0)'tail port
        For n As Long=Lbound(p) To Ubound(p)
            p(n)=p2(n)
        Next n
        inc(a(),p(),Rgb(0,100,200))
        
        createplate(412+235,768\2-tail,1,20,tail,p(),3)
        RotateArray(p(),p2(),Type<_float>(0,pi/2,0),Type(512,768/2,0),0)'tail port
        For n As Long=Lbound(p) To Ubound(p)
            p(n)=p2(n)
        Next n
        inc(a(),p(),Rgb(0,100,200))
        
        createplate(412+235,768\2+40,0,20,30,p(),0)
        RotateArray(p(),p2(),Type<_float>(0,pi/2,pi/2),Type(512,768/2,0),0)'fin
        For n As Long=Lbound(p) To Ubound(p)
            p(n)=p2(n)
        Next n
        inc(a(),p(),Rgb(0,100,200))
        '===  built ====
        
        
        Dim As v3 L(1 To 2)={Type(512,768\2,-205),Type(512,768\2,205)}'ends of central axis
        inc(a(),L(),0) 'add them to array
        SetQsort(V3,QsortZ,down,.z)'initiate quicksort
        
        Redim As v3 result()'working array
        Dim As Single ang
        Dim As Single r,g,b,rad,dt
        Dim As v3 light=Type(512,-10000,0)
        Dim As v3 ip 
        Dim As Line ln
        Dim As Long fps
        
        
        RotateArray(a(),result(),Type<_float>(pi/8,pi/2,pi/2),Type(512,768/2,0),0)
        For n As Long=Lbound(a) To Ubound(a)                        
            a(n)=result(n)                'rotate all points by pi/2 around the y axis
        Next
        
        
        Do
            ang+=.015
            RotateArray(a(),result(),Type<_float>(2*ang,0,0),Type(512,768\2,350),1)
            Qsortz(result(),Lbound(result),Ubound(result)-2)
            Screenlock
            Cls
            Put(0,0),i,Pset
            For n As Long=1 To Ubound(pt)
                If Rnd>.8 Then  Circle(pt(n).x,pt(n).y),10,Rgba(0,0,0,Rnd*80),,,,f 'twinkle
            Next n
            
            Draw String(20,20),"FPS " &fps
            For n As Long=Lbound(result) To Ubound(result)-2
                Select Case As Const result(n).flag
                
                Case 0 'tube
                    Dim As v3 d=result(n)-light'    'point to light
                    ln=Type<Line>(result(Ubound(result)-1),result(Ubound(result))) 'the central cylinder axis (line)
                    segment_distance(ln,result(n),ip) 'need ip (intercept of central axis)
                    Dim As v3 c=Type(result(n).x-ip.x,result(n).y-ip.y,result(n).z-ip.z)  'cylinder normals at point
                    Var q=c.unit dot d.unit        'shade by dot product
                    dt=map(-1,1,q,1,0)             'map dot product to [1,0]    
                    r=Cast(Ubyte Ptr,@result(n).col)[2]*dt
                    g=Cast(Ubyte Ptr,@result(n).col)[1]*dt
                    b=Cast(Ubyte Ptr,@result(n).col)[0]*dt
                    
                Case 1 'ends
                    dt=map(600,200,result(n).y,.3,1) 'shade by .y
                    r=Cast(Ubyte Ptr,@result(n).col)[2]*dt
                    g=Cast(Ubyte Ptr,@result(n).col)[1]*dt
                    b=Cast(Ubyte Ptr,@result(n).col)[0]*dt 
                    
                Case 2,3 'wings
                    Var v1=result(n)-result(Ubound(result))
                    Var v2=result(n)-result(Ubound(result)-1)
                    If result(n).flag=3  Then Swap v1,v2
                    Var v=(v1 cross v2)
                    Var vL=(result(n)-light)
                    Var q=v.unit dot vL.unit        'shade by dot product
                    dt=map(-1,1,q,1,.2)             'map dot product to [1,.2] 
                    
                    r=Cast(Ubyte Ptr,@result(n).col)[2]*dt
                    g=Cast(Ubyte Ptr,@result(n).col)[1]*dt
                    b=Cast(Ubyte Ptr,@result(n).col)[0]*dt
                End Select
                
                rad=map(-200,200,result(n).z,2,1) 
                Circle(result(n).x,result(n).y),rad,Rgb(r,g,b),,,,f
            Next n
            
            Screenunlock
            ' Sleep regulate(30,fps)
            'regulateW(30,fps)
            fps=regulateLite(30)
        Loop Until Inkey=Chr(27)
        Imagedestroy i
        
        Sleep
        
        
         
Every computer will perform differently of course.
I can screw 20 fps out of it in 32 bits/ 24 in 64 bits, about 18 gas64.
srvaldez
Posts: 3277
Joined: Sep 25, 2005 21:54

Re: FreeBasic's Timer

Post by srvaldez »

Hi dodicat
I changed line 541 to fps=regulateLite(60) to see what the max fps might be
in 32-bit gcc with -O2 I get some 27 mostly 32 fps, 10% CPU
in 64-bit gcc with -O2 I get some 38 mostly 48 fps, 10% CPU
in 64-bit gas64 with I get some 38 mostly 48 fps, 10% CPU
in 32-bit gas I get 27 fps, 10% CPU
fxm
Moderator
Posts: 11926
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: FreeBasic's Timer

Post by fxm »

On my laptop, the obtained FPS is always limited by the execution time of the loop without 'regulate*()'.
I get FPS = 9 to 10 in 32-bit, and FPS = 12 to 14 in 64-bit.
(AMD Ryzen 5 3500U with Radeon, Vega Mobile Gfx, 2.10 GHz)
UEZ
Posts: 919
Joined: May 05, 2017 19:59
Location: Germany

Re: FreeBasic's Timer

Post by UEZ »

I added the CPU usage to the code using WinAPI.

Code: Select all

'#cmdline "-gen gcc -O 3"
#cmdline "-gen gcc -Wc -Ofast -Wc -march=native"

#Include "windows.bi"

Function _WinAPI_GetNumberOfProcessors() As DWORD
	Dim As SYSTEM_INFO si
	GetSystemInfo(@si) 'https://docs.microsoft.com/en-us/windows/win32/api/processthreadsapi/nf-processthreadsapi-getprocesstimes
	Return si.dwNumberOfProcessors
End Function

Function Regulate(Byval MyFps As Long,Byref fps As Long=0) As Long
    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 sleeptime=1
    _lastsleeptime=sleeptime
    timervalue=T
    Return sleeptime
End Function

Function regulateW(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=0
    Return ans*60
End Function

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 Single tos
    Static As Single bias
    If tos = 0 Then
        Dim As Double t = Timer
        For I As Integer = 1 To 10
            Sleep 1, 1
        Next I
        tos = (Timer - t) / 10 * 1000
        bias = tos / 2
    End If
    Static As Long N
    Static As Long k
    Static As Single tf
    If N = 1 Then
        k = Int(MyFps / 240 * tos)
        If k = 0 Then k = 1
        tf = 1 / MyFps
    End If    
    Static As Double t0
    Static As Double t1
    Static As Double t3
    Static As Single dt0
    Static As Long start
    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
    If Start > 10 And N = 1 Then
        If Abs((t1 - t3) * 1000 - dt0) > 3 * tos Then
            tos = 0
            start = 0
            Exit Function
        End If
        bias += 0.01 * Sgn((t1 - t3) * 1000 - dt0)
    Elseif N = 1 Then
        Start += 1
    End If
    t3 = t2
    If N >= K Then
        Dim As Single dt = (k * tf - (t2 - t1)) * 1000 - bias
        If dt < 0 Then dt = 0
        dt0 = dt + bias
        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
        t0 = k / (t2 - t1)
        t1 = t2
        N = 1
    Else
        N += 1
    End If
    Return t0
End Function


Type v3
    As Single x,y,z
    As Ulong col
    flag As Long
    Declare Function length As Single
    Declare Function unit As v3
End Type

Type Line
    As v3 v1,v2
End Type
#define cross ^
#define dot *
Operator + (Byref v1 As v3,Byref v2 As v3) As v3
Return Type(v1.x+v2.x,v1.y+v2.y,v1.z+v2.z)
End Operator
Operator -(Byref v1 As v3,Byref v2 As v3) As v3
Return Type(v1.x-v2.x,v1.y-v2.y,v1.z-v2.z)
End Operator
Operator * (Byval f As Single,Byref v1 As v3) As v3
Return Type(f*v1.x,f*v1.y,f*v1.z)
End Operator
Operator * (Byref v1 As v3,Byref v2 As v3) As Single 
Return v1.x*v2.x+v1.y*v2.y+v1.z*v2.z
End Operator
Operator ^ (Byref v1 As v3,Byref v2 As v3) As v3 
Return Type(v1.y*v2.z-v2.y*v1.z,-(v1.x*v2.z-v2.x*v1.z),v1.x*v2.y-v2.x*v1.y)
End Operator
Operator <>(Byref v1 As V3,Byref v2 As V3) As Integer
Return (v1.x<>v2.x) Or (v1.y<>v2.y)
End Operator

Function v3.length As Single
    Return Sqr(x*x+y*y+z*z)
End Function

Function v3.unit As v3
    Dim n As Single=length
    If n=0 Then n=1e-20
    Return Type(x/n,y/n,z/n)
End Function

Type _float As V3

Dim Shared As Const v3 eyepoint=Type(512,768\2,500)
#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
#define incircle(cx,cy,radius,x,y) (cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius
'<><><><><><><><><><><> Quick SORT <><><><><><><><><><>
#define up <,>
#define down >,<
#macro SetQsort(datatype,fname,b1,b2,dot)
Sub fname(array() As datatype,begin As Long,Finish As Ulong)
    Dim As Long i=begin,j=finish 
    Dim As datatype x =array(((I+J)\2))
    While  I <= J
        While array(I)dot b1 X dot:I+=1:Wend
            While array(J)dot b2 X dot:J-=1:Wend
                If I<=J Then Swap array(I),array(J): I+=1:J-=1
            Wend
            If J > begin Then fname(array(),begin,J)
            If I < Finish Then fname(array(),I,Finish)
        End Sub
        #endmacro    
        
        Sub GetCircle(xm As Single, ym As Single,zm As Single, r As Integer,p() As v3)
            #define CIRC(r)  ( ( Int( (r)*(1 + Sqr(2)) ) - (r) ) Shl 2 )
            Dim As Long x = -r, y = 0, e = 2 - r Shl 1,count
            Redim p(1 To CIRC(r)+4 )
            Do
                count+=1:p(count)=Type<v3>(xm-x, ym+y,zm)
                count+=1:p(count)=Type<v3>(xm-y, ym-x,zm)
                count+=1:p(count)=Type<v3>(xm+x, ym-y,zm)
                count+=1:p(count)=Type<v3>(xm+y, ym+x,zm)
                r = e
                If r<=y Then
                    y+=1
                    e+=y Shl 1+1
                End If
                If r>x Or e>y Then
                    x+=1
                    e+=x Shl 1+1
                End If
            Loop While x<0
            Redim Preserve p(1 To count-1)
        End Sub
        
        
        
        Sub RotateArray(wa() As V3,result() As V3,angle As _float,centre As V3,flag As Long=0)
            Dim As Single dx,dy,dz,w
            Dim As Single SinAX=Sin(angle.x)
            Dim As Single SinAY=Sin(angle.y)
            Dim As Single SinAZ=Sin(angle.z)
            Dim As Single CosAX=Cos(angle.x)
            Dim As Single CosAY=Cos(angle.y)
            Dim As Single CosAZ=Cos(angle.z)
            Redim result(Lbound(wa) To Ubound(wa))
            For z As Long=Lbound(wa) To Ubound(wa)
                dx=wa(z).x-centre.x
                dy=wa(z).y-centre.y
                dz=wa(z).z-centre.z
                Result(z).x=((Cosay*Cosaz)*dx+(-Cosax*Sinaz+Sinax*Sinay*Cosaz)*dy+(Sinax*Sinaz+Cosax*Sinay*Cosaz)*dz)+centre.x
                result(z).y=((Cosay*Sinaz)*dx+(Cosax*Cosaz+Sinax*Sinay*Sinaz)*dy+(-Sinax*Cosaz+Cosax*Sinay*Sinaz)*dz)+centre.y
                result(z).z=((-Sinay)*dx+(Sinax*Cosay)*dy+(Cosax*Cosay)*dz)+centre.z
                #macro perspective()
                w = 1 + (result(z).z/eyepoint.z)
                result(z).x = (result(z).x-eyepoint.x)/w+eyepoint.x 
                result(z).y = (result(z).y-eyepoint.y)/w+eyepoint.y
                result(z).z = (result(z).z-eyepoint.z)/w+eyepoint.z
                #endmacro
                If flag Then: perspective():End If
                result(z).col=wa(z).col
                result(z).flag=wa(z).flag
            Next z
        End Sub
        
        Sub inc(a() As v3,b() As v3,clr As Ulong) 'increment an array
            Var u=Ubound(a)
            Redim Preserve a(1 To u+ Ubound(b)) 
            For n As Long=1 To Ubound(b)
                b(n).col=clr
                a(u+n)= b(n)
            Next n
        End Sub
        
        Sub createdisc(xc As Single,yc As Single,zc As Single,rad As Long,d() As v3)'ends
            Redim d(1 To 4*rad^2)
            Dim As Long ctr
            For x As Long=xc-rad To xc+rad
                For y As Long=yc-rad To yc+rad  
                    If incircle(xc,yc,rad,x,y) Then
                        ctr+=1
                        d(ctr)=Type(x,y,zc,0,1)
                    End If
                Next y
            Next x
            Redim Preserve d(1 To ctr)     
        End Sub
        
        Sub createplate(xc As Single,yc As Single,zc As Single,lngth As Long,bth As Long,d() As v3,flag As Long)
            Dim As Long ctr
            Redim d(1 To lngth*bth*5)
            For x As Long=xc-lngth To xc+lngth
                For y As Long=yc-bth To yc+bth
                    ctr+=1
                    d(ctr)=Type(x,y,zc,0,flag)
                Next y
            Next x
            Redim Preserve d(1 To ctr)
        End Sub
        
        Function segment_distance( l As Line, p As v3, ip As v3=Type(0,0,0)) As Single
            Var s=l.v1,f=l.v2
            Dim As Single linelength=(s-f).length
            Dim As Single dist= ((1/linelength)*((s-f) cross (p-s))).length
            Dim As Single lpf=(p-f).length,lps=(p-s).length
            If lps >= lpf Then
                Var temp=Sqr(lps*lps-dist*dist)/linelength
                If temp>=1 Then temp=1:dist=lpf
                ip=s+(temp)*(f-s)
                Return dist
            Else
                Var temp=Sqr(lpf*lpf-dist*dist)/linelength
                If temp>=1 Then temp=1:dist=lps
                ip=f+(temp)*(s-f)
                Return dist
            End If
            Return dist
        End Function
        
        
        
        
        Sub star(starX As Single,starY As Single,size As Single,col As Ulong,num As Long=5,rot As Single=0,cut As Single=.4,i As Any Ptr=0)
            Var count=0,rad=0.0,_px=0.0,_py=0.0,pi=4*Atn(1),prime=Rgb(255,254,253)
            For x As Long=1 To 2
                For z As Single=0+.28 +rot To 2*pi+.1+.28 +rot Step 2*pi/(2*num)
                    count=count+1
                    If count Mod 2=0 Then rad=size Else rad=cut*size
                    _px=starx+rad*Cos(z)
                    _py=stary+rad*Sin(z)
                    If count=1 Then Pset i,(_px,_py)Else Line i, -(_px,_py),prime
                Next z
                Paint i,(starx,stary),prime,prime
                count=0:prime=col
            Next x
        End Sub
        
        Function perspective(p As v3,eyepoint As v3) As v3
            Dim As Single   w=1+(p.z/eyepoint.z)
            Return Type((p.x-eyepoint.x)/w+eyepoint.x,_
            (p.y-eyepoint.y)/w+eyepoint.y,_
            (p.z-eyepoint.z)/w+eyepoint.z)
        End Function
        
        Function onsphere(S As v3,P As V3) As Long
            Return (S.x-P.x)*(S.x-P.x)+(S.y-P.y)*(S.y-P.y)+(S.z-P.z)*(S.z-P.z) <= S.col*S.col Andalso _
            (S.x-P.x)*(S.x-P.x)+(S.y-P.y)*(S.y-P.y)+(S.z-P.z)*(S.z-P.z) > (S.col-1)*(S.col-1)
        End Function
        
        Sub getsphere(a() As V3,pt As V3,rad As Long,col As Ulong=0,flag As Integer=0)
            Dim As Any Ptr i=Imagecreate (500,500,0)
            Dim As Long rd=10,gr=150,bl=250,kr=3,kg=3,kb=3,x=3
            For n As Long=1 To 500
                rd+=kr
                gr+=kg
                bl+=kb
                If rd<x Or rd>255-x Then kr=-kr
                If gr<x Or gr>255-x Then kg=-kg
                If bl<x Or bl>255-x Then kb=-kb
                Line i,(0,n)-(500,n),Rgb(rd,gr,bl)
            Next n
            Var g=750
            Redim a(1 To 172060)
            Dim As Long xx=Pt.x,yy=Pt.y,zz=Pt.z,r=rad,counter
            Dim As v3 sp=Type(xx,yy,zz,r)
            For x As Long= xx+r+1 -g To xx+r+1 Step 1
                For y As Long=yy-r+1  To yy-r+1+g Step 1
                    For z As Long= zz+r+1-1000 To zz+r+1 Step 2
                        If onsphere(sp,Type<V3>(x,y,z)) Then
                            counter+=1
                            Var xp=map((xx+r+1 -g),(xx+r+1),x,0,500)
                            Var yp=map((yy-r+1),(yy-r+1+g),y,0,500)
                            a(counter)=Type<V3>(x,y,z,Point(xp,yp,i))
                        End If
                    Next z
                Next y
            Next x
            Imagedestroy i
            Redim Preserve a(1 To counter)
        End Sub
        
        Sub filter(i As Any Ptr,n As Long)
            Dim As Integer ix,iy
            Imageinfo i,ix,iy
            Dim As Long p(0 To 4)
            For k As Long=1 To n
                For x As Long=1 To ix-2
                    For y As Long=1 To iy-2
                        Var r=0
                        Var g=0
                        Var b=0
                        p(0)=Point(x,y,i)
                        p(1)=Point(x,y-1,i)
                        p(2)=Point(x+1,y,i)
                        p(3)=Point(x,y+1,i)
                        p(4)=Point(x-1,y,i)
                        For n As Long=0 To 4
                            r+=Cast(Ubyte Ptr,@p(n))[2]
                            g+=Cast(Ubyte Ptr,@p(n))[1]
                            b+=Cast(Ubyte Ptr,@p(n))[0]
                        Next
                        r/=5
                        g/=5
                        b/=5
                        Pset i,(x,y),Rgb(r,g,b)
                    Next y
                Next x
            Next k
        End Sub
        
        Function fade(fore As Ulong,f As Single) As Ulong
            Dim As Ubyte fr=Cast(Ubyte Ptr,@fore)[2],fg=Cast(Ubyte Ptr,@fore)[1],fb=Cast(Ubyte Ptr,@fore)[0]
            Return Rgb(f*fr,f*fg,f*fb)
        End Function
        
        '======================== set up ============= 


		'get CPU usage of current pid
		Dim As Integer pid = GetCurrentProcessId()
		Dim As Long ekt = 0, eut = 0, iCPUs = _WinAPI_GetNumberOfProcessors()
		Dim As Any Ptr hProcHandle = OpenProcess(PROCESS_ALL_ACCESS, False, pid)
		Dim As FILETIME ct, et, kt, ut
		
		
        Screen 20,32,,64
        Locate 20,20
        Print "Please wait . . ."
        '==== background ====
        Dim As Any Ptr i=Imagecreate(1024,768,0)
        Dim As v3 pt(1 To 100)
        Dim As Single xx,yy
        For n As Long=1 To 100
            Do
                xx=Rnd*1024:yy=Rnd*768
            Loop Until incircle((-1000),(768+1000),1600,xx,yy)=0
            pt(n)=Type(xx,yy)
            star(xx,yy,2+Rnd,Rgb(200,200,200+Rnd*55),5,Rnd,.4,i)
        Next
        
        For kk As Long=1 To 30
            Var r=map(0,30,kk,0,200)
            Var g=map(0,30,kk,0,200)
            Var b=map(0,30,kk,0,255)
            Circle i,((-650),1418),1110-kk,Rgb(r,g,b),,,,f
        Next kk
        
        
        Redim As V3 sphere()
        getsphere(sphere(),Type<v3>(-1000,1768,0),2000-400-20)
        For n As Long=Lbound(sphere) To Ubound(sphere)
            Var p=perspective(sphere(n),Type(-1000,1768,900))
            Circle i,(p.x+70+40+370,p.y-70-40-370),3,fade(sphere(n).col,.75)
        Next n
        Redim sphere(0)
        filter(i,1)
        
        ' === build the craft ===
        Redim As v3 e1(),e2() 'ends
        Redim As v3 c(),a(0)  'cylinder
        Dim As Long tail=40,wing=100
        For z As Long=-200 To 200 'fill cylinder
            getcircle(512,768\2,z,20,c())
            inc(a(),c(),Rgb(0,200,0))
        Next
        Dim As Single pi=4*Atn(1)
        createdisc(512,768\2,-201,18,e1()) 'ends
        createdisc(512,768\2, 201,18,e2())
        inc(a(),e1(),Rgb(155,50,0))  'add them to the array
        inc(a(),e2(),Rgb(0,50,155))
        
        
        Redim As v3 p(),p2()
        createplate(412+20,768\2-wing,0,30,wing,p(),2)
        RotateArray(p(),p2(),Type<_float>(0,pi/2,0),Type(512,768/2,0),0)'main stbd
        For n As Long=Lbound(p) To Ubound(p)
            p(n)=p2(n)
        Next n
        inc(a(),p(),Rgb(0,100,200))
        
        createplate(412+20,768\2-wing,1,30,wing,p(),3)
        RotateArray(p(),p2(),Type<_float>(0,pi/2,0),Type(512,768/2,0),0)'main stbd
        For n As Long=Lbound(p) To Ubound(p)
            p(n)=p2(n)
        Next n
        inc(a(),p(),Rgb(0,100,200))
        
        createplate(412+20,768\2+wing,0,30,wing,p(),3)
        RotateArray(p(),p2(),Type<_float>(0,pi/2,0),Type(512,768/2,0),0)'main port
        For n As Long=Lbound(p) To Ubound(p)
            p(n)=p2(n)
        Next n
        inc(a(),p(),Rgb(0,100,200))
        
        createplate(412+20,768\2+wing,1,30,wing,p(),2)
        RotateArray(p(),p2(),Type<_float>(0,pi/2,0),Type(512,768/2,0),0)'main port
        For n As Long=Lbound(p) To Ubound(p)
            p(n)=p2(n)
        Next n
        inc(a(),p(),Rgb(0,100,200))
        
        createplate(412+235,768\2+tail,0,20,tail,p(),3)
        RotateArray(p(),p2(),Type<_float>(0,pi/2,0),Type(512,768/2,0),0)'tail port
        For n As Long=Lbound(p) To Ubound(p)
            p(n)=p2(n)
        Next n
        inc(a(),p(),Rgb(0,100,200))
        
        createplate(412+235,768\2+tail,1,20,tail,p(),2)
        RotateArray(p(),p2(),Type<_float>(0,pi/2,0),Type(512,768/2,0),0)'tail port
        For n As Long=Lbound(p) To Ubound(p)
            p(n)=p2(n)
        Next n
        inc(a(),p(),Rgb(0,100,200))
        
        createplate(412+235,768\2-tail,0,20,tail,p(),2)
        RotateArray(p(),p2(),Type<_float>(0,pi/2,0),Type(512,768/2,0),0)'tail port
        For n As Long=Lbound(p) To Ubound(p)
            p(n)=p2(n)
        Next n
        inc(a(),p(),Rgb(0,100,200))
        
        createplate(412+235,768\2-tail,1,20,tail,p(),3)
        RotateArray(p(),p2(),Type<_float>(0,pi/2,0),Type(512,768/2,0),0)'tail port
        For n As Long=Lbound(p) To Ubound(p)
            p(n)=p2(n)
        Next n
        inc(a(),p(),Rgb(0,100,200))
        
        createplate(412+235,768\2+40,0,20,30,p(),0)
        RotateArray(p(),p2(),Type<_float>(0,pi/2,pi/2),Type(512,768/2,0),0)'fin
        For n As Long=Lbound(p) To Ubound(p)
            p(n)=p2(n)
        Next n
        inc(a(),p(),Rgb(0,100,200))
        '===  built ====
        
        
        Dim As v3 L(1 To 2)={Type(512,768\2,-205),Type(512,768\2,205)}'ends of central axis
        inc(a(),L(),0) 'add them to array
        SetQsort(V3,QsortZ,down,.z)'initiate quicksort
        
        Redim As v3 result()'working array
        Dim As Single ang
        Dim As Single r,g,b,rad,dt
        Dim As v3 light=Type(512,-10000,0)
        Dim As v3 ip 
        Dim As Line ln
        Dim As Long fps
        
        
        RotateArray(a(),result(),Type<_float>(pi/8,pi/2,pi/2),Type(512,768/2,0),0)
        For n As Long=Lbound(a) To Ubound(a)                        
            a(n)=result(n)                'rotate all points by pi/2 around the y axis
        Next
        
		Dim As String sCPUUsage = ""
		Dim As Double t = Timer
        
        Do
            ang+=.015
            RotateArray(a(),result(),Type<_float>(2*ang,0,0),Type(512,768\2,350),1)
            Qsortz(result(),Lbound(result),Ubound(result)-2)
            Screenlock
            Cls
            Put(0,0),i,Pset
            For n As Long=1 To Ubound(pt)
                If Rnd>.8 Then  Circle(pt(n).x,pt(n).y),10,Rgba(0,0,0,Rnd*80),,,,f 'twinkle
            Next n
           			
			If Timer - t > 0.99 Then
				GetProcessTimes(hProcHandle, @ct, @et, @kt, @ut)
				sCPUUsage = Str(((kt.dwLowDateTime - ekt + ut.dwLowDateTime - eut) / 100000 / iCPUs)) & "%"
				ekt = kt.dwLowDateTime
				eut = ut.dwLowDateTime
				t = Timer
			Endif
			Draw String(20,20),"FPS " &fps & ", CPU usage: " & sCPUUsage
							
            For n As Long=Lbound(result) To Ubound(result)-2
                Select Case As Const result(n).flag
                
                Case 0 'tube
                    Dim As v3 d=result(n)-light'    'point to light
                    ln=Type<Line>(result(Ubound(result)-1),result(Ubound(result))) 'the central cylinder axis (line)
                    segment_distance(ln,result(n),ip) 'need ip (intercept of central axis)
                    Dim As v3 c=Type(result(n).x-ip.x,result(n).y-ip.y,result(n).z-ip.z)  'cylinder normals at point
                    Var q=c.unit dot d.unit        'shade by dot product
                    dt=map(-1,1,q,1,0)             'map dot product to [1,0]    
                    r=Cast(Ubyte Ptr,@result(n).col)[2]*dt
                    g=Cast(Ubyte Ptr,@result(n).col)[1]*dt
                    b=Cast(Ubyte Ptr,@result(n).col)[0]*dt
                    
                Case 1 'ends
                    dt=map(600,200,result(n).y,.3,1) 'shade by .y
                    r=Cast(Ubyte Ptr,@result(n).col)[2]*dt
                    g=Cast(Ubyte Ptr,@result(n).col)[1]*dt
                    b=Cast(Ubyte Ptr,@result(n).col)[0]*dt 
                    
                Case 2,3 'wings
                    Var v1=result(n)-result(Ubound(result))
                    Var v2=result(n)-result(Ubound(result)-1)
                    If result(n).flag=3  Then Swap v1,v2
                    Var v=(v1 cross v2)
                    Var vL=(result(n)-light)
                    Var q=v.unit dot vL.unit        'shade by dot product
                    dt=map(-1,1,q,1,.2)             'map dot product to [1,.2] 
                    
                    r=Cast(Ubyte Ptr,@result(n).col)[2]*dt
                    g=Cast(Ubyte Ptr,@result(n).col)[1]*dt
                    b=Cast(Ubyte Ptr,@result(n).col)[0]*dt
                End Select
                
                rad=map(-200,200,result(n).z,2,1) 
                Circle(result(n).x,result(n).y),rad,Rgb(r,g,b),,,,f
            Next n

            Screenunlock
            ' Sleep regulate(30,fps)
            'regulateW(30,fps)
            fps=regulateLite(30)
        Loop Until Inkey=Chr(27)
        Imagedestroy i
		CloseHandle(hProcHandle)
Getting best result with "-gen gcc -Wc -Ofast -Wc -march=native" compiled as x64.

Btw, the fps display is too fast, flipping around.
dodicat
Posts: 7919
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: FreeBasic's Timer

Post by dodicat »

Thanks for testing srvaldez/fxm/UEZ
I had a notion that fast computers would be above 30 fps.
You have a fast one srvaldez, and a slow one fxm.
Maybe yours is a gamer srvaldez, and fxm might have a load of stuff running in the background.
Nice addition UEZ, thank you.
Maybe a brand new regulator could be in the pipeline with your addition:
regulate(19% CPU)
Who knows!
UEZ
Posts: 919
Joined: May 05, 2017 19:59
Location: Germany

Re: FreeBasic's Timer

Post by UEZ »

dodicat wrote: Jun 08, 2023 19:59 Maybe a brand new regulator could be in the pipeline with your addition:
regulate(19% CPU)
Who knows!
That's a nice idea to use CPU load for FPS regulation instead of target FPS.
fxm
Moderator
Posts: 11926
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: FreeBasic's Timer

Post by fxm »

Last update of my 'regulateLite()' procedure:
- small adjustments,
- addition of an optional parameter to be able to deactivate the images skipping.

From an operational point of view, I do not think it is useful to deactivate the images skipping (from automatic thresholds depending on the OS cycle period), but it allows to appreciate its action (useful mainly in low resolution).

The test code below allows playing with FPS (<+>, or <->) and images skipping (<t>: True, or <f>: False) for a preset FPS of 150 (user loop imposing its duration >= 2 ms) to assess the FPS obtained :

Code: Select all

' In-loop smart procedure for easy-regulating FPS

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

Function regulateLite(ByVal MyFps As Ulong, ByVal SkipImage As Boolean = True) As Ulong
    '' 'MyFps' : requested FPS value, in frames per second
    '' 'SkipImage' : optional parameter to activate the image skipping (True by default)
    '' function return : applied FFS value, in frames per second
    Static As Long test = 10
    Static As Single tos
    Static As Single bias
    If tos = 0 Then
        Dim As Double t = Timer
        For I As Integer = 1 To test
            Sleep 1, 1
        Next I
        Dim As Double tt = Timer
        #if Not defined(__FB_WIN32__) And Not defined(__FB_LINUX__)
        If tt < t Then t -= 24 * 60 * 60
        #endif
        tos = (tt - t) / test * 1000
        bias = 0.55 * tos - 0.78
        test = 10 * 16 / tos
    End If
    Static As Long N
    Static As Long k
    Static As Single tf
    If N = 1 Then
        Dim As Single tos0 = tos
        If tos0 > 24 Then tos0 = 24
        If tos0 < 4.8 Then tos0 = 4.8
        k = Int(MyFps / 240 * tos0)
        If k = 0 Or SkipImage = False Then k = 1
        tf = 1 / MyFps
    End If
    Static As Double t0
    Static As Double t1
    Static As Double t3
    Static As Single dt0
    Static As Long start
    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
    If Start > 10 And N = 1 Then
        Dim As Single delta = (t1 - t3) * 1000 - dt0
        If Abs(delta) > 3 * tos Then
            tos = 0
            start = 0
            Exit Function
        End If
        bias += 0.01 * Sgn(delta)
    Elseif N = 1 Then
        Start += 1
    End If
    t3 = t2
    If N >= K Then
        Dim As Single dt = (k * tf - (t2 - t1)) * 1000 - bias
        If dt < 0 Then dt = 0
        dt0 = dt + bias
        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
        t0 = k / (t2 - t1)
        t1 = t2
        N = 1
    Else
        N += 1
    End If
    Return t0
End Function

Screen 12

Do
    Static As Ulongint MyFps = 150
    Static As Ulongint l
    Static As Double dt
    Static As Ulong fps
    Static As Boolean ImageSkip
    Static As Double t
    t = Timer
    Screenlock
    Cls
    Color 11
    Print "Called procedure : regulateLite ( " & MyFPS & " , " & ImageSkip & " )"
    Print
    Print Using "Measured FPS (skipped images excluded) : ###"; fps
    Print Using "Applied delay (when no skipped image)  : ###.### ms"; dt
    Print
    Print
    Print
    Color 14
    Print "<+>        : Increase FPS"
    Print "<->        : Decrease FPS"
    Print "<t> or <T> : Image skipping True"
    Print "<f> or <F> : Image skipping False"
    Print "<escape>   : Quit"
    Line (0, 80)-(639, 96), 7, B
    Line (0, 80)-(l, 96), 7, BF
    Screenunlock
    l = (l + 1) Mod 640
    Dim As String s = Ucase(Inkey)
    Select Case s
    Case "+"
        If MyFPS < 500 Then MyFPS += 1
    Case "-"
        If MyFPS > 5 Then MyFPS -= 1
    Case "T"
        ImageSkip = True
    Case "F"
        ImageSkip = False
    Case Chr(27)
        Exit Do
    End Select
    Do
    Loop Until Timer >= t + 0.002
    dt = Timer
    fps = regulateLite(MyFPS, ImageSkip)
    dt = (Timer - dt) * 1000
Loop
The obtained FPS follows the requested FPS (150) only when the 'image skipping' feature is activated.
(for Windows low resolution and for FPS = 150, 8 images are skipped of out 9, when image skipping is activated))

In high resolution of the Windows OS cycle, we can also test the two cases for a set-point of 300 for the FPS:
The obtained FPS follows the requested FPS (300) only when the 'image skipping' feature is activated.
(for Windows high resolution and for FPS = 300, 5 images are skipped of out 6, when image skipping is activated))

The 'regulateLite()' loop regulating is the one that provides the lowest CPU load for a provided FPS value, because all the delays added by 'regulateLite()' are generated using the only 'Sleep' keyword.
fxm
Moderator
Posts: 11926
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: FreeBasic's Timer

Post by fxm »

fxm wrote: Jun 10, 2023 8:15 Last update of my 'regulateLite()' procedure:
- small adjustments,
- addition of an optional parameter to be able to deactivate the images skipping.

Among the small adjustments, there is one concerning the FPS zones where the image skipping is activated.

Two limit zones are introduced for the activation of the image skipping:
  • - From minimum waiting times > 24 µs, the different image skipping zones are fixed (identical to these for 24 µs):
    Image skipping transition zones for requested FPS: 20, 30, 40, 50, 60, .....
    Thus, visible FPS = 10 at each start of image skipping zone, then increasing.
    (for greatest minimum waiting times, this allows to avoid flickering of visible images when image skipping is active)
  • - From minimum waiting times < 4.8 µs, the different image skipping zones are fixed (identical to these for 4.8 µs):
    Image skipping transition zones for requested FPS: 100, 150, 200, 250, 300, ...
    Thus, visible FPS = 50 at each start of image skipping zone, then increasing.
    (for smallest minimum waiting times, this allows to recover additional time for user loop execution)

Note:
  • For a required FPS value that activates the 'image skipping' feature, this also allows to lower the mean CPU load a little compared to a disabled 'image skipping' feature.

    A skipped image corresponds in fact to what 'regulateLite()' immediately returns, and therefore almost all of the 'Tfct' time consumed by its code (accuracy regulating, resolution inconsistency test, calculation of the waiting time to generate) is transformed into an increase in the timeout of the visible image after the skips.
    Thus, the code execution time gained was transformed into additional delay executed by SLEEP.
    Instead of doing N times 'Sleeep T, 1', we do once 'Sleep N * T - (N - 1) * Tfct, 1' about.
fxm
Moderator
Posts: 11926
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: FreeBasic's Timer

Post by fxm »

ALL IN ONE :
Comparison between enhanced regulating from "delay_regulate_framerate.bi", and lite regulating with 'regulateLite()' included below


Duration of the user loop (without call to regulating procedure) >= 2 ms

While running, we can change the FPS value, commute between enhanced regulating and lite regulating, and for this last choose between image skipping and no image skipping.

Code: Select all

#include "delay_regulate_framerate.bi"

'_setTimer()

Function regulateLite(ByVal MyFps As Ulong, ByVal SkipImage As Boolean = True) As Ulong
    '' 'MyFps' : requested FPS value, in frames per second
    '' 'SkipImage' : optional parameter to activate the image skipping (True by default)
    '' function return : applied FFS value, in frames per second
    Static As Long test = 10
    Static As Single tos
    Static As Single bias
    If tos = 0 Then
        Dim As Double t = Timer
        For I As Integer = 1 To test
            Sleep 1, 1
        Next I
        Dim As Double tt = Timer
        #if Not defined(__FB_WIN32__) And Not defined(__FB_LINUX__)
        If tt < t Then t -= 24 * 60 * 60
        #endif
        tos = (tt - t) / test * 1000
        bias = 0.55 * tos - 0.78
        test = 10 * 16 / tos
    End If
    Static As Long N
    Static As Long k
    Static As Single tf
    If N = 1 Then
        Dim As Single tos0 = tos
        If tos0 > 24 Then tos0 = 24
        If tos0 < 4.8 Then tos0 = 4.8
        k = Int(MyFps / 240 * tos0)
        If k = 0 Or SkipImage = False Then k = 1
        tf = 1 / MyFps
    End If
    Static As Double t0
    Static As Double t1
    Static As Double t3
    Static As Single dt0
    Static As Long start
    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
    If Start > 10 And N = 1 Then
        Dim As Single delta = (t1 - t3) * 1000 - dt0
        If Abs(delta) > 3 * tos Then
            tos = 0
            start = 0
            Exit Function
        End If
        bias += 0.01 * Sgn(delta)
    Elseif N = 1 Then
        Start += 1
    End If
    t3 = t2
    If N >= K Then
        Dim As Single dt = (k * tf - (t2 - t1)) * 1000 - bias
        If dt < 0 Then dt = 0
        dt0 = dt + bias
        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
        t0 = k / (t2 - t1)
        t1 = t2
        N = 1
    Else
        N += 1
    End If
    Return t0
End Function

Screen 12

Dim As Ulongint MyFps = 150
    
Dim As String reg = "E"
Dim As Boolean ImageSkip = True

Do
    Static As Ulongint l
    Static As Double dt
    Static As Ulong fps
    Static As Double t
    t = Timer
    Screenlock
    Cls
    Color 11
    Select Case reg
    Case "E"
        Print "Called procedure : Enhanced 'regulate ( " & MyFPS & " )'"
        Print
        Print Using "Measured FPS  : ###"; framerate()
        Print Using "Applied delay : ###.### ms"; dt
    Case "L"
        Print "Called procedure : Lite 'regulateLite ( " & MyFPS & " , " & ImageSkip & " )'"
        Print
        Print Using "Measured FPS  : ###"; fps
        Print Using "Applied delay : ###.### ms   (when no skipped image)"; dt
    End Select
    Print
    Print
    Print
    Color 14
    Print "<+>        : Increase FPS"
    Print "<->        : Decrease FPS"
    Print
    Print "<e> or <E> : Enhanced regulating"
    Print
    Print "<l> or <L> : Lite regulating"
    Print "   <t> or <T> : Image skipping True"
    Print "   <f> or <F> : Image skipping False"
    Print
    Print "<escape>   : Quit"
    Line (0, 80)-(639, 96), 7, B
    Line (0, 80)-(l, 96), 7, BF
    Screenunlock
    l = (l + 1) Mod 640
    Dim As String s = Ucase(Inkey)
    Select Case s
    Case "+"
        If MyFPS < 500 Then MyFPS += 1
    Case "-"
        If MyFPS > 10 Then MyFPS -= 1
    Case "E"
        reg = "E"
    Case "L"
        reg = "L"
    Case "T"
        If reg = "L" Then
            ImageSkip = True
        End If
    Case "F"
        If reg = "L" Then
            ImageSkip = False
        End If
    Case Chr(27)
        Exit Do
    End Select
    Do
    Loop Until Timer >= t + 0.002
    Select Case reg
    Case "E"
        dt = regulate(MyFps)
    Case "L"
        dt = Timer
        fps = regulateLite(MyFPS, ImageSkip)
        dt = (Timer - dt) * 1000
    End Select
Loop

Note:
For 'regulateLite()' when image skipping is active ('N-1' skipped-images out of 'N'):
- The 'N-1' skipped images are still plotted, but without a delay after them so that they are very quickly replaced by the visible image.
- The average CPU load is therefore almost identical, but on the other hand the instantaneous load increases during the pasted images one after the other, then after a greater dead time.

The CPU load due to the layout of the images is in-compressible.
The only place where you can win is in the generation of downtime:
- either generated by SLEEP (no CPU load)
- either generated by a loop testing TIMER (full CPU load),
- or a mixture of the two.

Code: Select all

Processor : AMD Ryzen 5 3500U with Radeon Vega Mobile Gfx, 2.10 GHz (4 cores, 8 threads)

Mean CPU load from Resource Monitor, in normal resolution for FPS = 20
    Enhanced regulating ('regulate()')                        : 5 % (part of the delay by SLEEP, the other by LOOP testing TIMER)
    Lite regulating ('regulateLite()') with image skipping    : 0 % (delay entirely by SLEEP)
    Lite regulating ('regulateLite()') without image skipping : 0 % (delay entirely by SLEEP)

Mean CPU load from Resource Monitor, in normal resolution for FPS = 50
    Enhanced regulating ('regulate()')                        : 12 % (delay entirely by LOOP testing TIMER)
    Lite regulating ('regulateLite()') with image skipping    :  1 % (delay entirely by SLEEP)
    Lite regulating ('regulateLite()') without image skipping : regulating not working well (delay entirely by SLEEP)

Mean CPU load from Resource Monitor, in normal resolution for FPS = 150
    Enhanced regulating ('regulate()')                        : 12 % (delay entirely by LOOP testing TIMER)
    Lite regulating ('regulateLite()') with image skipping    :  3 % (delay entirely by SLEEP)
    Lite regulating ('regulateLite()') without image skipping : regulating not working well (delay entirely by SLEEP)

Mean CPU load from Resource Monitor, in normal resolution for FPS = 300
    Enhanced regulating ('regulate()')                        : 12 % (delay entirely by LOOP testing TIMER)
    Lite regulating ('regulateLite()') with image skipping    :  7 % (delay entirely by SLEEP)
    Lite regulating ('regulateLite()') without image skipping : regulating not working well (delay entirely by SLEEP)
fxm
Moderator
Posts: 11926
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: FreeBasic's Timer

Post by fxm »

Updated 'regulateLite()':
- Small details.
- Code rearranging.
- Addition of a third optional parameter to force the acquisition of the resolution, to reset to False on the next call.

As the automatic detection of the resolution change only works for the transition from high resolution to low resolution, this third optional parameter allows the user to force the acquisition of the resolution (as executed at the first call). To reset to False on the next call.

Code: Select all

Function regulateLite(ByVal MyFps As Ulong, ByVal SkipImage As Boolean = True, ByVal Restart As Boolean = False) As Ulong
    '' 'MyFps' : requested FPS value, in frames per second
    '' 'SkipImage' : optional parameter to activate the image skipping (True by default)
    '' 'Restart' : optional parameter to force the resolution acquisition, to reset to False on the ext call (False by default)
    '' function return : applied FFS value, in frames per second
    Static As Single tos
    Static As Single bias
    If tos = 0 Or Restart = True Then
        Dim As Double t = Timer
        For I As Integer = 1 To 10
            Sleep 1, 1
        Next I
        Dim As Double tt = Timer
        #if Not defined(__FB_WIN32__) And Not defined(__FB_LINUX__)
        If tt < t Then t -= 24 * 60 * 60
        #endif
        tos = (tt - t) / 10 * 1000
        bias = 0.55 * tos - 0.78
    End If
    Static As Double t1
    Static As Double t3
    Static As Long N = 1
    Static As Long k = 1
    Static As Ulong fps
    Static As Single tf
    If N >= k Then
        Dim As Double t2 = Timer
        #if Not defined(__FB_WIN32__) And Not defined(__FB_LINUX__)
        If t2 < t1 Then t1 -= 24 * 60 * 60
        #endif
        t3 = t2
        Dim As Single dt = (k * tf - (t2 - t1)) * 1000 - bias
        If dt < 1 Then dt = 1
        Sleep dt, 1
        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
        fps = k / (t2 - t1)
        t1 = t2
        Dim As Single delta = (t2 - t3) * 1000 - (dt + bias)
        bias += 0.01 * Sgn(delta)
        tf = 1 / MyFps
        Dim As Single tos0 = tos
        If tos0 > 24 Then tos0 = 24
        If tos0 < 4.8 Then tos0 = 4.8
        k = Int(MyFps / 240 * tos0)
        If k = 0 Or SkipImage = False Then k = 1
        If Abs(delta) > 3 * tos Then
            tos = 0
        End If
        N = 1
    Else
        N += 1
    End If
    Return fps
End Function
Last edited by fxm on Jun 13, 2023 17:49, edited 2 times in total.
Reason: 'regulateLite()' updated.
Post Reply