GPipe-TextureLoad 1.0.0 → 1.0.1
raw patch · 2 files changed
+29/−18 lines, 2 filesdep +bitmapdep ~GPipedep ~stb-image
Dependencies added: bitmap
Dependency ranges changed: GPipe, stb-image
Files
GPipe-TextureLoad.cabal view
@@ -1,12 +1,12 @@ name: GPipe-TextureLoad-version: 1.0.0+version: 1.0.1 cabal-version: >=1.2.3 build-type: Simple license: BSD3 license-file: "" copyright: Tobias Bexelius maintainer: Tobias Bexelius-build-depends: GPipe -any, base ==4.1.0.0, stb-image -any+build-depends: GPipe >= 1.1.0, base ==4.1.0.0, stb-image >=0.2, bitmap -any stability: Experimental homepage: http://www.haskell.org/haskellwiki/GPipe package-url:
src/Graphics/GPipe/Texture/Load.hs view
@@ -23,6 +23,7 @@ import Graphics.GPipe import Codec.Image.STB+import Data.Bitmap.IO (withBitmap) import Data.Either import Foreign.Ptr (plusPtr) @@ -50,24 +51,34 @@ loadTexture' comp io path = do image <- loadImage' path comp either (ioError . userError)- (flip withImage io)+ (flip withBitmap io) image -texture3DFromImage cpufmt fmt path ptr s@(w,h) comp =+texture3DFromImage cpufmt fmt path s@(w,h) comp 0 ptr = case quotRem h w of (q, 0) -> newTexture cpufmt fmt (w:.w:.q:.()) [ptr] _ -> ioError $ userError ("loadTexture: Bad 3D image size " ++ show s ++ " in " ++ show path)-texture2DFromImage cpufmt fmt ptr (w,h) comp = newTexture cpufmt fmt (w:.h:.()) [ptr]-texture1DFromImage cpufmt fmt ptr (w,h) comp = newTexture cpufmt fmt (w*h) [ptr]-textureCubeFromImage cpufmt fmt path ptr s@(w,h) comp =+texture3DFromImage _ _ path _ _ _ _ = ioError $ userError ("loadTexture: Row padding is not supported, in " ++ show path)++texture2DFromImage cpufmt fmt path (w,h) comp 0 ptr = newTexture cpufmt fmt (w:.h:.()) [ptr]+texture2DFromImage _ _ path _ _ _ _ = ioError $ userError ("loadTexture: Row padding is not supported, in " ++ show path)++texture1DFromImage cpufmt fmt path (w,h) comp 0 ptr = newTexture cpufmt fmt (w*h) [ptr]+texture1DFromImage _ _ path _ _ _ _ = ioError $ userError ("loadTexture: Row padding is not supported, in " ++ show path)++textureCubeFromImage cpufmt fmt path s@(w,h) comp 0 ptr = case quotRem h 6 of (q, 0) -> newTexture cpufmt fmt (w:.q:.()) [ptr `plusPtr` (off*w*q) | off <- [0..5]] _ -> ioError $ userError ("loadTexture: Bad cube image size " ++ show s ++ " in " ++ show path)-texture3DFromImage' d cpufmt fmt path ptr s@(w,h) comp =+textureCubeFromImage _ _ path _ _ _ _ = ioError $ userError ("loadTexture: Row padding is not supported, in " ++ show path)++texture3DFromImage' d cpufmt fmt path s@(w,h) comp 0 ptr = case quotRem h d of (q, 0) -> newTexture cpufmt fmt (w:.q:.d:.()) [ptr] _ -> ioError $ userError ("loadTexture: Bad 3D image size " ++ show s ++ " in " ++ show path)+texture3DFromImage' _ _ _ path _ _ _ _ = ioError $ userError ("loadTexture: Row padding is not supported, in " ++ show path) + instance LoadableTexture (Texture3D AlphaFormat) where loadTexture fmt path = loadTexture' 1 (texture3DFromImage UnsignedByteFormat fmt path) path instance LoadableTexture (Texture3D LuminanceFormat) where@@ -80,26 +91,26 @@ loadTexture fmt path = loadTexture' 4 (texture3DFromImage (PerComp4 UnsignedByteFormat) fmt path) path instance LoadableTexture (Texture2D AlphaFormat) where- loadTexture fmt = loadTexture' 1 $ texture2DFromImage UnsignedByteFormat fmt+ loadTexture fmt path = loadTexture' 1 (texture2DFromImage UnsignedByteFormat fmt path) path instance LoadableTexture (Texture2D LuminanceFormat) where- loadTexture fmt = loadTexture' 1 $ texture2DFromImage UnsignedByteFormat fmt+ loadTexture fmt path = loadTexture' 1 (texture2DFromImage UnsignedByteFormat fmt path) path instance LoadableTexture (Texture2D LuminanceAlphaFormat) where- loadTexture fmt = loadTexture' 2 $ texture2DFromImage (PerComp2 UnsignedByteFormat) fmt+ loadTexture fmt path = loadTexture' 2 (texture2DFromImage (PerComp2 UnsignedByteFormat) fmt path) path instance LoadableTexture (Texture2D RGBFormat) where- loadTexture fmt = loadTexture' 3 $ texture2DFromImage (PerComp3 UnsignedByteFormat) fmt+ loadTexture fmt path = loadTexture' 3 (texture2DFromImage (PerComp3 UnsignedByteFormat) fmt path) path instance LoadableTexture (Texture2D RGBAFormat) where- loadTexture fmt = loadTexture' 4 $ texture2DFromImage (PerComp4 UnsignedByteFormat) fmt+ loadTexture fmt path = loadTexture' 4 (texture2DFromImage (PerComp4 UnsignedByteFormat) fmt path) path instance LoadableTexture (Texture1D AlphaFormat) where- loadTexture fmt = loadTexture' 1 $ texture1DFromImage UnsignedByteFormat fmt+ loadTexture fmt path = loadTexture' 1 (texture1DFromImage UnsignedByteFormat fmt path) path instance LoadableTexture (Texture1D LuminanceFormat) where- loadTexture fmt = loadTexture' 1 $ texture1DFromImage UnsignedByteFormat fmt+ loadTexture fmt path = loadTexture' 1 (texture1DFromImage UnsignedByteFormat fmt path) path instance LoadableTexture (Texture1D LuminanceAlphaFormat) where- loadTexture fmt = loadTexture' 2 $ texture1DFromImage (PerComp2 UnsignedByteFormat) fmt+ loadTexture fmt path = loadTexture' 2 (texture1DFromImage (PerComp2 UnsignedByteFormat) fmt path) path instance LoadableTexture (Texture1D RGBFormat) where- loadTexture fmt = loadTexture' 3 $ texture1DFromImage (PerComp3 UnsignedByteFormat) fmt+ loadTexture fmt path = loadTexture' 3 (texture1DFromImage (PerComp3 UnsignedByteFormat) fmt path) path instance LoadableTexture (Texture1D RGBAFormat) where- loadTexture fmt = loadTexture' 4 $ texture1DFromImage (PerComp4 UnsignedByteFormat) fmt+ loadTexture fmt path = loadTexture' 4 (texture1DFromImage (PerComp4 UnsignedByteFormat) fmt path) path instance LoadableTexture (TextureCube AlphaFormat) where loadTexture fmt path = loadTexture' 1 (textureCubeFromImage UnsignedByteFormat fmt path) path