Для Haskell есть замечательные биндинги к OpenGL, а также биндинги к популярным “клиентским” вспомогательным библиотекам вроде GLUT, GLFW, SDL и прочим.

Мощь и изящество языка Haskell вместе с разнообразием фундаментальных подходов к композиции программ (монады, Arrow, FRP и т.д.) делают его чуть-ли не идеальным инструментом в написании корректных графических программ вроде симуляций или игр.

Задачи⌗

Попробуем разобраться с минимальными действиями, необходимыми для создания простенькой программки, использующей систему OpenGL современным образом: а именно, выполняя вычисления на высокопроизводительном GPU и управляя программируемым графическим конвейером с помощью вершинных, фрагментных и других шейдеров. В данной статье мы напишем простенькую программку вращения кубика с клавиатуры, попутно разбираясь в Haskell-специфике следующих деталей:

  • Создание окна и инициализация графического контекста GL
  • Обработка внешних событий (например, нажатие клавиш) клиента коллбэками GLUT
  • Подготовка Vertex Attributes – потока данных для загрузки в GPU
  • Создание Vertex Array Object (VAO) и Vertex Buffer Object (VBO), буферизация данных и определение правил их интерпретации аппаратурой
  • Загрузка, компиляция и линковка GLSL-файлов программы для шейдерного процессора GPU
  • Манипулирование uniform-переменными GLSL-микропрограммы из Haskell-кода
  • Обсчёт преобразования вращения нашего кубика не в Haskell-программе, а в GPU (в вершинном шейдере)

Теория⌗

В общем виде наша простая программка будет состоять из следующих частей:

  1. Сопряжение OpenGL с оконной подсистемой (GLUT)
  2. Вершинные атрибуты (позиции вершин куба)
  3. Передача вершинных атрибутов аппаратуре, получение VAO
  4. Вершинный и фрагментный шейдеры

Очень общая идея такова:

  1. Создать окно
  2. Закачать данные в VBO, установить шейдеры, получить некоторый дескриптор
    • аппаратура работает только с треугольниками, поэтому куб задан 12 треугольниками (36 Vertex3)
  3. Использовать этот дескриптор в коллбэках GLUT (при перерисовке окна, при клавиатуре)
    • в дескрипторе: 3-вектор углов вращения, Program (шейдерная программа), VertexArrayObject (VAO)
    • а также количество индексов VAO (у нас это - количество вершин куба), нужное для команды рендеринга
    • нажатиями на стрелки клавиатуры меняются углы (X-Y компоненты); коллбэк модифицирует значение IORef
    • перед командой рендеринга drawArrays (в коллбэке дисплея) вектор с углами считываются по ссылке и подаётся как uniform-значение перед запуском шейдерной программы
  4. После полной инициализации мы входим в mainLoop GLUT и продолжаем в коллбэках
  5. Фрагментный шейдер выводит один цвет для всех фрагментов
  6. Вершинный шейдер использует этот самый вектор с углами и вычисляет матрицу поворота для вершины, применяя её (умножая на неё вектор позиции)

Практика⌗

Чтобы не пихать всё в один файл мы разобъём код на несколько Haskell-модулей. Код на языке GLSL поместим в файлы и будем загружать их во время выполнения.

Организация кода⌗

Не претендуя на особую смекалку я разделил функционал таким образом:

$ ls -1 src/
GLPipeline.hs
GLUTAbstraction.hs
LoadShaders.hs
Main.hs
Types.hs
Utils.hs
Vertices.hs
fragment.glsl
vertex.glsl

Модуль Vertices содержит позиции вершин куба. Модуль LoadShaders взят из официальных примеров GLUT и содержит удобный интерфейс загрузки/компиляции/линковки шейдеров (не будем останавливаться на этом подробнее). Коллбэки и код создания окна находятся в GLUTAbstraction, настройка GL-контекста, копирование данных, сборка шейдеров и прочие операции – в GLPipeline. Как результат последних мы получаем объект типа Descriptor, который и используем с GLUT далее.

Types⌗

Наш дескриптор:

module Types where

import Graphics.UI.GLUT
import Data.IORef

data Descriptor = Descriptor (IORef (Vector3 Float)) Program VertexArrayObject NumArrayIndices

Main⌗

Код начала программы прост. Подготавливаем всё, что связано с GLUT, и входим в event-loop.

module Main where

import GLUTAbstraction

main :: IO ()
main = do
  glutPrepare

  glutLoop

GLUTAbstraction⌗

Инициализация GLUT представлена в функции glutPrepare.

module GLUTAbstraction where

import Graphics.UI.GLUT
import Data.IORef

import Types
import GLPipeline


glutPrepare :: IO ()
glutPrepare = do
  (progName, _args) <- getArgsAndInitialize
  initialDisplayMode $= [ RGBAMode ]
  initialWindowSize $= Size 512 512
  initialContextVersion $= (4, 3)
  initialContextProfile $= [ CoreProfile ]
  createWindow progName

  descriptor <- pipelineSetup

  displayCallback $= display descriptor
  specialCallback $= Just (specKeyDown descriptor)


glutLoop :: IO ()
glutLoop = mainLoop

Удобная функция getArgsAndInitialize не только инициализирует подсистему OpenGL, но и парсит стандартные аргументы GLUT-программы. Установкой минимальных требований версии и initialContextProfile в CoreProfile мы сообщаем GLUT о том, что будем использовать новую систему OpenGL и теряем совместимость со старым железом. Кстати, биндинги подключают пакет StateVar, поэтому мы можем использовать удобные $= и $~ для установки и модификации глобальных переменных (все IORef тоже реализуют интерфейс StateVar). Далее, получаем дескриптор и устанавливаем коллбэки.

Код коллбэка перерисовщика окна выглядит так. Здесь и происходит рендеринг куба в drawArrays:

display :: Descriptor -> DisplayCallback
display (Descriptor avref prog vao numvs) = do
  -- очищаем цветовой буфер перед его использованием
  clear [ ColorBuffer ]

  -- считываем текущий вектор с углами
  (Vector3 ax ay az) <- get avref

  -- находим переменную uniform vec3 rotAngles в микропрограмме
  rotAngles <- get $ uniformLocation prog "rotAngles"
  -- устанавливаем её в значение вектора с углами
  uniform rotAngles $= Vector3 ax ay az

  -- можем включить wireframe-режим 
  polygonMode $= (Line, Line)

  -- рисуем (с начала VAO) сложную картинку одной командой OpenGL!
  drawArrays Triangles 0 numvs

  -- сброс цветового буфера в фреймбуфер (т.е. в контекст в окне)
  flush

Код обработки нажатия клавишей-стрелок довольно прост, потому что GLUT содержит специальный коллбэк для “special” клавиш:

specKeyDown :: Descriptor -> SpecialCallback
specKeyDown (Descriptor avref _ _ _) KeyLeft _ = avref $~ (\(Vector3 ax ay az) -> Vector3 ax (ay-0.1) az) >> p
specKeyDown (Descriptor avref _ _ _) KeyRight _ = avref $~ (\(Vector3 ax ay az) -> Vector3 ax (ay+0.1) az) >> p
specKeyDown (Descriptor avref _ _ _) KeyUp _ = avref $~ (\(Vector3 ax ay az) -> Vector3 (ax+0.1) ay az) >> p
specKeyDown (Descriptor avref _ _ _) KeyDown _ = avref $~ (\(Vector3 ax ay az) -> Vector3 (ax-0.1) ay az) >> p
specKeyDown _ _ _ = return ()

p = postRedisplay Nothing

В GLUT для удобства определены некоторые синонимы, поэтому фактических параметра три.

type SpecialCallback = SpecialKey -> Position -> IO ()

После эндоморфизма вектора с углами не забываем запросить у GLUT перерисовку окна (после чего в скором времени попадём в соответствующий коллбэк).

Vertices⌗

Здесь мы триангулированием задаём куб с шириной 1.

module Vertices where

import Graphics.UI.GLUT
import Foreign.Storable(sizeOf)

cube :: [Vertex3 GLfloat]
cube =
  [
    Vertex3 (-0.5) (-0.5) (-0.5)
  , Vertex3 (-0.5) (-0.5)  0.5
  , Vertex3 (-0.5)  0.5  0.5
  , Vertex3 0.5  0.5 (-0.5)
  , Vertex3 (-0.5) (-0.5) (-0.5)
  , Vertex3 (-0.5)  0.5 (-0.5)
  , Vertex3 0.5 (-0.5)  0.5
  , Vertex3 (-0.5) (-0.5) (-0.5)
  , Vertex3 0.5 (-0.5) (-0.5)
  , Vertex3 0.5  0.5 (-0.5)
  , Vertex3 0.5 (-0.5) (-0.5)
  , Vertex3 (-0.5) (-0.5) (-0.5)
  , Vertex3 (-0.5) (-0.5) (-0.5)
  , Vertex3 (-0.5)  0.5  0.5
  , Vertex3 (-0.5)  0.5 (-0.5)
  , Vertex3 0.5 (-0.5)  0.5
  , Vertex3 (-0.5) (-0.5)  0.5
  , Vertex3 (-0.5) (-0.5) (-0.5)
  , Vertex3 (-0.5)  0.5  0.5
  , Vertex3 (-0.5) (-0.5)  0.5
  , Vertex3 0.5 (-0.5)  0.5
  , Vertex3 0.5  0.5  0.5
  , Vertex3 0.5 (-0.5) (-0.5)
  , Vertex3 0.5  0.5 (-0.5)
  , Vertex3 0.5 (-0.5) (-0.5)
  , Vertex3 0.5  0.5  0.5
  , Vertex3 0.5 (-0.5)  0.5
  , Vertex3 0.5  0.5  0.5
  , Vertex3 0.5  0.5 (-0.5)
  , Vertex3 (-0.5)  0.5 (-0.5)
  , Vertex3 0.5  0.5  0.5
  , Vertex3 (-0.5)  0.5 (-0.5)
  , Vertex3 (-0.5)  0.5  0.5
  , Vertex3 0.5  0.5  0.5
  , Vertex3 (-0.5)  0.5  0.5
  , Vertex3 0.5 (-0.5)  0.5
  ]

Будем использовать список cube в следующем модуле.

GLPipeline⌗

В данном модуле представлена всего одна функция. Она настраивает пайплайн и как результат возвращает наш дескриптор с VAO и другими данными:

module GLPipeline where

import Foreign.Marshal.Array(withArray)
import Graphics.UI.GLUT
import Data.IORef

import Types
import Utils
import LoadShaders
import Vertices

pipelineSetup :: IO Descriptor
pipelineSetup = do
  -- создание и биндинг VAO
  vao <- genObjectName
  bindVertexArrayObject $= Just vao

  -- создание и биндинг VBO
  arrayBuffer <- genObjectName
  bindBuffer ArrayBuffer $= Just arrayBuffer

  -- собственно буферизация (знаем габариты cube)
  withArray cube $ \ptr -> do
    let size = fromIntegral (numVertices cube * vertexSize cube)
    bufferData ArrayBuffer $= (size, ptr, StaticDraw)

  -- считывание, компиляция, линковка и активация шейдерной программы
  program <- loadShaders [
     ShaderInfo VertexShader (FileSource "vertex.glsl"),
     ShaderInfo FragmentShader (FileSource "fragment.glsl")]
  currentProgram $= Just program

  -- правила доступа к загруженным данным (локация 0 VAO)
  vertexAttribPointer (AttribLocation 0) $=
    (ToFloat,
     VertexArrayDescriptor 3 Float 0 (bufferOffset 0))
  -- включаем локацию
  vertexAttribArray (AttribLocation 0) $= Enabled

  -- создание ссылки с вектором углов вращения (изначально: нет вращения)
  avref <- newIORef $ Vector3 0 0 (0 :: Float)

  return $
    Descriptor avref program vao (fromIntegral (numVertices cube))

Отдельного внимания заслуживет буферизация данных. Вспомогательные функции numVertices и vertexSize узнают габариты нашего cube. Для bufferData нужен указатель (Ptr a) на передаваемые данные, поэтому мы используем функцию withArray, которая делает такой указатель из своего аргумента и передаёт его Ptr некоторому монадическому действию.

[a] -> (Ptr a -> IO b) -> IO b

Как минимум необходимы вершинный и фрагментный шейдеры. Их код приведён в следующем параграфе.

Haskell-биндинг vertexAttribPointer концептуально довольно сильно отличается от исходной библиотечной функции glVertexAttribPointer, однако разобраться не так уж и сложно:

vertexAttribPointer :: AttribLocation -> StateVar (IntegerHandling, VertexArrayDescriptor a)

На “локации” (по индексу) 0 каждый компонент безликих данных (последовательности каких-то 3-векторов – только мы знаем, что это положения вершин) следует понимать так:

  • целые числа понимать как float
  • атрибут (в нашем случае это – позиция в пространстве) имеет 3 компонента (в списке у нас Vector3)
  • компоненты имеют тип float
  • смещение в байтах между последовательными атрибутами (ещ раз: один атрибут - это трёхкомпонентный вектор, под которым мы понимем положение) равно нулю, т.е. они идут подряд в потоке
  • начальное смещение в прибинденном в данный момент ArrayBuffer (т.е. VBO) равно нулю байтов; используем вспомогательную функцию bufferOffset для получения Ptr Int(?) из 0

Здесь мы создаём и ссылку на вектор углов вращения, которым будем пользоваться после получения дескриптора.

Loadshaders⌗

Код данного замечательного модуля позаимствуем у профессионалов. Семантика его использования в нашей программе довольно очевидна.

Utils⌗

Вспомогательный код, не имеющий отношение к OpenGL (а потому вынесенный в отдельный модель).

module Utils where

import Foreign.Ptr
import Foreign.Storable

bufferOffset :: Integral a => a -> Ptr b
bufferOffset = plusPtr nullPtr . fromIntegral

numVertices l = length l
vertexSize l = sizeOf (head l)

Вершинный шейдер⌗

Собственно преобразование (поворот) вершины достигается умножением матрицы на вершину. Матрица, в свою очередь, рассчитывается на основании uniform-локации rotAngles, установленной главной программой. Всё расчёты происходят в GPU.

#version 430 core

in vec4 vPosition;
uniform vec3 rotAngles;

mat4 rotationMatrix(vec3 axis, float angle)
{
  axis = normalize(axis);
  float s = sin(angle);
  float c = cos(angle);
  float oc = 1.0 - c;

  return mat4
    (oc*axis.x*axis.x+c,oc*axis.x*axis.y-axis.z*s,oc*axis.z*axis.x+axis.y*s,0.0,
     oc*axis.x*axis.y+axis.z*s,oc*axis.y*axis.y+c,oc*axis.y*axis.z-axis.x*s,0.0,
     oc*axis.z*axis.x-axis.y*s,oc*axis.y*axis.z+axis.x*s,oc*axis.z*axis.z+c,0.0,
     0.0,0.0,0.0,1.0);
}


void
main()
{
  mat4 trans =
    rotationMatrix(vec3(1,0,0), rotAngles.x) *
    rotationMatrix(vec3(0,1,0), rotAngles.y) *
    rotationMatrix(vec3(0,0,1), rotAngles.z);

  vec4 pos = trans * vPosition;
  gl_Position = pos;
}

Фрагментный шейдер⌗

Фрагментный шейдер тривиален, поскольку мы просто генерируем один и тот же цвет каждый раз:

#version 430 core

out vec4 fColor;

void
main()
{
  fColor = vec4(0.0, 0.0, 1.0, 1.0);
}

Результат⌗

Вот и всё. Стрелками влево-вправо и вверх-вниз можно плавно вращать наш кубик. При этом наша программа, фактически, ничего и не делает: почти все данные и вычисления находятся и выполняются в GPU!

filled

wireframe