На днях я разгребал свой список статей для отложенного прочтения. Помимо прочего, в нем был найден хабрапост Графика через OpenGL на Haskell , который пробудил во мне былой интерес к работе с трехмерной графикой на правильном языке . А что может остановить программиста, которому что-то дико интересно и хочется в этом разобраться?

Введение

OpenGL ( Open G raphics L ibrary) — это спецификация API для работы с двумерной и трехмерной графикой. Тут важно понимать разницу между описанием интерфейса и его реализацией для конкретного языка программирования под конкретную платформу. Несмотря на то, что программы, использующие OpenGL, часто пишутся на Си или C++, OpenGL не привязан к этим двум языкам программирования. Существуют реализации и биндинги OpenGL для Java, C#, Perl, Python и, само собой разумеется, Haskell. В отличие от DirectX OpenGL доступен как в Windows, так и в Linux, FreeBSD, Mac OS, iOS, а также Android. Кроме того, на OpenGL можно писать игры для PS3.

GLUT (Open GL U tility T oolkit) представляет собой библиотеку утилит для приложений, использующих OpenGL. GLUT позволяет рисовать окна, отслеживать нажатия клавиш и движения мыши, а также предоставляет функции для рисования таких графических примитивов, как куб, сфера или конус. Из аналогичных библиотек следует отметить GLFW. Правда, я пока не особо понимаю, в чем заключаются ее существенное отличие от GLUT.

Когда я начинал писать этот пост, то думал привести описание всех встречающихся функций и типов, однако, как оказалось, это описание займет очень много места. Если вас интересуют такие детали, рекомендую воспользоваться ghci:

$ cabal-dev ghci
ghci> :m + Graphics.Rendering.OpenGL
ghci> :m + Graphics.UI.GLUT
ghci> :t clear
clear :: [ClearBuffer] -> IO ()
ghci> :i ClearBuffer
data ClearBuffer
= ColorBuffer | AccumBuffer | StencilBuffer | DepthBuffer
— Defined in `Graphics.Rendering.OpenGL.GL.Framebuffer’

Документацию к функциям проще всего найти через Hoogle . Также можно попытать счастье, открыв документацию по OpenGL или GLUT на Hackage. Здесь же мы будем использовать OpenGL, «войдя в слияние разумов » с GHC.

Перейдем же, наконец, к коду!

Черное окно, красное окно

Рассмотрим простейшее OpenGL-приложение на Haskell, рисующее черное окно.

import Graphics . UI . GLUT
import Graphics . Rendering . OpenGL

main = do
getArgsAndInitialize
createWindow «Black Window»
displayCallback $= display
mainLoop

display = do
clear [ ColorBuffer ]
flush

Все действие происходит внутри монады IO . Функция getArgsAndInitialize инициализирует GLUT, после чего возвращает имя программы и ее аргументы. Впрочем, в данном случае мы их игнорируем. Функция createWindow создает новое окно с заданным заголовком. Далее мы устанавливаем колбэк, отвечающий за прорисовку изображения в окне и входим в цикл обработки событий GLUT’а. Указанные нами колбэки будут вызываться из этого цикла.

Функция clear очищает изображение в окне. Вызов функции flush приводит к принудительной перерисовке изображения. Команды, выполняемые перед flush, могут буферезироваться. Вызов flush очищает буферы команд, тем самым гарантируя, что указанные ранее команды будут выполнены. Их выполнение может занять произвольно большое время. Гарантируется только то, что это время конечно.

Если перед вызовом clear добавить строчку:

clearColor $= Color4 1 0 0 1

Окно будет раскрашено в красный цвет. Как несложно догадаться, здесь мы указываем цвет, используемый для очистки. Цвет задается в формате RGBA. Помимо типа Color4 a также существует тип Color3 a , позволяющий задавать цвет в формате RGB. Эти два типа обычно параметризуются GLfloat’ом или GLdouble’ом, которые представляют собой синонимы типов CFloat и CDouble из Foreign.C.Types.

Красный треугольник

Следующая программа рисует красный треугольник на черном фоне.

import Graphics . Rendering . OpenGL
import Graphics . UI . GLUT

main = do
_ <- getArgsAndInitialize
_ <- createWindow «Red Triangle»
displayCallback $= display
mainLoop

display = do
clear [ ColorBuffer ]
currentColor $= Color4 1 0 0 1
renderPrimitive Triangles $ do
vertex $ Vertex3 ( 0 :: GLfloat ) 0.5 0
vertex $ Vertex3 ( 0.5 :: GLfloat ) ( 0.5 ) 0
vertex $ Vertex3 ( 0.5 :: GLfloat ) ( 0.5 ) 0
flush

За рисование различных примитивов отвечает функция renderPrimitive.

Черное окно, красное окно и красный треугольник

Первый ее аргумент имеет тип PrimitiveMode. Он определяет, какой именно примитив мы хотим нарисовать. В данном случае мы рисуем треугольники, а вернее — один треугольник. Всего существует десять примитивов, описание которых вы найдете в туториале по OpenGL на Haskell Wiki .

Второй аргумент — это функция с типом IO () . Внутри этой функции задаются координаты точек (вершины), по которым рисуется примитив. Для представления координат используется тип Vertex3 a . Он оборачивается в монаду IO при помощи функции vertex с типом a -> IO () .

«Прыгающий» треугольник

Давайте заставим треугольник двигаться!

import Graphics . Rendering . OpenGL
import Graphics . UI . GLUT
import Data . IORef
import Data . Time . Clock . POSIX

main = do
_ <- getArgsAndInitialize
_ <- createWindow «Jumping Triangle»
tstamp <- getTimestamp
st <- newIORef ( 0.0 , 0.5 , tstamp )
displayCallback $= display st
idleCallback $= Just ( idle st )
mainLoop

display st = do
( dy , _, _ ) <- get st
clear [ ColorBuffer ]
currentColor $= Color4 1 0 0 1
renderPrimitive Triangles $ do
vertex $ Vertex3 ( 0 :: GLdouble ) ( 0.5 + dy ) 0
vertex $ Vertex3 ( 0.5 :: GLdouble ) ( 0.5 + dy ) 0
vertex $ Vertex3 ( 0.5 :: GLdouble ) ( 0.5 + dy ) 0
flush

idle st = do
( dy , delta , prevTStamp ) <- get st
tstamp <- getTimestamp
let dt = tstamp prevTStamp
dy’ = dy + delta * dt
delta’ = if abs dy’ <= 0.5 then delta else delta
st $=! ( dy’ , delta’ , tstamp )
postRedisplay Nothing

getTimestamp :: IO GLdouble
getTimestamp = do
now <- getPOSIXTime
return $ fromRational $ toRational now

У программы появилось состояние, представляемое тройкой из текущего смещения треугольника по оси Y, скорости движения треугольника и времени последнего перемещения треугольника. Состояние хранится в IORef — контейнере с семантикой ссылки на изменяемую переменную.

Функция display практически не изменилась, она просто стала прибавлять к Y-координатам точек текущее смещение треугольника. Само изменение состояния происходит в функции idle, которую мы прописали в idleCallback. Заданный idleCallback вызывается GLUT’ом в случае, когда у него кончаются события для обработки. При вызове idle мы (1) определяем dt, разность между текущим временем и временем последнего вызова idle, (2) вычисляем новое смещение по формуле dy' = dy + delta * dt и (3) если треугольник смещен достаточно сильно, умножаем скорость его движения на -1.

После изменения состояния происходит вызов postRedisplay. Этим мы говорим, что что-то изменилось и картинку нужно перерисовать.

Прыгающий красный треугольник

Теперь треугольник плавно перемещается от верхней границы окна к нижней и обратно.

Перемещаем треугольник стрелками «влево» и «вправо»

Нам хотелось бы иметь возможность как-то взаимодействовать с нашей программой. Сказано — сделано.

import Graphics . Rendering . OpenGL
import Graphics . UI . GLUT
import Data . IORef
import Data . Time . Clock . POSIX

main = do
_ <- getArgsAndInitialize
_ <- createWindow «Moving Triangle»
tstamp <- getTimestamp
st <- newIORef ( 0.0 , 0.0 , 0.5 , tstamp )
keyboardMouseCallback $= Just ( keyboardMouse st )
displayCallback $= display st
idleCallback $= Just ( idle st )
mainLoop

display st = do
( dx , dy , _, _ ) <- get st
clear [ ColorBuffer ]
renderPrimitive Triangles $ do
currentColor $= Color4 1 0 0 1
vertex $ Vertex3 ( dx + 0 :: GLdouble ) ( dy + 0.5 ) 0
currentColor $= Color4 0 1 0 1
vertex $ Vertex3 ( dx + 0.5 :: GLdouble ) ( dy 0.5 ) 0
currentColor $= Color4 0 0 1 1
vertex $ Vertex3 ( dx 0.5 :: GLdouble ) ( dy 0.5 ) 0
flush

idle st = do
( dx , dy , delta , prevTStamp ) <- get st
tstamp <- getTimestamp
let dt = tstamp prevTStamp
dy’ = dy + delta * dt
delta’ = if abs dy’ <= 0.5 then delta else delta
st $=! ( dx , dy’ , delta’ , tstamp )
postRedisplay Nothing

keyboardMouse st key keyState _ {-modifiers-} _ {- pos -} =
keyboardAct st key keyState

keyboardAct st ( SpecialKey KeyLeft ) Down = do
( dx , dy , delta , tstamp ) <- get st
let dx’ = dx 0.1
st $=! ( dx’ , dy , delta , tstamp )

keyboardAct st ( SpecialKey KeyRight ) Down = do
( dx , dy , delta , tstamp ) <- get st
let dx’ = dx + 0.1
st $=! ( dx’ , dy , delta , tstamp )

keyboardAct _ _ _ =
return ( )

getTimestamp :: IO GLdouble
getTimestamp = do
now <- getPOSIXTime
return $ fromRational $ toRational now

В состояние программы было добавлено смещение по оси X. Кроме того, мы прописали функцию keyboardMouse в keyboardMouseCallback. В итоге функция будет вызываться при любом нажатии кнопки на клавиатуре или мыши. При нажатии стрелок «влево» и «вправо» происходит изменение смещения по оси X. Теперь треугольник не только прыгает вверх-вниз, но и по нашему велению перемещается влево-вправо.

Радужный треугольник, который можно двигать

Также на этот раз для вершин треугольника были указаны различные цвета. В результате треугольник стал такой весь из себя радужный. Правда круто?

Вращающаяся пирамида с разноцветными гранями

Сколько можно жить в этом унылом двумерном мире? Разве OpenGL — это не про трехмерные игрушки и все такое? Нарисуем же что-нибудь объемное!

import Graphics . Rendering . OpenGL
import Graphics . UI . GLUT
import Data . IORef
import Data . Time . Clock . POSIX

data State = State {
deltaX :: GLdouble
, deltaY :: GLdouble
, moveSpeed :: GLdouble
, angle :: GLdouble
, rotateSpeed :: GLdouble
, tstamp :: GLdouble
}

main = do
_ <- getArgsAndInitialize
initialDisplayMode $= [ WithDepthBuffer ]
_ <- createWindow «Rotating Pyramid»
now <- getTimestamp
state <- newIORef State { deltaX = 0 , deltaY = 0 , moveSpeed = 0.5
, angle = 0.0 , rotateSpeed = 0.2
, tstamp = now
}
depthFunc $= Just Less
displayCallback $= display state
idleCallback $= Just ( idle state )
keyboardMouseCallback $= Just ( keyboardMouse state )
mainLoop

display state = do
st <- get state
clear [ ColorBuffer , DepthBuffer ]
let rot = rotateXZ ( angle st )
move = moveXY ( deltaX st ) ( deltaY st )
mr = move . rot
p1 = mr ( 0.58 ,- 0.29 ,- 0.00 )
p2 = mr ( 0.29 ,- 0.29 ,- 0.50 )
p3 = mr ( 0.29 ,- 0.29 , 0.50 )
p4 = mr ( 0.00 , 0.58 , 0.00 )

drawTriangle ( Color4 1 0 0 1 ) p1 p2 p4
drawTriangle ( Color4 0 1 0 1 ) p1 p3 p4
drawTriangle ( Color4 0 0 1 1 ) p2 p3 p4
drawTriangle ( Color4 1 0 1 1 ) p1 p2 p3
flush

idle state = do
st <- get state
now <- getTimestamp
let dt = now tstamp st
ms = moveSpeed st
dy’ = deltaY st + ms * dt
an = angle st + rotateSpeed st * 2 * pi * dt
an’ = if an > 2 * pi then an 2 * pi else an
ms’ = if abs dy’ <= 0.5 then ms else ms
state $=! st { deltaY = dy’ , moveSpeed = ms’
, angle = an’ , tstamp = now
}
postRedisplay Nothing

rotateXZ an ( x , y , z ) =
let x’ = ( x * cos an ) ( z * sin an )
z’ = ( x * sin an ) + ( z * cos an )
in ( x’ , y , z’ )

moveXY dx dy ( x , y , z ) =
( x + dx , y + dy , z )

drawTriangle clr p1 p2 p3 = do
let ( p1x , p1y , p1z ) = p1
( p2x , p2y , p2z ) = p2
( p3x , p3y , p3z ) = p3
currentColor $= clr
renderPrimitive Triangles $ do
vertex $ Vertex3 p1x p1y p1z
vertex $ Vertex3 p2x p2y p2z
vertex $ Vertex3 p3x p3y p3z

keyboardMouse st key keyState _ {- modifiers -} _ {- pos -} =
keyboardAct st key keyState

keyboardAct state ( SpecialKey KeyLeft ) Down = do
st <- get state
state $=! st { deltaX = deltaX st 0.1 }

keyboardAct state ( SpecialKey KeyRight ) Down = do
st <- get state
state $=! st { deltaX = deltaX st + 0.1 }

keyboardAct _ _ _ =
return ( )

getTimestamp :: IO GLdouble
getTimestamp = do
now <- getPOSIXTime
return $ fromRational $ toRational now

Эта программа делает все то же, что и предыдущая, только вместо радужного треугольника здесь рисуется правильная треугольная пирамида с разноцветными гранями. При этом основание вращается вокруг оси симметрии пирамиды, проходящей через центр этого основания. Чтобы нарисовать правильную треугольную пирамиду, нужно нарисовать четыре ее грани, представляющие собой треугольники. Поскольку треугольники мы рисовать уже умеем, вроде, все должно быть просто. Но есть нюанс.

Вращающаяся разноцветная пирамида на OpenGL и Haskell

Во-первых, строкой initialDisplayMode $= [WithDepthBuffer] мы говорим, что нам понадобится буфер глубины. Буфер глубины хранит значение глубины для каждого пикселя. Во-вторых, depthFunc $= Just Less говорит OpenGL отображать в окне цвета пикселей, лежащих на меньшей глубине. В-третьих, мы изменили вызов функции clear на clear [ColorBuffer, DepthBuffer] . Совершенно очевидно, что перед перерисовкой сцены буфер глубины должен очищаться.

Заключение

Дополнительные материалы в контексте Haskell:

Материалы по OpenGL вообще:

Исходники к заметке вы найдете в этом архиве . Для их компиляции используйте утилиту cabal .

У меня все еще много вопросов. Как работать с текстурами, анимацией, тенями и отражениям? Как управлять камерой? Как нарисовать туман, огонь, дождь, молнию или солнце? Как наложить на все это звуки? Тем не менее, знаний, описанных в этом посте, вполне достаточно для написания своих змеек, тетрисов, сборщиков кубика-рубика , эквалайзеров и многих других вещей. А это уже немало!

Дополнение: Учимся работать с текстурами в Haskell’евом OpenGL

EnglishRussianUkrainian