Image.hs

module Graphics.Rendering.Ombra.Image (
        Image,
        image,
        uimage,
        draw
) where

import Data.Foldable
import Data.Functor.Identity
import Data.Proxy

import Graphics.Rendering.Ombra.Internal.GL (gl)
import Graphics.Rendering.Ombra.Draw.Class
import Graphics.Rendering.Ombra.Geometry
import Graphics.Rendering.Ombra.Geometry.Draw
import Graphics.Rendering.Ombra.Shader
import Graphics.Rendering.Ombra.Shader.CPU
import Graphics.Rendering.Ombra.Shader.GLSL
import Graphics.Rendering.Ombra.Shader.Program
import Graphics.Rendering.Ombra.Shader.Types
import Graphics.Rendering.Ombra.Image.Types
import Graphics.Rendering.Ombra.Texture.Draw

-- | Create an 'Image'.
image :: (ShaderInput i, GeometryVertex i, ShaderInput v)
      => VertexShader i (GVec4, v)
      -> FragmentShader v o
      -> Geometry i
      -> Image o
image vs fs g = uimage (const vs) (const fs) (Identity (g, (), ()))

-- | Create an 'Image' using the same shader with different uniforms for each
-- geometry. The resulting image can be rendered more efficiently than an
-- equivalent sequence of images created with 'image'.
uimage :: (ShaderInput i, GeometryVertex i, ShaderInput v, Foldable t)
       => (UniformSetter vu -> VertexShader i (GVec4, v))
       -> (UniformSetter fu -> FragmentShader v o)
       -> t (Geometry i, vu, fu)
       -> Image o
uimage vs fs g = Image g vs fs

-- | Draw an 'Image'.
draw :: (MonadDraw o m, FragmentShaderOutput o) => Image o -> m o ()
draw (Image geometries vs fs) =
        let prg = program (vs undefined) (fs undefined)
            -- XXX
        in do setProgram prg
              for_ geometries $ \(geometry, vu, fu) ->
                let (uid, unisv, texsv) = uniformList (vs $ return vu) 0
                    (_, unisf, texsf) = uniformList (fs $ return fu) uid
                    unis = unisv ++ unisf
                    texs = texsv ++ texsf
                in withActiveTextures texs (const $ return ()) $ \samplers ->
                        withUniforms unis
                                     (zip texs samplers)
                                     (drawGeometry geometry)
                     
        where withUniforms unis texs a = (>> a) .
                for_ unis $ \(uid, uniformValue) ->
                        getUniform uid >>= \eu ->
                                case eu of
                                     Right (UniformLocation l) ->
                                        case uniformValue of
                                             UniformValue proxy value ->
                                                gl $ setUniform l proxy value
                                             UniformTexture tex ->
                                                let proxy = Proxy
                                                        :: Proxy TextureSampler
                                                    Just value = lookup tex texs
                                                in gl $ setUniform l proxy value
                                     Left _ -> return ()

draw (SeqImage i i') = draw i >> draw i'
draw NoImage = return ()