Начальное положение
В этой главе мы потренируемся в укрощении императивного кода. В Haskell все побочные эффекты огорожены от чистых функций бетонной стеной IO. Однажды оступившись, мы не можем свернуть с пути побочных эффектов, мы вынуждены тащить на себе груз IO до самого конца программы. Тип IO, хоть и обволакивает программу, всё же позволяет пользоваться благами чистых вычислений. От программиста зависит насколько сильна будет хватка IO. Необходимо уметь выделять точки, в которых применение побочных вычислений действительно необходимо, подключая в них чистые функции через методы классов Functor, Applicative и Monad. Тип IO похож на дорогу с контрольными пунктами, в которых необходимо отчитаться перед компилятором за “грязный код”. При неумелом проектировании написание программ, насыщенных побочными эффектами, может превратится в пытку. Контрольные пункты будут встречаться в каждой функции.
Естественный источник побочных эффектов – это пользователь программы. Но, к сожалению, это не единственный источник. Haskell – открытый язык программирования. В нём можно пользоваться программами из низкоуровневого языка C. Основное преимущество С заключается в непревзойдённой скорости программ. Этот язык позволяет программисту работать с памятью компьютера напрямую. Но за эту силу приходится платить. Возможны очень неприятные и трудноуловимые ошибки. Утечки памяти, обращение по неверному адресу в памяти, неожиданное обновление переменных. Ещё один плюс С в том, что это язык с историей, на нём написано много хороших библиотек. Некоторые из них встроены в Haskell с помощью специального механизма FFI (foreign function interface). Обсуждение того, как устроен FFI выходит за рамки этой книги. Интересующийся читатель может обратиться к книге Real World Haskell. Мы же потренируемся в использовании таких библиотек. Язык C является императивным, поэтому, применяя его функций в Haskell, мы неизбежно сталкиваемся с типом IO, поскольку большинство интересных функций в С изменяют состояние своих аргументов. В С пишут и чистые функции, такие функции переносятся в Haskell без потери чистоты, но это не всегда возможно.
В этой главе мы напишем небольшую 2D-игру, подключив две FFI-библиотеки, это графическая библиотека OpenGL и физический движок Chipmunk.
Игра происходит на бильярдной доске. Игрок управляет красным шаром, кликнув в любую точку экрана, он может изменить направление вектора скорости красного шара. Шар покатится туда, куда кликнул пользователь в последний раз. Из луз будут вылетать шары трёх типов: синие, зелёные и оранжевые. Столкновение красного шара с синим означает минус одну жизнь, с зелёным – плюс одну жизнь, оранжевый шар означает бонус. Если шар игрока сталкивается с оранжевым шаром все шары в определённом радиусе от места столкновения исчезают и записываются в бонусные очки, за каждый шар по одному очку, при этом шар с которым произошло столкновение не считается. Все столкновения – абсолютно упругие, поэтому при столкновении энергия сохраняется и шары никогда не остановятся. Если шар попадает в лузу, то он исчезает. Если в лузу попал шар игрока – это означает, что игра окончена. Игрок стартует с несколькими жизнями, когда их число подходит к нулю игра останавливается. После столкновения с зелёным шаром, шар пропадает, а после столкновения с синим – нет. В итоге все против игрока, кроме зелёных и оранжевых шаров.
Контролировать физику игрового мира будет библиотека Chipmunk, а библиотека OpenGL будет рисовать (конечно если мы её этому научим). Пришло время с ними познакомится.
Перед тем как мы перейдём к библиотекам нам нужно узнать ещё кое-что. В Haskell мы не можем изменять значения. Но в С это делается постоянно, а соответственно и в библиотеках написанных на С тоже. Для того чтобы имитировать в Haskell механизм обновления значений были придуманы специальные типы. Мы можем объявить изменяемое значение и обновлять его, но только в пределах типа IO.
Тип IORef из модуля Data.IORef описывает изменяемые значения:
newIORef :: a -> IO IORef readIORef :: IORef a -> IO a writeIORef :: IORef a -> a -> IO () modifyIORef :: IORef a -> (a -> a) -> IO ()
Функция newIORef создаёт изменяемое значение и инициализирует его некоторым значением, которые мы можем считать с помощью функции readIORef или обновить с помощью функций writeIORef или modifyIORef. Посмотрим как это работает:
module Main where
import Data.IORef
main = var >>= (\v ->
readIORef v >>= print
>> writeIORef v 4
>> readIORef v >>= print)
where var = newIORef 2
Теперь посмотрим на ответ ghci:
*Main> :l HelloIORef [1 of 1] Compiling Main ( HelloIORef.hs, interpreted ) Ok, modules loaded: Main. *Main> main 2 4
Самое время вернуться к главе 17 и вспомнить о do-нотации. Такой императивный код гораздо нагляднее писать так:
main = do
var <- newIORef 2
x <- readIORef var
print x
writeIORef var 4
x <- readIORef var
print x
Эта запись выглядит как последовательность действий. Не правда ли очень похоже на обычный императивный язык. Такие переменные встречаются очень часто в библиотеках, заимствованных из С.
В модуле Data.StateVar определены типы, которые накладывают ограничение на права по чтению и записи. Мы можем определять переменные доступные только для чтения (GettableStateVar a), только для записи (SettableStateVar a) или обычные изменяемые переменные (SetVar a).
Операции чтения и записи описываются с помощью классов:
class HasGetter s where
get :: s a -> IO a
class HasSetter s where
($=) :: s a -> a -> IO ()
Тип IORef принадлежит и тому, и другому классу:
main = do
var <- newIORef 2
x <- get var
print x
var $= 4
x <- get var
print x
OpenGL является ярким примером библиотеки построенной на изменяемых переменных. OpenGL можно представить как большой конечный автомат. Каждая строчка кода – это запрос на изменение состояния. Причём этот автомат является глобальной переменной. Его текущее состояние зависит от всей цепочки предыдущих команд. Параметры рисования задаются глобальными переменными (тип StateVar).
OpenGL не зависит от конкретной оконной системы, она отвечает лишь за рисование. Для того чтобы создать окно и перехватывать в нём действия пользователя нам понадобится отдельная библиотека. Для этого мы воспользуемся GLFW, это библиотека также пришла в Haskell из С. Интерфейсы GLFW и OpenGL очень похожи. Мы будем обновлять различные параметры библиотеки с помощью типа StateVar. Давайте создадим окно и закрасим фон белым цветом:
module Main where
import Graphics.UI.GLFW
import Graphics.Rendering.OpenGL
import System.Exit
title = "Hello OpenGL"
width = 700
height = 600
main = do
initialize
openWindow (Size width height) [] Window
windowTitle $= title
clearColor $= Color4 1 1 1 1
windowCloseCallback $= exitWith ExitSuccess
loop
loop = do
display
loop
display = do
clear [ColorBuffer]
swapBuffers
Мы инициализируем GLFW, задаём параметры окна. Устанавливаем цвет фона. Цвет имеет четыре параметра это RGB-цвета и параметр прозрачности. Затем мы говорим, что программе делать при закрытии окна. Мы устанавливаем функцию обратного вызова (callback) windowCloseCallback. В самом конце мы входим в цикл, который только и делает, что стирает окно цветом фона и делает рабочий буфер видимым. Что такое буфер? Буфер – это место в котором мы рисуем. У нас есть два буфера. Один мы показываем пользователю, а в другом в это в время рисуем, когда приходит время обновлять картинку мы просто меняем их местами командой swapBuffers.
Посмотрим, что у нас получилось:
$ ghc --make HelloOpenGL.hs $ ./HelloOpenGL
Нарисуем упрощённое начальное положение нашей игры: прямоугольную рамку и в ней – красный шар:
module Main where
import Graphics.UI.GLFW
import Graphics.Rendering.OpenGL
import System.Exit
title = "Hello OpenGL"
width, height :: GLsizei
width = 700
height = 600
w2, h2 :: GLfloat
w2 = (fromIntegral $ width) / 2
h2 = (fromIntegral $ height) / 2
dw2, dh2 :: GLdouble
dw2 = fromRational $ toRational w2
dh2 = fromRational $ toRational h2
main = do
initialize
openWindow (Size width height) [] Window
windowTitle $= title
clearColor $= Color4 1 1 1 1
ortho (-dw2-50) (dw2+50) (-dh2-50) (dh2+50) (-1) 1
windowCloseCallback $= exitWith ExitSuccess
windowSizeCallback $= (\size -> viewport $= (Position 0 0, size))
loop
loop = do
display
loop
display = do
clear [ColorBuffer]
color black
line (-w2) (-h2) (-w2) h2
line (-w2) h2 w2 h2
line w2 h2 w2 (-h2)
line w2 (-h2) (-w2) (-h2)
color red
circle 0 0 10
swapBuffers
vertex2f :: GLfloat -> GLfloat -> IO ()
vertex2f a b = vertex (Vertex3 a b 0)
-- colors
white = Color4 (0::GLfloat)
black = Color4 (0::GLfloat) 0 0 1
red = Color4 (1::GLfloat) 0 0 1
-- primitives
line :: GLfloat -> GLfloat -> GLfloat -> GLfloat -> IO ()
line ax ay bx by = renderPrimitive Lines $ do
vertex2f ax ay
vertex2f bx by
circle :: GLfloat -> GLfloat -> GLfloat -> IO ()
circle cx cy rad =
renderPrimitive Polygon $ mapM_ (uncurry vertex2f) points
where n = 50
points = zip xs ys
xs = fmap (\x -> cx + rad * sin (2*pi*x/n)) [0 .. n]
ys = fmap (\x -> cy + rad * cos (2*pi*x/n)) [0 .. n]
Начальное положение
Мы рисуем с помощью функции renderPrimitive. Она принимает метку элемента, который мы собираемся рисовать и набор вершин. Так метка Lines обозначает линии, а метка Polygon – закрашенные многоугольники. В OpenGL нет специальной операции для рисования окружностей, поэтому нам придётся представить окружность в виде многоугольника (circle). Функция ortho устанавливает область видимости рисунка, шесть аргументов функции обозначают пары диапазонов по каждой из трёх координат. При этом вершины передаются не списком а в специальном do-блоке. За счёт этого мы можем изменить какие-нибудь параметры OpenGL во время рисования. Обратите внимание на то, как мы изменяем цвет примитива. Перед тем как рисовать примитив мы устанавливаем значение цвета (color).
Оживим нашу картинку. При клике мышкой шарик игрока последует в направлении курсора. Для того чтобы картинка задвигалась нам необходимо обновлять рисунок с определённой частотой. Мы будем регулировать частоту обновления с помощью функции sleep, с её помощью мы можем задержать выполнение программы (время измеряется в секундах):
sleep :: Double -> IO ()
За перехват действий пользователя отвечает функции:
getMouseButton :: MouseButton -> IO KeyButtonState mousePos :: StateVar Position
Функция getMouseButton сообщает текущее состояние кнопок мыши, мы будем перехватывать положение мыши во время нажатия левой кнопки:
onMouse ball = do
mb <- getMouseButton ButtonLeft
when (mb == Press) (get mousePos >>= updateVel ball)
Стандартная функция when из модуля Control.Monad выполняет действие только в том случае, если первый аргумент равен True. Для обновления положения и направления скорости шарика нам придётся воспользоваться глобальной переменной типа IORef Ball:
data Ball = Ball
{ ballPos :: Vec2d
, ballVel :: Vec2d
}
Код программы:
module Main where
import Control.Applicative
import Data.IORef
import Graphics.UI.GLFW
import Graphics.Rendering.OpenGL
import System.Exit
import Control.Monad
type Time = Double
title = "Hello OpenGL"
width, height :: GLsizei
fps :: Int
fps = 60
frameTime :: Time
frameTime = 1000 * ((1::Double) / fromIntegral fps)
width = 700
height = 600
w2, h2 :: GLfloat
w2 = (fromIntegral $ width) / 2
h2 = (fromIntegral $ height) / 2
dw2, dh2 :: GLdouble
dw2 = fromRational $ toRational w2
dh2 = fromRational $ toRational h2
type Vec2d = (GLfloat, GLfloat)
data Ball = Ball
{ ballPos :: Vec2d
, ballVel :: Vec2d
}
initBall = Ball (0, 0) (0, 0)
dt :: GLfloat
dt = 0.3
minVel = 10
main = do
initialize
openWindow (Size width height) [] Window
windowTitle $= title
clearColor $= Color4 1 1 1 1
ortho (-dw2) (dw2) (-dh2) (dh2) (-1) 1
ball <- newIORef initBall
windowCloseCallback $= exitWith ExitSuccess
windowSizeCallback $= (\size -> viewport $= (Position 0 0, size))
loop ball
loop :: IORef Ball -> IO ()
loop ball = do
display ball
onMouse ball
sleep frameTime
loop ball
display ball = do
(px, py) <- ballPos <$> get ball
(vx, vy) <- ballVel <$> get ball
ball $= Ball (px + dt*vx, py + dt*vy) (vx, vy)
clear [ColorBuffer]
color black
line (-ow2) (-oh2) (-ow2) oh2
line (-ow2) oh2 ow2 oh2
line ow2 oh2 ow2 (-oh2)
line ow2 (-oh2) (-ow2) (-oh2)
color red
circle px py 10
swapBuffers
where ow2 = w2 - 50
oh2 = h2 - 50
onMouse ball = do
mb <- getMouseButton ButtonLeft
when (mb == Press) (get mousePos >>= updateVel ball)
updateVel ball pos = do
(p0x, p0y) <- ballPos <$> get ball
v0 <- ballVel <$> get ball
size <- get windowSize
let (p1x, p1y) = mouse2canvas size pos
v1 = scaleV (max minVel $ len v0) $ norm (p1x - p0x, p1y - p0y)
ball $= Ball (p0x, p0y) v1
where norm v@(x, y) = (x / len v, y / len v)
len (x, y) = sqrt (x*x + y*y)
scaleV k (x, y) = (k*x, k*y)
mouse2canvas :: Size -> Position -> (GLfloat, GLfloat)
mouse2canvas (Size sx sy) (Position mx my) = (x, y)
where d a b = fromIntegral a / fromIntegral b
x = fromIntegral width * (d mx sx - 0.5)
y = fromIntegral height * (negate $ d my sy - 0.5)
vertex2f :: GLfloat -> GLfloat -> IO ()
vertex2f a b = vertex (Vertex3 a b 0)
-- colors
... white, black, red
-- primitives
line :: GLfloat -> GLfloat -> GLfloat -> GLfloat -> IO ()
circle :: GLfloat -> GLfloat -> GLfloat -> IO ()
Теперь функция display принимает ссылку на глобальную переменную, которая отвечает за движение шарика. Функция mouse2canvas переводит координаты в окне GLFW в координаты OpenGL. В GLFW начало координат лежит в левом верхнем углу окна и ось Oy направлена вниз. Мы же переместили начало координат в центр окна и ось Oy направлена вверх.
Посмотрим что у нас получилось:
$ ghc --make Animation.hs $ ./Animation
Картинка ожила, но шарик движется не реалистично. Он проходит сквозь стены. Добавим в нашу программу немного физики. Воспользуемся библиотекой Hipmunk
cabal install Hipmunk
Она даёт возможность вызывать из Haskell функции С-библиотеки Chipmunk. Эта библиотека позволяет строить двухмерные физические модели. Основным элементом модели является пространство (Space). К нему мы можем добавлять различные объекты. Объект состоит из двух компонент: тела (Body) и формы (Shape). Тело отвечает за такие физические характеристики как масса, момент инерции, восприимчивость к силам. По форме определяются моменты столкновения тел. Форма может состоять из нескольких примитивов: окружностей, линий и выпуклых многоугольников. Также мы можем добавлять различные ограничения (Constraint) они имитируют пружинки, шарниры. Мы можем назначать выполнение IO-действий на столкновения.
Опишем в Hipmunk модель шарика бегающего в замкнутой коробке:
module Main where
import Data.StateVar
import Physics.Hipmunk
main = do
initChipmunk
space <- newSpace
initWalls space
ball <- initBall space initPos initVel
loop 100 space ball
loop :: Int -> Space -> Body -> IO ()
loop 0 _ _ = return ()
loop n space ball = do
showPosition ball
step space 0.5
loop (n-1) space ball
showPosition :: Body -> IO ()
showPosition ball = do
pos <- get $ position ball
print pos
initWalls :: Space -> IO ()
initWalls space = mapM_ (uncurry $ initWall space) wallPoints
initWall :: Space -> Position -> Position -> IO ()
initWall space a b = do
body <- newBody infinity infinity
shape <- newShape body (LineSegment a b wallThickness) 0
elasticity shape $= nearOne
spaceAdd space body
spaceAdd space shape
initBall :: Space -> Position -> Velocity -> IO Body
initBall space pos vel = do
body <- newBody ballMass ballMoment
shape <- newShape body (Circle ballRadius) 0
position body $= pos
velocity body $= vel
elasticity shape $= nearOne
spaceAdd space body
spaceAdd space shape
return body
----------------------------
-- inits
nearOne = 0.9999
ballMass = 20
ballMoment = momentForCircle ballMass (0, ballRadius) 0
ballRadius = 10
initPos = Vector 0 0
initVel = Vector 10 5
wallThickness = 1
wallPoints = fmap (uncurry f) [
((-w2, -h2), (-w2, h2)),
((-w2, h2), (w2, h2)),
((w2, h2), (w2, -h2)),
((w2, -h2), (-w2, -h2))]
where f a b = (g a, g b)
g (a, b) = H.Vector a b
h2 = 100
w2 = 100
Функция initChipmunk инициализирует библиотеку Chipmunk. Она должна быть вызвана один раз до любой из функций библиотеки Hipmunk. Функции new[Body|Shape|Space] создают объекты модели. Мы сделали стены неподвижными, присвоив им бесконечную массу и момент инерции (initWall). Упругость удара определяется переменной elasticity, она не может быть больше единицы. Единица обозначает абсолютно упругое столкновение. В документации к Hipmunk не рекомендуют присваивать значение равное единице из-за возможных погрешностей округления, поэтому мы выбираем число близкое к единице. После инициализации элементов модели мы запускаем цикл, в котором происходит обновление модели (step) и печать положения шарика. Обратите внимание на то, что координаты шарика никогда не выйдут за установленные рамки.
Теперь объединим OpenGL и Hipmunk:
module Main where
import Control.Applicative
import Control.Applicative
import Data.StateVar
import Data.IORef
import Graphics.UI.GLFW
import System.Exit
import Control.Monad
import qualified Physics.Hipmunk as H
import qualified Graphics.UI.GLFW as G
import qualified Graphics.Rendering.OpenGL as G
title = "in the box"
----------------------------
-- inits
type Time = Double
-- frames per second
fps :: Int
fps = 60
-- frame time in milliseconds
frameTime :: Time
frameTime = 1000 * ((1::Double) / fromIntegral fps)
nearOne = 0.9999
ballMass = 20
ballMoment = H.momentForCircle ballMass (0, ballRadius) 0
ballRadius = 10
initPos = H.Vector 0 0
initVel = H.Vector 0 0
wallThickness = 1
wallPoints = fmap (uncurry f) [
((-ow2, -oh2), (-ow2, oh2)),
((-ow2, oh2), (ow2, oh2)),
((ow2, oh2), (ow2, -oh2)),
((ow2, -oh2), (-ow2, -oh2))]
where f a b = (g a, g b)
g (a, b) = H.Vector a b
dt :: Double
dt = 0.5
minVel :: Double
minVel = 10
width, height :: Double
height = 500
width = 700
w2, h2 :: Double
h2 = height / 2
w2 = width / 2
ow2, oh2 :: Double
ow2 = w2 - 50
oh2 = h2 - 50
data State = State
{ stateBall :: H.Body
, stateSpace :: H.Space
}
ballPos :: State -> StateVar H.Position
ballPos = H.position . stateBall
ballVel :: State -> StateVar H.Velocity
ballVel = H.velocity . stateBall
main = do
H.initChipmunk
initGLFW
state <- newIORef =<< initState
loop state
loop :: IORef State -> IO ()
loop state = do
display state
onMouse state
sleep frameTime
loop state
simulate :: State -> IO Time
simulate a = do
t0 <- get G.time
H.step (stateSpace a) dt
t1 <- get G.time
return (t1 - t0)
initGLFW :: IO ()
initGLFW = do
G.initialize
G.openWindow (G.Size (d2gli width) (d2gli height)) [] G.Window
G.windowTitle $= title
G.windowCloseCallback $= exitWith ExitSuccess
G.windowSizeCallback $= (\size -> G.viewport $= (G.Position 0 0, size))
G.clearColor $= G.Color4 1 1 1 1
G.ortho (-dw2) (dw2) (-dh2) (dh2) (-1) 1
where dw2 = realToFrac w2
dh2 = realToFrac h2
initState :: IO State
initState = do
space <- H.newSpace
initWalls space
ball <- initBall space initPos initVel
return $ State ball space
initWalls :: H.Space -> IO ()
initWalls space = mapM_ (uncurry $ initWall space) wallPoints
initWall :: H.Space -> H.Position -> H.Position -> IO ()
initWall space a b = do
body <- H.newBody H.infinity H.infinity
shape <- H.newShape body (H.LineSegment a b wallThickness) 0
H.elasticity shape $= nearOne
H.spaceAdd space body
H.spaceAdd space shape
initBall :: H.Space -> H.Position -> H.Velocity -> IO H.Body
initBall space pos vel = do
body <- H.newBody ballMass ballMoment
shape <- H.newShape body (H.Circle ballRadius) 0
H.position body $= pos
H.velocity body $= vel
H.elasticity shape $= nearOne
H.spaceAdd space body
H.spaceAdd space shape
return body
-------------------------------
-- graphics
display state = do
drawState =<< get state
simTime <- simulate =<< get state
sleep (max 0 $ frameTime - simTime)
drawState :: State -> IO ()
drawState st = do
pos <- get $ ballPos st
G.clear [G.ColorBuffer]
drawWalls
drawBall pos
G.swapBuffers
drawBall :: H.Position -> IO ()
drawBall pos = do
G.color red
circle x y $ d2gl ballRadius
where (x, y) = vec2gl pos
drawWalls :: IO ()
drawWalls = do
G.color black
line (-dow2) (-doh2) (-dow2) doh2
line (-dow2) doh2 dow2 doh2
line dow2 doh2 dow2 (-doh2)
line dow2 (-doh2) (-dow2) (-doh2)
where dow2 = d2gl ow2
doh2 = d2gl oh2
onMouse state = do
mb <- G.getMouseButton ButtonLeft
when (mb == Press) (get G.mousePos >>= updateVel state)
updateVel state pos = do
size <- get G.windowSize
st <- get state
p0 <- get $ ballPos st
v0 <- get $ ballVel st
let p1 = mouse2canvas size pos
ballVel st $=
H.scale (H.normalize $ p1 - p0) (max minVel $ H.len v0)
mouse2canvas :: G.Size -> G.Position -> H.Vector
mouse2canvas (G.Size sx sy) (G.Position mx my) = H.Vector x y
where d a b = fromIntegral a / fromIntegral b
x = width * (d mx sx - 0.5)
y = height * (negate $ d my sy - 0.5)
vertex2f :: G.GLfloat -> G.GLfloat -> IO ()
vertex2f a b = G.vertex (G.Vertex3 a b 0)
vec2gl :: H.Vector -> (G.GLfloat, G.GLfloat)
vec2gl (H.Vector x y) = (d2gl x, d2gl y)
d2gl :: Double -> G.GLfloat
d2gl = realToFrac
d2gli :: Double -> G.GLsizei
d2gli = toEnum . fromEnum . d2gl
...
Функции не претерпевшие особых изменений пропущены. Теперь наше глобальное состояние (State) содержит тело шара (оно пригодится нам для вычисления его положения) и пространство, в котором живёт наша модель. Стоит отметить функцию simulate. В ней происходит обновление состояния модели. При этом мы возвращаем время, которое ушло на вычисление этой функции. Оно нужно нам для того, чтобы показывать новые кадры равномерно. Мы вычтем время симуляции из общего времени, которое мы можем потратить на один кадр (frameTime).
Кажется, что мы попали в какой-то другой язык. Это совсем не тот элегантный Haskell, знакомый нам по предыдущим главам. Столько do и IO разбросано по всему коду. И такой примитивный результат в итоге. Если так будет продолжаться и дальше, то мы можем не вытерпеть и бросить и нашу задачу и Haskell…
Не отчаивайтесь!
Давайте лучше подумаем как свести этот псевдо-Haskell к минимуму. Подумаем какие источники IO точно будут в нашей программе. Это инициализация GLFW и Hipmunk, клики мышью, обновление модели в Hipmunk, также для рисования нам придётся считывать положения шаров. Нам придётся удалять и создавать новые шары, добавляя их к пространству модели. Также в IO происходит отрисовка игры. Hipmunk будет контролировать столкновения шаров, и эти данные нам тоже надо будет считывать из глобальных переменных. Сколько всего! Голова идёт кругом.
Но помимо всего этого у нас есть логика игры. Логика игры отвечает за реакцию игрового мира на различные события. Например столкновение с “плохим” шаром влечёт к уменьшению жизней, если игрок сталкивается с бонусным шаром, определённые шары необходимо удалить. Приходит момент и мы выпускаем новый шар из лузы новый шар. Давайте подумаем как сохранить логику игры в чистоте.
Тип IO обычно отвечает за связь с внешним миром, это глаза, уши, руки и ноги программы. Через IO мы получаем информацию из внешнего мира и отправляем её обратно. Но в нашем случае он проник в сердце программы. За обновление объектов отвечает насыщенная IO библиотека Hipmunk.
Мы постараемся побороться с IO-кодом так. Сначала мы выделим те параметры, которые могут быть обновлены чистыми функциями. Это все те параметры, для которых не нужен Hipmunk. Этот шаг разбивает наш мир на два лагеря: “чистый” и “грязный”:
data World = World
{ worldPure :: Pure
, worldDirty :: Dirty }
Чистые данные хотят как-то узнать о том, что происходит в грязных данных. Также чистые данные могут рассказать грязным, как им нужно измениться. Это приводит нас к определению двух языков запросов, на которых чистый и грязный мир общаются между собой:
data Query = Remove Ball | HeroVelocity H.Velocity | MakeBall Freq
data Event = Touch Ball | UserClick H.Position
data Sense = Sense
{ senseHero :: HeroBall
, senseBalls :: [Ball] }
Через Query чистые данные могут рассказать грязным о том, что необходимо удалить шар из игры, обновить скорость шара игрока или создать новый шар (Freq отвечает за параметры создания шара). Грязные данные могут рассказать чистым на языке Event и Sense о том, что один из шаров коснулся до шара игрока, или игрок кликнул мышкой в определённой точке. Также мы сообщаем все обновлённые положения параметры шаров в типе Sense. Тип Event отвечает за события, которые происходят иногда, а тип Sense за те параметры, которые мы наблюдаем непрерывно (это типы глазорук), Query – это язык действий (это тип руконог). Нам понадобится ещё один маленький язык, на котором мы будем объясняться с OpenGL.
data Picture = Prim Color Primitive
| Join Picture Picture
data Primitive = Line Point Point | Circle Point Radius
data Point = Point Double Double
type Radius = Double
data Color = Color Double Double Double
Эти три языка станут барьером, которым мы ограничим влияние IO. У нас будут функции:
percept :: Dirty -> IO (Sense, [Event]) updatePure :: Sense -> [Event] -> Pure -> (Pure, [Query]) react :: [Query] -> Dirty -> IO Dirty updateDirty :: Dirty -> IO Dirty picture :: Pure -> Picture draw :: Picture -> IO ()
Вся логика игры будет происходить в чистой функции updatePure, обновлять модель мира мы будем в updateDirty. Давайте опять начнём проектирование сверху-вниз. С этими функциями мы уже можем написать основную функцию цикла игры:
loop :: IORef World -> IO ()
loop worldRef = do
world <- get worldRef
drawWorld world
(world, dt) <- updateWorld world
worldRef $= world
G.addTimerCallback (max 0 $ frameTime - dt) $ loop worldRef
updateWorld :: World -> IO (World, Time)
updateWorld world = do
t0 <- get G.elapsedTime
(sense, events) <- percept dirty
let (pure', queries) = updatePure sense events pure
dirty' <- updateDirty =<< react queries dirty
t1 <- get G.elapsedTime
return (World pure' dirty', t1 - t0)
where dirty = worldDirty world
pure = worldPure world
drawWorld :: World -> IO ()
drawWorld = draw . picture . worldPure
Давайте подумаем, из чего состоят типы Dirty и Pure. Начнём с Pure. Там точно будет вся информация необходимая нам для рисования картинки (ведь функция picture определена на Pure). Для рисования нам необходимо знать положения всех шаров и их типы (они определяют цвет). На картинке мы будем показывать разную статистику (данные о жизнях, бонусные очки). Также из типа Pure мы будем управлять созданием шаров. Так мы приходим к типу:
data Pure = Pure
{ pureScores :: Scores
, pureHero :: HeroBall
, pureBalls :: [Ball]
, pureStat :: Stat
, pureCreation :: Creation
}
Что нам нужно знать о шаре героя? Нам нужно его положение для отрисовки и модуль вектора скорости (он понадобится нам при обновлении вектора скорости шара игрока):
data HeroBall = HeroBall
{ heroPos :: H.Position
, heroVel :: H.CpFloat
}
Для остальных шаров нам нужно знать только тип шара, его положение и идентификатор шара. По идентификатору потом мы сможем понять какой шар удалить из грязных данных:
data Ball = Ball
{ ballType :: BallType
, ballPos :: H.Position
, ballId :: Id
}
data BallType = Hero | Good | Bad | Bonus
deriving (Show, Eq, Enum)
type Id = Int
Статистика игры состоит из числа жизней и бонусных очков:
data Scores = Scores
{ scoresLives :: Int
, scoresBonus :: Int
}
Как будет происходить создание новых шаров? Если плохих шаров будет слишком много, то играть будет не интересно, игрок слишком быстро проиграет. Если хороших шаров будет слишком много, то игроку также быстро надоест. Будет очень легко. Нам необходимо поддерживать определённый баланс шаров. Создание шаров будет происходить случайным образом через равные промежутки времени, но создание нового шара будет зависеть от пропорции шаров на доске в данный момент. Если у нас слишком много плохих шаров, то скорее всего мы создадим хороший шар и наоборот. Если общее число шаров велико, то мы не будем усложнять игроку жизнь новыми шарами, дождёмся пока какие-нибудь шары не покинут пределы поля или не будут уничтожены игроком. Эти рассуждения приводят нас к типам:
data Creation = Creation
{ creationStat :: Stat
, creationGoalStat :: Stat
, creationTick :: Int
}
data Stat = Stat
{ goodCount :: Int
, badCount :: Int
, bonusCount :: Int
}
data Freq = Freq
{ freqGood :: Float
, freqBad :: Float
, freqBonus :: Float
}
Поле creationStat содержит текущее число шаров на поле, поле creationGoalStat – число шаров, к которому мы стремимся. Значение типа Freq содержит веса вероятностей создания нового шара определённого типа. На каждом шаге мы будем прибавлять единицу к creationTiсk, как только оно достигнет определённого значения мы попробуем создать новый шар.
Перейдём к грязным данным. Там мы будем хранить информацию, необходимую для обновления модели в Hipmunk, и значение, в которое GLFW будет записывать состояние мыши, также мы будем следить за тем, кто столкнулся с шаром игрока в данный момент:
data Dirty = Dirty
{ dirtyHero :: Obj
, dirtyObjs :: IxMap Obj
, dirtySpace :: H.Space
, dirtyTouchVar :: Sensor H.Shape
, dirtyMouse :: Sensor H.Position
}
data Obj = Obj
{ objType :: BallType
, objShape :: H.Shape
, objBody :: H.Body
}
type Sensor a = IORef (Maybe a)
Особая структура IxMap отвечает за хранение значений вместе с индексами. Пока остановимся на самом простом представлении:
type IxMap a = [(Id, a)]
Наметим структуру проекта. У нас уже есть модуль Types.hs. Основной цикл игры будет описан в модуле Loop.hs. Общие функции обновления состояния будут определены в World.hs, также у нас будет два модуля отвечающие за обновление чистых и грязных данных – Pure.hs и Dirty.hs. Мы выделим отдельный модуль для описания всех констант игры (Inits.hs). Так нам будет удобно настроить игру, когда мы закончим с кодом. Отдельный модуль Utils будет содержать все функции общего назначения, преобразования между типами OpenGL и Hipmunk.
Начнём с восприятия:
module World where
import qualified Physics.Hipmunk as H
import Data.Maybe
import Types
import Utils
import Pure
import Dirty
percept :: Dirty -> IO (Sense, [Event])
percept a = do
hero <- obj2hero $ dirtyHero a
balls <- mapM (uncurry obj2ball) $ setIds dirtyObjs a
evts1 <- fmap maybeToList $ getTouch (dirtyTouchVar a) $ dirtyObjs a
evts2 <- fmap maybeToList $ getClick $ dirtyMouse a
return $ (Sense hero balls, evts1 ++ evts2)
where setIds = zip [0..]
-- в Dirty.hs
obj2hero :: Obj -> IO HeroBall
obj2ball :: Id -> Obj -> IO Ball
getTouch :: Sensor H.Shape -> IxMap Obj -> IO (Maybe Event)
getClick :: Sensor H.Position -> IO (Maybe Event)
Далее мы не будем каждый раз выписывать новые неопределённые функции, мы будем просто оставлять объявления типов без определений. Итак мы написали одну функцию, и получили ещё четыре новых.
Мы сделаем предположение о том, что сначала мы реагируем на непрерывные события, а затем на дискретные. Причём к запросам на реакции могут привести только дискретные события:
updatePure :: Sense -> [Event] -> Pure -> (Pure, [Query]) updatePure s evts = updateEvents evts . updateSenses s -- в Pure.hs updateSenses :: Sense -> Pure -> Pure updateEvents :: [Event] -> Pure -> (Pure, [Query])
В функции react мы предполагаем, что реакции мира на события независимы друг от друга. foldQuery~– функция свёртки для типа Query.
import Control.Monad
...
react :: [Query] -> Dirty -> IO Dirty
react = foldr (<=<) return
. fmap (foldQuery removeBall heroVelocity makeBall)
-- в Dirty.hs
removeBall :: Ball -> Dirty -> IO Dirty
heroVelocity :: H.Velocity -> Dirty -> IO Dirty
makeBall :: Freq -> Dirty -> IO Dirty
Обратите внимание на то, как мы воспользовались функциями foldr, return и <=< для того чтобы нанизывать друг на друга функции типа Dirty -> IO Dirty. Напомню, что функция <=<~– это аналог композиции для монадных функций.
Обновление модели:
updateDirty :: Dirty -> IO Dirty updateDirty = stepDirty dt -- в Dirty.hs stepDirty :: H.Time -> Dirty -> IO Dirty -- в Inits.hs dt :: H.Time dt = 0.5
Функции рисования поместим в отдельный модуль Graphics.hs
-- переместим из Loop.hs в World.hs drawWorld :: World -> IO () drawWorld = draw . picture . worldPure -- в Graphics.hs draw :: Picture -> IO () -- в Pure.hs picture :: Pure -> Picture
Добавим функцию инициализации игры:
initWorld :: IO World
initWorld = do
dirty <- initDirty
(sense, events) <- percept dirty
return $ World (initPure sense events) dirty
-- в Dirty.hs
initDirty :: IO Dirty
-- в Pure.hs
initPure :: Sense -> [Event] -> Pure
Вот так на самом интересном месте… Мы вынуждены прерваться. Я надеюсь, что вы уловили основную идею метода и сможете закончить эту игру самостоятельно. Вся логика игры будет описана в модуле Pure.hs. Причём в этом модуле будут только чистые функции. Осталось примерно 1000 строк кода. Я не буду выписывать своё решение, если вы где-то запнётесь или у вас что-то не будет получаться, вы можете свериться с ним (оно входит в код, что прилагается с книгой).
В этой главе мы посмотрели на две интересные библиотеки. Физический движок Hipmunk и графическую библиотеку OpenGL и узнали метод укрощения императивного кода. Мы разделили состояние игры на две части. В одну поместили все те параметры, для которых невозможно обойтись без IO-функций, а в другой те параметры, которые необходимы для реализации логики игры. Все функции, отвечающие за логику игры являются чистыми. Параметры императивной части не обновляются сразу, сначала мы делаем с них снимок, потом передаём этот снимок в чистую часть, и она разбирается с тем как их обновлять. Части общаются между собой на специальных маленьких языках, которые закодированы в типах. Это язык наблюдений (Event), язык реакций (Query) и язык отрисовки игрового мира (Picture).
Закончите код игры. Или, возможно, при знакомстве с Hipmunk у вас появилась идея новой игры с невероятной динамикой. Ещё лучше! Напишите её. При этом продумайте проект игры так, чтобы IO-типы не разбежались по всей программе.