ref: 4161ae98a0bd95edcd9a8f48c5daf019dd7164bb misc/reflex-gl-demo/src/Uniform.hs -rw-r--r-- 1.5 KiB View raw
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
{-# OPTIONS_GHC -Wno-unused-matches #-}

{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell       #-}

module Uniform where

import           Control.Monad (unless)
import           Control.Monad.IO.Class (MonadIO)
import           Data.Dependent.Sum (DSum(..))
import qualified Data.Dependent.Sum as DSum
import           Data.Foldable (traverse_)
import           Data.Functor.Identity (Identity(..))
import           Data.GADT.Compare.TH (deriveGEq, deriveGCompare)
import           Data.GADT.Show.TH (deriveGShow)
import           Data.Map (Map)
import qualified Data.Map as Map
import           Data.StateVar (($=))
import           Graphics.Glow (Mat4, Program)
import qualified Graphics.Glow as Glow

data UniformKey a where
  Mat4 :: UniformKey Mat4

$(deriveGEq ''UniformKey)
$(deriveGCompare ''UniformKey)
$(deriveGShow ''UniformKey)

instance DSum.EqTag UniformKey Identity where
  eqTagged Mat4 Mat4 = (==)

-- | Set of uniforms to apply to a shader program.
type Uniforms = Map String (DSum UniformKey Identity)

-- | Set the current program and apply a set of uniforms to it.
applyUniforms :: MonadIO m => Program -> Uniforms -> m ()
applyUniforms prog uniforms = do
  Glow.currentProgram $= prog
  traverse_ (uncurry applyUniform) $ Map.toList uniforms
  where
    applyUniform name uniform = do
      loc <- Glow.uniformLocation prog name
      unless (loc == -1) $ case uniform of
        Mat4 :=> Identity m -> Glow.uniformMat4 loc m