Time.hs

module Ramus.Time where

import Prelude hiding (filter)
import Ramus.Signal
import Control.Concurrent
import Data.IORef
import System.IO.Unsafe

type Time = Float

millisecond :: Time
millisecond = 1.0

second :: Time
second = 1000.0

-- |Creates a signal which yields the current time (according to `now`) every
-- |given number of milliseconds.
every :: Time -> Signal Time
every = undefined

-- |Returns the number of milliseconds since an arbitrary, but constant, time
-- |in the past.
now :: IO Time
now = undefined

-- |Takes a signal and delays its yielded values by a given number of
-- |milliseconds.
delay :: Time -> Signal a -> Signal a
delay t sig = unsafePerformIO $ do
  let out = make $ get sig
  first <- newIORef True
  sig `subscribe` \val -> do
    first' <- readIORef first
    if first'
      then writeIORef first False
      else do
        threadDelay (round $ t * 1000)
        out `set` val
      
  return out

-- |Takes a signal and a time value, and creates a signal which yields `True`
-- |when the input signal yields, then goes back to `False` after the given
-- |number of milliseconds have elapsed, unless the input signal yields again
-- |in the interim.
since :: Time -> Signal a -> Signal Bool
since t sig = unsafePerformIO $ do
  let out = make False
  firstRef <- newIORef True
  timerRef <- newIORef Nothing
  let tick = do
          out `set` False
          writeIORef timerRef Nothing
  sig `subscribe` \val -> do
    first <- readIORef firstRef
    if first
      then writeIORef firstRef False
      else do
        timer <- readIORef timerRef
        case timer of
          Nothing -> do
            out `set` True
            tim <- forkIO $ do
              threadDelay (round $ t * 1000)
              tick
            writeIORef timerRef $ Just tim           

          Just tim -> do
            killThread tim
            tim' <- forkIO $ do
              threadDelay (round $ t * 1000)
              tick
            writeIORef timerRef $ Just tim'
  return out


-- |Takes a signal and a time value, and creates a signal which waits to yield
-- |the next result until the specified amount of time has elapsed. It then
-- |yields only the newest value from that period. New events during the debounce
-- |period reset the delay.
debounce :: Time -> Signal a -> Signal a
debounce t s =
  let leading = whenChangeTo False $ since t s
  in sampleOn leading s
  where
    whenEqual value = filter (value ==) value
    whenChangeTo value input = whenEqual value $ dropRepeats input