gloss-rendering 1.9.3.1 → 1.10.1.1

raw patch · 7 files changed

+77/−88 lines, 7 filesdep ~OpenGLPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: OpenGL

API changes (from Hackage documentation)

Files

• Graphics/Gloss/Internals/Data/Picture.hs +21/−19
• Graphics/Gloss/Internals/Rendering/Bitmap.hs +37/−57
• Graphics/Gloss/Internals/Rendering/Circle.hs +1/−1
• Graphics/Gloss/Internals/Rendering/Picture.hs +13/−7
• Graphics/Gloss/Internals/Rendering/State.hs +2/−2
• Graphics/Gloss/Rendering.hs +1/−0
• gloss-rendering.cabal +2/−2

@@ -9,7 +9,7 @@         , Picture(..)          -- * Bitmaps-        , BitmapData+        , BitmapData, PixelFormat(..), BitmapFormat(..), RowOrder(..)         , bitmapOfForeignPtr         , bitmapOfByteString         , bitmapOfBMP@@ -93,11 +93,15 @@          -- | A bitmap image with a width, height and some 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`.+        --  in GPU memory between frames. If you are programatically generating+        --  the image for each frame then use @False@. If you have loaded it+        --  from a file then use @True@. +        --  Setting @False@ for static images will make rendering slower+        --  than it needs to be.+        --  Setting @True@  for dynamically generated images will cause a+        --  GPU memory leak.         | Bitmap        Int     Int     BitmapData Bool          -- Color ------------------------------------------@@ -130,16 +134,16 @@ -- Bitmaps -------------------------------------------------------------------- -- | O(1). Use a `ForeignPtr` of RGBA data as a bitmap with the given --   width and height.-+-- --   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`.-bitmapOfForeignPtr :: Int -> Int -> ForeignPtr Word8 -> Bool -> Picture-bitmapOfForeignPtr width height fptr cacheMe+bitmapOfForeignPtr :: Int -> Int -> BitmapFormat -> ForeignPtr Word8 -> Bool -> Picture+bitmapOfForeignPtr width height fmt fptr cacheMe  = let  len     = width * height * 4-        bdata   = BitmapData len fptr-   in   Bitmap width height bdata cacheMe +        bdata   = BitmapData len fmt fptr+   in   Bitmap width height bdata cacheMe   -- | O(size). Copy a `ByteString` of RGBA data into a bitmap with the given@@ -149,9 +153,8 @@ --   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`.-{-# NOINLINE bitmapOfByteString #-}-bitmapOfByteString :: Int -> Int -> ByteString -> Bool -> Picture-bitmapOfByteString width height bs cacheMe+bitmapOfByteString :: Int -> Int -> BitmapFormat -> ByteString -> Bool -> Picture+bitmapOfByteString width height fmt bs cacheMe  = unsafePerformIO  $ do   let len = width * height * 4         ptr     <- mallocBytes len@@ -160,17 +163,17 @@         BSU.unsafeUseAsCString bs          $ \cstr -> copyBytes ptr (castPtr cstr) len -        let bdata = BitmapData len fptr+        let bdata = BitmapData len fmt fptr         return $ Bitmap width height bdata cacheMe+{-# NOINLINE bitmapOfByteString #-}   -- | 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 bs                  = unpackBMPToRGBA32 bmp         let len                 = width * height * 4          ptr     <- mallocBytes len@@ -179,10 +182,10 @@         BSU.unsafeUseAsCString bs          $ \cstr -> copyBytes ptr (castPtr cstr) len -        let bdata = BitmapData len fptr-        reverseRGBA bdata+        let bdata = BitmapData len (BitmapFormat BottomToTop PxRGBA) fptr          return $ Bitmap width height bdata True+{-# NOINLINE bitmapOfBMP #-}   -- | Load an uncompressed 24 or 32bit RGBA BMP file as a bitmap.@@ -192,5 +195,4 @@         case ebmp of          Left err       -> error $ show err          Right bmp      -> return $ bitmapOfBMP bmp- 

@@ -3,84 +3,64 @@ -- | Helper functions for rendering bitmaps module Graphics.Gloss.Internals.Rendering.Bitmap         ( BitmapData(..)-        , reverseRGBA+        , BitmapFormat(..), PixelFormat(..), RowOrder(..)         , bitmapPath-        , freeBitmapData-        )+        , freeBitmapData) where import Data.Data import Foreign   -- | Abstract 32-bit RGBA bitmap data.-data BitmapData -        = BitmapData -                Int                     -- length (in bytes)-                (ForeignPtr Word8)      -- pointer to data+data BitmapData+        = BitmapData+        { bitmapDataLength :: Int  -- length (in bytes)+        , bitmapFormat     :: BitmapFormat+        , bitmapPointer    :: (ForeignPtr Word8) }          deriving (Eq, Data, Typeable)  +-- | Description of how the bitmap is layed out in memory.+--+--   * Prior version of Gloss assumed `BitmapFormat BottomToTop PxAGBR`+--+data BitmapFormat+        = BitmapFormat +        { rowOrder    :: RowOrder+        , pixelFormat :: PixelFormat }+        deriving (Eq, Data, Typeable, Show, Ord)+++-- | Order of rows in an image are either:+--+--   * `TopToBottom` - the top row, followed by the next-lower row and so on.+--   * `BottomToTop` - the bottom row followed by the next-higher row and so on.+--+data RowOrder+        = TopToBottom +        | BottomToTop+        deriving (Eq, Data, Typeable, Show, Ord, Enum, Bounded)+++-- | Pixel formats describe the order of the color channels in memory.+data PixelFormat+        = PxRGBA | PxABGR+        deriving (Eq, Data, Typeable, Show, Ord, Enum, Bounded)++ instance Show BitmapData where  show _ = "BitmapData"   -- | Generates the point path to display the bitmap centred bitmapPath :: Float -> Float -> [(Float, Float)]-bitmapPath width height +bitmapPath width height  = [(-width', -height'), (width', -height'), (width', height'), (-width', height')]  where  width'  = width  / 2         height' = height / 2  --- | 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)----- | 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 ()- -- | Frees the allocated memory given to OpenGL to avoid a memory leak freeBitmapData :: Ptr Word8 -> IO ()-{-# INLINE freeBitmapData #-} freeBitmapData p = free p----- | 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)+{-# INLINE freeBitmapData #-}

@@ -15,13 +15,13 @@ --   the size of the circle on the screen, not its intrinsic radius. --   If the viewport has been zoomed-in then we need to use more segments. ---{-# INLINE circleSteps #-} circleSteps :: Float -> Int circleSteps sDiam         | sDiam < 8     = 8         | sDiam < 16    = 16         | sDiam < 32    = 32         | otherwise     = 64+{-# INLINE circleSteps #-}   -- Circle ---------------------------------------------------------------------

@@ -163,6 +163,11 @@         -- Bitmap -------------------------------         Bitmap width height imgData cacheMe          -> do  +                let rowInfo =+                      case rowOrder (bitmapFormat imgData) of+                         BottomToTop -> [(0,0), (1,0), (1,1), (0,1)]+                         TopToBottom -> [(0,1), (1,1), (1,0), (0,0)]+                 -- Load the image data into a texture,                 -- or grab it from the cache if we've already done that before.                 tex     <- loadTexture (stateTextures state) width height imgData cacheMe@@ -191,7 +196,7 @@                                 GL.vertex   $ GL.Vertex2   (gf pX) (gf pY))                          (bitmapPath (fromIntegral width) (fromIntegral height))-                                [(0,0), (1.0,0), (1.0,1.0), (0,1.0)]+                                rowInfo                  -- Restore color                 GL.currentColor $= oldColor@@ -284,8 +289,11 @@         -> Bool         -> IO Texture -installTexture width height bitmapData@(BitmapData _ fptr) cacheMe+installTexture width height bitmapData@(BitmapData _ fmt fptr) cacheMe  = do   +        let glFormat = case pixelFormat fmt of+                           PxABGR -> GL.RGBA+                           PxRGBA -> GL.ABGR         -- Allocate texture handle for texture         [tex] <- GL.genObjectNames 1         GL.textureBinding GL.Texture2D $= Just tex@@ -304,7 +312,7 @@                         (gsizei width)                         (gsizei height))                 0-                (GL.PixelData GL.RGBA GL.UnsignedInt8888 ptr)+                (GL.PixelData glFormat 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@@ -321,7 +329,7 @@   -- | If this texture does not have its `cacheMe` flag set then delete it from ---   OpenGL and free the memory.+--   OpenGL and free the GPU memory. freeTexture :: Texture -> IO () freeTexture tex  | texCacheMe tex       = return ()@@ -349,11 +357,9 @@   vertexPFs ::    [(Float, Float)] -> IO ()-{-# INLINE vertexPFs #-} vertexPFs []    = return () vertexPFs ((x, y) : rest)  = do   GL.vertex $ GL.Vertex2 (gf x) (gf y)         vertexPFs rest--+{-# INLINE vertexPFs #-} 

@@ -14,7 +14,8 @@ import qualified Graphics.Rendering.OpenGL.GL   as GL  --- | Render options settings+-- | Abstract Gloss render state which holds references to textures+--   loaded into the GPU context. data State         = State         { -- | Whether to use color@@ -69,4 +70,3 @@                 , stateLineSmooth       = False                  , stateTextures         = textures }         -

@@ -15,6 +15,7 @@            -- * Bitmaps         , BitmapData+        , BitmapFormat(..), PixelFormat(..), RowOrder(..)         , bitmapOfForeignPtr         , bitmapOfByteString         , bitmapOfBMP

@@ -1,5 +1,5 @@ name:           gloss-rendering-version:        1.9.3.1+version:        1.10.1.1 license:        MIT license-file:   LICENSE author:         Elise Huard@@ -31,7 +31,7 @@         base       == 4.8.*,         containers == 0.5.*,         bytestring == 0.10.*,-        OpenGL     == 2.12.*,+        OpenGL     >= 2.12 && < 3.1,         GLUT       == 2.7.*,         bmp        == 1.2.*