gloss-raster 1.7.6.2 → 1.7.7.1
raw patch · 3 files changed
+83/−13 lines, 3 files
Files
Graphics/Gloss/Raster/Array.hs view
@@ -1,6 +1,4 @@- {-# LANGUAGE BangPatterns, MagicHash, PatternGuards, ScopedTypeVariables #-}- -- | Rendering of Repa arrays as raster images. -- -- Gloss programs should be compiled with @-threaded@, otherwise the GHC runtime@@ -24,13 +22,16 @@ -- * Display functions , Display (..) , animateArray- , playArray)+ , playArray+ , animateArrayIO+ , playArrayIO) 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 Graphics.Gloss.Interface.IO.Game import Data.Word import System.IO.Unsafe import Unsafe.Coerce@@ -40,6 +41,7 @@ import Data.Array.Repa.Repr.ForeignPtr as R import Prelude as P + -- Color ---------------------------------------------------------------------- -- | Construct a color from red, green, blue components. -- @@ -90,6 +92,33 @@ -- INLINE so the repa functions fuse with the users client functions. +-- AnimateIO --------------------------------------------------------------------+-- | Animate a bitmap generated from a Repa array, via the IO monad.+animateArrayIO+ :: Display + -- ^ Display mode.+ -> (Int, Int)+ -- ^ Number of pixels to draw per element.+ -> (Float -> IO (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 ()+ +animateArrayIO 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 = fmap (makeFrame scale) (makeArray time)+ in animateFixedIO display black frame+{-# INLINE animateArrayIO #-}+-- INLINE so the repa functions fuse with the users client functions.++ -- Play ----------------------------------------------------------------------- -- | Play with a bitmap generated from a Repa array. playArray@@ -109,7 +138,8 @@ -- ^ 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+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 " @@ -126,15 +156,50 @@ {-# INLINE playArray #-} +-- PlayIO -----------------------------------------------------------------------+-- | Play with a bitmap generated from a Repa array, via the IO monad.+playArrayIO+ :: 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 -> IO (Array D DIM2 Color))+ -- ^ Function to convert the world to an array.+ -> (Event -> world -> IO world) + -- ^ Function to handle input events.+ -> (Float -> world -> IO world) + -- ^ Function to step the world one iteration.+ -- It is passed the time in seconds since the program started.+ -> IO ()+playArrayIO !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 = fmap (makeFrame scale) (makeArray world)++ in playIO display black+ stepRate + initWorld+ frame+ handleEvent+ stepWorld+{-# INLINE playArrayIO #-}++ -- 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@@ -148,6 +213,7 @@ .|. unsafeShiftL b' 8 .|. a in w+ {-# INLINE convColor #-} in unsafePerformIO $ do @@ -168,28 +234,30 @@ False -- don't cache this in texture memory. return picture+{-# INLINE makeFrame #-} -- | 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 word8OfFloat #-} -{-# INLINE unpackColor #-} unpackColor :: Color -> (Word8, Word8, Word8) unpackColor c | (r, g, b, _) <- rgbaOfColor c = ( word8OfFloat (r * 255) , word8OfFloat (g * 255) , word8OfFloat (b * 255))+{-# INLINE unpackColor #-} -{-# INLINE sizeOfDisplay #-}+ sizeOfDisplay :: Display -> (Int, Int) sizeOfDisplay display = case display of InWindow _ s _ -> s FullScreen s -> s+{-# INLINE sizeOfDisplay #-}
Graphics/Gloss/Raster/Field.hs view
@@ -118,7 +118,8 @@ -- ^ Function to step the world one iteration. -- It is passed the time in seconds since the program started. -> IO ()-playField !display (zoomX, zoomY) !stepRate !initWorld !makePixel !handleEvent !stepWorld+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 scale factor " @@ -231,15 +232,16 @@ -- | 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 word8OfFloat #-} -{-# INLINE unpackColor #-}+ unpackColor :: Color -> (Word8, Word8, Word8) unpackColor c | (r, g, b, _) <- rgbaOfColor c = ( word8OfFloat (r * 255) , word8OfFloat (g * 255) , word8OfFloat (b * 255))+{-# INLINE unpackColor #-}
gloss-raster.cabal view
@@ -1,5 +1,5 @@ Name: gloss-raster-Version: 1.7.6.2+Version: 1.7.7.1 License: MIT License-file: LICENSE Author: Ben Lippmeier