PureBoard

Verfasst: **16.05.2009 14:24**

Easy Timer ist ein kleines Timerbeispiel das leicht erweitert werden kann und an eure Bedürfnisse angepasst werden kann.

Konkret kann man damit eine Procedure alle x - Millisekunden im Hintergrund aufrufen lassen.

Code: Alles auswählen

; ------------------------------------------------------------------------------------
; Easy Timer
; Einfacher leicht erweiterbarer Timer
; PB 4.3 +
; Alexander Aigner
; V 1.0
; ------------------------------------------------------------------------------------

; ------------------------------------------------------------------------------------
; Internes Zeugs
; ------------------------------------------------------------------------------------

; ------------------------------------------------------------------------------------
; 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

; Initialisierung des High-Res 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

; ------------------------------------------------------------------------------------
; Eigentlicher Timer
; ------------------------------------------------------------------------------------

Prototype ET_Procedure(Event, UserData)

Enumeration ; Sollte klar sein ...
  #ET_Call
  #ET_Pause
  #ET_Resume
  #ET_Free
EndEnumeration

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
      
      If \CBEvent ; Nur 1. If-Abfrage für (später) beliebie viele Events
        If \CBEventPause ; Pausesignal
          \CB(#ET_Pause, \UserData)
          WaitSemaphore(\CBEventPause)
          \CB(#ET_Resume, \UserData)
        EndIf
        If \CBEventStop ; Stopsignal
          \CB(#ET_Free, \UserData)
          SignalSemaphore(\CBEventStop)
          ProcedureReturn #Null
        EndIf
        \CBEvent = #False
      EndIf
      
      cTime = GetTimeMS()
      While wTime>GetTimeMS()-cTime
        Delay(1)
        If \CBEvent ; Nur 1. If-Abfrage für (später) beliebie viele Events
          If \CBEventPause ; Pausesignal
            \CB(#ET_Pause, \UserData)
            WaitSemaphore(\CBEventPause)
            \CB(#ET_Resume, \UserData)
          EndIf
          If \CBEventStop ; Stopsignal
            \CB(#ET_Free, \UserData)
            SignalSemaphore(\CBEventStop)
            ProcedureReturn #Null
          EndIf
          \CBEvent = #False
        EndIf
      Wend
      
      ; Callback aufrufen und Ausgleichszeit errechnen
      cTime = GetTimeMS()
      \CB(#ET_Call, \UserData)
      wTime = \Delay-GetTimeMS() + cTime
      
      ; Delay(<0) = warte unendlich
      If wTime<0
        wTime = #Null
      EndIf
      
    ForEver
  EndWith
EndProcedure

; ------------------------------------------------------------------------------------
; Proceduren
; ------------------------------------------------------------------------------------

; Neuen Timer anlegen
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

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

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

; Timer freigeben
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(Event, Dummy)
  Static x, lT, cT
  If Event = #ET_Call
    x + 1
    cT = GetTimeMs()
    If lT
      PrintN("Getriggert nach " + Str(cT-lT) + " ms " + Str(x))
    Else
      PrintN("Timer Initialisiert " + Str(x))
    EndIf
    Delay(Random(50))
    lT = ct
  ElseIf Event = #ET_Free
    PrintN("Timer freigegeben ")
  EndIf
  ;Debug x
EndProcedure

; Test alle 100 ms aufrufen

OpenConsole()

Timer1 = ET_New(@Test(), 50, #Null)
Delay(1020)
; Timer freigeben
ET_Free(Timer1)

Input()
CloseConsole()

Gruß, Alex

Verfasst: **16.05.2009 14:33**

dann schreib dem "Job" mal ne messitch, damit es das auch findet...

Verfasst: **16.05.2009 14:50**

Schon passiert...

Verfasst: **17.05.2009 17:30**

dankeschön für den codeh

Verfasst: **22.05.2009 19:05**

Update:

Timer kann pausiert/fortgesetzt werden
Kleiner BugFix (Delay(<0) = Unendlich warten, sollte vlt. in die Doku...)

Code siehe 1. Post

Gruß, Alex

Verfasst: **22.05.2009 19:52**

Ich finde das mit dem Delay ein bisschen schlecht gelöst. Besser finde ich es überhaupt
kein Delay zu nutzen und stattdessen nur mit 'ElapsedMilliseconds()' zu arbeiten. Bei dem
Delay kann sich nämlich wegen der geringen Ungenauigkeit eine große Ungenauigkeit
ansammeln!

Code: Alles auswählen

Wir nehmen als Timerwert mal 100 ms.

ideal  bisher  besser   
0      0       0        Timer initialisiert
100    105     105      ausgelöst
200    212     207      ausgelöst
300    320     308      ausgelöst
400    426     406      ausgelöst
500    530     504      ausgelöst

Verfasst: **22.05.2009 20:04**

Habs mal verbessert, bei mir ist die max. Ungenauigkeit jetzt 1 ms:

Code siehe oben.

Debugger hat geschrieben:Timer Initialisiert
Getriggert nach 100 ms
Getriggert nach 101 ms
Getriggert nach 100 ms
Getriggert nach 101 ms
Getriggert nach 100 ms
Getriggert nach 100 ms
Getriggert nach 101 ms
Getriggert nach 100 ms
Getriggert nach 101 ms

Verfasst: **23.05.2009 17:13**

Kleines Update.

Code nochmal leicht überarbeitet, genauer gehts nicht. (Außer man macht lastet die CPU resp. 1. Kern beim Warten mal eben 100% aus

).

Im Demo sieht man jetzt schön wie der Timer die Ausführungsdauer der Procedure ausgleicht.

Gruß, Alex

Verfasst: **23.05.2009 19:52**

schön. Gleich wird geupdatet.

Verfasst: **24.05.2009 14:04**

Hi,

Schöne Arbeit

Deine letzte version funktionierte bei kleinen Delay besser. Versuch es mal mit 10ms

Code: Alles auswählen

      wTime = \Delay - dTime
      cTime = GetTimeMS()
      While wTime > GetTimeMS()-cTime
        Delay(1)
      Wend

Delay(1) (WinAPI Sleep) kehrt wohl sofort zurück und entlastet nur die CPU um die bearbeitung andere Thread zu gewährleisten
Delay(>1) wird sehr ungenau.

Tipp: Vergib bitte eine Versionsnummer

Vielleicht die Eventkennung su umbauen das man in der eigenen Thread noch den Pause und Free abfragen kann um noch wichtige verarbeitungen
durchführen kann

FF

PureBoard

EasyTimer

EasyTimer