PureBasic Forums - English

Posted: **Sat May 23, 2009 4:25 pm**

EasyTimer is a short code to call a Procedure each n - milliseconds. It's very exact, because it uses HighRes - timers, the maximum deviation is 1 ms (in the test).

The timer can also be paused and resumed.

Greets, Alex

Code: Select all

; ------------------------------------------------------------------------------------
; Easy Timer
; Easy to use Timer
; PB 4.3 +
; Alexander Aigner
; ------------------------------------------------------------------------------------

; ------------------------------------------------------------------------------------
; Internal Stuff
; ------------------------------------------------------------------------------------

; ------------------------------------------------------------------------------------
; HighRes - Timer
; ------------------------------------------------------------------------------------
EnableExplicit

Prototype HR_Time()

Structure _HR_Internal
  StartTime.q
  Res.d
EndStructure

Define _HR._HR_Internal
Global GetTimeMS.HR_Time

Procedure _HR_InitTime()
  Shared _HR._HR_Internal
  Protected Frequency.q
  With _HR
    If Not QueryPerformanceFrequency_(@Frequency)
      ProcedureReturn #False
    Else
      QueryPerformanceCounter_(@\StartTime)
      \Res = 1000/Frequency
      ProcedureReturn #True
    EndIf
  EndWith
EndProcedure

Procedure _HR_Get()
  Shared _HR._HR_Internal
  Protected currentTime.q
  With _HR
    QueryPerformanceCounter_(@currentTime)
    ProcedureReturn (currentTime-\StartTime)*\Res
  EndWith
EndProcedure

Procedure _HR_oldPC_or_Linux()
  ProcedureReturn ElapsedMilliseconds()
EndProcedure

; Init HR Timers

CompilerIf #PB_Compiler_OS<>#PB_OS_Windows
  GetTimeMS = @_HR_oldPC_or_Linux()
CompilerElse
  If _HR_InitTime()
    GetTimeMS = @_HR_Get()
  Else
    GetTimeMS = @_HR_oldPC_or_Linux()
  EndIf
CompilerEndIf

; ------------------------------------------------------------------------------------
; Other Stuff
; ------------------------------------------------------------------------------------

Prototype ET_Procedure(UserData)

Structure ET_Data
  *CB.ET_Procedure
  UserData.i
  Delay.i
  CBEvent.i
  CBEventStop.i
  CBEventPause.i
EndStructure

Procedure _ET_Thread(*ET.ET_Data)
  Protected cTime, wTime
  With *ET
    wTime = \Delay
    Repeat
     
      Delay(wTime)
     
      If \CBEvent ; 
        If \CBEventPause ; Pause - Signal
          WaitSemaphore(\CBEventPause)
        EndIf
        If \CBEventStop ; Stop - Signal
          SignalSemaphore(\CBEventStop)
          ProcedureReturn #Null
        EndIf
        \CBEvent = #False
      EndIf
     
      ; call Procedure and calc diff. time
      cTime = GetTimeMS()
      \CB(\UserData)
      wTime = \Delay-GetTimeMS() + cTime
     
      If wTime<0
        wTime = #Null
      EndIf
     
    ForEver
  EndWith
EndProcedure

; ------------------------------------------------------------------------------------
; Procedures
; ------------------------------------------------------------------------------------

; new Timer
Procedure ET_New(*Callback.ET_Procedure, Delay.i, UserData.i)
  Protected *ET.ET_Data = AllocateMemory(SizeOf(ET_Data))
  With *ET
    \CB = *Callback
    \Delay = Delay
    \UserData = UserData
    CreateThread(@_ET_Thread(), *ET)
    ProcedureReturn *ET
  EndWith
EndProcedure

; pause Timer
Procedure ET_Pause(*ET.ET_Data)
  With *ET
    If Not \CBEventPause
      \CBEventPause = CreateSemaphore()
      \CBEvent = #True
    EndIf
  EndWith
EndProcedure

; resume Timer
Procedure ET_Resume(*ET.ET_Data)
  With *ET
    If \CBEventPause
      SignalSemaphore(\CBEventPause)
      FreeSemaphore(\CBEventPause)
    EndIf
  EndWith
EndProcedure

; free Timer
Procedure ET_Free(*ET.ET_Data)
  With *ET
    \CBEventStop = CreateSemaphore()
    \CBEvent = #True
    ET_Resume(*ET) ; Wenn nötig fortsetzen
    WaitSemaphore(\CBEventStop)
    FreeSemaphore(\CBEventStop)
    FreeMemory(*ET)
  EndWith
EndProcedure

DisableExplicit




; ------------------------------------------------------------------------------------
; Test
; ------------------------------------------------------------------------------------

Procedure Test(Dummy)
  Static x, lT, cT
  x + 1
  cT = GetTimeMs()
  If lT
    PrintN("Timer called after " + Str(cT-lT) + " ms " + Str(x))
  Else
    PrintN("Timer initialized " + Str(x))
  EndIf
  ; random Delay
  Delay(Random(50))
  lT = ct
EndProcedure



OpenConsole()

; call Procedure Test every 50 ms 
Timer1 = ET_New(@Test(), 50, #Null)
Delay(1010)
; free Timer
ET_Free(Timer1)


Input()
CloseConsole()

Posted: **Sat May 23, 2009 7:17 pm**

nice code, thanks for it

Posted: **Sat May 23, 2009 11:46 pm**

@cxAlex:

Your code calls CreateThread() in procedure ET_New().
So surely it should call KillThread() in procedure ET_Free().

Or does the thread get killed some other way?

Posted: **Sat May 23, 2009 11:57 pm**

> Or does the thread get killed some other way?

Yes.

KillThread() is evil, evil, evil

.