Мы устанавливаем функцию обратного вызова (callback) windowCloseCallback. В самом конце мы входим в
цикл, который только и делает, что стирает окно цветом фона и делает рабочий буфер видимым. Что такое
буфер? Буфер – это место в котором мы рисуем. У нас есть два буфера. Один мы показываем пользователю,
а в другом в это в время рисуем, когда приходит время обновлять картинку мы просто меняем их местами
командой swapBuffers.
Посмотрим, что у нас получилось:
$ ghc —make HelloOpenGL.hs
$ ./HelloOpenGL
Нарисуем упрощённое начальное положение нашей игры: прямоугольную рамку и в ней – красный шар:
290 | Глава 20: Императивное программирование
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 ()
Основные библиотеки | 291
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]
Рис. 20.1: Начальное положение
Мы рисуем с помощью функции 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