gloss-raster (empty) → 1.7.2.1
raw patch · 4 files changed
+265/−0 lines, 4 filesdep +basedep +containersdep +ghc-primsetup-changed
Dependencies added: base, containers, ghc-prim, gloss, repa
Files
- Graphics/Gloss/Raster/Field.hs +216/−0
- LICENSE +13/−0
- Setup.hs +2/−0
- gloss-raster.cabal +34/−0
+ Graphics/Gloss/Raster/Field.hs view
@@ -0,0 +1,216 @@+{-# LANGUAGE BangPatterns, MagicHash, PatternGuards, ScopedTypeVariables #-}++-- | Rendering of continuous 2D functions as raster fields.+--+-- 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.Field+ ( -- * Color+ module Graphics.Gloss.Data.Color+ , rgb, rgb8, rgb8w++ -- * Display functions+ , Display (..)+ , Point+ , animateField+ , playField)+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 continuous 2D function.+animateField+ :: Display + -- ^ Display mode.+ -> (Int, Int) + -- ^ Pixels per point.+ -> (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+ = let (winSizeX, winSizeY) = sizeOfDisplay display++ {-# INLINE frame #-}+ frame !time+ = return+ $ makeFrame winSizeX winSizeY zoomX zoomY (makePixel time)++ in animateFixedIO display black frame+{-# 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.+ -> Int -- ^ Number of simulation steps to take+ -- for each second of real time+ -> world + -- ^ The initial world.+ -> (world -> Point -> Color) + -- ^ Function to compute the color of the world at the given point.+ -> (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 ()+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 " + P.++ show (zoomX, zoomY)+ else let (winSizeX, winSizeY) = sizeOfDisplay display+ in winSizeX `seq` winSizeY `seq`+ play display black stepRate + initWorld+ (\world -> + world `seq` + makeFrame winSizeX winSizeY zoomX zoomY (makePixel world))+ handleEvent+ stepWorld+{-# INLINE playField #-}+++-- Frame ----------------------------------------------------------------------+{-# INLINE sizeOfDisplay #-}+sizeOfDisplay :: Display -> (Int, Int)+sizeOfDisplay display+ = case display of+ InWindow _ s _ -> s+ FullScreen s -> s++{-# INLINE makeFrame #-}+makeFrame + :: Int -> Int -> Int -> Int + -> (Point -> Color) -> Picture+makeFrame !winSizeX !winSizeY !zoomX !zoomY !makePixel+ = let -- Size of the raw image to render.+ sizeX = winSizeX `div` zoomX+ sizeY = winSizeY `div` zoomY++ fsizeX, fsizeY :: Float+ !fsizeX = fromIntegral sizeX+ !fsizeY = fromIntegral sizeY++ fsizeX2, fsizeY2 :: Float+ !fsizeX2 = fsizeX / 2+ !fsizeY2 = fsizeY / 2++ -- Midpoint of image.+ midX, midY :: Int+ !midX = sizeX `div` 2+ !midY = sizeY `div` 2++ {-# INLINE pixelOfIndex #-}+ pixelOfIndex (Z :. y :. x)+ = let x' = fromIntegral (x - midX) / fsizeX2+ y' = fromIntegral (y - midY) / fsizeY2+ in makePixel (x', y')++ {-# INLINE conv #-} + conv (r, g, b)+ = let 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 conv+ $ R.map unpackColor + $ R.fromFunction (Z :. sizeY :. sizeX)+ $ pixelOfIndex+ traceEventIO "Gloss.Raster[makeFrame]: done, returning picture."++ -- Wrap the ForeignPtr from the Array as a gloss picture.+ let picture + = Scale (fromIntegral zoomX) (fromIntegral zoomY)+ $ 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))
+ LICENSE view
@@ -0,0 +1,13 @@+Copyright (c) 2011-2012 Benjamin Lippmeier ++ Permission is hereby granted, free of charge, to any person+ obtaining a copy of this software and associated documentation+ files (the "Software"), to deal in the Software without+ restriction, including without limitation the rights to use,+ copy, modify, merge, publish, distribute, sublicense, and/or sell+ copies of the Software, and to permit persons to whom the+ Software is furnished to do so, subject to the following+ condition:++ The above copyright notice and this permission notice shall be+ included in all copies or substantial portions of the Software.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ gloss-raster.cabal view
@@ -0,0 +1,34 @@+Name: gloss-raster+Version: 1.7.2.1+License: MIT+License-file: LICENSE+Author: Ben Lippmeier+Maintainer: benl@ouroborus.net+Build-Type: Simple+Cabal-Version: >=1.6+Stability: provisional+Category: Graphics+Homepage: http://gloss.ouroborus.net+Bug-reports: gloss@ouroborus.net+Description:+ Parallel rendering of raster images.++Synopsis:+ Parallel rendering of raster images.++Tested-with: GHC == 6.12.1, GHC == 7.0.1++Library+ Build-Depends: + base == 4.*,+ ghc-prim == 0.2.*,+ containers >= 0.3.0 && < 0.5.0,+ gloss == 1.7.2.*,+ repa == 3.1.*++ ghc-options: -Odph -fno-liberate-case -fllvm -optlo-O3++ Exposed-modules:+ Graphics.Gloss.Raster.Field++