gloss-raster 1.7.8.1 → 1.13.1.2
raw patch · 4 files changed
Files
- Graphics/Gloss/Raster/Array.hs +72/−43
- Graphics/Gloss/Raster/Field.hs +153/−48
- LICENSE +1/−1
- gloss-raster.cabal +31/−11
Graphics/Gloss/Raster/Array.hs view
@@ -1,4 +1,7 @@-{-# LANGUAGE BangPatterns, MagicHash, PatternGuards, ScopedTypeVariables #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE ScopedTypeVariables #-} -- | Rendering of Repa arrays as raster images. -- -- Gloss programs should be compiled with @-threaded@, otherwise the GHC runtime@@ -7,17 +10,19 @@ -- 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. +-- compile options. ----- @-threaded -Odph -fno-liberate-case -funfolding-use-threshold1000 -funfolding-keeness-factor1000 -fllvm -optlo-O3@+-- @-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 +-- 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+ , rgb, rgbI, rgb8w+ , rgb', rgbI' -- * Display functions , Display (..)@@ -29,9 +34,12 @@ import Graphics.Gloss.Data.Color import Graphics.Gloss.Data.Picture import Graphics.Gloss.Data.Display+import Graphics.Gloss.Data.Bitmap import Graphics.Gloss.Interface.Pure.Game import Graphics.Gloss.Interface.IO.Animate import Graphics.Gloss.Interface.IO.Game+import Graphics.Gloss.Interface.Environment+import Graphics.Gloss.Rendering import Data.Word import System.IO.Unsafe import Unsafe.Coerce@@ -44,8 +52,8 @@ -- Color ---------------------------------------------------------------------- -- | Construct a color from red, green, blue components.--- --- Each component is clipped to the range [0..1]+--+-- Each component is clamped to the range [0..1] rgb :: Float -> Float -> Float -> Color rgb r g b = makeColor r g b 1.0 {-# INLINE rgb #-}@@ -53,33 +61,53 @@ -- | 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 #-}+-- Each component is clamped to the range [0..255]+rgbI :: Int -> Int -> Int -> Color+rgbI r g b = makeColorI r g b 255+{-# INLINE rgbI #-} -- | 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+rgb8w r g b = makeRawColorI (fromIntegral r) (fromIntegral g) (fromIntegral b) 255 {-# INLINE rgb8w #-} +-- | Like `rgb`, but take pre-clamped components for speed.+--+-- If you're building a new color for every pixel then use this version,+-- however if your components are out of range then the picture you get will+-- be implementation dependent.+rgb' :: Float -> Float -> Float -> Color+rgb' r g b = makeRawColor r g b 1.0+{-# INLINE rgb' #-}+++-- | Like `rgbI`, but take pre-clamped components for speed.+--+-- If you're building a new color for every pixel then use this version,+-- however if your components are out of range then the picture you get will+-- be implementation dependent.+rgbI' :: Int -> Int -> Int -> Color+rgbI' r g b = makeRawColorI r g b 255+{-# INLINE rgbI' #-}++ -- Animate -------------------------------------------------------------------- -- | Animate a bitmap generated from a Repa array. animateArray- :: Display + :: 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 + -- 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@@ -87,7 +115,7 @@ P.++ show (scaleX, scaleY) else let {-# INLINE frame #-} frame !time = return $ makeFrame scale (makeArray time)- in animateFixedIO display black frame+ in animateFixedIO display black frame (const $ return ()) {-# INLINE animateArray #-} -- INLINE so the repa functions fuse with the users client functions. @@ -95,18 +123,18 @@ -- AnimateIO -------------------------------------------------------------------- -- | Animate a bitmap generated from a Repa array, via the IO monad. animateArrayIO- :: Display + :: 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 + -- 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@@ -114,7 +142,7 @@ P.++ show (scaleX, scaleY) else let {-# INLINE frame #-} frame !time = fmap (makeFrame scale) (makeArray time)- in animateFixedIO display black frame+ in animateFixedIO display black frame (const $ return ()) {-# INLINE animateArrayIO #-} -- INLINE so the repa functions fuse with the users client functions. @@ -122,19 +150,19 @@ -- Play ----------------------------------------------------------------------- -- | Play with a bitmap generated from a Repa array. playArray- :: Display + :: Display -- ^ Display mode.- -> (Int, Int) + -> (Int, Int) -- ^ Number of pixels to draw per element. -> Int -- ^ Number of simulation steps to take -- for each second of real time- -> world + -> world -- ^ The initial world. -> (world -> Array D DIM2 Color) -- ^ Function to convert the world to an array.- -> (Event -> world -> world) + -> (Event -> world -> world) -- ^ Function to handle input events.- -> (Float -> world -> world) + -> (Float -> world -> world) -- ^ Function to step the world one iteration. -- It is passed the time in seconds since the program started. -> IO ()@@ -142,13 +170,13 @@ !initWorld !makeArray !handleEvent !stepWorld = scaleX `seq` scaleY `seq` if scaleX < 1 || scaleY < 1- then error $ "Graphics.Gloss.Raster.Array: invalid pixel scale factor " + 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 + stepRate initWorld frame handleEvent@@ -159,19 +187,19 @@ -- PlayIO ----------------------------------------------------------------------- -- | Play with a bitmap generated from a Repa array, via the IO monad. playArrayIO- :: Display + :: Display -- ^ Display mode.- -> (Int, Int) + -> (Int, Int) -- ^ Number of pixels to draw per element. -> Int -- ^ Number of simulation steps to take -- for each second of real time- -> world + -> world -- ^ The initial world. -> (world -> IO (Array D DIM2 Color)) -- ^ Function to convert the world to an array.- -> (Event -> world -> IO world) + -> (Event -> world -> IO world) -- ^ Function to handle input events.- -> (Float -> world -> IO world) + -> (Float -> world -> IO world) -- ^ Function to step the world one iteration. -- It is passed the time in seconds since the program started. -> IO ()@@ -179,13 +207,13 @@ !initWorld !makeArray !handleEvent !stepWorld = scaleX `seq` scaleY `seq` if scaleX < 1 || scaleY < 1- then error $ "Graphics.Gloss.Raster.Array: invalid pixel scale factor " + 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 + stepRate initWorld frame handleEvent@@ -197,7 +225,7 @@ makeFrame :: (Int, Int) -> Array D DIM2 Color -> Picture makeFrame (scaleX, scaleY) !array = let -- Size of the array- _ :. sizeY :. sizeX + _ :. sizeY :. sizeX = R.extent array convColor :: Color -> Word32@@ -206,14 +234,14 @@ r' = fromIntegral r g' = fromIntegral g b' = fromIntegral b- a = 255 + a = 255 !w = unsafeShiftL r' 24 .|. unsafeShiftL g' 16 .|. unsafeShiftL b' 8 .|. a in w- {-# INLINE convColor #-} + {-# INLINE convColor #-} in unsafePerformIO $ do @@ -225,11 +253,12 @@ traceEventIO "Gloss.Raster[makeFrame]: done, returning picture." -- Wrap the ForeignPtr from the Array as a gloss picture.- let picture + let picture = Scale (fromIntegral scaleX) (fromIntegral scaleY) $ bitmapOfForeignPtr sizeX sizeY -- raw image size- (R.toForeignPtr $ unsafeCoerce arrRGB) + (BitmapFormat BottomToTop PxABGR)+ (R.toForeignPtr $ unsafeCoerce arrRGB) -- the image data. False -- don't cache this in texture memory. @@ -241,7 +270,7 @@ -- doesn't have enout specialisations and goes via Integer. word8OfFloat :: Float -> Word8 word8OfFloat f- = fromIntegral (truncate f :: Int) + = fromIntegral (truncate f :: Int) {-# INLINE word8OfFloat #-} @@ -254,10 +283,10 @@ {-# INLINE unpackColor #-} -sizeOfDisplay :: Display -> (Int, Int)+sizeOfDisplay :: Display -> IO (Int, Int) sizeOfDisplay display = case display of- InWindow _ s _ -> s- FullScreen s -> s+ InWindow _ s _ -> return s+ FullScreen -> getScreenSize {-# INLINE sizeOfDisplay #-}
Graphics/Gloss/Raster/Field.hs view
@@ -1,4 +1,7 @@-{-# LANGUAGE BangPatterns, MagicHash, PatternGuards, ScopedTypeVariables #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE ScopedTypeVariables #-} -- | Rendering of continuous 2D functions as raster fields. --@@ -8,23 +11,26 @@ -- 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. +-- 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 +-- See the examples the @raster@ directory of the @gloss-examples@ package -- for more details. -- module Graphics.Gloss.Raster.Field ( -- * Color module Graphics.Gloss.Data.Color- , rgb, rgb8, rgb8w+ , rgb, rgbI, rgb8w+ , rgb', rgbI' -- * Display functions , Display (..) , Point , animateField+ , animateFieldIO , playField+ , playFieldIO -- * Frame creation , makePicture@@ -33,8 +39,11 @@ import Graphics.Gloss.Data.Color import Graphics.Gloss.Data.Picture import Graphics.Gloss.Data.Display+import Graphics.Gloss.Data.Bitmap import Graphics.Gloss.Interface.Pure.Game import Graphics.Gloss.Interface.IO.Animate+import Graphics.Gloss.Interface.IO.Game+import Graphics.Gloss.Interface.Environment import Data.Word import System.IO.Unsafe import Unsafe.Coerce@@ -47,8 +56,8 @@ -- Color ---------------------------------------------------------------------- -- | Construct a color from red, green, blue components.--- --- Each component is clipped to the range [0..1]+--+-- Each component is clamped to the range [0..1] rgb :: Float -> Float -> Float -> Color rgb r g b = makeColor r g b 1.0 {-# INLINE rgb #-}@@ -56,65 +65,114 @@ -- | 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 #-}+-- Each component is clamped to the range [0..255]+rgbI :: Int -> Int -> Int -> Color+rgbI r g b = makeColorI r g b 255+{-# INLINE rgbI #-} -- | 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+rgb8w r g b = makeColorI (fromIntegral r) (fromIntegral g) (fromIntegral b) 255 {-# INLINE rgb8w #-} +-- | Like `rgb`, but take pre-clamped components for speed.+--+-- If you're building a new color for every pixel then use this version,+-- however if your components are out of range then the picture you get will+-- be implementation dependent.+rgb' :: Float -> Float -> Float -> Color+rgb' r g b = makeColor r g b 1.0+{-# INLINE rgb' #-}+++-- | Like `rgbI`, but take pre-clamped components for speed.+--+-- If you're building a new color for every pixel then use this version,+-- however if your components are out of range then the picture you get will+-- be implementation dependent.+rgbI' :: Int -> Int -> Int -> Color+rgbI' r g b = makeColorI r g b 255+{-# INLINE rgbI' #-}++ -- Animate -------------------------------------------------------------------- -- | Animate a continuous 2D function. animateField- :: Display + :: Display -- ^ Display mode.- -> (Int, Int) + -> (Int, Int) -- ^ Number of pixels to draw per point.- -> (Float -> Point -> Color) + -> (Float -> Point -> Color) -- ^ Function to compute the color at a particular point. -- -- It is passed the time in seconds since the program started, -- and a point between (-1, -1) and (+1, +1). -> IO ()- + animateField display (zoomX, zoomY) makePixel = 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+ else+ do (winSizeX, winSizeY) <- sizeOfDisplay display - {-# INLINE frame #-}- frame !time- = return+ let frame !time+ = return $ makePicture winSizeX winSizeY zoomX zoomY (makePixel time) - in animateFixedIO display black frame+ animateFixedIO display black frame (const $ return ())+ {-# INLINE animateField #-} -- INLINE so the repa functions fuse with the users client functions. +-- AnimateIO --------------------------------------------------------------------+-- | Animate a continuous 2D function, via the IO monad.+animateFieldIO+ :: Display+ -- ^ Display mode.+ -> (Int, Int)+ -- ^ Number of pixels to draw per point.+ -> (Float -> IO (Point -> Color))+ -- ^ Function to compute the color at a particular point.+ --+ -- It is passed the time in seconds since the program started,+ -- and a point between (-1, -1) and (+1, +1).+ -> IO ()++animateFieldIO display (zoomX, zoomY) makePixel+ = zoomX `seq` zoomY `seq`+ if zoomX < 1 || zoomY < 1+ then error $ "Graphics.Gloss.Raster.Field: invalid pixel scale factor "+ P.++ show (zoomX, zoomY)+ else+ do (winSizeX, winSizeY) <- sizeOfDisplay display++ let frame !time+ = makePicture winSizeX winSizeY zoomX zoomY <$> makePixel time++ animateFixedIO display black frame (const $ return ())++{-# INLINE animateFieldIO #-}+ -- Play ----------------------------------------------------------------------- -- | Play a game with a continous 2D function.-playField - :: Display +playField+ :: Display -- ^ Display mode.- -> (Int, Int) + -> (Int, Int) -- ^ Number of pixels to draw per point. -> Int -- ^ Number of simulation steps to take -- for each second of real time- -> world + -> world -- ^ The initial world.- -> (world -> Point -> Color) + -> (world -> Point -> Color) -- ^ Function to compute the color of the world at the given point.- -> (Event -> world -> world) + -> (Event -> world -> world) -- ^ Function to handle input events.- -> (Float -> world -> world) + -> (Float -> world -> world) -- ^ Function to step the world one iteration. -- It is passed the time in seconds since the program started. -> IO ()@@ -122,25 +180,70 @@ !initWorld !makePixel !handleEvent !stepWorld = zoomX `seq` zoomY `seq` if zoomX < 1 || zoomY < 1- then error $ "Graphics.Gloss.Raster.Field: invalid pixel scale factor " + 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`- play display black stepRate - initWorld- (\world -> - world `seq` - makePicture winSizeX winSizeY zoomX zoomY (makePixel world))- handleEvent- stepWorld+ else do (winSizeX, winSizeY) <- sizeOfDisplay display+ winSizeX `seq` winSizeY `seq`+ play display black stepRate+ ((winSizeX, winSizeY), initWorld)+ (\((winSizeX', winSizeY'), world) ->+ winSizeX' `seq` winSizeY' `seq` world `seq`+ makePicture winSizeX' winSizeY' zoomX zoomY (makePixel world))+ (\event (winSize, world) ->+ let winSize' =+ case event of+ EventResize dims -> dims+ _ -> winSize+ in (winSize', handleEvent event world))+ (fmap . stepWorld) {-# INLINE playField #-} +-- PlayIO -----------------------------------------------------------------------+-- | Play a game with a continous 2D function, via the IO monad.+playFieldIO+ :: Display+ -- ^ Display mode.+ -> (Int, Int)+ -- ^ Number of pixels to draw per point.+ -> Int -- ^ Number of simulation steps to take+ -- for each second of real time+ -> world+ -- ^ The initial world.+ -> (world -> IO (Point -> Color))+ -- ^ Function to compute the color of the world at the given point.+ -> (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 ()+playFieldIO !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 "+ P.++ show (zoomX, zoomY)+ else do (winSizeX, winSizeY) <- sizeOfDisplay display+ winSizeX `seq` winSizeY `seq`+ playIO display black stepRate+ ((winSizeX, winSizeY), initWorld)+ (\((winSizeX', winSizeY'), world) ->+ winSizeX' `seq` winSizeY' `seq` world `seq`+ makePicture winSizeX' winSizeY' zoomX zoomY <$> makePixel world)+ (\event (winSize, world) ->+ let winSize' =+ case event of+ EventResize dims -> dims+ _ -> winSize+ in (,) winSize' <$> handleEvent event world)+ (\time (winSize, world) -> (,) winSize <$> stepWorld time world)+{-# INLINE playFieldIO #-} -sizeOfDisplay :: Display -> (Int, Int)+sizeOfDisplay :: Display -> IO (Int, Int) sizeOfDisplay display = case display of- InWindow _ s _ -> s- FullScreen s -> s+ InWindow _ s _ -> return s+ FullScreen -> getScreenSize {-# INLINE sizeOfDisplay #-} @@ -157,12 +260,12 @@ sizeX = winSizeX `div` zoomX sizeY = winSizeY `div` zoomY - {-# INLINE conv #-} + {-# INLINE conv #-} conv (r, g, b) = let r' = fromIntegral r g' = fromIntegral g b' = fromIntegral b- a = 255 + a = 255 !w = unsafeShiftL r' 24 .|. unsafeShiftL g' 16@@ -176,17 +279,18 @@ -- We don't need the alpha because we're only drawing one image. traceEventIO "Gloss.Raster[makePicture]: start frame evaluation." (arrRGB :: Array F DIM2 Word32)- <- R.computeP + <- R.computeP $ R.map conv $ makeFrame sizeX sizeY makePixel traceEventIO "Gloss.Raster[makePicture]: done, returning picture." -- Wrap the ForeignPtr from the Array as a gloss picture.- let picture + let picture = Scale (fromIntegral zoomX) (fromIntegral zoomY) $ bitmapOfForeignPtr sizeX sizeY -- raw image size- (R.toForeignPtr $ unsafeCoerce arrRGB) + (BitmapFormat BottomToTop PxABGR)+ (R.toForeignPtr $ unsafeCoerce arrRGB) -- the image data. False -- don't cache this in texture memory. @@ -223,7 +327,7 @@ in makePixel (x', y') in R.hintInterleave- $ R.map unpackColor + $ R.map unpackColor $ R.fromFunction (Z :. sizeY :. sizeX) $ pixelOfIndex {-# INLINE makeFrame #-}@@ -234,7 +338,7 @@ -- doesn't have enout specialisations and goes via Integer. word8OfFloat :: Float -> Word8 word8OfFloat f- = fromIntegral (truncate f :: Int) + = fromIntegral (truncate f :: Int) {-# INLINE word8OfFloat #-} @@ -245,3 +349,4 @@ , word8OfFloat (g * 255) , word8OfFloat (b * 255)) {-# INLINE unpackColor #-}+
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2011-2012 Benjamin Lippmeier +Copyright (c) 2011-2016 The Gloss Development Team Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation
gloss-raster.cabal view
@@ -1,11 +1,11 @@ Name: gloss-raster-Version: 1.7.8.1+Version: 1.13.1.2 License: MIT License-file: LICENSE Author: Ben Lippmeier Maintainer: benl@ouroborus.net Build-Type: Simple-Cabal-Version: >=1.6+Cabal-Version: >=1.10 Stability: provisional Category: Graphics Homepage: http://gloss.ouroborus.net@@ -16,21 +16,41 @@ Synopsis: Parallel rendering of raster images. -Tested-with: GHC == 6.12.1, GHC == 7.0.1+Flag llvm+ Description: Compile via LLVM. This produces much better object code+ but your GHC needs to have been built against the LLVM compiler. + Default: False++source-repository head+ type: git+ location: https://github.com/benl23x5/gloss++source-repository this+ type: git+ tag: v1.13.0.2+ location: https://github.com/benl23x5/gloss+ Library- Build-Depends: - base == 4.6.*,- ghc-prim == 0.3.*,- containers == 0.5.*,- repa == 3.2.*,- gloss == 1.7.8.*+ Build-Depends:+ base >= 4.8 && < 5+ , containers >= 0.5 && < 0.7+ , ghc-prim+ , gloss == 1.13.*+ , gloss-rendering == 1.13.*+ , repa == 3.4.* + Default-Language:+ Haskell2010+ ghc-options:- -Odph -fno-liberate-case- -fllvm -optlo-O3+ -O2+ -fmax-simplifier-iterations=20+ -fsimplifier-phases=3+ -fno-liberate-case Exposed-modules: Graphics.Gloss.Raster.Field Graphics.Gloss.Raster.Array +-- vim: nospell