File: ActuatePause.hs

package info (click to toggle)
haskell-reactive-banana 1.3.2.0-3
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 412 kB
  • sloc: haskell: 3,151; makefile: 2
file content (78 lines) | stat: -rw-r--r-- 2,498 bytes parent folder | download | duplicates (5)
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
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
{-----------------------------------------------------------------------------
    reactive-banana
    
    Example: Actuate and pause an event network
------------------------------------------------------------------------------}
import Control.Monad (when)
import Data.Maybe (isJust, fromJust)
import Data.List (nub)
import System.Random
import System.IO
import Debug.Trace
import Data.IORef

import Reactive.Banana
import Reactive.Banana.Frameworks


main :: IO ()
main = do
    displayHelpMessage
    sources <- (,) <$> newAddHandler <*> newAddHandler
    network <- setupNetwork sources
    actuate network
    eventLoop sources network

displayHelpMessage :: IO ()
displayHelpMessage = mapM_ putStrLn $
    "Commands are:":
    "   count   - send counter event":
    "   pause   - pause event network":
    "   actuate - actuate event network":
    "   quit    - quit the program":
    "":
    []

-- Read commands and fire corresponding events 
eventLoop :: (EventSource (),EventSource EventNetwork) -> EventNetwork -> IO ()
eventLoop (escounter, espause) network = loop
    where
    loop = do
        putStr "> "
        hFlush stdout
        s <- getLine
        case s of
            "count"   -> fire escounter ()
            "pause"   -> fire espause network
            "actuate" -> actuate network
            "quit"    -> return ()
            _         -> putStrLn $ s ++ " - unknown command"
        when (s /= "quit") loop

{-----------------------------------------------------------------------------
    Event sources
------------------------------------------------------------------------------}
-- Event Sources - allows you to register event handlers
-- Your GUI framework should provide something like this for you
type EventSource a = (AddHandler a, a -> IO ())

addHandler :: EventSource a -> AddHandler a
addHandler = fst

fire :: EventSource a -> a -> IO ()
fire = snd

{-----------------------------------------------------------------------------
    Program logic
------------------------------------------------------------------------------}
-- Set up the program logic in terms of events and behaviors.
setupNetwork :: (EventSource (),EventSource EventNetwork) -> IO EventNetwork
setupNetwork (escounter, espause) = compile $ do
    ecounter <- fromAddHandler (addHandler escounter)
    epause   <- fromAddHandler (addHandler espause  )
    
    ecount <- accumE 0 $ (+1) <$ ecounter
    
    reactimate $ fmap print ecount
    reactimate $ fmap pause epause