bitmap-opengl 0.0.0.1 → 0.0.1.5
raw patch · 4 files changed
+162/−29 lines, 4 filesdep ~OpenGLdep ~base
Dependency ranges changed: OpenGL, base
Files
- Data/Bitmap/OpenGL.hs +82/−13
- Data/Bitmap/OpenGL/CubeMap.hs +60/−0
- LICENSE +1/−1
- bitmap-opengl.cabal +19/−15
Data/Bitmap/OpenGL.hs view
@@ -1,7 +1,7 @@ -- | OpenGL support for Data.Bitmap -{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE CPP, ScopedTypeVariables #-} module Data.Bitmap.OpenGL ( makeSimpleBitmapTexture , makeTextureFromBitmap@@ -10,7 +10,7 @@ -------------------------------------------------------------------------------- -import Data.Bitmap+import Data.Bitmap.Pure -- Data.Bitmap.IO import Graphics.Rendering.OpenGL @@ -26,9 +26,62 @@ -------------------------------------------------------------------------------- +-- OpenGL pixel store+-- unfortunately, it is not really flexible enough :(+data PixelStore = PixelStore+ { _swapBytes :: Bool + , _lsbFirst :: Bool + , _rowLength :: GLint+ , _skipRows :: GLint+ , _skipPixels :: GLint+ , _rowAlignment :: GLint+ , _imageHeight :: GLint+ , _skipImages :: GLint+ }+ +getPixelStore :: PixelStoreDirection -> IO PixelStore+getPixelStore dir = do+ sb <- get (swapBytes dir)+ lf <- get (lsbFirst dir)+ rl <- get (rowLength dir)+ sr <- get (skipRows dir)+ sp <- get (skipPixels dir)+ ra <- get (rowAlignment dir)+ ih <- get (imageHeight dir)+ si <- get (skipImages dir)+ return (PixelStore sb lf rl sr sp ra ih si)+ +setPixelStore :: PixelStoreDirection -> PixelStore -> IO ()+setPixelStore dir (PixelStore sb lf rl sr sp ra ih si) = do+ (swapBytes dir) $= sb+ (lsbFirst dir) $= lf+ (rowLength dir) $= rl+ (skipRows dir) $= sr+ (skipPixels dir) $= sp+ (rowAlignment dir) $= ra+ (imageHeight dir) $= ih+ (skipImages dir) $= si++{-# SPECIALIZE isValidOpenGLAlignment :: Int -> Bool #-}+isValidOpenGLAlignment :: Integral a => a -> Bool+isValidOpenGLAlignment k = elem k [1,2,4,8]++-- computes the padding of OpenGL pixel rectangle+glPadding :: Int -> Alignment -> PixelComponentType -> NChn -> Padding+glPadding width glalign pct nchn = pad where+ n = nchn+ s = pixelComponentSize pct+ l = width+ b = glalign+ a = if b >= s then b else s+ k = div a s * div (s*n*l+a-1) a -- OpenGL is a bit weird+ pad = s * (k - n*l)++--------------------------------------------------------------------------------+ -- | This function guesses the pixel format from the number of channels: -- --- * 1 ~> Alpha+-- * 1 ~> Intensity -- -- * 2 ~> Luminance, Alpha --@@ -37,42 +90,58 @@ -- * 4 ~> RGBA -- -- For more control, use 'makeTextureFromBitmap'.-makeSimpleBitmapTexture :: forall t. PixelComponent t => Bitmap t -> IO TextureObject+makeSimpleBitmapTexture :: forall s. PixelComponent s => Bitmap s -> IO TextureObject makeSimpleBitmapTexture bm = do- let (pf,pif) = case pixelComponentType (undefined::t) of + let (pf,pif) = case pixelComponentType (undefined::s) of PctWord8 -> case bitmapNChannels bm of- 1 -> (Alpha, Alpha8)+ 1 -> (Luminance, Intensity8) -- (Intensity, Intensity8) -- (Alpha, Alpha8) 2 -> (LuminanceAlpha, Luminance8Alpha8) 3 -> (RGB, RGB8) 4 -> (RGBA, RGBA8) _ -> case bitmapNChannels bm of- 1 -> (Alpha, Alpha')+ 1 -> (Luminance, Intensity) -- (Intensity, Intensity') -- (Alpha, Alpha') 2 -> (LuminanceAlpha, LuminanceAlpha') 3 -> (RGB, RGB') 4 -> (RGBA, RGBA') - makeTextureFromBitmap bm Nothing 0 pf pif 0 +#if OPENGL_VERSION >= 29+ makeTextureFromBitmap bm Texture2D 0 pf pif 0 +#else+ makeTextureFromBitmap bm Nothing 0 pf pif 0 +#endif -- | Creates a new OpenGL texture from a bitmap makeTextureFromBitmap - :: PixelComponent t - => Bitmap t -> Maybe CubeMapTarget -> Level -> PixelFormat -> PixelInternalFormat -> Border -> IO TextureObject+#if OPENGL_VERSION >= 29+ :: (PixelComponent s, TwoDimensionalTextureTarget target) + => Bitmap s -> target -> Level -> PixelFormat -> PixelInternalFormat -> Border -> IO TextureObject+#else+ :: PixelComponent s + => Bitmap s -> Maybe CubeMapTarget -> Level -> PixelFormat -> PixelInternalFormat -> Border -> IO TextureObject+#endif makeTextureFromBitmap bm cubemap level pf pif border = do old_binding <- get (textureBinding Texture2D) [tex] <- genObjectNames 1 textureBinding Texture2D $= Just tex textureFilter Texture2D $= ((Linear',Nothing),Linear')+ textureWrapMode Texture2D S $= (Repeated,Clamp)+ textureWrapMode Texture2D T $= (Repeated,Clamp) texImageFromBitmap bm cubemap level pf pif border textureBinding Texture2D $= old_binding return tex texImageFromBitmap- :: forall t. PixelComponent t - => Bitmap t -> Maybe CubeMapTarget -> Level -> PixelFormat -> PixelInternalFormat -> Border -> IO ()+#if OPENGL_VERSION >= 29+ :: forall s target. (PixelComponent s, TwoDimensionalTextureTarget target) + => Bitmap s -> target -> Level -> PixelFormat -> PixelInternalFormat -> Border -> IO ()+#else+ :: forall s. PixelComponent s + => Bitmap s -> Maybe CubeMapTarget -> Level -> PixelFormat -> PixelInternalFormat -> Border -> IO ()+#endif texImageFromBitmap bm cubemap level pf pif border = do withBitmap bm $ \(width,height) nchn pad ptr -> do -- old_rowlength <- get (rowLength Unpack) old_alignment <- get (rowAlignment Unpack)- let pdata = PixelData pf (dataType (undefined::t)) ptr + let pdata = PixelData pf (dataType (undefined::s)) ptr size = TextureSize2D (fromIntegral width) (fromIntegral height) -- rowLength Unpack $= fromIntegral (bitmapPaddedRowSizeInBytes bm) rowAlignment Unpack $= fromIntegral (bitmapRowAlignment bm)
+ Data/Bitmap/OpenGL/CubeMap.hs view
@@ -0,0 +1,60 @@+++-- | Minimal cubemap support (at the moment just some help with the layout)++{-# LANGUAGE CPP #-}+module Data.Bitmap.OpenGL.CubeMap + ( + CubeMapFace(..)+ )+ where++--------------------------------------------------------------------------------++import Data.Bitmap.IO+import Data.Bitmap.OpenGL++import Graphics.Rendering.OpenGL++--------------------------------------------------------------------------------++-- | The layout:+--+-- > +------++-- > | |+-- > | top |+-- > | |+-- > +------+------+------+------+ +-- > | | | | |+-- > | left |front |right | back |+-- > | | | | |+-- > +------+------+------+------+ +-- > | |+-- > |bottom| +-- > | |+-- > +------++--+data CubeMapFace+ = CubeFront+ | CubeBack+ | CubeTop+ | CubeDown+ | CubeLeft+ | CubeRight+ deriving (Eq,Ord,Show)+ +#if OPENGL_VERSION >= 29+target :: CubeMapFace -> TextureTargetCubeMapFace +#else+target :: CubeMapFace -> CubeMapTarget +#endif +target face = case face of+ CubeRight -> TextureCubeMapPositiveX+ CubeLeft -> TextureCubeMapNegativeX+ CubeTop -> TextureCubeMapPositiveY + CubeDown -> TextureCubeMapNegativeY+ CubeFront -> TextureCubeMapPositiveZ+ CubeBack -> TextureCubeMapNegativeZ + +--------------------------------------------------------------------------------+
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2009, Balazs Komuves+Copyright (c) 2009-2011, Balazs Komuves All rights reserved. Redistribution and use in source and binary forms, with or without
bitmap-opengl.cabal view
@@ -1,11 +1,12 @@ Name: bitmap-opengl-Version: 0.0.0.1+Version: 0.0.1.5+ Synopsis: OpenGL support for Data.Bitmap. Description: OpenGL support for Data.Bitmap. It has its own package so that the bitmap package does not depend on OpenGL. License: BSD3 License-file: LICENSE-Copyright: (c) 2009 Balazs Komuves+Copyright: (c) 2009-2011 Balazs Komuves Author: Balazs Komuves Maintainer: bkomuves (plus) hackage (at) gmail (dot) com Homepage: http://code.haskell.org/~bkomuves/@@ -15,21 +16,24 @@ Cabal-Version: >= 1.2 Build-Type: Simple -Flag base4- Description: Base v4-+Flag opengl29+ Description: OpenGL v2.9+ Library- build-depends: OpenGL, bitmap >= 0.0.2 && < 0.1- if flag(base4)- Build-Depends: base >= 4 && < 5- cpp-options: -DBASE_VERSION=4+ Build-Depends: base >= 4 && < 5,+ bitmap >= 0.0.2 && < 0.1+ + if flag(OpenGL29)+ build-depends: OpenGL >= 2.9.0.0+ cpp-options: -DOPENGL_VERSION=29 else- Build-Depends: base >= 3 && < 4- cpp-options: -DBASE_VERSION=3- - Exposed-Modules: Data.Bitmap.OpenGL+ build-depends: OpenGL >= 2.3 && < 2.9.0.0+ cpp-options: -DOPENGL_VERSION=28+ + Exposed-Modules: Data.Bitmap.OpenGL+ Data.Bitmap.OpenGL.CubeMap - Hs-Source-Dirs: .- Extensions: ScopedTypeVariables, CPP+ Hs-Source-Dirs: .+ Extensions: ScopedTypeVariables, CPP