GPipe 2.2.2 → 2.2.3

raw patch · 4 files changed

+18/−29 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• GPipe.cabal +1/−1
• src/Graphics/GPipe/Internal/Compiler.hs +10/−22
• src/Graphics/GPipe/Internal/Context.hs +3/−6

@@ -1,3 +1,7 @@+### 2.2.3
+
+- Removing an unnecessary optimization that was broken since 2.2
+
 ### 2.2.2
 
 - Support for GHC 8.2.1 (#52)

@@ -1,5 +1,5 @@ name:           GPipe
-version:        2.2.2
+version:        2.2.3
 cabal-version:  >= 1.8
 build-type:     Simple
 author:         Tobias Bexelius

@@ -29,7 +29,6 @@ import Data.Word
 import Data.Monoid ((<>))
 
-
 type WinId = Int
 data Drawcall s = Drawcall {
                     drawcallFBO :: s -> (Either WinId (IO FBOKeys, IO ()), IO ()),
@@ -177,17 +176,13 @@                                                                      case Map.lookup wid (perWindowRenderState rs) of
                                                                        Nothing -> return () -- Window deleted
                                                                        Just (ws, doAsync) -> do
-                                                                         let (bindUni, uniState') = makeBind (boundUniforms ws :: Map.IntMap Int) uNameToRenderIOmap' (zip unis ubinds)
-                                                                         let (bindSamp, sampState') = makeBind (boundSamplers ws :: Map.IntMap Int) (samplerNameToRenderIO s) $ zip samps sbinds
-                                                                         let bindRast = if rastN == boundRasterizerN ws then const $ return () else rasterizationNameToRenderIO s ! rastN
-                                                                             wmap' = Map.insert wid (ws { boundUniforms = uniState', boundSamplers = sampState', boundRasterizerN = rastN }, doAsync) (perWindowRenderState rs)
-                                                                         lift $ lift $ put (rs {perWindowRenderState = wmap', renderLastUsedWin = wid })
+                                                                         lift $ lift $ put (rs {renderLastUsedWin = wid })
                                                                          mErr <- liftIO $ asSync doAsync $ do
                                                                              pName' <- readIORef pNameRef -- Cant use pName, need to touch pNameRef
                                                                              glUseProgram pName'
-                                                                             _ <- bindUni x (const $ return True :: () -> IO Bool)
-                                                                             isOk <- bindSamp x (return . not . (`Set.member` renderWriteTextures rs)  :: Int -> IO Bool)
-                                                                             bindRast x
+                                                                             _ <- bind uNameToRenderIOmap' (zip unis ubinds) x (const $ return True :: () -> IO Bool)
+                                                                             isOk <- bind (samplerNameToRenderIO s) (zip samps sbinds) x (return . not . (`Set.member` renderWriteTextures rs)  :: Int -> IO Bool)
+                                                                             (rasterizationNameToRenderIO s ! rastN) x
                                                                              blendio
                                                                              mErr2 <- m
                                                                              let mErr = if isOk then Nothing else Just "Running shader that samples from texture that currently has an image borrowed from it. Try run this shader from a separate render call where no images from the same texture are drawn to or cleared.\n"
@@ -276,19 +271,12 @@     addPstrUniform _ 0 = id
     addPstrUniform bname uSize = Map.insert 0 $ \_ bind -> glBindBufferRange GL_UNIFORM_BUFFER (fromIntegral bind) bname 0 (fromIntegral uSize)
 
-
-
-makeBind :: Map.IntMap Int -> Map.IntMap (s -> Binding -> IO x) -> [(Int, Int)] -> (s -> Asserter x -> IO Bool, Map.IntMap Int)
-makeBind m iom ((n,b):xs) = (g, m'')
-   where
-       (f, m') = makeBind m iom xs
-       (io, m'') = case Map.lookup b m' of
-                           Just x | x == n -> (\_ _ -> return True, m') -- Optimization, save gl calls to already bound buffers/samplers
-                           _               -> (\s asserter -> (iom ! n) s b >>= asserter, Map.insert b n m')
-       g s a = do ok1 <- f s a
-                  ok2 <- io s a
-                  return $ ok1 && ok2
-makeBind m _ [] = (\_ _ -> return True, m)
+bind ::  Map.IntMap (s -> Binding -> IO x) -> [(Int, Int)] -> s -> Asserter x -> IO Bool
+bind iom ((n,b):xs) s a = do
+    ok1 <- bind iom xs s a
+    ok2 <- (iom ! n) s b >>= a
+    return $ ok1 && ok2
+bind _ [] _ _ = return True
 
 orderedUnion :: Ord a => [a] -> [a] -> [a]
 orderedUnion xxs@(x:xs) yys@(y:ys) | x == y    = x : orderedUnion xs ys

@@ -137,10 +137,7 @@ type PerWindowState ctx = IMap.IntMap (WindowState, ContextWindow ctx) -- -1 is no window. 0 is the hidden window. 1.. are visible windows
 type PerWindowRenderState = IMap.IntMap (WindowState, ContextDoAsync)
 data WindowState = WindowState {
-    windowContextData :: !ContextData,
-    boundUniforms :: !(IMap.IntMap Int),
-    boundSamplers :: !(IMap.IntMap Int),
-    boundRasterizerN :: !Int
+    windowContextData :: !ContextData
   }
 
 -- | Run a 'Render' monad, that may have the effect of windows or textures being drawn to.
@@ -190,7 +187,7 @@   ContextState wid _ _ <- lift get -- We need to keep next window id and not start over at 1
   w <- liftIO $ createContext ctx Nothing
   cd <- liftIO $ addContextData (contextDelete ctx w) cds
-  let ws = WindowState cd IMap.empty IMap.empty (-1)
+  let ws = WindowState cd
   lift $ put $ ContextState wid (IMap.singleton 0 (ws,w)) 0
   liftIO $ contextDoAsync ctx (Just w) initGlState
   return w
@@ -203,7 +200,7 @@   w <- liftIO $ createContext ctx (Just (windowBits wf, wp))
   cd <- liftIO $ addContextData (contextDelete ctx w) cds
   let wid' = wid+1
-  let ws = WindowState cd IMap.empty IMap.empty (-1)
+  let ws = WindowState cd
   lift $ put $ ContextState wid' (IMap.insert wid (ws,w) wmap) wid
   liftIO $ contextDoAsync ctx (Just w) initGlState
   return $ Window wid