fixed-timestep (empty) → 0.1.0.0

raw patch · 6 files changed

+233/−0 lines, 6 filesdep +asyncdep +basedep +clocksetup-changed

Dependencies added: async, base, clock, time

Files

CHANGELOG.md +5/−0
LICENSE +20/−0
Setup.hs +2/−0
fixed-timestep.cabal +37/−0
lib/Time/Flick.hs +85/−0
lib/TimeStep.hs +84/−0

+ CHANGELOG.md view

@@ -0,0 +1,5 @@+# Revision history for fixed-timestep
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.

+ LICENSE view

@@ -0,0 +1,20 @@+Copyright (c) 2019 Solonarv
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be included
+in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain

+ fixed-timestep.cabal view

@@ -0,0 +1,37 @@+cabal-version:       2.2
+-- Initial package description 'fixed-timestep.cabal' generated by 'cabal
+-- init'.  For further documentation, see
+-- http://haskell.org/cabal/users-guide/
+
+name:                fixed-timestep
+version:             0.1.0.0
+synopsis:            Pure Haskell library to repeat an action at a specific frequency.
+description:         Repeat IO actions at a specific frequency, using
+                     flicks (1/705600000 of a second) for timekeeping.
+                     Also contains a simple implementation of flicks.
+homepage:            https://github.com/Solonarv/fixed-timestep#README
+bug-reports:         https://github.com/Solonarv/fixed-timestep/issues
+license:             MIT
+license-file:        LICENSE
+author:              Solonarv
+maintainer:          Nicolas Stamm <nstamm@gmx.de>
+copyright:           2019 Nicolas Stamm (Solonarv)
+category:            Time
+extra-source-files:  CHANGELOG.md
+
+source-repository head
+  type:     git
+  location: git://github.com/Solonarv/fixed-timestep.git
+
+library
+  exposed-modules:     Time.Flick
+                     , TimeStep
+  -- other-modules:
+  other-extensions:    DerivingStrategies GeneralizedNewtypeDeriving NamedFieldPuns
+                       ScopedTypeVariables
+  build-depends:       base >= 4.10 && < 4.13
+                     , clock ^>= 0.7
+                     , async >= 2.0.1.0 && < 2.3
+                     , time >= 1.6 && < 1.10
+  hs-source-dirs:      lib
+  default-language:    Haskell2010

+ lib/Time/Flick.hs view

@@ -0,0 +1,85 @@+-- | A simple implementation of flicks, using 64-bit integers.
+-- See https://github.com/OculusVR/Flicks#README for the spec.
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+module Time.Flick
+  ( -- * The Flicks data type
+    Flicks(..)
+  , flicksPerSecond, secnd
+    -- * Conversions
+  , approxFlicks
+  , periodForFreq
+  , timeSpecToFlicks
+  , flicksToDiffTime
+    -- * Measuring time in flicks
+  , flicksNow
+  , threadDelayFlicks
+  ) where
+
+import Control.Concurrent (threadDelay)
+import Data.Fixed
+import Data.Int
+import Data.Proxy
+import Data.Ratio
+
+import Data.Time.Clock
+import System.Clock
+
+-- | Time measured in units of flicks. One flick is precisely
+-- @1/705600000@ seconds. Many common frame rates produce
+-- frame times which are an integer number of flicks.
+newtype Flicks = Flicks { unFlicks :: Int64 }
+  deriving newtype (Eq, Ord, Show, Num, Enum, Integral, Real)
+
+-- | How many flicks are in a second. Precisely 705600000.
+flicksPerSecond :: Num a => a
+flicksPerSecond = 705600000
+
+-- | One second in flicks.
+secnd :: Flicks
+secnd = flicksPerSecond
+
+-- | Convert a number of seconds into flicks, rounding towards zero.
+approxFlicks :: Rational -> Flicks
+approxFlicks t = Flicks . truncate $ t * flicksPerSecond
+
+-- | Duration in flicks of one oscillation at the given frequency (in Hertz).
+-- The result is rounded towards zero.
+periodForFreq :: Rational -> Flicks
+periodForFreq = approxFlicks . recip
+
+-- | Convert a @'TimeSpec'@ into flicks. Rounds towards zero.
+timeSpecToFlicks :: TimeSpec -> Flicks
+timeSpecToFlicks TimeSpec{sec, nsec} = Flicks (secPart + nsecPart)
+  where
+    secPart = flicksPerSecond * sec
+    nsecPart = (flicksPerSecond * nsec) `quot` 10^9
+
+-- | Convert flicks into seconds with some amount of precision.
+flicksToFixed :: forall r. HasResolution r => Flicks -> Fixed r
+flicksToFixed (Flicks t) = MkFixed val
+  where
+    val = fromIntegral t * resolution (Proxy @r) `quot` flicksPerSecond
+
+-- | Convert flicks into @'DiffTime'@
+flicksToDiffTime :: Flicks -> DiffTime
+flicksToDiffTime t = picosecondsToDiffTime picos
+  where
+    MkFixed picos = flicksToFixed t :: Fixed E12
+
+-- | Get the current time in flicks. The epoch is an arbitrary starting
+-- point and the maginute of the result should not be relied on.
+-- 
+-- See the documentation of @"System.Clock"@ for details.
+flicksNow :: Clock -> IO Flicks
+flicksNow clockTy = timeSpecToFlicks <$> getTime clockTy
+
+-- | Suspend the current thread for a given duration.
+-- Inherits 'threadDelay' 's lack of guarantees.
+threadDelayFlicks :: Flicks -> IO ()
+threadDelayFlicks (Flicks t) = do
+  let micros = fromIntegral $ (10^6 * t) `quot` flicksPerSecond
+  threadDelay micros

+ lib/TimeStep.hs view

@@ -0,0 +1,84 @@+-- | Utilities for repeatedly running @'IO'@ actions
+-- at a specific frequency.
+module TimeStep
+  ( -- * Repeating actions
+    repeatedly
+  , repeatedly'
+    -- * Repeating actions in another thread
+  , asyncRepeatedly
+  , asyncRepeatedly'
+    -- * Implementation details
+  , TimeStepClock
+  , newClock
+  , loopUsing
+    -- * Reexports (timekeeping)
+  , module Time.Flick
+  , Clock(..)
+  ) where
+
+import Control.Concurrent
+import Control.Monad
+import Data.Bifunctor
+import Data.Fixed (divMod')
+import Data.Int
+import Data.IORef
+import Data.Ratio
+
+import Control.Concurrent.Async
+import System.Clock
+
+import Time.Flick
+
+-- | Internal state of the stepper. Created using @'newClock'@.
+data TimeStepClock = TimeStepClock
+  { tscLastTick :: IORef Flicks
+  , tscDesiredTickTime :: Flicks
+  , tscClockType :: Clock
+  } deriving Eq
+
+-- | Run an action repeatedly at the specified frequency.
+-- Uses the 'Monotonic' clock for timing.
+repeatedly :: Rational -> IO a -> IO void
+repeatedly freq = repeatedly' freq Monotonic
+
+-- | Run an action repeatedly at the specified frequency,
+-- using the given clock type.
+repeatedly' :: Rational -> Clock -> IO a -> IO void
+repeatedly' freq clockTy act = do
+  clock <- newClock freq clockTy
+  loopUsing clock act
+
+-- | Run an action repeatedly at the specified frequency, in a separate thread.
+-- Uses the 'Monotonic' clock for timing.
+asyncRepeatedly :: Rational -> IO a -> IO (Async void)
+asyncRepeatedly freq = asyncRepeatedly' freq Monotonic
+
+-- | Run an action repeatedly at the specified frequency, in a separate thread,
+-- using the given clock type.
+asyncRepeatedly' :: Rational -> Clock -> IO a -> IO (Async void)
+asyncRepeatedly' freq clockTy act = do
+  clock <- newClock freq clockTy
+  async (loopUsing clock act)
+
+-- | Initialise a new clock structure for the given frequency and using
+-- the given clock type.
+newClock :: Rational -> Clock -> IO TimeStepClock
+newClock freq clockTy = do
+  leftoverRef <- newIORef =<< flicksNow clockTy
+  pure TimeStepClock
+    { tscLastTick = leftoverRef
+    , tscDesiredTickTime = periodForFreq freq
+    , tscClockType = clockTy
+    }
+
+-- | Repeat the given action using the information in the clock structure.
+loopUsing :: TimeStepClock -> IO a -> IO void
+loopUsing (TimeStepClock lastTickRef tickTime clockTy) act = forever $ do
+  now <- flicksNow clockTy
+  lastTick <- readIORef lastTickRef
+  let elapsed = now - lastTick
+      (ticksToRun, leftover) = elapsed `divMod` tickTime
+  replicateM_ (fromIntegral ticksToRun) act
+  writeIORef lastTickRef now
+  now' <- flicksNow clockTy
+  threadDelayFlicks (tickTime + now - now')