I just recently started using FreeBASIC and wanted to start contributing to the community. Here is some code which shows how I limit sections of code execution to a certain # of times per second. I use this code to limit sprite animations and sometimes my entire game loop.
Hope someone finds this useful.
*note: Compiles for Win32 console
' TimeSlice - by Vincent DeCampo 2007
' Free to use and distribute.
' Feel free to mention me! :-)
'
' No Warranties given or implied
' Use at own risk
#include "windows.bi"
Type TimeSlice
Initialized As Integer
IntervalsPerSec As Single
StartTicks As Double
EndTicks As Double
IntervalTicks As Double
End Type
Declare Function GetTickCounter Lib "kernel32" Alias "GetTickCount" () As Integer
Function TickFrequency() As Double
TickFrequency = 1000
End Function
Function TickCounter() As Double
TickCounter = GetTickCounter
End Function
Function TimeSliceInitialize(ByRef tSlice As TimeSlice, IPS As Single) As Integer
If IPS >0 Then
tSlice.IntervalsPerSec = IPS
tSlice.IntervalTicks = TickFrequency / tSlice.IntervalsPerSec
tSlice.StartTicks = TickCounter
tSlice.EndTicks = tSlice.StartTicks + tSlice.IntervalTicks
tSlice.Initialized = TRUE
Else
tSlice.Initialized = FALSE
End If
TimeSliceInitialize=tSlice.Initialized
End Function
Function TimeSliceCheck(ByRef tSlice As TimeSlice) As Integer
Dim Cnt As Double
If tSlice.Initialized = TRUE Then
Cnt = TickCounter
TimeSliceCheck = FALSE
If Cnt < tSlice.StartTicks Then
TimeSliceCheck = TRUE
tSlice.StartTicks = Cnt
tSlice.EndTicks = tSlice.StartTicks + tSlice.IntervalTicks
Exit Function
End If
If Cnt > tSlice.EndTicks Then
TimeSliceCheck = TRUE
tSlice.StartTicks = Cnt
tSlice.EndTicks = tSlice.StartTicks + tSlice.IntervalTicks
Exit Function
End If
End If
End Function
Sub Main ()
Dim tm1 As TimeSlice
Dim tm2 As TimeSlice
Dim tm3 As TimeSlice
TimeSliceInitialize tm1,1
TimeSliceInitialize tm2,4
TimeSliceInitialize tm3, .5
Do
If TimeSliceCheck(tm1)=TRUE Then
Print "This code executes at " & tm1.IntervalsPerSec & " times per second."
EndIf
If TimeSliceCheck(tm2)=TRUE Then
Print "This code executes at " & tm2.IntervalsPerSec & " times per second."
EndIf
If TimeSliceCheck(tm3)=TRUE Then
Print "This code executes at " & tm3.IntervalsPerSec & " times per second."
EndIf
Loop Until InKey<>""
End Sub
'
'PROGRAM STARTS HERE
'
Main ()
End
' TimeSlice - by Vincent DeCampo 2007
' Free to use and distribute.
' Feel free to mention me! :-)
'
' No Warranties given or implied
' Use at own risk
#include "windows.bi"
Type TimeSlice
Initialized As Integer
IntervalsPerSec As Single
StartTicks As Double
EndTicks As Double
IntervalTicks As Double
End Type
Function TickFrequency() As Double
TickFrequency = 1000
End Function
Function TickCounter() As Double
TickCounter = Timer*1000
End Function
Function TimeSliceInitialize(Byref tSlice As TimeSlice, IPS As Single) As Integer
If IPS >0 Then
tSlice.IntervalsPerSec = IPS
tSlice.IntervalTicks = TickFrequency / tSlice.IntervalsPerSec
tSlice.StartTicks = TickCounter
tSlice.EndTicks = tSlice.StartTicks + tSlice.IntervalTicks
tSlice.Initialized = TRUE
Else
tSlice.Initialized = FALSE
End If
TimeSliceInitialize=tSlice.Initialized
End Function
Function TimeSliceCheck(Byref tSlice As TimeSlice) As Integer
Dim Cnt As Double
If tSlice.Initialized = TRUE Then
Cnt = TickCounter
TimeSliceCheck = FALSE
If Cnt < tSlice.StartTicks Then
TimeSliceCheck = TRUE
tSlice.StartTicks = Cnt
tSlice.EndTicks = tSlice.StartTicks + tSlice.IntervalTicks
Exit Function
End If
If Cnt > tSlice.EndTicks Then
TimeSliceCheck = TRUE
tSlice.StartTicks = Cnt
tSlice.EndTicks = tSlice.StartTicks + tSlice.IntervalTicks
Exit Function
End If
End If
End Function
Sub Main ()
Dim tm1 As TimeSlice
Dim tm2 As TimeSlice
Dim tm3 As TimeSlice
TimeSliceInitialize tm1,1
TimeSliceInitialize tm2,4
TimeSliceInitialize tm3, .5
Do
If TimeSliceCheck(tm1)=TRUE Then
Print "This code executes at " & tm1.IntervalsPerSec & " times per second."
Endif
If TimeSliceCheck(tm2)=TRUE Then
Print "This code executes at " & tm2.IntervalsPerSec & " times per second."
Endif
If TimeSliceCheck(tm3)=TRUE Then
Print "This code executes at " & tm3.IntervalsPerSec & " times per second."
Endif
Loop Until InKey<>""
End Sub
'
'PROGRAM STARTS HERE
'
Main ()
End
Timer on Windows will use the Win32 high-performance multimedia timer when available, which is much more accurate than GetTickCount (usually GetTickCount is at best 10ms resolution, regardless of the precision).
Further testing has revealed to me that the Timer function is not as accurate (on my system) as using GetTickCount. When using Timer, my sprites become unsychronized. Re-instating GetTickCount in my code keeps all my sprites 100% in sync.
I'm not sure why since you said FB would institute the PerformaceTimer functions. I am using a P4 3.0e HT with Windows XP sp2.
Perhaps this deserves some further investigation under FB's hood?
:-]
Your system should support a performance counter, and it should have an effective resolution of ~2 microsecond, which is ~5000 times finer than the resolution of the tick count.
'====================================================================
'' Timer resolution tests.
'====================================================================
#include "windows.bi"
dim as integer i
dim as ulongint pcfreq, count1, count2
dim as double t1, t2, accum
SetPriorityClass( GetCurrentProcess(), HIGH_PRIORITY_CLASS )
sleep 3000
for i = 1 to 1000000
t1 = timer
do
t2 = timer
loop until t2 > t1
accum += t2 - t1
next
print using "TIMER resolution:##.## us";accum
print
accum = 0
if QueryPerformanceFrequency(cast(PLARGE_INTEGER,@pcfreq)) then
for i = 1 to 1000000
QueryPerformanceCounter( cast(PLARGE_INTEGER, @count1) )
do
QueryPerformanceCounter( cast(PLARGE_INTEGER, @count2) )
loop until count2 > count1
accum += count2 - count1
next
print "Performance frequency: ";pcfreq;" Hz"
print
accum /= pcfreq
print using "Performance counter resolution:##.## us";accum
print
endif
accum = 0
for i = 1 to 1000
t1 = GetTickCount
do
t2 = GetTickCount
loop until t2 > t1
accum += t2 - t1
next
accum /= 1000 ' Must adjust for return value in ms.
print using "GetTickCount resolution:###.## ms";accum
print
accum = 0
for i = 1 to 1000
t1 = timer
sleep 1
t2 = timer
accum += t2 - t1
next
print using "SLEEP resolution:###.## ms";accum
print
SetPriorityClass( GetCurrentProcess(), NORMAL_PRIORITY_CLASS )
sleep
Perhaps the sprites became unsynced because of the INCREASED timer resolution? The lower precision could have been masking the true sprite performance?
