/
SinWaveI.hs
40 lines (33 loc) · 1.2 KB
/
SinWaveI.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
import FRP.Reactive
import FRP.Reactive.LegacyAdapters
import Control.Applicative
import System.IO
import Control.Concurrent
import Control.Monad
import Data.Monoid
import Data.List
sinB :: Behavior Double
sinB = sin <$> time
type Scale = Double
draw :: Behavior Double -> Scale -> Behavior String
draw d s = replicate <$> (truncate <$> scaled) <*> pure '#'
where scaled = pure s * (d + 1)
sinWave :: Event () -> Behavior Double
sinWave ev = sinB `switcher` (next <$ once ev)
where next = 0 `switcher` (next' <$ once (restE ev))
next' = 1 `switcher` (loop <$ once (restE (restE ev)))
loop = sinWave $ restE $ restE $ restE ev
sinWave' :: Event () -> Behavior Double
sinWave' = cycleB [ sinB, 0, 1 ]
cycleB :: [Behavior a] -> Event e -> Behavior a
cycleB bs ev = loop ev bs
where loop e [] = cycleB bs e
loop e (b:bs') = b `switcher` (loop (restE e) bs' <$ once e)
main :: IO ()
main = do
hSetBuffering stdin NoBuffering
hSetBuffering stdout NoBuffering
hSetEcho stdin False
(sink, event) <- makeEvent =<< makeClock
forkIO $ forever $ getChar >> sink () >> putStrLn "A key is pressed"
adaptE $ putStrLn <$> draw (sinWave' event) 30 `snapshot_` atTimes [0, 0.2 ..]