Unify matrix uniform assignment, move towards uniform block

src/Dodge/Creature.hs

@@ -142,8 +142,8 @@ startCr :: Creature
 startCr = defaultCreature
     { _crPos = (0,0)
     , _crOldPos = (0,0)
-    , _crDir = (pi/2)
+    , _crDir = pi/2
-    , _crMvDir  = (pi/2)
+    , _crMvDir  = pi/2
     , _crID = 0
     , _crPict = basicCrPict black
     , _crUpdate = stateUpdate yourControl

src/Dodge/Event.hs

@@ -114,7 +114,7 @@ wheelEvent y w = case (_carteDisplay w, _inventoryMode w) of
 moveYourAmmoSel :: Int -> World -> World
 moveYourAmmoSel i w = case yourItem w ^? wpAmmo . amPjParams of
     Just l -> w & creatures . ix (_yourID w) . crInv . ix (_crInvSel (you w))
-                    . wpAmmo . amParamSel %~ (`mod` (length l)) . subtract i
+                    . wpAmmo . amParamSel %~ (`mod` length l) . subtract i
     _ -> w
 moveYourAmmoParam :: Int -> World -> World
 moveYourAmmoParam i w = case yourItem w ^? wpAmmo . amPjParams . ix paramid . pjMaxParam of

src/Dodge/Item/Weapon.hs

@@ -830,7 +830,7 @@ explodeRemoteRocket
     -> World
 explodeRemoteRocket itid pjid w
     = set (projectiles . ix pjid . pjUpdate) (\_ -> retireRemoteRocket itid 30 pjid)
-    $ set (projectiles . ix pjid . pjDraw) (\_ -> blank)
+    $ set (projectiles . ix pjid . pjDraw) (const blank)
     $ set (itPoint . itUse) (\_ _ -> id)
     $ resetName
     $ makeExplosionAt (_pjPos (_projectiles w IM.! pjid)) w
@@ -850,7 +850,7 @@ throwRemoteBomb cr w = setLocation
         { _pjPos = p
         , _pjStartPos = p
         , _pjVel = v
-        , _pjDraw = \_ -> blank
+        , _pjDraw = const blank
         , _pjID = i
         , _pjUpdate = \_ -> moveRemoteBomb itid 50 i
         }

src/Dodge/Item/Weapon/Booster.hs

@@ -97,7 +97,7 @@ drawBoostShockwave pj = setLayer 1 $ onLayer UPtLayer $ pictures $
         r <- safeHead xs
         return $ color (snd $ last lpairs) $ uncurry translate hp 
             $ arc (argV hv - pi/2) (argV hv + pi/2) $ r * magV hv
-    cols = map (flip withAlpha white) [0,0.05..]
+    cols = map (`withAlpha` white) [0,0.05..]
     lpairs = zip (reverse lps) cols
     pvs = _pjPoints pj
     t = _pjTimer pj

src/Dodge/Layout.hs

@@ -38,7 +38,7 @@ generateLevelFromRoomList gr w = updateWallZoning
   where
     plmnts = concatMap _rmPS rs
     rs = zipWith addTile zs rs'
-    zs = map fromIntegral $ randomRs (0,(63::Int)) $ _randGen w
+    zs = map fromIntegral $ randomRs (0,63::Int) $ _randGen w
     rs' = evalState gr $ _randGen w
 
 -- | connects a collection (tree) of rooms together

src/Dodge/LevelGen.hs

@@ -81,7 +81,7 @@ placeSpot ps w = case _psType ps of
     PutDoubleDoor col f a b -> putDoubleDoor col f (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w
     PutAutoDoor a b -> addAutoDoor (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w
     PutBlock (hp:hps) col ps' -> putBlock (map (shiftPointBy (p,rot)) ps') hp col False hps w
-    PutBlock _ _ _ -> error "messed up block placement somehow"
+    PutBlock{} -> error "messed up block placement somehow"
     PutBtDoor c bp f a b -> addButtonDoor c (shiftPointBy (p,rot) bp) (f + rot) 
                             (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w
     PutSwitchDoor c bp f a b -> addSwitchDoor c (shiftPointBy (p,rot) bp) (f + rot) 

src/Dodge/Render.hs

@@ -21,7 +21,7 @@ import Picture.Tree
 import Shader
 import Shader.Data
 import Shader.Poke
-import MatrixHelper
+--import MatrixHelper
 
 import Foreign (Word32)
 --import Control.Applicative
@@ -59,10 +59,8 @@ doDrawing pdata w = do
     --setIsoMatrixUniforms pdata rot camzoom trans wins
     setPerpMatrixUniforms pdata rot camzoom trans wins viewFroms
     depthFunc $= Just Less
-    pmat <- (newMatrix RowMajor $ perspectiveMatrix rot camzoom trans wins viewFroms) 
-        :: IO (GLmatrix GLfloat)
     -- draw the lightmap. Probably changes the bound framebufferObject
-    createLightMap pdata (w ^. config . shadow_resolution) wallPoints lightPoints viewFroms pmat
+    createLightMap pdata (w ^. config . shadow_resolution) wallPoints lightPoints viewFroms
         (foregroundPics w)
 
 --    -- set the coordinate uniforms ready for drawing elements using world coordinates
@@ -78,11 +76,11 @@ doDrawing pdata w = do
     -- draw the walls
     depthFunc $= Just Less
     if w ^. config . wall_textured
-        then renderTextureWalls pdata wallPointsCol pmat
+        then renderTextureWalls pdata wallPointsCol
-        else renderBlankWalls pdata wallPointsCol pmat
+        else renderBlankWalls pdata wallPointsCol
     -- I believe a more apt name would be setCeilingDepth: stops drawing of objects
     -- at points that are behind the extension of walls to the screen edge
-    _ <- setWallDepth pdata wallPoints (viewFromx,viewFromy) pmat
+    _ <- setWallDepth pdata wallPoints (viewFromx,viewFromy)
     -- draw the first layer of pictures
     -- these will probably all be opaque
     _ <- renderFoldable pdata $ picToLTree (Just 0) pic
@@ -99,7 +97,7 @@ doDrawing pdata w = do
     depthMask $= Disabled
     -- render transparent walls
     -- the ordering between these and transparent clouds perhaps presents a challenge
-    renderBlankWalls pdata windowPoints pmat
+    renderBlankWalls pdata windowPoints
 
     depthMask $= Enabled
     forM_ (_pictureShaders pdata) $ setPerpMatUniform rot camzoom trans wins viewFroms
@@ -138,13 +136,12 @@ doDrawing pdata w = do
 renderBlankWalls 
     :: RenderData 
     -> [((Point2,Point2),Point4)]   -- ^ List: wall positions and color
-    -> GLmatrix GLfloat 
+--    -> GLmatrix GLfloat 
     -> IO ()
-renderBlankWalls pdata wps pmat = do
+renderBlankWalls pdata wps = do
     n <- F.foldM (pokeShader $ _wallBlankShader pdata) (map Render22x4 wps)
     bindShaderBuffers [_wallBlankShader pdata] [n]
     currentProgram $= Just (_shaderProgram $ _wallBlankShader pdata)
-    uniform (_shaderMatrixUniform $ _wallBlankShader pdata) $= pmat
     cullFace $= Just Back
     drawShader (_wallBlankShader pdata) n
     cullFace $= Nothing
@@ -152,13 +149,11 @@ renderBlankWalls pdata wps pmat = do
 renderTextureWalls 
     :: RenderData 
     -> [((Point2,Point2),Point4)]   -- ^ List: wall positions and color
-    -> GLmatrix GLfloat 
     -> IO ()
-renderTextureWalls pdata wps pmat = do
+renderTextureWalls pdata wps = do
     n <- F.foldM (pokeShader $ _wallTextureShader pdata) (map Render22x4 wps)
     bindShaderBuffers [_wallTextureShader pdata] [n]
     currentProgram $= Just (_shaderProgram $ _wallTextureShader pdata)
-    uniform (_shaderMatrixUniform $ _wallTextureShader pdata) $= pmat
     cullFace $= Just Back
     drawShader (_wallTextureShader pdata) n
     cullFace $= Nothing

src/Dodge/Room/Foreground.hs

@@ -16,9 +16,9 @@ highDiagonalMesh
     -> Float    -- ^ vertical distance between lines
     -> Picture
 highDiagonalMesh pa pb w d = setDepth (-0.2) $ pictures $
-    (map (flip thickLine 3 . flat2) $ diagonalLinesRect pb pa w d (3*pi/4))
+    map (flip thickLine 3 . flat2) (diagonalLinesRect pb pa w d (3*pi/4))
     ++ 
-    (map (flip thickLine 3 . flat2) $ diagonalLinesRect pb pc (negate h) d (pi/4))
+    map (flip thickLine 3 . flat2) (diagonalLinesRect pb pc (negate h) d (pi/4))
   where
     pc = pb +.+ w *.* normalizeV (vNormal (pb -.- pa))
     h = dist pa pb
@@ -42,7 +42,7 @@ diagonalLinesRect pa pb w d ang = zip lhsPoints $ map findDiPoint lhsPoints
         ,intersectSegLine' pa pax p (p +.+ diVec)
         ,intersectSegLine' pb pbx p (p +.+ diVec)
         ]
-    yN = d * 0.5 *.* (normalizeV $ pa -.- pb)
+    yN = d * 0.5 *.* normalizeV (pa -.- pb)
 
 highPipe :: Point2 -> Point2 -> Picture
 highPipe x y = pictures 
@@ -60,7 +60,7 @@ girderZ w x y = setDepth (-0.1) $ color red $ pictures $
     ]
     ++ map (flip thickLine 3 . flat2) ls
   where
-    n = w *.* (normalizeV $ vNormal $ y -.- x)
+    n = w *.* normalizeV (vNormal $ y -.- x)
     xb = x +.+ n
     yb = y +.+ n
     xt = x -.- n
@@ -77,27 +77,27 @@ girderV col w x y = setDepth (-0.1) $ color col $ pictures $
     ++ map (flip thickLine 3 . flat2) as'
     ++ map (flip thickLine 3 . flat2) bs'
   where
-    n = w *.* (normalizeV $ vNormal $ y -.- x)
+    n = w *.* normalizeV (vNormal $ y -.- x)
     xb = x +.+ n
     yb = y +.+ n
     xt = x -.- n
     yt = y -.- n
     ps = divideLineExact (w*2) xb yb
     (as,_) = evenOddSplit ps
-    f a = map (\p -> intersectSegLine' xt yt p (p +.+ (rotateV a n)))
+    f a = map (\p -> intersectSegLine' xt yt p (p +.+ rotateV a n))
     as' = catMaybes $ zipWith (fmap . (,)) as $ f (pi/4) as
     bs' = catMaybes $ zipWith (fmap . (,)) as $ f (3*pi/4) as
 girder :: Color -> Float -> Point2 -> Point2 -> Picture
 girder col w x y = pictures $
-    [ setDepth (-0.1) $ color col $ pictures $
+    (setDepth (-0.1) $ color col $ pictures $
         [ thickLine [xt,yt] 3 
         , thickLine [xb,yb] 3
         ]
         ++ map (flip thickLine 3 . flat2) ls
-    ]
+    )
-    ++ map (\p -> verticalPipe 1.5 col p 0 (-0.1)) [xb,xt,yb,yt]
+    : map (\p -> verticalPipe 1.5 col p 0 (-0.1)) [xb,xt,yb,yt]
   where
-    n = w *.* (normalizeV $ vNormal $ y -.- x)
+    n = w *.* normalizeV (vNormal $ y -.- x)
     xb = x +.+ n
     yb = y +.+ n
     xt = x -.- n

src/Dodge/WorldEvent/Cloud.hs

@@ -39,7 +39,7 @@ makeThinSmokeAt = makeCloudAt 5 400 (drawCloudWith 4 400 (withAlpha 0.05 black))
 
 makeStartCloudAt :: Point2 -> World -> World
 --makeSmokeCloudAt = makeCloudAt 10 200 (drawCloudWith 2 200 (greyN 0.5))
-makeStartCloudAt = makeCloudAt 10 400 (drawCloudWith (2) 800 white)
+makeStartCloudAt = makeCloudAt 10 400 (drawCloudWith 2 800 white)
 
 makeSmokeCloudAt :: Point2 -> World -> World
 --makeSmokeCloudAt = makeCloudAt 10 200 (drawCloudWith 2 200 (greyN 0.5))

src/Dodge/WorldEvent/Explosion.hs

@@ -37,7 +37,7 @@ makeTeslaExplosionAt
     :: Point2   -- ^ Position
     -> World 
     -> World
-makeTeslaExplosionAt pos w = undefined pos w
+makeTeslaExplosionAt = undefined
 --     soundOncePos grenadeBang pos $ foldr ($) w listOfFunctions -- a bit shorter
 --  where 
 --    xs = randomRs (0, 2*pi) $ _randGen w

src/Picture.hs

@@ -122,7 +122,7 @@ extrapolate (ox,oy) (ax,ay) (bx,by) (x,y) =
 
 color :: RGBA -> Picture -> Picture
 {-# INLINE color #-}
-color c = OverPic id 0 (const c)
+color c = OverPic id (const c)
 
 translate3 :: Float -> Float -> Point3 -> Point3
 {-# INLINE translate3 #-}
@@ -130,11 +130,11 @@ translate3 a b (x,y,z) = (x+a,y+b,z)
 
 translate :: Float -> Float -> Picture -> Picture
 {-# INLINE translate #-}
-translate x y = OverPic (translate3 x y) 0 id
+translate x y = OverPic (translate3 x y) id
 
 setDepth :: Float -> Picture -> Picture
 {-# INLINE setDepth #-}
-setDepth d = OverPic (\(x,y,_) -> (x,y,d)) 0 id
+setDepth d = OverPic (\(x,y,_) -> (x,y,d)) id
 
 setLayer :: Int -> Picture -> Picture
 {-# INLINE setLayer #-}
@@ -146,7 +146,7 @@ scale3 a b (x,y,z) = (x*a,y*b,z)
 
 scale :: Float -> Float -> Picture -> Picture
 {-# INLINE scale #-}
-scale x y = OverPic (scale3 x y) 0 id
+scale x y = OverPic (scale3 x y) id
 
 rotate3 :: Float -> Point3 -> Point3
 {-# INLINE rotate3 #-}
@@ -156,7 +156,7 @@ rotate3 a (x,y,z) = (x',y',z)
 
 rotate :: Float -> Picture -> Picture
 {-# INLINE rotate #-}
-rotate a = OverPic (rotate3 a) a id
+rotate a = OverPic (rotate3 a) id
 
 pictures :: [Picture] -> Picture
 {-# INLINE pictures #-}

src/Picture/Data.hs

@@ -86,7 +86,7 @@ data Picture
     | Line Int [Point2]
     | LineCol Int [(Point2,RGBA)]
     | Pictures [Picture]
-    | OverPic (Point3 -> Point3) Float (Point4 -> Point4) Picture
+    | OverPic (Point3 -> Point3) (Point4 -> Point4) Picture
     | OnLayer Int Picture
 
 blank :: Picture

src/Picture/Render.hs

@@ -27,9 +27,8 @@ setWallDepth
     :: RenderData
     -> [(Point2,Point2)]    -- ^ Wall points
     -> (Float,Float)        -- ^ View from point
-    -> GLmatrix GLfloat
     -> IO Word32
-setWallDepth pdata wallPoints (viewFromx,viewFromy) _ = do
+setWallDepth pdata wallPoints (viewFromx,viewFromy) = do
     startTicks <- SDL.ticks
     colorMask $= Color4 Disabled Disabled Disabled Disabled
     nWalls <- F.foldM (pokeShader $ _lightingOccludeShader pdata) (map Render22 wallPoints)
@@ -62,10 +61,9 @@ createLightMap
     -> [(Point2,Point2)]    -- Wall pairs
     -> [Point4]             -- Lights
     -> (Float,Float)        -- View from position
-    -> GLmatrix GLfloat     -- perspective matrix
     -> Picture              -- foreground pictures
     -> IO ()
-createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) pmat _ = do
+createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) _ = do
 
 -- get viewport size so we can reset it later
     (vppos,vpsize) <- get viewport
@@ -79,9 +77,9 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) pmat _
     nWalls <- F.foldM (pokeShader $ _lightingOccludeShader pdata) (map Render22 wallPoints)
     bindShaderBuffers [_lightingOccludeShader pdata] [nWalls]
 -- set uniforms for shader that draws lights
-    currentProgram $= Just (_shaderProgram $ _lightingWallShader pdata)
+--    currentProgram $= Just (_shaderProgram $ _lightingWallShader pdata)
-    uniform (_shaderMatrixUniform $ _lightingWallShader pdata)
+--    uniform (_shaderMatrixUniform $ _lightingWallShader pdata)
-            $= pmat
+--            $= pmat
 -- clear buffer to full alpha and furthest depth
     clearColor $= Color4 0 0 0 1
     clearDepth $= 1
@@ -92,7 +90,7 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) pmat _
     currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata)
     uniform (head $  _shaderCustomUnis $ _lightingOccludeShader pdata)
             $= Vector2 viewFromx viewFromy  
-    uniform (_shaderMatrixUniform $ _lightingOccludeShader pdata) $= pmat
+--    uniform (_shaderMatrixUniform $ _lightingOccludeShader pdata) $= pmat
     cullFace $= Just Back
     drawShader (_lightingOccludeShader pdata) nWalls
 
@@ -215,12 +213,16 @@ setPerpMatrixUniforms
     -> (Float,Float)    -- ^ ViewFrom
     -> IO ()
 setPerpMatrixUniforms pdata rot czoom trans wins vfs = mapM_ (setPerpMatUniform rot czoom trans wins vfs)
-    $ ( (_lightingFloorShader pdata) 
+    ( _lightingFloorShader pdata
-        : (_backgroundShader pdata) 
+    : _lightingWallShader pdata
-        : (_textureShader pdata)
+    : _lightingOccludeShader pdata
-        : (_textureArrayShader pdata)
+    : _backgroundShader pdata
-        : (_pictureShaders pdata)
+    : _textureShader pdata
-        )
+    : _textureArrayShader pdata
+    : _wallBlankShader pdata
+    : _wallTextureShader pdata
+    : _pictureShaders pdata
+    )
 
 renderShader
     :: Foldable f

src/Picture/Tree.hs

@@ -30,7 +30,6 @@ picToLTree mx (BezierQuad i vs) = filtB mx i $ LLeaf $ RenderBezQ $ zip3 (map ze
   where 
     (ps,cols,offps,rads) = unzip4 vs
     rs = zipWith (\(x,y) (z,w) -> (x,y,z,w)) offps rads
-                                      
 picToLTree mx (Circle i colC colE r) = filtB mx i $ LLeaf $ RenderEllipse 
     [( (-r, r,0), colC)
     ,( (-r,-r,0), colE)
@@ -53,24 +52,21 @@ picToLTree mx (Line i ps)
 picToLTree mx (LineCol i vs) 
     = filtB mx i $ LLeaf $ RenderLine $ zip (map zeroZ $ doubleLine ps) $ doubleLine cs
   where (ps,cs) = unzip vs
-picToLTree mx (Text i s) 
+picToLTree mx (Text i s) = filtB mx i $ LLeaf $ RenderText $ stringToList s
-    = filtB mx i $ LLeaf $ RenderText $ stringToList s
 picToLTree _ Blank = LBranches []
 picToLTree j (Pictures pics) = LBranches $ map (picToLTree j) pics
-picToLTree j (OverPic f r f'' (OverPic g s g'' pic)) 
+picToLTree j (OverPic f f' (OverPic g g' pic)) = picToLTree j $ OverPic (f . g) (f' . g') pic
-    = picToLTree j $ OverPic (f . g) (r + s) (f'' . g'') pic
+picToLTree j (OverPic f f' (Pictures ps)) = LBranches (map (picToLTree j . OverPic f f') ps)
-picToLTree j (OverPic f r f'' (Pictures ps)) 
+picToLTree j (OverPic f f' pic) = overPos f . overCol f' <$> picToLTree j pic
-    = LBranches (map (picToLTree j . OverPic f r f'') ps)
-picToLTree j (OverPic f r f'' pic) 
-    = overPos f . overRot r . overCol f'' <$> picToLTree j pic
 picToLTree (Just j) (OnLayer i pic) | j == i = picToLTree Nothing pic
                                     | otherwise = LBranches []
 picToLTree Nothing  (OnLayer _ pic) = picToLTree Nothing pic
 
 filtB :: Maybe Int -> Int -> LTree RenderType -> LTree RenderType
 {-# INLINE filtB #-}
-filtB mx i t | Just i == mx || isNothing mx = t
+filtB mx i t 
-             | otherwise                     = LBranches []
+    | Just i == mx || isNothing mx = t
+    | otherwise                    = LBranches []
 
 doubleLine :: [a] -> [a]
 {-# INLINE doubleLine #-}
@@ -91,10 +87,6 @@ overPos f (RenderEllipse vs) = RenderEllipse $ map (first f) vs
 overPos f (RenderArc vs)  = RenderArc $ map (\(a,b,c) -> (f a,b,c)) vs
 overPos _ _ = undefined
 
-overRot :: Float -> RenderType -> RenderType
-{-# INLINE overRot #-}
-overRot _ ren = ren
-
 overCol :: (Point4 -> Point4) -> RenderType -> RenderType
 {-# INLINE overCol #-}
 overCol f (RenderPoly vs)     = RenderPoly    $ map (second f) vs
@@ -102,12 +94,12 @@ overCol f (RenderLine vs)     = RenderLine    $ map (second f) vs
 overCol f (RenderEllipse vs)  = RenderEllipse $ map (second f) vs
 overCol f (RenderText vs)     = RenderText    $ map (\(a,b,c) -> (a,f b,c)) vs
 overCol f (RenderBezQ vs)     = RenderBezQ    $ map (\(a,b,c) -> (a,f b,c)) vs
-overCol f (RenderArc vs) = RenderArc $ map (\(a,b,c) -> (a,f b,c)) vs
+overCol f (RenderArc vs)      = RenderArc     $ map (\(a,b,c) -> (a,f b,c)) vs
 overCol _ _ = undefined
 
 stringToList :: String -> [(Point3,Point4,Point2)]
 {-# INLINE stringToList #-}
-stringToList s = concat $ zipWith (\x -> map (f x))
+stringToList s = concat $ zipWith (map . f)
     [0,0.9*dimText..]
     $ map charToTuple s
   where
@@ -133,12 +125,3 @@ charToTuple c =
 translate3 :: Float -> Float -> Point3 -> Point3
 {-# INLINE translate3 #-}
 translate3 a b (x,y,z) = (x+a,y+b,z)
-{- Scale a 3D vector in the x and y directions. -}
---scale3 :: Float -> Float -> Point3 -> Point3
---{-# INLINE scale3 #-}
---scale3 a b (x,y,z) = (x*a,y*b,z)
---{- Rotate a 3D vector in the x-y plane. -}
---rotate3 :: Float -> Point3 -> Point3
---{-# INLINE rotate3 #-}
---rotate3 a (x,y,z) = (x',y',z)
---    where (x',y') = rotateV a (x,y)

src/Preload/Render.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE TemplateHaskell #-}
+--{-# LANGUAGE TemplateHaskell #-}
 {-# OPTIONS_GHC -Wno-unused-top-binds #-}
 module Preload.Render
     ( preloadRender
@@ -167,7 +167,7 @@ pokeBezQStrat _ = []
 
 {-# INLINE pokeTriStrat #-}
 pokeTriStrat,pokeCharStrat,pokeArcStrat,pokeLineStrat,pokeEllStrat :: RenderType -> [[Float]]
-pokeTriStrat (RenderPoly vs) = fmap (\(p,co) -> concat [flat3 p,flat4 co]) vs
+pokeTriStrat (RenderPoly vs) = fmap (\(p,co) -> flat3 p ++ flat4 co) vs
 pokeTriStrat _ = []
 
 pokeLightingFloorStrat :: RenderType -> [[Float]]

src/Shader.hs

@@ -28,8 +28,7 @@ bindArrayBuffers :: Int -> VBO -> IO ()
 bindArrayBuffers numVs theVBO = do
     bindBuffer ArrayBuffer $= Just (_vbo theVBO)
     bufferData ArrayBuffer $= 
-        (fromIntegral $ floatSize * numVs * (sum $ _vboAttribSizes theVBO), _vboPointer theVBO, DynamicDraw)
+        (fromIntegral $ floatSize * numVs * sum (_vboAttribSizes theVBO), _vboPointer theVBO, DynamicDraw)
-    
 
 bindShaderBuffers :: [FullShader] -> [Int] -> IO ()
 bindShaderBuffers = zipWithM_ f

src/Shader/AuxAddition.hs

@@ -15,7 +15,7 @@ import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
     
 -- I am not sure if this assumes that the shader is constructed directly before
 -- the texture is added...
-addTexture :: String -> FullShader -> IO (FullShader)
+addTexture :: String -> FullShader -> IO FullShader
 addTexture texturePath shad = do
     Right cmap <- readImage texturePath
     let tex = convertRGBA8 cmap
@@ -31,7 +31,7 @@ addTexture texturePath shad = do
     textureFilter Texture2D $= ((Linear',Just Linear') , Nearest)
     return $ shad & shaderTexture ?~ ShaderTexture {_textureObject = textureOb}
 
-addTextureArray :: String -> FullShader -> IO (FullShader)
+addTextureArray :: String -> FullShader -> IO FullShader
 addTextureArray texturePath shad = do
     Right cmap <- readImage texturePath
     let tex = convertRGBA8 cmap
@@ -56,7 +56,7 @@ tilesToLine
     -> [a]
 tilesToLine w n = concat . concat . transpose . chunksOf n . chunksOf w
 
-addUniforms :: [String] -> FullShader -> IO (FullShader)
+addUniforms :: [String] -> FullShader -> IO FullShader
 addUniforms uniStrings shad = do
     uniLocs <- mapM (uniformLocation $ _shaderProgram shad) uniStrings
     return $ shad & shaderCustomUnis %~ (++ uniLocs)

src/Shader/Compile.hs

@@ -23,7 +23,7 @@ makeShader
     -> [Int]   -- ^ The input vertex sizes
     -> PrimitiveMode
     -> (RenderType -> [[Float]])   -- ^ Poke strategy: method for creating a list of vertex data to be bound
-    -> IO (FullShader)
+    -> IO FullShader
 makeShader s shaderlist sizes pm renStrat = do
     (prog,unis)  <- makeSourcedShader s shaderlist
     vaob        <- setupVAO sizes
@@ -57,7 +57,7 @@ setupVAO :: [Int] -> IO VAO
 setupVAO sizes = do
     theVAO <- genObjectName
     bindVertexArrayObject $= Just theVAO
-    theVBO <- setupVBO $ sizes
+    theVBO <- setupVBO sizes
     return $ VAO 
         { _vao = theVAO
         , _vaoVBO = theVBO

src/Tile.hs

@@ -10,7 +10,7 @@ tToRender t = map Render3x3 $ polyToTris $ zip ps3 coords3
   where
     ps = _tilePoly t
     coords = map (calcTexCoord (_tileCenter t) (_tileX t) (_tileY t)) ps
-    ps3 = map (mkTrip (0.9)) ps
+    ps3 = map (mkTrip 0.9) ps
     coords3 = map (mkTrip (_tileZ t)) coords
 
 mkTrip :: c -> (a,b) -> (a,b,c)
@@ -43,6 +43,6 @@ oTile poly z = Tile
     }
   where
     c = head poly
-    xdir = 50 *.* (normalizeV (poly !! 1 -.- c))
+    xdir = 50 *.* normalizeV (poly !! 1 -.- c)
     x = c +.+ xdir
     y = c +.+ vNormal xdir