(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 ()
294 | Глава 20: Императивное программирование
Теперь функция display принимает ссылку на глобальную переменную, которая отвечает за движение
шарика. Функция mouse2canvas переводит координаты в окне GLFW в координаты OpenGL. В GLFW начало ко-
ординат лежит в левом верхнем углу окна и ось Oy направлена вниз. Мы же переместили начало координат
в центр окна и ось Oy направлена вверх.
Посмотрим что у нас получилось:
$ ghc —make Animation.hs
$ ./Animation
Chipmunk
Картинка ожила, но шарик движется не реалистично. Он проходит сквозь стены. Добавим в нашу про-
грамму немного физики. Воспользуемся библиотекой 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
Основные библиотеки | 295
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