It is OK for this.
FreeBasic's Timer
Re: FreeBasic's Timer
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.
Reason: Almost final code.
Re: FreeBasic's Timer
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: 4156
- Joined: Jan 02, 2017 0:34
- Location: UK
- Contact:
Re: FreeBasic's Timer
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.
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 secondsRe: FreeBasic's Timer
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)
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)
Re: FreeBasic's Timer
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.
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.
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
I can screw 20 fps out of it in 32 bits/ 24 in 64 bits, about 18 gas64.
Re: FreeBasic's Timer
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
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
Re: FreeBasic's Timer
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)
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)
Re: FreeBasic's Timer
I added the CPU usage to the code using WinAPI.
Getting best result with "-gen gcc -Wc -Ofast -Wc -march=native" compiled as x64.
Btw, the fps display is too fast, flipping around.
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)
Btw, the fps display is too fast, flipping around.
Re: FreeBasic's Timer
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!
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!
Re: FreeBasic's Timer
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 :
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.
- 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
(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.
Re: FreeBasic's Timer
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.
Re: FreeBasic's Timer
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.
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.
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)
Re: FreeBasic's Timer
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.
- 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.
Reason: 'regulateLite()' updated.