Llayland’s Food, Oracle, and Haskell

April 9, 2012

Trying to learn FRP 3 (a simple “game”)

Filed under: Haskell — Tags: , , — llayland @ 4:40 am

In this post I’ll implement a simple “game” where the user must move on a grid from the origin to a given position.

Let’s get the boilerplate out of the way

> import Reactive.Banana
> import Control.Monad
> import Data.Monoid
> import qualified Data.Map as Map
> import Prelude hiding (Left,Right)
> import Data.IORef   — I wish I could get rid of this

> eventLoop condRef fire = loop
>    where
>    loop = do
>       s <- getLine
>       fire s
>       cond <- readIORef condRef
>       when (cond == Playing) loop

> main = do
>   gameCondRef <- newIORef Playing
>   (addHandler,fire) <- newAddHandler
>   compile (networkDescription gameCondRef $ fromAddHandler addHandler ) >>= actuate
>   eventLoop gameCondRef fire
>   cond <- readIORef gameCondRef
>   putStrLn $ “You ” ++ show cond

The user starts at the point (1,0)
Moving onto a point on the x=y line loses
moving onto the point (6,4) wins
The commands UP,DOWN,LEFT,RIGHT move the user
The command DEF <name> <string>…  defines macros
The command UNDEF String removes a macro
macros may refer to other macros

Lets pull some types out of that desciption

> type XY = (Sum Int,Sum Int)

> data GameCondition = Won | Lost | Quit | Playing
>    deriving (Show, Eq)

> data Direction = Up | Down | Left | Right | Stay
>    deriving (Show, Enum)

> data Macro = Macro Direction
>            | Refs [String]
>    deriving Show

> type Dict = Map.Map String Macro

and the obvious functions

> xy :: Direction -> XY
> xy Up = (Sum 0,Sum 1); xy Down = (Sum 0,Sum (-1)); xy Left = (Sum (-1),Sum 0); xy Right = (Sum 1,Sum 0); xy Stay = (Sum 0, Sum 0)

> gameCond :: XY -> GameCondition
> gameCond p@(x,y) | x == y     = Lost
>                  | p == (Sum 6,Sum 4) = Won
>                  | otherwise  = Playing

> getMove :: Dict -> String -> XY
> getMove d k = case Map.lookup k d of
>                 Nothing -> xy Stay
>                 Just (Macro m) -> xy m
>                 Just (Refs rs) -> mconcat . map (getMove d) $ rs

> parseDef :: [String] -> Maybe (Dict -> Dict)
> parseDef (“def”:name:rs) = Just $ Map.insert name (Refs rs)
> parseDef _ = Nothing

> parseUndef :: [String] -> Maybe (Dict -> Dict)
> parseUndef [“undef”,name] = Just $ Map.delete name
> parseUndef _ = Nothing

We’ll need to start with a dictionary containing the basic movement commands

> initialDict = Map.fromList . map namer $ [Up .. Right]
>   where namer x = (show x, Macro x)

Finally, we are at the FRP part.

> networkDescription :: (IORef GameCondition) -> NetworkDescription (Event String) -> NetworkDescription ()
> networkDescription condRef lineEnd = do
>    lineE <- lineEnd

The filterJust function fits nicely with our parse functions to create events that only fire on a successful parse

>    let defE = filterJust $ parseDef . words <$> lineE
>        undefE = filterJust $ parseUndef . words <$> lineE

The current dictionary is just the accumulation of the updates from the successful parses

>        dictB = accumB initialDict $ defE `union` undefE

We need both a behavior for the players position and an event that fires when we update the behavior.
A combinator for this is easy to build on top of the mapAccum combinator.

>        accumEB :: a -> Event (a->a) -> (Event a, Behavior a)
>        accumEB seed e = mapAccum seed (fmap (\f -> pairAp f) e)
>           where pairAp f a = (f a, f a)
>        (positionE, positionB) = accumEB (Sum 1, Sum 0) (fmap mappend $ getMove <$> dictB <@> lineE)

now we can fire events when the player reaches a position

>        loseE = filterE (uncurry (==)) positionE
>        winE = filterE (== (Sum 6, Sum 4)) positionE
>        quitE = filterE (== “quit”) lineE

Last, we react to some of the events.

>        exitWith retval = reactimate . fmap (const $ writeIORef condRef retval)
>
>    reactimate $ fmap print positionE
>    exitWith Lost loseE
>    exitWith Won winE
>    exitWith Quit quitE

That was easier than I thought it would be. I would like to find a better way to communicate back to the event loop than IORefs.
Other than that, I like this code.

Leave a Comment »

No comments yet.

RSS feed for comments on this post. TrackBack URI

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

Create a free website or blog at WordPress.com.

%d bloggers like this: