packages feed

lambdacube-gl 0.5.0.1 → 0.5.0.3

raw patch · 5 files changed

+16/−14 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

lambdacube-gl.cabal view
@@ -1,5 +1,5 @@ name:                lambdacube-gl-version:             0.5.0.1+version:             0.5.0.3 synopsis:            OpenGL 3.3 Core Profile backend for LambdaCube 3D description:         OpenGL 3.3 Core Profile backend for LambdaCube 3D homepage:            http://lambdacube3d.com
src/LambdaCube/GL/Backend.hs view
@@ -4,6 +4,7 @@ import Control.Applicative import Control.Monad import Control.Monad.State+import Data.Maybe import Data.Bits import Data.IORef import Data.IntMap (IntMap)@@ -264,7 +265,7 @@         , inputUniforms         = Map.fromList inUniforms         , inputTextures         = Map.fromList inTextures         , inputTextureUniforms  = S.fromList $ texUnis-        , inputStreams          = Map.fromList [(n,(idx, attrName)) | (n,idx) <- Map.toList $ attributes, let Just attrName = Map.lookup n lcStreamName]+        , inputStreams          = Map.fromList [(n,(idx, attrName)) | (n,idx) <- Map.toList $ attributes, let attrName = fromMaybe (error $ "missing attribute: " ++ n) $ Map.lookup n lcStreamName]         }  compileRenderTarget :: Vector TextureDescriptor -> Vector GLTexture -> RenderTarget -> IO GLRenderTarget@@ -393,7 +394,7 @@   buffer <- compileBuffer arrays   cmdRef <- newIORef []   let toStream (n,i) = (n,Stream-        { streamType    = fromJust $ toStreamType =<< Map.lookup n (IR.streamType s)+        { streamType    = fromMaybe (error $ "missing attribute: " ++ n) $ toStreamType =<< Map.lookup n (IR.streamType s)         , streamBuffer  = buffer         , streamArrIdx  = i         , streamStart   = 0@@ -436,7 +437,7 @@         uniInputType (GLUniform ty _) = ty      -- object attribute stream commands-    streamCmds = [attrCmd i s | (i,name) <- Map.elems attrMap, let Just s = Map.lookup name attrs]+    streamCmds = [attrCmd i s | (i,name) <- Map.elems attrMap, let s = fromMaybe (error $ "missing attribute: " ++ name) $ Map.lookup name attrs]       where          attrMap = inputStreams prg         attrCmd i s = case s of@@ -603,7 +604,7 @@                     return (i,Nothing)             -- create input connection             let sm      = slotMap input-                pToI    = [i | n <- glSlotNames, let Just i = Map.lookup n sm]+                pToI    = [i | n <- glSlotNames, let i = fromMaybe (error $ "missing object array: " ++ n) $ Map.lookup n sm]                 iToP    = V.update (V.replicate (Map.size sm) Nothing) (V.imap (\i v -> (v, Just i)) pToI)             writeIORef glInput $ Just $ InputConnection idx input pToI iToP
src/LambdaCube/GL/Input.hs view
@@ -5,6 +5,7 @@ import Control.Exception import Control.Monad import Control.Monad.Writer+import Data.Maybe import Data.IORef import Data.Map (Map) import Data.IntMap (IntMap)@@ -78,15 +79,15 @@ addObject input slotName prim indices attribs uniformNames = do     let sch = schema input     forM_ uniformNames $ \n -> case Map.lookup n (uniforms sch) of-        Nothing -> throw $ userError $ "Unknown uniform: " ++ show n+        Nothing -> fail $ "Unknown uniform: " ++ show n         _ -> return ()     case Map.lookup slotName (objectArrays sch) of-        Nothing -> throw $ userError $ "Unknown slot: " ++ show slotName+        Nothing -> fail $ "Unknown slot: " ++ show slotName         Just (ObjectArraySchema sPrim sAttrs) -> do-            when (sPrim /= (primitiveToFetchPrimitive prim)) $ throw $ userError $+            when (sPrim /= (primitiveToFetchPrimitive prim)) $ fail $                 "Primitive mismatch for slot (" ++ show slotName ++ ") expected " ++ show sPrim  ++ " but got " ++ show prim             let sType = fmap streamToStreamType attribs-            when (sType /= sAttrs) $ throw $ userError $ unlines $ +            when (sType /= sAttrs) $ fail $ unlines $                  [ "Attribute stream mismatch for slot (" ++ show slotName ++ ") expected "                 , show sAttrs                 , " but got "@@ -101,7 +102,7 @@     enabled <- newIORef True     index <- readIORef seed     modifyIORef seed (1+)-    (setters,unis) <- mkUniform [(n,t) | n <- uniformNames, let Just t = Map.lookup n (uniforms sch)]+    (setters,unis) <- mkUniform [(n,t) | n <- uniformNames, let t = fromMaybe (error $ "missing uniform: " ++ n) $ Map.lookup n (uniforms sch)]     cmdsRef <- newIORef (V.singleton V.empty)     let obj = Object             { objSlot       = slotIdx@@ -216,7 +217,7 @@         uniInputType (GLUniform ty _) = ty      -- object attribute stream commands-    objStreamCmds = [attrCmd i s | (i,name) <- Map.elems attrMap, let Just s = Map.lookup name objAttrs]+    objStreamCmds = [attrCmd i s | (i,name) <- Map.elems attrMap, let s = fromMaybe (error $ "missing attribute: " ++ name) $ Map.lookup name objAttrs]       where          attrMap = inputStreams prg         objAttrs = objAttributes obj
src/LambdaCube/GL/Mesh.hs view
@@ -50,7 +50,7 @@ addMeshToObjectArray :: GLStorage -> String -> [String] -> GPUMesh -> IO Object addMeshToObjectArray input slotName objUniNames (GPUMesh _ (GPUData prim streams indices _)) = do     -- select proper attributes-    let Just (ObjectArraySchema slotPrim slotStreams) = Map.lookup slotName $! objectArrays $! schema input+    let (ObjectArraySchema slotPrim slotStreams) = fromMaybe (error $ "missing object array: " ++ slotName) $ Map.lookup slotName $! objectArrays $! schema input         filterStream n _ = Map.member n slotStreams     addObject input slotName prim indices (Map.filterWithKey filterStream streams) objUniNames @@ -82,7 +82,7 @@ updateMesh (GPUMesh (Mesh dMA dMP) (GPUData _ dS dI _)) al mp = do   -- check type match   let arrayChk (Array t1 s1 _) (Array t2 s2 _) = t1 == t2 && s1 == s2-      ok = and [Map.member n dMA && arrayChk (meshAttrToArray a1) (meshAttrToArray a2) | (n,a1) <- al, let Just a2 = Map.lookup n dMA]+      ok = and [Map.member n dMA && arrayChk (meshAttrToArray a1) (meshAttrToArray a2) | (n,a1) <- al, let a2 = fromMaybe (error $ "missing mesh attribute: " ++ n) $ Map.lookup n dMA]   if not ok then putStrLn "updateMesh: attribute mismatch!"     else do       forM_ al $ \(n,a) -> do
src/LambdaCube/GL/Util.hs view
@@ -341,7 +341,7 @@         | 0 <= i && i < V.length a &&           if elem t integralTypes then elem at integralArrTypes else True         -> fromStreamType t-        | otherwise -> throw $ userError "streamToInputType failed"+        | otherwise -> error "streamToInputType failed"       where         at = arrType $! (a V.! i)         integralTypes    = [Attribute_Word, Attribute_V2U, Attribute_V3U, Attribute_V4U, Attribute_Int, Attribute_V2I, Attribute_V3I, Attribute_V4I]