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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
|
{-----------------------------------------------------------------------------
reactive-banana
Example: Slot machine
------------------------------------------------------------------------------}
{-# LANGUAGE ScopedTypeVariables #-}
-- allows pattern signatures like
-- do
-- (b :: Behavior Int) <- stepper 0 ...
{-# LANGUAGE RecursiveDo #-}
-- allows recursive do notation
-- mdo
-- ...
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 as R
import Reactive.Banana.Frameworks as R
main :: IO ()
main = do
displayHelpMessage
sources <- makeSources
network <- compile $ networkDescription sources
actuate network
eventLoop sources
displayHelpMessage :: IO ()
displayHelpMessage = mapM_ putStrLn $
"-----------------------------":
"- THE REACTIVE SLOT MACHINE -":
"------ WIN A BANANA ---------":
"":
"Commands are:":
" coin - insert a coin":
" play - play one game":
" quit - quit the program":
"":
[]
-- Create event sources corresponding to coin and play
makeSources = (,) <$> newAddHandler <*> newAddHandler
-- Read commands and fire corresponding events
eventLoop :: (EventSource (), EventSource ()) -> IO ()
eventLoop (escoin,esplay) = loop
where
loop = do
putStr "> "
hFlush stdout
s <- getLine
case s of
"coin" -> fire escoin () -- fire corresponding events
"play" -> fire esplay ()
"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
------------------------------------------------------------------------------}
type Money = Int
-- State of the reels, consisting of three numbers from 1-4. Example: "222"
type Reels = (Int,Int,Int)
-- A win consist of either double or triple numbers
data Win = Double | Triple
-- Program logic in terms of events and behaviors.
networkDescription :: (EventSource (), EventSource ()) -> MomentIO ()
networkDescription (escoin,esplay) = mdo
-- initial random number generator
initialStdGen <- liftIO $ newStdGen
-- Obtain events corresponding to the coin and play commands
ecoin <- fromAddHandler (addHandler escoin)
eplay <- fromAddHandler (addHandler esplay)
-- The state of the slot machine is captured in Behaviors.
-- State: credits that the player has to play the game
-- The ecoin event adds a coin to the credits
-- The edoesplay event removes money
-- The ewin event adds credits because the player has won
(ecredits :: Event Money, bcredits :: Behavior Money)
<- mapAccum 0 . fmap (\f x -> (f x,f x)) $ unions $
[ addCredit <$ ecoin
, removeCredit <$ edoesplay
, addWin <$> ewin
]
let
-- functions that change the accumulated state
addCredit = (+1)
removeCredit = subtract 1
addWin Double = (+5)
addWin Triple = (+20)
-- Event: does the player have enough money to play the game?
emayplay :: Event Bool
emayplay = (\credits _ -> credits > 0) <$> bcredits <@> eplay
-- Event: player has enough coins and plays
edoesplay :: Event ()
edoesplay = () <$ filterE id emayplay
-- Event: event that fires when the player doesn't have enough money
edenied :: Event ()
edenied = () <$ filterE not emayplay
-- State: random number generator
(eroll :: Event Reels, bstdgen :: Behavior StdGen)
-- accumulate the random number generator while rolling the reels
<- mapAccum initialStdGen $ roll <$> edoesplay
let
-- roll the reels
roll :: () -> StdGen -> (Reels, StdGen)
roll () gen0 = ((z1,z2,z3),gen3)
where
random = randomR(1,4)
(z1,gen1) = random gen0
(z2,gen2) = random gen1
(z3,gen3) = random gen2
-- Event: it's a win!
ewin :: Event Win
ewin = fmap fromJust $ filterE isJust $ fmap checkWin eroll
checkWin (z1,z2,z3)
| length (nub [z1,z2,z3]) == 1 = Just Triple
| length (nub [z1,z2,z3]) == 2 = Just Double
| otherwise = Nothing
-- ecredits <- changes bcredits
reactimate $ putStrLn . showCredit <$> ecredits
reactimate $ putStrLn . showRoll <$> eroll
reactimate $ putStrLn . showWin <$> ewin
reactimate $ putStrLn "Not enough credits!" <$ edenied
showCredit money = "Credits: " ++ show money
showRoll (z1,z2,z3) = "You rolled " ++ show z1 ++ show z2 ++ show z3
showWin Double = "Wow, a double!"
showWin Triple = "Wowwowow! A triple! So awesome!"
|
