Мы рисуем с помощью функции renderPrimitive. Она принимает метку элемента, который мы собира-
емся рисовать и набор вершин. Так метка Lines обозначает линии, а метка Polygon – закрашенные много-
угольники. В OpenGL нет специальной операции для рисования окружностей, поэтому нам придётся предста-
вить окружность в виде многоугольника (circle). Функция ortho устанавливает область видимости рисунка,
шесть аргументов функции обозначают пары диапазонов по каждой из трёх координат. При этом вершины
передаются не списком а в специальном do-блоке. За счёт этого мы можем изменить какие-нибудь парамет-
ры OpenGL во время рисования. Обратите внимание на то, как мы изменяем цвет примитива. Перед тем как
рисовать примитив мы устанавливаем значение цвета (color).
Анимация
Оживим нашу картинку. При клике мышкой шарик игрока последует в направлении курсора. Для того
чтобы картинка задвигалась нам необходимо обновлять рисунок с определённой частотой. Мы будем регу-
лировать частоту обновления с помощью функции sleep, с её помощью мы можем задержать выполнение
программы (время измеряется в секундах):
sleep :: Double -> IO ()
За перехват действий пользователя отвечает функции:
getMouseButton
:: MouseButton -> IO KeyButtonState
mousePos
:: StateVar Position
Функция getMouseButton сообщает текущее состояние кнопок мыши, мы будем перехватывать положение
мыши во время нажатия левой кнопки:
292 | Глава 20: Императивное программирование
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
Основные библиотеки | 293
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)