initWall space a b = do
body
<- H.
newBody H. infinity H. infinityshape
<- H.
newShape body (H.LineSegment a b wallThickness) 0H.
elasticity shape $= nearOneH.
spaceAdd space bodyH.
spaceAdd space shapeinitBall :: H.Space -> H.Position -> H.Velocity -> IO H.Body
initBall space pos vel = do
body
<- H.
newBody ballMass ballMomentshape
<- H.
newShape body (H.Circle ballRadius) 0H.
position body $= posH.
velocity body $= velH.
elasticity shape $= nearOneH.
spaceAdd space bodyH.
spaceAdd space shapereturn body
-------------------------------
-- graphics
display state = do
drawState =<<
get statesimTime <-
simulate =<< get statesleep (max 0 $
frameTime - simTime)drawState :: State -> IO
()drawState st = do
pos <-
get $ ballPos stG.
clear [G.ColorBuffer]drawWalls
drawBall pos
G.
swapBuffersdrawBall :: H.Position -> IO
()298 | Глава 20: Императивное программирование
drawBall pos = do
G.
color redcircle x y $
d2gl ballRadiuswhere
(x, y) = vec2gl posdrawWalls :: IO
()drawWalls = do
G.
color blackline (-
dow2) (-doh2) (-dow2) doh2line (-
dow2) doh2dow2
doh2
line dow2
doh2
dow2
(-
doh2)line dow2
(-
doh2)(-
dow2) (-doh2)where
dow2 = d2gl ow2doh2 =
d2gl oh2onMouse state = do
mb <- G.
getMouseButton ButtonLeftwhen (mb == Press
) (get G. mousePos >>= updateVel state)updateVel state pos = do
size <-
get G. windowSizest <-
get statep0 <-
get $ ballPos stv0 <-
get $ ballVel stlet
p1 = mouse2canvas size posballVel 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 ywhere
d a b=
fromIntegral a / fromIntegral bx
=
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 =
realToFracd2gli :: Double -> G.GLsizei
d2gli =
toEnum . fromEnum . d2gl...
Функции не претерпевшие особых изменений пропущены. Теперь наше глобальное состояние (State
)содержит тело шара (оно пригодится нам для вычисления его положения) и пространство, в котором живёт
наша модель. Стоит отметить функцию simulate. В ней происходит обновление состояния модели. При
этом мы возвращаем время, которое ушло на вычисление этой функции. Оно нужно нам для того, чтобы
показывать новые кадры равномерно. Мы вычтем время симуляции из общего времени, которое мы можем
потратить на один кадр (frameTime).
20.2 Боремся с IO
Кажется, что мы попали в какой-то другой язык. Это совсем не тот элегантный Haskell, знакомый нам по
предыдущим главам. Столько do
и IO разбросано по всему коду. И такой примитивный результат в итоге.Если так будет продолжаться и дальше, то мы можем не вытерпеть и бросить и нашу задачу и Haskell…
Не отчаивайтесь!
Давайте лучше подумаем как свести этот псевдо-Haskell к минимуму. Подумаем какие источники IO
точно будут в нашей программе. Это инициализация GLFW
и Hipmunk, клики мышью, обновление модели вБоремся с IO | 299
Hipmunk
, также для рисования нам придётся считывать положения шаров. Нам придётся удалять и создаватьновые шары, добавляя их к пространству модели. Также в IO
происходит отрисовка игры. Hipmunk будет кон-тролировать столкновения шаров, и эти данные нам тоже надо будет считывать из глобальных переменных.
Сколько всего! Голова идёт кругом.
Но помимо всего этого у нас есть логика игры. Логика игры отвечает за реакцию игрового мира на раз-
личные события. Например столкновение с “плохим” шаром влечёт к уменьшению жизней, если игрок стал-
кивается с бонусным шаром, определённые шары необходимо удалить. Приходит момент и мы выпусткаем
новый шар из лузы новый шар. Давайте подумаем как сохранить логику игры в чистоте.
Тип IO
обычно отвечает за связь с внешним миром, это глаза, уши, руки и ноги программы. Через IO мыполучаем информацию из внешнего мира и отправляем её обратно. Но в нашем случае он проник в сердце
программы. За обновление объектов отвечает насыщенная IO
библиотека Hipmunk.Мы постараемся побороться с IO
-кодом так. Сначала мы выделем те параметры, которые могут бытьобновлены чистыми функциями. Это все те параметры, для которых не нужен Hipmunk
. Этот шаг разбиваетнаш мир на два лагеря: “чистый” и “грязный”:
data World = World
{ worldPure
:: Pure
, worldDirty
:: Dirty
}Чистые данные хотят как-то узнать о том, что происходит в грязных данных. Также чистые данные могут
рассказать грязным, как им нужно измениться. Это приводит нас к определению двух языков запросов, на
которых чистый и грязный мир общаются между собой: