Реактивное программирование

Как известно, функциональный подход к программированию имеет свою специфику: в нём мы преобразовываем данные, а не меняем их. Но это накладывает свои ограничения, например при создании программ активно взаимодействующих с пользователем. В императивном языке намного проще реализовать такое поведение, ведь мы можем реагировать на какие либо события «в реальном времени», в то время как в чистых функциональных языках нам придётся откладывать общение с системой до самого конца. Однако относительно недавно стала развиваться новая парадигма программирования, решающая эту проблему. И имя ей — Functional Reactive Programming (FRP). В этой статье я попытаюсь показать основы FRP на примере написания змейки на Haskell с использованием библиотеки reactive-banana.

Далее в этой статье предполагается, что читатель знаком с функторами. Если это не так, я настоятельно рекомендую ознакомиться с ними, так как от этого зависит понимание всей статьи.

Основные идеи

В FRP появляются два новых типа данных: Event и Behavior. Оба этих типа являются функторами, и многие действия над ними будут производиться комбинаторами функторов. Опишем эти типы.

Event

Event представляет собой поток событий, имеющих точную временную отметку. Его можно представить себе как (только представить, потому что в реальности всё не так просто):

type Event a = [(Time, a)]

Например, Event String может представлять собой поток событий о входящих в чат пользователях.
Как было уже сказано, Event относится к классу функторов, значит мы можем производить кое-какие действия с ним.
Например:

("Wellcome, " ++) <$> eusers

создаст поток приветствий пользователей вошедших в чат.

Behavior

Behavior обозначает значение, меняющееся со временем.

type Behavior a = Time -> a

Этот тип хорошо подходит для игровых объектов, змейка в нашей игре как раз будет Behavior.
Мы можем комбинировать Behavior и Event с помощью функции apply:

apply :: Behavior t (a -> b) -> Event t a -> Event t b
apply bf ex = [(time, bf time x) | (time, x) <- ex]

Как видно из этого определения, apply применяет функцию внутри Behavior на Event-ы, с учётом времени.

Перейдём непосредственно к змейке.

Механика игры

Пока забудем о реактивном программировании и займёмся механикой игры. Для начала типы:

module Snake where

type Segment = (Int, Int)
type Pos = (Int, Int)
type Snake = [Segment]

Один сегмент змейки — это пара координат, а сама змейка есть цепочка этих сегментов. Тип Pos нужен только для удобства.

startingSnake :: Snake
startingSnake = [(10, 0), (11, 0), (12, 0)]

wdth = 64
hdth = 48

Создадим начальную позицию змейки и константы для размеров игрового поля.

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

Функция moveTo сдвигает змейку в указанное место, keepMoving продолжает движение, а ifDied проверяет не умерла ли змейка от самоедства или столкновения с границами.
На этом механика заканчивается, теперь предстоит наиболее сложная часть — логика поведения.

Логика

Подключим необходимые модули и опишем некоторые константы:

{-# 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 — ширина и высота экрана соответственно, ticks — количество миллисекунд на которые кадр задержится на экране.

Теперь определимся с входами. Из внешнего мира к нам будут приходить только два события: нажатие клавиши и сигнал часов. Значит нам нужно только два «слота» для событий и они создаются функцией newAddHandler:

main :: IO ()
main = withInit [InitEverything] $ do
    initScreen
    sources <- (,) <$> newAddHandler <*> newAddHandler
    network <- compile $ setupNetwork sources
    actuate network
    eventLoop sources network

В setupNetwork будет строиться «сеть» из Event-ов и Behavior-ов, compile скомпилирует NetworkDescription в EventNetwork, а actuate запустит её. События будут посылаться в сеть из функции eventLoop, словно сигналы в мозг из рецепторов.

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)

Это и есть «рецептор» нашей программы. fire essdl — запускает событие essdl, содержащее в себе название клавиши, если её вообще нажали. estick запускается вне зависимости от поведения пользователя и несёт в себе время с начала запуска программы.

Вот, кстати, как происходит переход от EventSource, который возвращает newAddHandler, к AddHandler:

type EventSource a = (AddHandler a, a -> IO ())

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

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

Теперь начнём самую ответственную часть: описание сети событий.

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)

Сначала получим Event-ы из тех событий таймера и клавиатуры, которые мы запустили в 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

Теперь создадим событие, означающее нажатие стрелочки — другие клавиши нам не нужны. Как Вы наверное уже догадались, filterE отсеивает события не удовлетворяющие предикату. moveSnake просто двигает змейку в зависимости от нажатой клавиши.

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 реализовывает ещё один способ взаимодействия с реальным миром, но он отличается от того, что мы использовали до этого. Во-первых, мы получаем Behavior, а не Event. И во-вторых действие в fromPoll не должно быть затратным. Например, хорошо использовать fromPoll вкупе с переменными.
Далее, мы описываем змейку с помощью accumB (отметим, что тип змейки не просто Behavior Snake, а Behavior t Snake. Это имеет свой глубокий смысл, которой знать нам не обязательно).
accumB «собирает» Behavior из Event-ов и начального значения:

accumB :: a -> Event t (a -> a) -> Behavior t a

То есть, грубо говоря, когда какое-либо событие произойдёт, функция внутри него будет применена к текущему значению.
Например:

accumB "x" [(time1,(++"y")),(time2,(++"z"))]

создаст Behavior, который в момент времени time1 будет держать в себе «xy», а в time2 — «xyz».
Ещё одна неизвестная нам функция — union. Она объединяет события в одно (если два события произошли одновременно, union отдаёт приоритет тому, что из первого аргумента).
Теперь мы можем понять как работает bsnake. Сначала змейка равна startingSnake, а потом с ней происходит ряд изменений:

• Она возвращается в начало, если умерла (событие edie)
• Поворачивает, когда нажата стрелочка
• Продолжает двигаться по сигналу
• И растёт, если съела фрукт (событие egot)

Событие edie запускается когда змейка умерла, и достигается это использованием filterApply:

filterApply :: Behavior t (a -> Bool) -> Event t a -> Event t a

Эта функция отбрасывает события, не удовлетворяющие предикату внутри Behavior. Как следует из названия, это что-то вроде filter + apply.
Заметьте, как часто мы используем комбинаторы функторов, чтобы превратить что-либо в функцию.

Теперь перейдём к фруктам:

-- 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

Новый фрукт с координатами в brandom появляется как только змейка собрала текущий. Комбинатор <@ «переносит» содержимое одного Behavior в Event, то есть в данном случае, содержимое события egot будет заменено случайной координатой из brandom. Новая для нас функция stepper создаёт Behavior из Event-ов и начального значения, и единственное её отличие от accumB в том, что новое событие Behavior не будет зависеть от предыдущего.
Событие egot запускается в тот сигнал таймера, когда змейка собрала фрукт и новый фрукт не попадает в её тело.

-- Counter
        ecount = accumE 0 $ ((+1) <$ egot) `union` ((const 0) <$ edie)

ecount — это событие увеличения набранных очков. Как несложно догадаться, accumE создаёт Event, а не Behavior. Счётчик будет увеличен на единицу при событии egot, и обнулён при edie.

let edraw = apply ((,,) <$> bsnake <*> bfruit) etick

edraw запускается в каждый сигнал таймера, и содержит текущее положение змейки и фрукта.

Теперь дело осталось за малым: вывести изображение на экран.

reactimate $ fmap drawScreen edraw
    reactimate $ fmap (flip setCaption [] . (++) "Snake. Points: " . show) ecount

Функция reactimate запускает IO действие из Event-а. drawScreen отрисовывает экран, а setCaption меняет имя окна.
На этом setupNetwork заканчивается, и нам остаётся только дописать недостающие функции.
Инициализация экрана:

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

Генератор случайных позиций:

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

Ну, и наконец функции отрисовки:

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)

Вот и всё. Для компиляции Вам понадобится: reactive-banana, opengl, sdl. Отсюда можно скачать исходные файлы программы: minus.com/mZyZpD4Hx/1f

Заключение

На примере небольшой игры я попытался показать основные принципы работы с FRP: представление механики программы как сеть из Event-ов и Behavior-ов, разделение входных и выходных данных. Даже на такой простой программе можно увидеть преимущества FRP, например, нам не пришлось заводить тип для состояния игры, как мы бы сделали без использования этой парадигмы. Надеюсь, что эта статья поможет в изучении реактивного программирования и облегчит его понимание.

Ссылки

hackage.haskell.org/package/reactive-banana — reactive-banana на hackage
github.com/HeinrichApfelmus/reactive-banana — репозиторий проекта на github. Имеются примеры.

Автор: savask