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
296 | Глава 20: Императивное программирование
— 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
Основные библиотеки | 297
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 ()
298 | Глава 20: Императивное программирование
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).
20.2 Боремся с IO
Кажется, что мы попали в какой-то другой язык. Это совсем не тот элегантный Haskell, знакомый нам по
предыдущим главам. Столько do и IO разбросано по всему коду. И такой примитивный результат в итоге.
Если так будет продолжаться и дальше, то мы можем не вытерпеть и бросить и нашу задачу и Haskell…
Не отчаивайтесь!
Давайте лучше подумаем как свести этот псевдо-Haskell к минимуму. Подумаем какие источники IO
точно будут в нашей программе. Это инициализация GLFW и Hipmunk, клики мышью, обновление модели в
Боремся с IO | 299
Hipmunk, также для рисования нам придётся считывать положения шаров. Нам придётся удалять и создавать
новые шары, добавляя их к пространству модели. Также в IO происходит отрисовка игры. Hipmunk будет кон-
тролировать столкновения шаров, и эти данные нам тоже надо будет считывать из глобальных переменных.
Сколько всего! Голова идёт кругом.
Но помимо всего этого у нас есть логика игры. Логика игры отвечает за реакцию игрового мира на раз-
личные события. Например столкновение с “плохим” шаром влечёт к уменьшению жизней, если игрок стал-
кивается с бонусным шаром, определённые шары необходимо удалить. Приходит момент и мы выпусткаем
новый шар из лузы новый шар. Давайте подумаем как сохранить логику игры в чистоте.
