bitmap-opengl (empty) → 0.0.0

raw patch · 4 files changed

+151/−0 lines, 4 filesdep +OpenGLdep +basedep +bitmapsetup-changed

Dependencies added: OpenGL, base, bitmap

Files

Data/Bitmap/OpenGL.hs +83/−0
LICENSE +29/−0
Setup.lhs +4/−0
bitmap-opengl.cabal +35/−0

+ Data/Bitmap/OpenGL.hs view

@@ -0,0 +1,83 @@++-- | OpenGL support for Data.Bitmap++{-# LANGUAGE ScopedTypeVariables #-}+module Data.Bitmap.OpenGL +  ( makeSimpleBitmapTexture+  , makeTextureFromBitmap+  , texImageFromBitmap+  ) where++--------------------------------------------------------------------------------++import Data.Bitmap.IO++import Graphics.Rendering.OpenGL++--------------------------------------------------------------------------------++-- OpenGL data type+dataType :: PixelComponent t => t -> DataType+dataType t = case pixelComponentType t of+  PctWord8  -> UnsignedByte+  PctWord16 -> UnsignedShort+  PctWord32 -> UnsignedInt+  PctFloat  -> Float++--------------------------------------------------------------------------------++-- | This function guesses the pixel format from the number of channels:+-- +-- * 1 ~> Alpha+--+-- * 2 ~> Luminance, Alpha+--+-- * 3 ~> RGB+--+-- * 4 ~> RGBA+--+-- For more control, use 'makeTextureFromBitmap'.+makeSimpleBitmapTexture :: forall t. PixelComponent t => Bitmap t -> IO TextureObject+makeSimpleBitmapTexture bm = do+  let (pf,pif) = case pixelComponentType (undefined::t) of +        PctWord8 -> case bitmapNChannels bm of+          1 -> (Alpha, Alpha8)+          2 -> (LuminanceAlpha, Luminance8Alpha8)+          3 -> (RGB, RGB8)+          4 -> (RGBA, RGBA8)  +        _ -> case bitmapNChannels bm of+          1 -> (Alpha, Alpha')+          2 -> (LuminanceAlpha, LuminanceAlpha')+          3 -> (RGB, RGB')+          4 -> (RGBA, RGBA')  +  makeTextureFromBitmap bm Nothing 0 pf pif 0 +  +-- | Creates a new OpenGL texture from a bitmap+makeTextureFromBitmap +  :: PixelComponent t +  => Bitmap t -> Maybe CubeMapTarget -> Level -> PixelFormat -> PixelInternalFormat -> Border -> IO TextureObject+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')+  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 ()+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  +        size = TextureSize2D (fromIntegral width) (fromIntegral height) +--    rowLength Unpack $= fromIntegral (bitmapPaddedRowSizeInBytes bm)+    rowAlignment Unpack $= fromIntegral (bitmapRowAlignment bm)+    texImage2D cubemap NoProxy level pif size border pdata+--    rowLength Unpack $= old_rowlength +    rowAlignment Unpack $= old_alignment+  +--------------------------------------------------------------------------------

+ LICENSE view

@@ -0,0 +1,29 @@+Copyright (c) 2009, Balazs Komuves+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++- Redistributions of source code must retain the above copyright notice,+this list of conditions and the following disclaimer.+ +- Redistributions in binary form must reproduce the above copyright notice,+this list of conditions and the following disclaimer in the documentation+and/or other materials provided with the distribution.+ +- Neither names of the copyright holders nor the names of the contributors+may be used to endorse or promote products derived from this software without+specific prior written permission. ++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER +OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,+EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,+PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+

+ Setup.lhs view

@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell
+ 
+> import Distribution.Simple
+> main = defaultMain

+ bitmap-opengl.cabal view

@@ -0,0 +1,35 @@+Name:                bitmap-opengl+Version:             0.0.0+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+Author:              Balazs Komuves+Maintainer:          bkomuves (plus) hackage (at) gmail (dot) com+Homepage:            http://code.haskell.org/~bkomuves/+Stability:           Experimental+Category:            Graphics, Data+Tested-With:         GHC == 6.10.1+Cabal-Version:       >= 1.2+Build-Type:          Simple++Flag base4+  Description: Base v4++Library+  build-depends:    OpenGL, bitmap <= 0.1+  if flag(base4)+    Build-Depends:   base >= 4 && < 5+    cpp-options:     -DBASE_VERSION=4+  else+    Build-Depends:   base >= 3 && < 4+    cpp-options:     -DBASE_VERSION=3+    +  Exposed-Modules:     Data.Bitmap.OpenGL++  Hs-Source-Dirs:      .+  Extensions:          ScopedTypeVariables, CPP++