GPipe-TextureLoad (empty) → 1.0.0

raw patch · 3 files changed

+176/−0 lines, 3 filesdep +GPipedep +basedep +stb-imagesetup-changed

Dependencies added: GPipe, base, stb-image

Files

GPipe-TextureLoad.cabal +46/−0
Setup.lhs +6/−0
src/Graphics/GPipe/Texture/Load.hs +124/−0

+ GPipe-TextureLoad.cabal view

@@ -0,0 +1,46 @@+name: GPipe-TextureLoad+version: 1.0.0+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+stability: Experimental+homepage: http://www.haskell.org/haskellwiki/GPipe+package-url:+bug-reports: mailto:tobias_bexelius@hotmail.com+synopsis: Load GPipe textures from filesystem+description: The functions of this package helps loading GPipe textures from file. It is based on the stb-image package, and supports subsets of the JPG, PNG, TGA, BMP and PSD formats.+category: Graphics+author: Tobias Bexelius+tested-with:+data-files:+data-dir: ""+extra-source-files:+extra-tmp-files:+exposed-modules: Graphics.GPipe.Texture.Load+exposed: True+buildable: True+build-tools:+cpp-options:+cc-options:+ld-options:+pkgconfig-depends:+frameworks:+c-sources:+extensions: FlexibleContexts FlexibleInstances+extra-libraries:+extra-lib-dirs:+includes:+install-includes:+include-dirs:+hs-source-dirs: src+other-modules:+ghc-prof-options:+ghc-shared-options:+ghc-options:+hugs-options:+nhc98-options:+jhc-options:

+ Setup.lhs view

@@ -0,0 +1,6 @@+#!/usr/bin/runhaskell 
+> module Main where
+> import Distribution.Simple
+> main :: IO ()
+> main = defaultMain
+

+ src/Graphics/GPipe/Texture/Load.hs view

@@ -0,0 +1,124 @@+-----------------------------------------------------------------------------+--+-- Module      :  Graphics.GPipe.Texture.Load+-- Copyright   :  Tobias Bexelius+-- License     :  BSD3+--+-- Maintainer  :  Tobias Bexelius+-- Stability   :  Experimental+-- Portability :+--+-- |+-- This module provides the means to load all kinds of textures from file.+-- It's based on the stb-image package, and inherits its strengths and limitations.+-- Specifically, it handles a subset of the JPEG, PNG, TGA, BMP and PSD file formats, but is not+-- entirely thread safe. See <http://hackage.haskell.org/package/stb-image> for more information.+--+-----------------------------------------------------------------------------++module Graphics.GPipe.Texture.Load (+    LoadableTexture(..),+    LoadableTexture3D(..),+) where++import Graphics.GPipe+import Codec.Image.STB+import Data.Either+import Foreign.Ptr (plusPtr)++-- | Provides the general way of loading any kind of textures. A 3D texture is assumed to be an array of square images+-- tiled vertically in the image file. Cube textures are assumed to be composed of 6 equally sized images+-- tiled vertically. No additional mipmaps are loaded.+--+-- Filesystem errors or bad texture dimensions (e.g. loading a cube texture from a file where the height+-- is not a multiple of 6) are thrown as 'IOError's.+class Texture t => LoadableTexture t where+    loadTexture :: TextureFormat t+                -> FilePath+                -> IO t++-- | Provides an alternative way of loading 'Texture3D's that are arrays of non-square images tiled vertically. No additional mipmaps are loaded.+--+-- Filesystem errors or bad texture dimensions (i.e. the height of the image is not a multiple of the supplied depth)+-- are thrown as 'IOError's.+class LoadableTexture3D f where+    loadTexture3D :: Int -- ^ The depth of the resulting 'Texture3D'+                  -> f+                  -> FilePath+                  -> IO (Texture3D f)++loadTexture' comp io path = do image <- loadImage' path comp+                               either+                                  (ioError . userError)+                                  (flip withImage io)+                                  image++texture3DFromImage cpufmt fmt path ptr s@(w,h) comp =+    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 =+    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 =+    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)++instance LoadableTexture (Texture3D AlphaFormat) where+    loadTexture fmt path = loadTexture' 1 (texture3DFromImage UnsignedByteFormat fmt path) path+instance LoadableTexture (Texture3D LuminanceFormat) where+    loadTexture fmt path = loadTexture' 1 (texture3DFromImage UnsignedByteFormat fmt path) path+instance LoadableTexture (Texture3D LuminanceAlphaFormat) where+    loadTexture fmt path = loadTexture' 2 (texture3DFromImage (PerComp2 UnsignedByteFormat) fmt path) path+instance LoadableTexture (Texture3D RGBFormat) where+    loadTexture fmt path = loadTexture' 3 (texture3DFromImage (PerComp3 UnsignedByteFormat) fmt path) path+instance LoadableTexture (Texture3D RGBAFormat) where+    loadTexture fmt path = loadTexture' 4 (texture3DFromImage (PerComp4 UnsignedByteFormat) fmt path) path++instance LoadableTexture (Texture2D AlphaFormat) where+    loadTexture fmt = loadTexture' 1 $ texture2DFromImage UnsignedByteFormat fmt+instance LoadableTexture (Texture2D LuminanceFormat) where+    loadTexture fmt = loadTexture' 1 $ texture2DFromImage UnsignedByteFormat fmt+instance LoadableTexture (Texture2D LuminanceAlphaFormat) where+    loadTexture fmt = loadTexture' 2 $ texture2DFromImage (PerComp2 UnsignedByteFormat) fmt+instance LoadableTexture (Texture2D RGBFormat) where+    loadTexture fmt = loadTexture' 3 $ texture2DFromImage (PerComp3 UnsignedByteFormat) fmt+instance LoadableTexture (Texture2D RGBAFormat) where+    loadTexture fmt = loadTexture' 4 $ texture2DFromImage (PerComp4 UnsignedByteFormat) fmt++instance LoadableTexture (Texture1D AlphaFormat) where+    loadTexture fmt = loadTexture' 1 $ texture1DFromImage UnsignedByteFormat fmt+instance LoadableTexture (Texture1D LuminanceFormat) where+    loadTexture fmt = loadTexture' 1 $ texture1DFromImage UnsignedByteFormat fmt+instance LoadableTexture (Texture1D LuminanceAlphaFormat) where+    loadTexture fmt = loadTexture' 2 $ texture1DFromImage (PerComp2 UnsignedByteFormat) fmt+instance LoadableTexture (Texture1D RGBFormat) where+    loadTexture fmt = loadTexture' 3 $ texture1DFromImage (PerComp3 UnsignedByteFormat) fmt+instance LoadableTexture (Texture1D RGBAFormat) where+    loadTexture fmt = loadTexture' 4 $ texture1DFromImage (PerComp4 UnsignedByteFormat) fmt++instance LoadableTexture (TextureCube AlphaFormat) where+    loadTexture fmt path = loadTexture' 1 (textureCubeFromImage UnsignedByteFormat fmt path) path+instance LoadableTexture (TextureCube LuminanceFormat) where+    loadTexture fmt path = loadTexture' 1 (textureCubeFromImage UnsignedByteFormat fmt path) path+instance LoadableTexture (TextureCube LuminanceAlphaFormat) where+    loadTexture fmt path = loadTexture' 2 (textureCubeFromImage (PerComp2 UnsignedByteFormat) fmt path) path+instance LoadableTexture (TextureCube RGBFormat) where+    loadTexture fmt path = loadTexture' 3 (textureCubeFromImage (PerComp3 UnsignedByteFormat) fmt path) path+instance LoadableTexture (TextureCube RGBAFormat) where+    loadTexture fmt path = loadTexture' 4 (textureCubeFromImage (PerComp4 UnsignedByteFormat) fmt path) path++instance LoadableTexture3D AlphaFormat where+    loadTexture3D d fmt path = loadTexture' 1 (texture3DFromImage' d UnsignedByteFormat fmt path) path+instance LoadableTexture3D LuminanceFormat where+    loadTexture3D d fmt path = loadTexture' 1 (texture3DFromImage' d UnsignedByteFormat fmt path) path+instance LoadableTexture3D LuminanceAlphaFormat where+    loadTexture3D d fmt path = loadTexture' 2 (texture3DFromImage' d (PerComp2 UnsignedByteFormat) fmt path) path+instance LoadableTexture3D RGBFormat where+    loadTexture3D d fmt path = loadTexture' 3 (texture3DFromImage' d (PerComp3 UnsignedByteFormat) fmt path) path+instance LoadableTexture3D RGBAFormat where+    loadTexture3D d fmt path = loadTexture' 4 (texture3DFromImage' d (PerComp4 UnsignedByteFormat) fmt path) path