gloss-raster 1.7.2.1 → 1.7.4.1

raw patch · 3 files changed

+209/−10 lines, 3 filesdep ~glossdep ~repaPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: gloss, repa

API changes (from Hackage documentation)

Files

• Graphics/Gloss/Raster/Array.hs +195/−0
• Graphics/Gloss/Raster/Field.hs +9/−5
• gloss-raster.cabal +5/−5

@@ -0,0 +1,195 @@++{-# LANGUAGE BangPatterns, MagicHash, PatternGuards, ScopedTypeVariables #-}++-- | Rendering of Repa arrays as raster images.+--+--  Gloss programs should be compiled with @-threaded@, otherwise the GHC runtime+--  will limit the frame-rate to around 20Hz.+--+--  The performance of programs using this interface is sensitive to how much+--  boxing and unboxing the GHC simplifier manages to eliminate. For the best+--  result add INLINE pragmas to all of your numeric functions and use the following+--  compile options.  +--+--  @-threaded -Odph -fno-liberate-case -funfolding-use-threshold1000 -funfolding-keeness-factor1000 -fllvm -optlo-O3@+--+--  See the examples the @raster@ directory of the @gloss-examples@ package +--  for more details.+--+module Graphics.Gloss.Raster.Array+        ( -- * Color+          module Graphics.Gloss.Data.Color+        , rgb, rgb8, rgb8w++          -- * Display functions+        , Display       (..)+        , animateArray+        , playArray)+where+import Graphics.Gloss.Data.Color+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Display+import Graphics.Gloss.Interface.Pure.Game+import Graphics.Gloss.Interface.IO.Animate+import Data.Word+import System.IO.Unsafe+import Unsafe.Coerce+import Debug.Trace+import Data.Bits+import Data.Array.Repa                          as R+import Data.Array.Repa.Repr.ForeignPtr          as R+import Prelude                                  as P++-- Color ----------------------------------------------------------------------+-- | Construct a color from red, green, blue components.+--  +--   Each component is clipped to the range [0..1]+rgb  :: Float -> Float -> Float -> Color+rgb r g b   = makeColor r g b 1.0+{-# INLINE rgb #-}+++-- | Construct a color from red, green, blue components.+--+--   Each component is clipped to the range [0..255]+rgb8 :: Int -> Int -> Int -> Color+rgb8 r g b  = makeColor8 r g b 255+{-# INLINE rgb8 #-}+++-- | Construct a color from red, green, blue components.+rgb8w :: Word8 -> Word8 -> Word8 -> Color+rgb8w r g b = makeColor8 (fromIntegral r) (fromIntegral g) (fromIntegral b) 255+{-# INLINE rgb8w #-}+++-- Animate --------------------------------------------------------------------+-- | Animate a bitmap generated from a Repa array.+animateArray+        :: Display                      +                -- ^ Display mode.+        -> (Int, Int)+                -- ^ Number of pixels to draw per element.+        -> (Float -> Array D DIM2 Color)+                -- ^ A function to construct a delayed array for the given time.+                --   The function should return an array of the same extent each +                --   time it is applied.+                --+                --   It is passed the time in seconds since the program started.+        -> IO ()+        +animateArray display scale@(scaleX, scaleY) makeArray+ = scaleX `seq` scaleY `seq`+ if scaleX < 1 || scaleY < 1+   then error $ "Graphics.Gloss.Raster.Array: invalid pixel scale factor "+                P.++ show (scaleX, scaleY)+   else let {-# INLINE frame #-}+            frame !time          = return $ makeFrame scale (makeArray time)+        in  animateFixedIO display black frame+{-# INLINE animateArray #-}+--  INLINE so the repa functions fuse with the users client functions.+++-- Play -----------------------------------------------------------------------+-- | Play with a bitmap generated from a Repa array.+playArray+        :: Display                      +                -- ^ Display mode.+        -> (Int, Int)   +                -- ^ Number of pixels to draw per element.+        -> Int  -- ^ Number of simulation steps to take+                --   for each second of real time+        -> world +                -- ^ The initial world.+        -> (world -> Array D DIM2 Color)+                -- ^ Function to convert the world to an array.+        -> (Event -> world -> world)    +                -- ^ Function to handle input events.+        -> (Float -> world -> world)    +                -- ^ Function to step the world one iteration.+                --   It is passed the time in seconds since the program started.+        -> IO ()+playArray !display scale@(scaleX, scaleY) !stepRate !initWorld !makeArray !handleEvent !stepWorld+ = scaleX `seq` scaleY `seq`+   if scaleX < 1 || scaleY < 1+     then  error $ "Graphics.Gloss.Raster.Array: invalid pixel scale factor " +                 P.++ show scale+     else  let  {-# INLINE frame #-}+                frame !world    = makeFrame scale (makeArray world)++           in   play display black+                        stepRate +                        initWorld+                        frame+                        handleEvent+                        stepWorld+{-# INLINE playArray #-}+++-- Frame ----------------------------------------------------------------------+{-# INLINE makeFrame #-}+makeFrame :: (Int, Int) -> Array D DIM2 Color -> Picture+makeFrame (scaleX, scaleY) !array+ = let  -- Size of the array+        _ :. sizeY :. sizeX +                         = R.extent array++        {-# INLINE convColor #-} +        convColor :: Color -> Word32+        convColor color+         = let  (r, g, b) = unpackColor color+                r'        = fromIntegral r+                g'        = fromIntegral g+                b'        = fromIntegral b+                a         = 255 ++                !w        =  unsafeShiftL r' 24+                         .|. unsafeShiftL g' 16+                         .|. unsafeShiftL b' 8+                         .|. a+           in   w++   in unsafePerformIO $ do++        -- Define the image, and extract out just the RGB color components.+        -- We don't need the alpha because we're only drawing one image.+        traceEventIO "Gloss.Raster[makeFrame]: start frame evaluation."+        (arrRGB :: Array F DIM2 Word32)+                <- R.computeP $ R.map convColor array+        traceEventIO "Gloss.Raster[makeFrame]: done, returning picture."++        -- Wrap the ForeignPtr from the Array as a gloss picture.+        let picture     +                = Scale (fromIntegral scaleX) (fromIntegral scaleY)+                $ bitmapOfForeignPtr+                        sizeX sizeY     -- raw image size+                        (R.toForeignPtr $ unsafeCoerce arrRGB)   +                                        -- the image data.+                        False           -- don't cache this in texture memory.++        return picture+++-- | Float to Word8 conversion because the one in the GHC libraries+--   doesn't have enout specialisations and goes via Integer.+{-# INLINE word8OfFloat #-}+word8OfFloat :: Float -> Word8+word8OfFloat f+        = fromIntegral (truncate f :: Int) +++{-# INLINE unpackColor #-}+unpackColor :: Color -> (Word8, Word8, Word8)+unpackColor c+        | (r, g, b, _) <- rgbaOfColor c+        = ( word8OfFloat (r * 255)+          , word8OfFloat (g * 255)+          , word8OfFloat (b * 255))++{-# INLINE sizeOfDisplay #-}+sizeOfDisplay :: Display -> (Int, Int)+sizeOfDisplay display+ = case display of+        InWindow _ s _  -> s+        FullScreen s    -> s+

@@ -69,7 +69,7 @@         :: Display                                       -- ^ Display mode.         -> (Int, Int)                   -                -- ^ Pixels per point.+                -- ^ Number of pixels to draw per point.         -> (Float -> Point -> Color)                     -- ^ Function to compute the color at a particular point.                 --@@ -78,7 +78,12 @@         -> IO ()          animateField display (zoomX, zoomY) makePixel- = let  (winSizeX, winSizeY) = sizeOfDisplay display+ = zoomX `seq` zoomY `seq`+ if zoomX < 1 || zoomY < 1+   then error $ "Graphics.Gloss.Raster.Field: invalid pixel scale factor "+                P.++ show (zoomX, zoomY)+   else +    let (winSizeX, winSizeY) = sizeOfDisplay display          {-# INLINE frame #-}         frame !time@@ -89,14 +94,13 @@ {-# INLINE animateField #-} --  INLINE so the repa functions fuse with the users client functions. - -- Play ----------------------------------------------------------------------- -- | Play a game with a continous 2D function. playField          :: Display                                       -- ^ Display mode.         -> (Int, Int)   -                -- ^ Pixels per point.+                -- ^ Number of pixels to draw per point.         -> Int  -- ^ Number of simulation steps to take                 --   for each second of real time         -> world @@ -112,7 +116,7 @@ playField !display (zoomX, zoomY) !stepRate !initWorld !makePixel !handleEvent !stepWorld  = zoomX `seq` zoomY `seq`    if zoomX < 1 || zoomY < 1-     then  error $ "Graphics.Gloss.Raster.Field: invalid pixel multiplication " +     then  error $ "Graphics.Gloss.Raster.Field: invalid pixel scale factor "                   P.++ show (zoomX, zoomY)      else  let  (winSizeX, winSizeY) = sizeOfDisplay display            in   winSizeX `seq` winSizeY `seq`

@@ -1,5 +1,5 @@ Name:                gloss-raster-Version:             1.7.2.1+Version:             1.7.4.1 License:             MIT License-file:        LICENSE Author:              Ben Lippmeier@@ -22,13 +22,13 @@   Build-Depends:          base       == 4.*,         ghc-prim   == 0.2.*,-        containers >= 0.3.0 && < 0.5.0,-        gloss      == 1.7.2.*,-        repa       == 3.1.*+        containers >= 0.3.0 &&   < 0.5.0,+        gloss      == 1.7.4.*,+        repa       >= 3.1.2.1 && < 3.2    ghc-options:      -Odph -fno-liberate-case -fllvm -optlo-O3    Exposed-modules:         Graphics.Gloss.Raster.Field-+        Graphics.Gloss.Raster.Array