Refactor shader types

src/Shader.hs

@@ -1,87 +1,71 @@
-module Shader
-    ( freeShaderPointers'
-    , drawShaderLay
-    , shadVBOptr
-    , drawFullShader
-    , drawShader
-    , pokeBindFoldable
-    , pokeBindFoldableLayer
-    ) where
-import Control.Lens
-import Shader.Data
-import Shader.Parameters
-import Shader.ExtraPrimitive
-import Shader.Poke
-import Shader.Bind
-import Picture.Data
+module Shader (
+    freeShaderPointers',
+    drawShaderLay,
+    shadVBOptr,
+    drawShader,
+    pokeBindFoldable,
+    pokeBindFoldableLayer,
+) where
 
-import qualified Data.Vector.Unboxed.Mutable as UMV
-import qualified Data.Vector.Mutable as MV
+import Control.Lens
+import Control.Monad
 import Control.Monad.Primitive
+--import qualified Data.Vector as V
+import qualified Data.Vector.Mutable as MV
+--import qualified Data.Vector.Unboxed as UV
+import qualified Data.Vector.Unboxed.Mutable as UMV
 import Foreign
 import Graphics.GL.Core45
+import Picture.Data
+import Shader.Bind
+import Shader.Data
+import Shader.Parameters
+import Shader.Poke
 
-drawShaderLay :: Int -> UMV.MVector (PrimState IO) Int -> Int -> (FullShader,VBO) -> IO ()
+drawShaderLay :: Int -> UMV.MVector (PrimState IO) Int -> Int -> (Shader, VBO) -> IO ()
 {-# INLINE drawShaderLay #-}
-drawShaderLay l countsVector shadIn fs = do 
+drawShaderLay l countsVector shadIn fs = do
     i <- UMV.read countsVector shadIn
-    glUseProgram (_shadName $ fst fs)
-    glBindVertexArray $ fs ^. _1 . shadVAO . vaoName
-    case _shadTex' $ fst fs of 
-        Just ShaderTexture{_textureObject = txo} --, _textureTarget = tt}
-            -> glBindTextureUnit 0 txo
-        _   -> return ()
-    glDrawArrays 
-        (marshalEPrimitiveMode $ _shadPrim' $ fst fs) 
-        (fromIntegral $ l*numSubElements) 
-        (fromIntegral i)
-
-drawFullShader :: FullShader -> Int -> IO ()
-{-# INLINE drawFullShader #-}
-drawFullShader fs i = do 
-    glUseProgram (_shadName fs)
-    glBindVertexArray $ fs ^. shadVAO . vaoName
-    case _shadTex' fs of 
-        Just ShaderTexture{_textureObject = txo
-                }
-            -> glBindTextureUnit 0 txo
-        _   -> return ()
-    glDrawArrays 
-        (marshalEPrimitiveMode $ _shadPrim' fs) 
-        0 
+    glUseProgram (_shaderUINT $ fst fs)
+    glBindVertexArray $ fs ^. _1 . shaderVAO . vaoName
+    zipWithM_ (\ti -> glBindTextureUnit ti . _unTO) [0 ..] (fs ^. _1 . shaderTextures)
+    glDrawArrays
+        (_unPrimitiveMode $ _shaderPrimitive $ fst fs)
+        (fromIntegral $ l * numSubElements)
         (fromIntegral i)
 
 drawShader :: Shader -> Int -> IO ()
 {-# INLINE drawShader #-}
-drawShader fs i = do 
+drawShader fs i = do
     glUseProgram (_shaderUINT fs)
     glBindVertexArray $ fs ^. shaderVAO . vaoName
-    glDrawArrays 
-        (_shaderPrimitive fs) 
-        0 
+    zipWithM_ (\ti -> glBindTextureUnit ti . _unTO) [0..] (fs ^. shaderTextures)
+    glDrawArrays
+        (_unPrimitiveMode $ _shaderPrimitive fs)
+        0
         (fromIntegral i)
 
-freeShaderPointers' :: (FullShader,VBO) -> IO ()
+freeShaderPointers' :: (Shader, VBO) -> IO ()
 freeShaderPointers' = free . _vboPtr . snd
 
-pokeBindFoldable
-    :: MV.MVector (PrimState IO) (FullShader,VBO)
-    -> UMV.MVector (PrimState IO) Int
-    -> Picture
-    -> IO ()
+pokeBindFoldable ::
+    MV.MVector (PrimState IO) (Shader, VBO) ->
+    UMV.MVector (PrimState IO) Int ->
+    Picture ->
+    IO ()
 pokeBindFoldable shadV counts m = do
     pokeVerxs shadV counts m
     bufferShaderVector shadV counts
 
-pokeBindFoldableLayer
-    :: MV.MVector (PrimState IO) (FullShader,VBO)
-    -> UMV.MVector (PrimState IO) Int
-    -> Picture
-    -> IO ()
+pokeBindFoldableLayer ::
+    MV.MVector (PrimState IO) (Shader, VBO) ->
+    UMV.MVector (PrimState IO) Int ->
+    Picture ->
+    IO ()
 pokeBindFoldableLayer shadV counts m = do
     pokeLayVerxs shadV counts m
     bindShaderLayers shadV counts
 
-shadVBOptr :: (FullShader,VBO) -> Ptr Float
+shadVBOptr :: (Shader, VBO) -> Ptr Float
 {-# INLINE shadVBOptr #-}
 shadVBOptr = _vboPtr . snd