PureBoard

Code: Alles auswählen

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

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

Prototype HR_Time()

Structure _HR_Internal
  TicksPerSecond.l
  Frequency.q
  StartTime.q
EndStructure

Define _HR._HR_Internal
Global GetTimeMS.HR_Time

Procedure _HR_InitTime()
  Shared _HR._HR_Internal
  With _HR
    If Not QueryPerformanceFrequency_(@\Frequency)
      ProcedureReturn 0
    Else
      QueryPerformanceCounter_(@\StartTime)
      \TicksPerSecond = 1000 ; 1000 = Millisekunden
      ProcedureReturn 1
    EndIf
  EndWith
EndProcedure

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

Procedure _HR_oldPC_or_Linux()
  ProcedureReturn ElapsedMilliseconds()
EndProcedure

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

Prototype ET_Procedure(UserData)

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

Procedure _ET_Thread(*ET.ET_Data)
  Protected dTime, cTime, wTime
  With *ET
    Repeat
     
      wTime = \Delay - dTime
      cTime = GetTimeMS()
      If wTime > 50
        Delay(wtime)
      Else
        While wTime > GetTimeMS()-cTime
          Delay(1)
        Wend
      EndIf
      
      If \CBEventPause ; Pausesignal
        WaitSemaphore(\CBEventPause)
      EndIf
      If \CBEventStop ; Stopsignal
        SignalSemaphore(\CBEventStop)
        ProcedureReturn #Null
      EndIf
     
      ; Callback aufrufen und Ausgelichszeit errechnen
      cTime = GetTimeMS()
      \CB(\UserData)
      dTime = GetTimeMS()-cTime
     
      ; Delay(<0) = warte unendlich
      If dTime<0
        dTime = 0
      ElseIf dTime>\Delay
        dTime = \Delay
      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()
    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()
    ET_Resume(*ET) ; Wenn nötig fortsetzen
    WaitSemaphore(\CBEventStop)
    FreeSemaphore(\CBEventStop)
    FreeMemory(*ET)
  EndWith
EndProcedure

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

Procedure Test(Dummy)
  Static x, lT, cT
  cT = GetTimeMs()
  If lT
    Debug "Getriggert nach " + Str(cT-lT)+" ms"
  Else
    Debug "Timer Initialisiert"
  EndIf
  lT = ct
  x +1
  ;Debug x
EndProcedure

; Test alle 100 ms aufrufen

Timer1 = ET_New(@Test(), 45, #Null)
Delay(1010)
; Timer freigeben
ET_Free(Timer1)