diff --git a/Data/Bitmap/OpenGL.hs b/Data/Bitmap/OpenGL.hs --- a/Data/Bitmap/OpenGL.hs +++ b/Data/Bitmap/OpenGL.hs @@ -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) diff --git a/Data/Bitmap/OpenGL/CubeMap.hs b/Data/Bitmap/OpenGL/CubeMap.hs new file mode 100644 --- /dev/null +++ b/Data/Bitmap/OpenGL/CubeMap.hs @@ -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 + +-------------------------------------------------------------------------------- + diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -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 diff --git a/bitmap-opengl.cabal b/bitmap-opengl.cabal --- a/bitmap-opengl.cabal +++ b/bitmap-opengl.cabal @@ -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