Моя первая попытка поиграться с OpenGL на Haskell

28 августа 2013

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

Введение

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

GLUT (OpenGL Utility Toolkit) представляет собой библиотеку утилит для приложений, использующих 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 в Haskell, правда, на OpenGL.Raw и GLFW (также в интернетах пишут, что туториал, с которого эти примеры переводились на Haskell, сильно устарел);
Трассировка лучей на Haskell с использованием OpenGL;
Шутер от первого лица Frag написан на Haskell и поддерживает модели в формате md3, tga-текстуры, а также карты от Quake 3 (для успешной компиляции GHC 7 нужно немного пропатчить AFRPVectorSpace.hs);
Пример рисования множества Мандельброта на OpenGL, картинку можно двигать и масштабировать мышью;
В блогах можно найти немало постов по теме – раз, два, три, четыре, …;

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

Книга OpenGL SuperBible считается очень хорошим учебником по OpenGL (переводилась на русский);
Помимо SuperBible также советуют OpenGL Programming Guide, известную под кодовом именем RedBook (тоже переводилась на русский);
Довольно интересно выглядит wiki-книга OpenGL Programming – в ней есть примеры рисования трехмерных графиков и создания порталов;
Еще часто рекомендуют OpenGL Samples Pack;

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

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

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