Пример интерактивного приложения

В этой главе описывается написание простого приложения с графическим интерфейсом, отзывающимся на нажатие кнопки мыши.

Управление пакетами

При написании любого сколько-нибудь сложного приложения приходится пользоваться функциональностью, не встроенной в стандартную поставку используемого языка программирования. В таких случаях говорят об использовании «внешних библиотек функций». В языке Haskell такие библиотеки называются пакетами. Каждый пакет состоит из одного или нескольких модулей. Модуль приблизительно соответствует одному .hs-файлу (вспомните, что любой такой файл начинается с объявления модуля).

Все широкоиспользуемые пакеты хранятся в центральном репозитории Hackage. Для установки и сборки пакетов используется утилита Cabal Install (по каким-то причинам исполняемый файл называется cabal или cabal.exe). Последнее время получил распространение аналог Cabal Install под названием Haskell Stack, обладающий отдельным центральным репозиторием, в котором хранятся наборы пакетов совместимых между собой версий. Тем не менее, нам пока будет достаточно базовой функциональности, предоставляемой Cabal Install.

Работа с Cabal Install осуществляется в командной строке интерпретатора команд операционной системы. Будем по-умолчанию считать, что используется POSIX-совместимая ОС и интерпретатор bash.

Создание проекта

Запустите интерпретатор команд ОС, создайте новый каталог, войдите в него и для инициализации проекта выполните команду

cabal init

Эта команда после краткого опроса (все ответы по-умолчанию, тип пакета – Executable) создаст в текущем каталоге файл foobar.cabal где вместо foobar будет название проекта. В этом файле содержатся всевозможные параметры пакета. Нас сейчас интересует параметр build-depends, в котором перечисляются зависимости – сторонние пакеты, функциональность которых потребуется для реализации наших целей. Изначально зависимость одна: стандартная библиотека base.

Допишите в этой параметр (через запятую) следующие пакеты: sdl2, JuicyPixels, mtl, bytestring, text. Полную документацию к этим пакетам можно найти в Hackage. Тем не менее, кратко опишем их назначение:

Пакет sdl2 содержит программный интерфейс к кроссплатформенной библиотеке SDL2 для работы с мультимедиа (видео, аудио, устройства ввода). Убедитесь перед установкой пакета sdl2, что в операционной системе установлена версия библиотеки для разработки.
Пакет JuicyPixels позволяет работать с разнообразными форматами графических файлов.
Пакет mtl предоставляет несколько полезных конструкторов типов данных (нам нужен будет конструктор State из модуля Control.Monad.State.Strict).
Пакет bytestring предоставляет тип ByteString, используемый для хранения неструктурированных данных в виде массива байт.
Пакет text предоставляет тип Text, используемый для хранения текстовых данных. В отличие от объектов типа String, представляющих собой последовательности символов, объекты типа Text не предоставляют прямого доступа к их внутренней структуре. В большинстве ситуаций использование объектов типа Text существенно более эффективно по вычислительным ресурсам, чем использование объектов типа String, поэтому почти все сторонние библиотеки используют Text вместо String. Расширение языка OverloadedStrings позволяет использовать текстовые литералы как объекты типа Text (и прочих типов, принадлежащих классу IsString).

После того, как вы добавите эти зависимости в файл с настройками проекта, нужно будет эти зависимости установить. Если вы используете Haskell Stack, нужно сначала выполнить команду stack init, которая инициализирует Haskell Stack для проекта в текущем каталоге (вместо двухступенчатой инициализации проекта можно просто воспользоваться командой stack new название_пакета simple, которая сама создаст каталог для проекта и .cabal-файл с настройками). После этого проект можно собрать командой stack build, а запустить – командой stack exec название_пакета. В случае, если Stack жалуется на отсутствие подходящего компилятора, его можно установить командой stack setup.

Если же используется Cabal Install, придётся повозиться чуть дольше. Сначала нужно выполнить команду

cabal sandbox init

Эта команда создаст в текущем каталоге локальный репозиторий пакетов, который будет использоваться только для сборки проекта, находящегося в этом каталоге. Использование локальных репозиториев уменьшает вероятность того, что проект не соберётся по причине конфликта его зависимостей с зависимостями других проектов.

Затем нужно обновить список пакетов командой cabal update и установить все зависимости проекта командой

cabal install --only-dependencies

После того, как зависимости скачаются и соберутся, можно собрать проект командой cabal build и запустить командой cabal run.

Если по какой-то причине зависимости не собрались, нужно удалить каталог .cabal,
находящийся в домашнем каталоге пользователя и повторить cabal update и cabal install --only-dependencies.

Инструкция для Windows-систем

Со стандартной поставкой Haskell Platform (а точнее, с Cabal Install) возникают некоторые проблемы, связанные с установкой пакета sdl2: под Windows не предусмотрено централизованного хранилища динамических библиотек, а настройка локального хранилища для Haskell Platform – это не слишком простая и довольно муторная задача.

В настоящее время в большинстве ситуаций рекомендуется использовать Stack вместо Haskell Platform/Cabal Install. Перед установкой Stack нужно удалить полностью Haskell Platform. После установки со Stack можно общаться из командной строки (cmd.exe).

Компилятор GHC можно установить командой stack setup. После установки можно запустить интерпретатор командой stack exec -- ghci или просто stack ghci.

Для того, чтобы установка sdl2 прошла без происшествий, нужно выполнить два действия:

Обновление менеджера пакетов встроенного эмулятора POSIX-окружения: 
stack exec -- pacman -Syu

Установка библиотеки SDL2 и программы pkg-config в POSIX-окружение: 
stack exec -- pacman -S mingw-w64-x86_64-pkg-config mingw-w64-x86_64-SDL2

Для 32-битных систем вместо предыдущей команды нужно выполнить
stack exec -- pacman -S mingw-w64-i686-pkg-config mingw-w64-i686-SDL2

Далее следует действовать так, как описано в подразделе «Создание проекта», создав проект при помощи команды stack new название_проекта simple. Альтернативно можно установить cabal-install при помощи команды

stack install cabal-install

и создать проект при помощи команды

stack exec --no-ghc-package-path -- cabal init

В настоящий момент (весна 2017) есть проблема с версией пакета sdl2, входящей в состав снимков lts-8.X. Её можно решить одним из двух способов:

Использовать снимки 7-й версии. Например, lts-7.20. Версия снимка указывается в файле stack.yaml. Поскольку снимки 7-й версии используют другую версию компилятора, придётся ещё раз сделать stack setup.
Распаковать куда-нибудь пакет sdl2 версии 2.2.0, дописать в файл sdl2.cabal строчку cpp-options: -D_SDL_main_h, после чего указать путь к этому пакету в разделе packages файла stack.yaml.

Пустое окно

Следующая программа создаёт пустое окно, реагирующее только на нажатие крестика в углу:

{-# LANGUAGE OverloadedStrings #-}

import qualified SDL
-- Эта директива позволяет пользоваться переменными, определёнными в модуле SDL.
-- Переменная вида foobar доступна под названием SDL.foobar (если хочется импортировать названия 
-- без приписки "SDL." спереди, нужно опустить модификатор qualified).



-- Все интерактивные приложения явно или неявно используют цикл обработки событий.
mainLoop = do 
    event <- SDL.waitEvent  -- действие waitEvent ожидает очередное событие
    
    case SDL.eventPayload event of
        -- событие QuitEvent происходит тогда, когда пользователь пытается закрыть окно приложения
        SDL.QuitEvent -> pure () 
        
        -- на остальные события не реагируем 
        _             -> mainLoop


main = do
    SDL.initialize [SDL.InitVideo]
    
    SDL.createWindow "Пустое окно" SDL.defaultWindow
    
    mainLoop

Чёрное окно

Следующая итерация нашего приложения выглядит так:

{-# LANGUAGE OverloadedStrings #-}

import qualified SDL


mainLoop rnd = do 
    SDL.clear   rnd
    SDL.present rnd

    event <- SDL.waitEvent  -- действие waitEvent ожидает очередное событие
    
    case SDL.eventPayload event of
        SDL.QuitEvent -> pure () 
        _             -> mainLoop rnd


main = do
    SDL.initialize [SDL.InitVideo]
    
    wnd <- SDL.createWindow "Чёрное окно" SDL.defaultWindow
    rnd <- SDL.createRenderer wnd (-1) SDL.defaultRenderer
    
    mainLoop rnd

Здесь произошло три изменения. Первое: в рамках действия main было исполнено действие createRenderer, создающее визуализатор (по-английски Renderer). Под этим термином в SDL2 понимается некая сущность, хранящая общее для всех команд рисования состояние. Второе: цикл mainLoop получил на вход созданный визуализатор. Третье: в начале цикла выполняется действие clear, очищающее окно, а также – действие present, обновляющее содержимое окна.

Действие present необходимо по той причине, что рисовать сразу на окно не принято: если в момент смены кадра на мониторе изображение оказалось нарисовано лишь частично, пользователь увидит не то, что он хотел увидеть. Поэтому рисование осуществляется на задний буффер. А present всего лишь переносит текущее содержимое заднего буффера на окно. Вероятность того, что обновление экрана случится в процессе переноса заднего буффера, существенно меньше, чем вероятность обновления экрана посереди процесса рисования. Для полного обнуления этой вероятности используется технология, называемая вертикальной синхронизацией.

Загрузка изображения из файла

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

-- все директивы import должны находиться сверху программы, перед определением функций и типов данных

import qualified Codec.Picture   as P   
-- все названия из модуля Codec.Picture пакета JuicyPixels доступны с префиксом "P."

import qualified Data.ByteString as BS  
-- все названия из модуля Data.ByteString пакета bytestring доступны с префиксом "BS."

import Control.Monad.State.Strict
-- все названия из модуля Control.Monad.State.Strict пакета mtl доступны в неизменном виде


-- функция, загружающая изображение из указанного файла
loadTexture :: SDL.Renderer -> FilePath -> IO SDL.Texture
loadTexture rnd path = do
    eImage <- P.readImage path
    case eImage of 
        Left  e -> error e
        Right i -> process $ P.convertRGBA8 i
  where
    process image = do
        let width  = fromIntegral $ P.imageWidth  image
            height = fromIntegral $ P.imageHeight image
        texture <- SDL.createTexture rnd SDL.RGBA8888 SDL.TextureAccessStatic (SDL.V2 width height)
        SDL.updateTexture texture Nothing (toBS image) (width*4)
    
    toBS image = 
        let 
          generator = flip execState id $
              flip P.imagePixels image $ \p@(P.PixelRGBA8 r g b a) -> do
                  modify (\gen x -> gen $ [a,b,g,r] ++ x)
                  pure p
        in BS.pack $ generator []

Эта функция требует большого количества пояснений. Начнём с её типа:

loadTexture :: SDL.Renderer -> FilePath -> IO SDL.Texture

С типом Renderer мы уже знакомы – это тип визуализатора. Тип FilePath – синоним для String. Тип Texture – основной тип изображений в библиотеке SDL2.

Основная часть функции – получение изображения из файла при помощи действия readImage и преобразования его в формат, требуемый библиотекой SDL2.

Преобразование осуществляется при помощи вспомогательной функции process, которая создаёт объект типа Texture при помощи действия createTexture, а затем заполняет созданное изображение при помощи функции updateTexture пикселями, считанными из файла. Здесь можно увидеть пример применения функции fromIntegral, которая осуществляется для перехода от произвольного целочисленного типа к произвольному числоподобному типу.

Пиксели updateTexture получает из последних двух своих входов: первый из них – массив байт типа ByteString; второй – ширина одной строчки изображения в байтах. Чтобы получить от JuicyPixels массив типа ByteString, используется вспомогательная функция toBS. К сожалению, библиотека JuicyPixels предоставляет только одно средство для массовой обработки пикселей – функцию imagePixels, которая была бы семантически эквивалентна выражению

\f -> (fromList <$>) . sequence . (f <$>) . toList

если бы были определены преобразования toList и fromList из изображения в последовательность его пикселей и обратно. С комбинатором <$> Вы знакомы, а комбинатор sequence определён так:

sequence [] = pure []
sequence (a:as) = do
    x  <- a
    xs <- sequence as
    pure $ x : xs

Конструктор типа State

Для того, чтобы сохранить все пиксели изображения при помощи imagePixels, нам пригодится конструктор типа State, определённый примерно следующим образом:

-- не настоящее определение

type State s a = s -> (a, s)

pure :: a -> State s a
pure x = \state -> (x,state)


(>>=) :: State s a -> (a -> State s b) -> State s b
action >>= generator = \state0 ->
    case action state0 of
        (value,state1) -> generator value state1
        
        
execState :: State s a -> s -> s
execState a state0 = case a state0 of
    (_,state1) -> state1
    
modify :: (s -> s) -> State s ()
modify f = \state -> ((), f state)

На самом деле, с этим конструктором Вы уже знакомы: конструктор IO семантически эквивалентен State RealWorld (разве что для IO отсутствуют execState и modify). Вариант State из модуля Control.Monad.State.Strict существенно отличается от приведённого определения лишь тем, что перед передачей величины типа s в функцию s -> (a,s) эта величина нормализуется.

В свете этого определения должен проясниться и принцип работы преобразователя изображения в последовательность пикселей:

generator = flip execState id $
    flip P.imagePixels image $ \p@(P.PixelRGBA8 r g b a) -> do
        modify (\gen x -> gen $ [a,b,g,r] ++ x)
        pure p

Состоянием для действия

do
    modify (\gen x -> gen $ [a,b,g,r] ++ x)
    pure p

является функция типа [Word8] -> [Word8], которая приделывает к произвольному списку список из цветов встреченных к данному моменту пикселей изображения (вспомните про изоморфизм между списками и операциями по приделыванию этих списков к произвольному). Построенная в результате execState операция применяется к пустому списку: generator [].

Неэффективным, но более понятным аналогом generator [] является следующий вариант преобразования:

flip execState [] $
flip P.imagePixels image $ \p@(P.PixelRGBA8 r g b a) -> do
    modify (\colors -> colors ++ [a,b,g,r])
    pure p

Также можно воспользоваться следующим вариантом, эффективным, но более сложным для восприятия:

concat $ reverse $
flip execState [] $
flip P.imagePixels image $ \p@(P.PixelRGBA8 r g b a) -> do
    modify (\pixels -> [a,b,g,r]:pixels)
    pure p

Подробнее о конструкторах типов можно прочитать в соответствующей главе.

Реакция на нажатие кнопки мыши

Нарисуйте в любимом графическом редакторе две картинки и сохраните их под названиями picture1.png и picture2.png в папке с проектом. Теперь эти картинки можно загрузить при помощи следующего кода:

main = do
    SDL.initialize [SDL.InitVideo]
    
    wnd <- SDL.createWindow "Чёрное окно" SDL.defaultWindow
    rnd <- SDL.createRenderer wnd (-1) SDL.defaultRenderer
    
    [t1,t2] <- sequence $ loadTexture rnd <$> ["picture1.png", "picture2.png"] -- новая строчка
    
    mainLoop rnd t1 t2

Модифицируем теперь mainLoop следующим образом:

mainLoop rnd tex1 tex2 = do 
    SDL.clear   rnd
    SDL.copy    rnd tex1 Nothing Nothing -- рисование всей картинки на всё окно
    SDL.present rnd

    event <- SDL.waitEvent
    
    case SDL.eventPayload event of
        SDL.QuitEvent -> pure () 
        
        SDL.MouseButtonEvent e ->
            let motion = SDL.mouseButtonEventMotion e
                button = SDL.mouseButtonEventButton e
            in uncurry (mainLoop rnd) $ case motion of
                SDL.Pressed
                  | button == SDL.ButtonLeft -> (tex2,tex1)
                  | True                     -> (tex1,tex2)
                SDL.Released                 -> (tex1,tex2)
        
        _ -> mainLoop rnd tex1 tex2

Нажатие левой кнопки мыши в пределах окна будет приводить к смене изображения. В завершение этой главы упростим логику mainLoop, разбив её на две части – получение события и его обработка. Для этого введём тип

data Command = Nop | Quit | Swap

и модифицируем mainLoop:

mainLoop rnd tex1 tex2 = do 
    SDL.clear   rnd
    SDL.copy    rnd tex1 Nothing Nothing -- рисование всей картинки на всё окно
    SDL.present rnd

    event <- SDL.waitEvent
    
    let command = case SDL.eventPayload event of
            SDL.QuitEvent -> Quit
            
            SDL.MouseButtonEvent e ->
                let motion = SDL.mouseButtonEventMotion e
                    button = SDL.mouseButtonEventButton e
                in case motion of
                    SDL.Pressed
                      | button == SDL.ButtonLeft -> Swap
                      | True                     -> Nop
                    SDL.Released                 -> Nop
            
            _ -> Nop
        
    case command of
        Quit -> pure ()
        Swap -> mainLoop rnd tex2 tex1
        Nop  -> mainLoop rnd tex1 tex2

Разделение на компоненты

Если внимательно присмотреться к mainLoop, можно заметить в нём три блока: рисование картинки, получение события и его обработку. Эти части независимы друг от друга, поэтому их полезно явно разделить.

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

Модель заключает в себя всю «бизнес-логику» приложения. Модель по сути решает ту задачу, ради которой приложение и написано.
Вид преобразует модель в некоторое представление, понятное пользователю приложения. Например, для интерактивных графических приложений вид отвечает за отображение графического интерфейса. Также вид может (но не обязан) заниматься получением ввода от пользователя.
Контроллер получает входные данные (от вида или же непосредственно от пользователя) и на их основании даёт команды модели и виду.

Шаблон MVC основывается на классической объектно-ориентированной парадигме программирования, согласно которой приложение состоит из независимых компонент, каждая из которых умеет отправлять сообщения другим компонентам и реагировать на полученные сообщения. В функциональном же программировании используются разнообразные упрощения объектно-ориентированного MVC.

Мы остановимся на разновидности MVU (Model, View, Update). Она устроена так:

type Input  = ...  -- тип входных данных
type Output = ...  -- тип выходных данных
type Model  = ...  -- модель описывает данные, с которыми работает приложение  
type View   = Model -> Output  -- вид описывает выходное представление этих данных 
type Update = Input -> Model -> Model  -- контроллер по входному сигналу обновляет модель

В нашем случае

type Input  = Event
type Output = IO ()
type Model  = (Texture, Texture)

Перед тем, как преобразовать наше приложение к этой модели, заметим, что оно использует промеждуточный тип входных сигналов Command. Таким образом, обновление модели состоит из двух преобразований: Event -> Command и Command -> Model -> Model. Первое из них традиционно называется адаптером.

Теперь, наконец, итоговый вид приложения:

{-# LANGUAGE OverloadedStrings #-}

import SDL

-----------------------------------
-- пропущена часть с loadTexture --
-----------------------------------


data Model = Model Texture Texture

view :: Renderer -> Model -> IO ()
view rnd (Model t1 t2) = do
    clear   rnd
    copy    rnd t1 Nothing Nothing
    present rnd


data Command = Nop | Quit | Swap

adapter :: Event -> Command
adapter event = case eventPayload event of
  QuitEvent -> Quit
  
  MouseButtonEvent e ->
      let motion = mouseButtonEventMotion e
          button = mouseButtonEventButton e
      in case motion of
          Pressed
            | button == ButtonLeft -> Swap
            | True                 -> Nop
          Released                 -> Nop
  
  _ -> Nop
  

update :: Command -> Model -> Model
update Nop  (Model t1 t2) = Model t1 t2
update Quit (Model t1 t2) = Model t1 t2
update Swap (Model t1 t2) = Model t2 t1



mainLoop :: Renderer -> Model -> IO ()
mainLoop rnd model = do 
    view rnd model
    
    event <- waitEvent
    
    let command  = adapter event
        newModel = update command model
    
    case command of
        Quit -> pure ()
        _    -> mainLoop rnd newModel


main = do
    initialize [InitVideo]
    
    wnd <- createWindow "Нечёрное окно" defaultWindow
    rnd <- createRenderer wnd (-1) defaultRenderer
    
    t1 <- loadTexture rnd "pic1.png"
    t2 <- loadTexture rnd "pic2.png"
    
    mainLoop rnd $ Model t1 t2