gloss 1.4.0.1 → 1.5.0.1

raw patch · 6 files changed

+137/−68 lines, 6 filesdep +vectorPVP ok

version bump matches the API change (PVP)

Dependencies added: vector

API changes (from Hackage documentation)

Files

• Graphics/Gloss.hs +5/−0
• Graphics/Gloss/Data/Picture.hs +68/−13
• Graphics/Gloss/Internals/Render/Bitmap.hs +40/−21
• Graphics/Gloss/Internals/Render/Picture.hs +16/−26
• Graphics/Gloss/Internals/Render/State.hs +5/−6
• gloss.cabal +3/−2

@@ -30,6 +30,11 @@ -- -- @Release Notes: --+-- For 1.5.0:+--   * O(1) Conversion of ForeignPtrs to bitmaps.+--   * An extra flag on the Bitmap constructor allows bitmaps to be cached+--     in texture memory between frames.+-- -- For 1.4.0: --   Thanks to Christiaan Baaij:  --   * Refactoring of Gloss internals to support multiple window manager backends.

@@ -5,14 +5,20 @@ 	, Vector 	, Path 	, Picture(..)+	, BitmapData  	-- * Aliases for Picture constructors 	, blank, polygon, line, circle, thickCircle, text, bitmap 	, color, translate, rotate, scale 	, pictures -	-- * Miscellaneous+        -- * Loading Bitmaps+        , bitmapOfForeignPtr+	, bitmapOfByteString+	, bitmapOfBMP 	, loadBMP++	-- * Miscellaneous  	, lineLoop  	, circleSolid 	@@ -23,10 +29,18 @@ import Graphics.Gloss.Data.Color import Graphics.Gloss.Data.Point import Graphics.Gloss.Data.Vector+import Graphics.Gloss.Internals.Render.Bitmap import Control.Monad-import Data.Monoid import Codec.BMP-import Data.ByteString (ByteString)+import Foreign.ForeignPtr+import Foreign.Marshal.Alloc+import Foreign.Marshal.Utils+import Foreign.Ptr+import Data.Word+import Data.Monoid+import Data.ByteString+import System.IO.Unsafe+import qualified Data.ByteString.Unsafe as BSU   -- | A path through the x-y plane.@@ -56,12 +70,12 @@ 	-- | Some text to draw with a vector font. 	| Text		String -	-- | A bitmap image with a width, height and a ByteString holding the 32 bit RGBA bitmap data.+	-- | A bitmap image with a width, height and a Vector holding the 32 bit RGBA bitmap data. 	--  	--  The boolean flag controls whether Gloss should cache the data between frames 	--  for speed. If you are programatically generating the image for each frame then use 	--  `False`.  If you have loaded it from a file then use `True`.-	| Bitmap	Int	Int 	ByteString      Bool+	| Bitmap	Int	Int 	BitmapData Bool  	-- Color ------------------------------------------ 	-- | A picture drawn with this color.@@ -109,7 +123,7 @@ text :: String -> Picture text = Text -bitmap :: Int -> Int -> ByteString -> Bool -> Picture+bitmap :: Int -> Int -> BitmapData -> Bool -> Picture bitmap = Bitmap  color :: Color -> Picture -> Picture@@ -128,18 +142,59 @@ pictures = Pictures  --- BMP file loader --------------------------------------------------------------- | An IO action that loads a BMP format file from the given path, and---   produces a picture.+-- Bitmaps --------------------------------------------------------------------+-- | O(1). Use a `ForeignPtr` of RGBA data as a bitmap.+bitmapOfForeignPtr :: Int -> Int -> ForeignPtr Word8 -> Bool -> Picture+bitmapOfForeignPtr width height fptr cacheMe+ = let  len     = width * height * 4+        bdata   = BitmapData len fptr+   in   Bitmap width height bdata cacheMe +++-- | O(size). Copy a `ByteString` of RGBA data into a bitmap.+{-# NOINLINE bitmapOfByteString #-}+bitmapOfByteString :: Int -> Int -> ByteString -> Bool -> Picture+bitmapOfByteString width height bs cacheMe+ = unsafePerformIO+ $ do   let len = width * height * 4+        ptr     <- mallocBytes len+        fptr    <- newForeignPtr finalizerFree ptr++        BSU.unsafeUseAsCString bs+         $ \cstr -> copyBytes ptr (castPtr cstr) len++        let bdata = BitmapData len fptr+        return $ Bitmap width height bdata cacheMe+++-- | O(size). Copy a `BMP` file into a bitmap.+{-# NOINLINE bitmapOfBMP #-}+bitmapOfBMP :: BMP -> Picture+bitmapOfBMP bmp+ = unsafePerformIO+ $ do   let (width, height)     = bmpDimensions bmp+        let bs                  = unpackBMPToRGBA32 bmp +        let len                 = width * height * 4++        ptr     <- mallocBytes len+        fptr    <- newForeignPtr finalizerFree ptr++        BSU.unsafeUseAsCString bs+         $ \cstr -> copyBytes ptr (castPtr cstr) len++        let bdata = BitmapData len fptr+        reverseRGBA bdata++        return $ Bitmap width height bdata True+++-- | Load an uncompressed 24 or 32bit RGBA BMP file as a bitmap. loadBMP :: FilePath -> IO Picture loadBMP filePath  = do   ebmp    <- readBMP filePath         case ebmp of          Left err       -> error $ show err-         Right bmp-          -> do let (width, height)     = bmpDimensions bmp-                let bs                  = bmpRawImageData bmp -                return $ Bitmap width height bs True +         Right bmp      -> return $ bitmapOfBMP bmp   -- Shapes ----------------------------------------------------------------------------------------

@@ -2,15 +2,27 @@  -- | Helper functions for rendering bitmaps module Graphics.Gloss.Internals.Render.Bitmap-	( reverseRGBA+	( BitmapData(..)+	, reverseRGBA 	, bitmapPath 	, freeBitmapData 	) where import Foreign-import qualified Data.ByteString as B  +-- | Abstract bitmap data.+data BitmapData +        = BitmapData +                Int                     -- length (in bytes)+                (ForeignPtr Word8)      -- pointer to data+        deriving (Eq)+++instance Show BitmapData where+ show _ = "BitmapData"++ -- | Generates the point path to display the bitmap centred bitmapPath :: Float -> Float -> [(Float, Float)] bitmapPath width height @@ -19,28 +31,31 @@ 	height' = height / 2  --- | This is necessary as OpenGL reads pixel data as ABGR, rather than RGBA-reverseRGBA :: B.ByteString -> IO (Ptr Word8)-reverseRGBA orig - = do ptr  <- newArray $ B.unpack orig-      reverseRGBA' (B.length orig `div` 4) (castPtr ptr) 0-      return ptr+-- | Destructively reverse the byte order in an array.+--   This is necessary as OpenGL reads pixel data as ABGR, rather than RGBA+reverseRGBA :: BitmapData -> IO ()+reverseRGBA (BitmapData length8 fptr)+ = withForeignPtr fptr (reverseRGBA_ptr length8)  --- | Parses through pixel values, shifting the bytes into OpenGL ABGR order-reverseRGBA' :: Int -> Ptr Word32 -> Int -> IO ()-reverseRGBA' len ptr count- | count < len - = do	curr <- peekElemOff ptr count-      	let byte0 = shift (isolateByte0 curr) 24-      	let byte1 = shift (isolateByte1 curr) 8-      	let byte2 = shift (isolateByte2 curr) (-8)-      	let byte3 = shift (isolateByte3 curr) (-24)-      	pokeElemOff ptr count (byte0 .|. byte1 .|. byte2 .|. byte3)-      	reverseRGBA' len ptr (count + 1)+-- | Destructively reverses the byte order in an array.+reverseRGBA_ptr :: Int -> Ptr Word8 -> IO ()+reverseRGBA_ptr length8 ptr8+ = go (length8 `div` 4) (castPtr ptr8) 0+ where+        go :: Int -> Ptr Word32 -> Int -> IO ()+        go len ptr count+         | count < len +         = do	curr <- peekElemOff ptr count+      	        let byte0 = shift (isolateByte0 curr) 24+      	        let byte1 = shift (isolateByte1 curr) 8+      	        let byte2 = shift (isolateByte2 curr) (-8)+      	        let byte3 = shift (isolateByte3 curr) (-24)+      	        pokeElemOff ptr count (byte0 .|. byte1 .|. byte2 .|. byte3)+      	        go len ptr (count + 1) - | otherwise - = return ()+         | otherwise +         = return ()  -- | Frees the allocated memory given to OpenGL to avoid a memory leak freeBitmapData :: Ptr Word8 -> IO ()@@ -49,18 +64,22 @@   -- | These functions work as bit masks to isolate the Word8 components+{-# INLINE isolateByte0 #-} isolateByte0 :: Word32 -> Word32 isolateByte0 word =    word .&. (255 :: Word32) +{-# INLINE isolateByte1 #-} isolateByte1 :: Word32 -> Word32 isolateByte1 word =    word .&. (65280 :: Word32) +{-# INLINE isolateByte2 #-} isolateByte2 :: Word32 -> Word32 isolateByte2 word =    word .&. (16711680 :: Word32) +{-# INLINE isolateByte3 #-} isolateByte3 :: Word32 -> Word32 isolateByte3 word =    word .&. (4278190080 :: Word32)

@@ -13,14 +13,14 @@ import	Graphics.Gloss.Internals.Render.Common import	Graphics.Gloss.Internals.Render.Circle import	Graphics.Gloss.Internals.Render.Bitmap-import	Graphics.Rendering.OpenGL		(($=), get)-import	qualified Graphics.Rendering.OpenGL.GL	as GL-import	qualified Graphics.UI.GLUT		as GLUT import  System.Mem.StableName+import  Foreign.ForeignPtr import	Data.IORef import  Data.List-import  Data.ByteString                         (ByteString) import  Control.Monad+import	Graphics.Rendering.OpenGL		(($=), get)+import	qualified Graphics.Rendering.OpenGL.GL	as GL+import	qualified Graphics.UI.GLUT		as GLUT   -- ^ Render a picture using the given render options and viewport.@@ -201,7 +201,7 @@ --   otherwise load it into OpenGL. loadTexture         :: IORef [Texture]-        -> Int -> Int -> ByteString+        -> Int -> Int -> BitmapData         -> Bool         -> IO Texture @@ -230,23 +230,22 @@ -- | Install a texture into OpenGL. installTexture              :: Int -> Int-        -> ByteString+        -> BitmapData         -> Bool         -> IO Texture -installTexture width height imgData cacheMe+installTexture width height bitmapData@(BitmapData _ fptr) cacheMe  = do   -        -- As OpenGL reads texture pixels as ABGR (instead of RGBA)-	--  each pixel's value needs to be reversed we also need to-	--  Convert imgData from ByteString to Ptr Word8-	ptrData <- reverseRGBA $ imgData- 	-- Allocate texture handle for texture 	[tex] <- GL.genObjectNames 1 	GL.textureBinding GL.Texture2D $= Just tex  	-- Sets the texture in imgData as the current texture-	GL.texImage2D+	-- This copies the data from the pointer into OpenGL texture memory, +	-- so it's ok if the foreignptr gets garbage collected after this.+        withForeignPtr fptr+         $ \ptr ->+   	   GL.texImage2D 		Nothing 		GL.NoProxy 		0@@ -255,18 +254,18 @@ 			(gsizei width) 			(gsizei height)) 		0-		(GL.PixelData GL.RGBA GL.UnsignedInt8888 ptrData)+		(GL.PixelData GL.RGBA GL.UnsignedInt8888 ptr)          -- Make a stable name that we can use to identify this data again.         -- If the user gives us the same texture data at the same size then we         -- can avoid loading it into texture memory again.-        name    <- makeStableName imgData+        name    <- makeStableName bitmapData          return  Texture                 { texName       = name                 , texWidth      = width                 , texHeight     = height-                , texData       = ptrData+                , texData       = fptr                 , texObject     = tex                 , texCacheMe    = cacheMe } @@ -276,17 +275,8 @@ freeTexture :: Texture -> IO () freeTexture tex  | texCacheMe tex       = return ()- | otherwise            = deleteTexture tex----- | Delete a texture object from OpenGL.-deleteTexture :: Texture -> IO ()-deleteTexture tex- = do   -- Delete texture-	GL.deleteObjectNames [texObject tex]+ | otherwise            = GL.deleteObjectNames [texObject tex] -	-- Free image data-	freeBitmapData (texData tex)   -- Utils ------------------------------------------------------------------------------------------

@@ -7,11 +7,11 @@ 	, Texture (..)) where import qualified Graphics.Rendering.OpenGL.GL	as GL-import Foreign.Ptr+import Foreign.ForeignPtr import System.Mem.StableName-import Data.ByteString                          (ByteString) import Data.Word import Data.IORef+import Graphics.Gloss.Data.Picture  -- | Render options settings data State@@ -36,9 +36,8 @@ -- | A texture that we've sent to OpenGL. data Texture         = Texture-        { -- | Stable name derived from the `ByteString` that the user gives us.-          --   We -          texName       :: StableName ByteString+        { -- | Stable name derived from the `BitmapData` that the user gives us.+          texName       :: StableName BitmapData          -- | Width of the image, in pixels.         , texWidth      :: Int@@ -47,7 +46,7 @@         , texHeight     :: Int          -- | Pointer to the Raw texture data.-        , texData       :: Ptr Word8+        , texData       :: ForeignPtr Word8                  -- | The OpenGL texture object.         , texObject     :: GL.TextureObject

@@ -1,5 +1,5 @@ Name:                gloss-Version:             1.4.0.1+Version:             1.5.0.1 License:             MIT License-file:        LICENSE Author:              Ben Lippmeier@@ -41,7 +41,8 @@         bytestring == 0.9.*,         OpenGL     == 2.4.*,         GLUT       == 2.2.*,-        bmp        == 1.1.*+        bmp        == 1.1.*,+        vector     >= 0.8 && < 1.0    ghc-options:      -O2 -Wall