Yampa/reactimate: Difference between revisions
(Changed System.CPUTime to Data.Time.Clock and added the Precision section) |
m (Use Yampa instead of Animas (outdated) and use POSIX time instead of UTC) |
||
Line 21: | Line 21: | ||
module Main where | module Main where | ||
import FRP. | import FRP.Yampa | ||
import Data.IORef | import Data.IORef | ||
import Data.Time.Clock | import Data.Time.Clock.POSIX | ||
sf :: SF () Bool -- The signal function to be run | sf :: SF () Bool -- The signal function to be run | ||
Line 31: | Line 31: | ||
main :: IO () | main :: IO () | ||
main = do | main = do | ||
t <- | t <- getPOSIXTime -- Current POSIX time in seconds | ||
timeRef <- newIORef t | timeRef <- newIORef t | ||
let init = putStrLn "Hello... wait for it..." | let init = putStrLn "Hello... wait for it..." | ||
sense = (\_ -> do | sense = (\_ -> do | ||
t' <- | t' <- getPOSIXTime | ||
t <- readIORef timeRef | t <- readIORef timeRef | ||
let dt = realToFrac ( | let dt = realToFrac (t' - t) -- Time difference in seconds | ||
writeIORef timeRef t' | writeIORef timeRef t' | ||
return (dt, Nothing)) -- we could equally well return (dt, Just ()) | return (dt, Nothing)) -- we could equally well return (dt, Just ()) |
Revision as of 16:40, 22 September 2012
reactimate :: IO a -- init
-> (Bool -> IO (DTime, Maybe a)) -- input/sense
-> (Bool -> b -> IO Bool) -- output/actuate
-> SF a b -- process/signal function
-> IO ()
The Bool
parameter of sense
and actuate
are unused if you look up the definition of reactimate so just ignore them (cf. the explanations below).
reactimate
basically is an input-process-output loop and forms the interface between (pure) Yampa signal functions and the (potentially impure) external world. More specifically, a Yampa signal function of type SF a b
is an abstract data type that transforms a signal of type Time -> a
into a signal of type Time -> b
(note that one does not have direct access to signals in Yampa but just to signal functions). The Time
parameter here is assumed to model continuous time but to evaluate a signal function (or a signal for that matter) it is necessary to sample the signals at discrete points in time. This is exactly what reactimate
does (among other things).
Further explanations
- The
init
action is rather self-explanatory; it executes an initial IO action (e.g. print a welcome message), which then yields an initial sample of typea
for the signal function that is passed toreactimate
as the last argument. - The
sense
argument is then evaluated atFalse
and should return an IO action yielding a pair that contains the time passed since the last sample and a new sample of typea
(wrapped in aMaybe
) for the signal function. If the second component ofsense
's return value isNothing
then the previous sample is used again. actuate
is evaluated atTrue
and the signal function's output of typeb
, obtained by processing the input sample previously provided bysense
.actuate
's job now is to process the output (e.g. render a collection of objects contained in it) in an IO action that yields a result of typeBool
. If this result isTrue
the processing loop stops (i.e. the IO action defined byreactimate
returns()
).- Finally, the last argument of
reactimate
is the signal function to be run (or "animated"). Keep in mind that the signal function may take pretty complex forms like a parallel switch embedded in a loop.
Example
To illustrate this, here's a simple example of a Hello World program but with some time dependence added. Its purpose is to print "Hello... wait for it..." to the console once and then wait for 2 seconds until it prints "World!" and then stops.
module Main where
import FRP.Yampa
import Data.IORef
import Data.Time.Clock.POSIX
sf :: SF () Bool -- The signal function to be run
sf = time >>> arr (\t -> if (t < 2) then False else True)
-- the time signal function ignores its input and returns the time
main :: IO ()
main = do
t <- getPOSIXTime -- Current POSIX time in seconds
timeRef <- newIORef t
let init = putStrLn "Hello... wait for it..."
sense = (\_ -> do
t' <- getPOSIXTime
t <- readIORef timeRef
let dt = realToFrac (t' - t) -- Time difference in seconds
writeIORef timeRef t'
return (dt, Nothing)) -- we could equally well return (dt, Just ())
actuate = (\_ x -> if x
then putStrLn "World!" >> return x
else return x)
reactimate init sense actuate sf
Note that as soon as x
in the definition of actuate
becomes True
(that is after 2 seconds), actuate
returns True
, hence reactimate returns ()
and the program stops. If we change the definition of actuate
to always return False
the line "World!" will be print out indefinitely.
Precision Issues
In the above example, we used the Data.Time.Clock
module to measure time differences. One might be concerned about leap seconds and try to fall back to System.CPUTime
. However, the precision of System.CPUTime
is reduced by a factor of 106 compared to Data.Time.Clock
(1ms vs. 1ps). This precision is usually not sufficient even for simple real time applications (like the game Pong) because the integral
and derivative
signal functions provided by Yampa behave unpredictably. This can result in programs being highly system dependent, e.g. the ball in Pong moving significantly faster on faster hardware. In contrast to this, leap seconds are usually of no concern.