Reactive programming

    As you know, a functional approach to programming has its own specifics: in it we convert data, not change it. But this imposes its limitations, for example, when creating programs that actively interact with the user. In an imperative language, it is much easier to implement this behavior, because we can respond to any events “in real time”, while in pure functional languages ​​we have to postpone communication with the system until the very end. However, a new programming paradigm has begun to develop relatively recently that solves this problem. And her name is Functional Reactive Programming (FRP). In this article, I will try to show the basics of FRP by writing a snake in Haskell using the reactive-banana library.

    The rest of this article assumes that the reader is familiar with functors. If this is not the case, I highly recommend that you familiarize yourself with them, since the understanding of the entire article depends on it.

    Main ideas


    Two new data types appear in FRP: Event and Behavior . Both of these types are functors, and many actions on them will be performed by combinators of functors. We describe these types.

    Event

    Event is a stream of events that have an accurate time stamp. It can be imagined as (just imagine, because in reality everything is not so simple):
    type Event a = [(Time, a)]
    For example, an Event String can be a stream of events about incoming users in a chat.
    As already mentioned, Event belongs to the class of functors, which means we can perform some actions with it.
    For instance:
    ("Wellcome, " ++) <$> eusers
    will create a stream of greetings from users who have entered the chat.

    Behavior

    Behavior means a value that changes over time.
    type Behavior a = Time -> a
    This type is well suited for game objects, the snake in our game will be Behavior.
    We can combine Behavior and Event with the apply function:
    apply :: Behavior t (a -> b) -> Event t a -> Event t b
    apply bf ex = [(time, bf time x) | (time, x) <- ex]
    As you can see from this definition, apply applies the function inside Behavior to Events, taking into account the time.

    We proceed directly to the snake.

    Game mechanics


    For now, forget about reactive programming and take up the mechanics of the game. For starters, the types:
    module Snake where
    type Segment = (Int, Int)
    type Pos = (Int, Int)
    type Snake = [Segment]
    One segment of a snake is a pair of coordinates, and the snake itself is a chain of these segments. Type Pos is for convenience only.

    startingSnake :: Snake
    startingSnake = [(10, 0), (11, 0), (12, 0)]
    wdth = 64
    hdth = 48
    Create the initial position of the snake and constant for the size of the playing field.

    moveTo :: Pos -> Snake -> Snake
    moveTo h s = if h /= head s then h : init s else s
    keepMoving :: Snake -> Snake
    keepMoving s = let (x, y) = head s
                       (x', y') = s !! 1
                   in moveTo (2*x - x', 2*y - y') s
    ifDied :: Snake -> Bool
    ifDied s@((x, y):_) = x<0 || x>=wdth || y<0 || y>=hdth || head s `elem` tail s
    The moveTo function moves the snake to the specified location, keepMoving continues to move, and ifDied checks to see if the snake died from self-eating or collision with borders.
    This is where the mechanics end; now the most difficult part lies ahead - the logic of behavior.

    Logics


    We will connect the necessary modules and describe some constants:
    {-# LANGUAGE ScopedTypeVariables #-}
    import Control.Monad (when)
    import System.IO
    import System.Random
    import Graphics.UI.SDL as S hiding (flip)
    import Graphics.Rendering.OpenGL hiding (Rect, get)
    import Reactive.Banana as R
    import Data.Word (Word32)
    import Snake
    screenWidth = wdth*10
    screenHeight = hdth*10
    screenBpp = 32
    ticks = 1000 `div` 20
    screenWidth, screenHeight - width and height of the screen, respectively, ticks - the number of milliseconds by which the frame will linger on the screen.

    Now let's decide on the inputs. From the outside world, only two events will come to us: a key press and a clock signal. So we need only two “slots” for events and they are created by the newAddHandler function:
    main :: IO ()
    main = withInit [InitEverything] $ do
        initScreen
        sources <- (,) <$> newAddHandler <*> newAddHandler
        network <- compile $ setupNetwork sources
        actuate network
        eventLoop sources network
    In setupNetwork, a “network” of Event and Behavior will be built, compile will compile NetworkDescription into EventNetwork, and actuate will launch it. Events will be sent to the network from the eventLoop function, like signals to the brain from receptors.

    eventLoop :: (EventSource SDLKey, EventSource Word32) -> EventNetwork -> IO ()
    eventLoop (essdl, estick) network = loop 0 Nothing
        where
        loop lt k = do
            s <- pollEvent
            t <- getTicks
            case s of
                 (KeyDown (Keysym key _ _)) -> loop t (Just key)
                 NoEvent -> do maybe (return ()) (fire essdl) k
                               fire estick t
                               loop t Nothing
                 _ -> when (s /= Quit) (loop t k)
    This is the “receptor” of our program. fire essdl - fires the essdl event containing the name of the key, if any was pressed. estick starts regardless of user behavior and carries the time from the start of the program.

    Here, by the way, is the transition from an EventSource that returns newAddHandler to AddHandler:
    type EventSource a = (AddHandler a, a -> IO ())
    addHandler :: EventSource a -> AddHandler a
    addHandler = fst
    fire :: EventSource a -> a -> IO ()
    fire = snd

    Now let's start the most crucial part: a description of the network of events.

    setupNetwork :: forall t. (EventSource SDLKey, EventSource Word32) -> NetworkDescription t ()
    setupNetwork (essdl, estick) = do
        -- Keypress and tick events
        esdl <- fromAddHandler (addHandler essdl)
        etick <- fromAddHandler (addHandler estick)
    First we get Events from those timer and keyboard events that we fired in eventLoop.

    let ekey = filterE (flip elem [SDLK_DOWN, SDLK_UP, SDLK_LEFT, SDLK_RIGHT]) esdl
            moveSnake :: SDLKey -> Snake -> Snake
            moveSnake k s = case k of
                                 SDLK_UP -> moveTo (x, y-1) s
                                 SDLK_DOWN -> moveTo (x, y+1) s
                                 SDLK_LEFT -> moveTo (x-1, y) s
                                 SDLK_RIGHT -> moveTo (x+1, y) s
                          where (x, y) = head s
    Now let's create an event that means pressing the arrow - we do not need other keys. As you probably already guessed, filterE filters out events that do not satisfy the predicate. moveSnake simply moves the snake based on the key pressed.

    brandom <- fromPoll randomFruits
        -- Snake
        let bsnake :: Behavior t Snake
            bsnake = accumB startingSnake $ 
                (const startingSnake <$ edie) `union`
                (moveSnake <$> ekey) `union` 
                (keepMoving <$ etick) `union` ((\s -> s ++ [last s]) <$ egot) 
            edie = filterApply ((\s _ -> ifDied s) <$> bsnake) etick
    fromPoll implements yet another way to interact with the real world, but it is different from what we used before. First, we get Behavior, not Event. And secondly, the action in fromPoll should not be costly. For example, it is good to use fromPoll coupled with variables.
    Further, we describe the snake using accumB (note that the type of snake is not just Behavior Snake, but Behavior t Snake. This has its deep meaning, which we do not need to know).
    accumB "collects" Behavior from Events and initial value:
    accumB :: a -> Event t (a -> a) -> Behavior t a
    That is, roughly speaking, when an event occurs, the function inside it will be applied to the current value.
    For instance:
    accumB "x" [(time1,(++"y")),(time2,(++"z"))]
    will create a Behavior, which at time1 will hold “xy” in itself, and “xyz” in time2.
    Another function unknown to us is union. It combines events into one (if two events occurred simultaneously, union gives priority to that of the first argument).
    Now we can understand how bsnake works. First, the snake is equal to startingSnake, and then a number of changes occur with it:
    • She returns to the beginning if she died (event edie)
    • Turns when arrow is pressed.
    • Continues to move on signal
    • And grows if she ate fruit (egot event)

    The edie event is fired when the snake is dead, and this is achieved using filterApply:
    filterApply :: Behavior t (a -> Bool) -> Event t a -> Event t a
    This function discards events that do not satisfy the predicate inside Behavior. As the name suggests, this is something like filter + apply.
    Notice how often we use combinatorial functors to turn something into a function.

    Now let's move on to the fruit:
    -- Fruits
            bfruit :: Behavior t Pos
            bfruit = stepper (hdth `div` 2, wdth `div` 2) (brandom <@ egot)
            egot = filterApply ((\f s r _ -> elem f s && notElem r s) <$> bfruit <*> bsnake <*> brandom) etick
    A new fruit with coordinates in brandom appears as soon as the snake has collected the current one. The combinator <@ "transfers" the contents of one Behavior to Event, that is, in this case, the contents of the egot event will be replaced by a random coordinate from brandom. The stepper function, new to us, creates Behavior from Events and the initial value, and its only difference from accumB is that the new Behavior event will not depend on the previous one.
    The egot event is triggered on that timer signal when the snake has collected fruit and a new fruit does not enter its body.

    -- Counter
            ecount = accumE 0 $ ((+1) <$ egot) `union` ((const 0) <$ edie)
    ecount is an event of increasing points. As you might guess, accumE creates an Event, not a Behavior. The counter will be incremented by one at the egot event, and zeroed at edie.

    let edraw = apply ((,,) <$> bsnake <*> bfruit) etick
    edraw is triggered at every timer signal, and contains the current position of the snake and fruit.

    Now the matter remains for small: display the image on the screen.
    reactimate $ fmap drawScreen edraw
        reactimate $ fmap (flip setCaption [] . (++) "Snake. Points: " . show) ecount
    The reactimate function fires an IO action from an Event. drawScreen draws the screen, and setCaption changes the name of the window.
    This completes the setupNetwork, and we can only add the missing functions.
    Screen initialization:
    initScreen = do
        glSetAttribute glDoubleBuffer 1
        screen <- setVideoMode screenWidth screenHeight screenBpp [OpenGL]
        setCaption "Snake. Points: 0" []
        clearColor $= Color4 0 0 0 0
        matrixMode $= Projection
        loadIdentity
        ortho 0 (fromIntegral screenWidth) (fromIntegral screenHeight) 0 (-1) 1
        matrixMode $= Modelview 0
        loadIdentity

    Random Position Generator:
    randomFruits :: IO Pos
    randomFruits = (,) <$> (randomRIO (0, wdth-1)) <*> (randomRIO (0, hdth-1))

    Well, finally, the rendering functions:
    showSquare :: (GLfloat, GLfloat, GLfloat, GLfloat) -> Pos -> IO ()
    showSquare (r, g, b, a) (x, y) = do
        -- Move to offset
        translate $ Vector3 (fromIntegral x*10 :: GLfloat) (fromIntegral y*10) 0
        -- Start quad
        renderPrimitive Quads $ do
            -- Set color
            color $ Color4 r g b a
            -- Draw square
            vertex $ Vertex3 (0 :: GLfloat) 0 0
            vertex $ Vertex3 (10 :: GLfloat) 0 0
            vertex $ Vertex3 (10 :: GLfloat)  10 0
            vertex $ Vertex3 (0 :: GLfloat) 10 0
        loadIdentity
    showFruit :: Pos -> IO ()
    showFruit = showSquare (0, 1, 0, 1)
    showSnake :: Snake -> IO ()
    showSnake = mapM_ (showSquare (1, 1, 1, 1))
    drawScreen (s, f, t) = do
            clear [ColorBuffer]
            showSnake s
            showFruit f
            glSwapBuffers
            t' <- getTicks
            when ((t'-t) < ticks) (delay $ ticks - t' + t)

    That's all. For compilation you will need: reactive-banana, opengl, sdl. From here you can download the program source files: minus.com/mZyZpD4Hx/1f

    Conclusion


    Using an example of a small game, I tried to show the basic principles of working with FRP: representing the mechanics of a program as a network of Events and Behavior, separating input and output data. Even with such a simple program, you can see the advantages of FRP, for example, we did not have to get a type for the state of the game, as we would have done without using this paradigm. I hope that this article will help in the study of reactive programming and facilitate its understanding.

    References


    hackage.haskell.org/package/reactive-banana - reactive-banana on hackage
    github.com/HeinrichApfelmus/reactive-banana - project repository on github. There are examples.

    Also popular now: