]> Git — Sourcephile - tmp/julm/arpeggigon.git/blob - src/RMCA/YampaReactive.hs
Edit change log.
[tmp/julm/arpeggigon.git] / src / RMCA / YampaReactive.hs
1 {-# LANGUAGE FlexibleContexts, MultiParamTypeClasses #-}
2
3 module RMCA.YampaReactive where
4
5 import Data.ReactiveValue
6 import FRP.Yampa
7 import Hails.Yampa
8 import RMCA.IOClockworks
9
10 yampaReactiveFrom :: (ReactiveValueRead c a IO) => SF a b -> c
11 -> IO (ReactiveFieldRead IO b)
12 yampaReactiveFrom sf rv = do
13 init <- reactiveValueRead rv
14 (input,output) <- yampaReactiveDual init sf
15 rv =:> input
16 return output
17
18 yampaReactiveWithMetronome :: (ReactiveValueRead c a IO) =>
19 SF a b -> c -> DTime
20 -> IO (ReactiveFieldRead IO b)
21 yampaReactiveWithMetronome sf rv dt = do
22 clock <- mkClock dt
23 init <- reactiveValueRead rv
24 (input,output) <- yampaReactiveDual init sf
25 rv =:> input
26 reactiveValueOnCanRead clock $
27 reactiveValueRead rv >>= reactiveValueWrite input
28 return output
29
30 yampaReactiveWithTick :: (ReactiveValueRead c a IO) =>
31 a -> SF a b -> c -> IOTick
32 -> IO (ReactiveFieldRead IO b)
33 yampaReactiveWithTick init sf rv tick = do
34 (input,output) <- yampaReactiveDual init sf
35 rv =:> input
36 reactiveValueOnCanRead tick $
37 reactiveValueRead rv >>= reactiveValueWrite input
38 return output