gloss-raster-accelerate (empty) → 0.2.0.0
raw patch · 6 files changed
+525/−0 lines, 6 filesdep +acceleratedep +basedep +colour-acceleratesetup-changed
Dependencies added: accelerate, base, colour-accelerate, gloss, gloss-accelerate
Files
- Graphics/Gloss/Accelerate/Raster/Array.hs +201/−0
- Graphics/Gloss/Accelerate/Raster/Field.hs +224/−0
- Graphics/Gloss/Accelerate/Render.hs +26/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- gloss-raster-accelerate.cabal +42/−0
+ Graphics/Gloss/Accelerate/Raster/Array.hs view
@@ -0,0 +1,201 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RankNTypes #-}+-- |+-- Module : Graphics.Gloss.Accelerate.Raster.Array+-- Copyright : [2013..2017] Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--+-- Rendering of Accelerate arrays as raster images+--+module Graphics.Gloss.Accelerate.Raster.Array (++ module Graphics.Gloss.Accelerate.Data.Point,+ module Data.Array.Accelerate.Data.Colour.RGBA,++ -- * Display functions+ Render, Display(..),+ animateArrayWith,+ animateArrayIOWith,+ playArrayWith,+ playArrayIOWith,++ -- * Picture creation+ makePicture,++) where++-- Friends+import Graphics.Gloss.Accelerate.Render+import Graphics.Gloss.Accelerate.Data.Point+import Graphics.Gloss.Accelerate.Data.Picture+import Data.Array.Accelerate.Data.Colour.RGBA++-- Standard library+import Prelude as P++-- Gloss+import Graphics.Gloss.Data.Display ( Display(..) )+import Graphics.Gloss.Data.Picture ( Picture(..) )+import Graphics.Gloss.Interface.IO.Animate as G ( animateFixedIO, black )+import Graphics.Gloss.Interface.Pure.Game as G ( Event, play )+import Graphics.Gloss.Interface.IO.Game as G ( playIO )++-- Accelerate+import Data.Array.Accelerate as A+++-- Animate --------------------------------------------------------------------+-- -------++-- | Animate a bitmap generated by an Accelerate computation, specifying the+-- backend used to render the image.+--+animateArrayWith+ :: Render -- ^ Method to render the array (backend 'run1' function to use)+ -> Display -- ^ Display mode+ -> (Int, Int) -- ^ Number of pixels to draw per point+ -> (Exp Float -> Acc (Array DIM2 Colour))+ -- ^ A function to construct an array of colours. The function+ -- should return an array of the same extent every time it is+ -- applied.+ --+ -- It is passed the time in seconds since the program started.+ -> IO ()+animateArrayWith render display (zoomX, zoomY) makeArray+ | zoomX P.< 1 P.|| zoomY P.< 1+ = error "Graphics.Gloss.Raster: invalid pixel scalar factor"++ | otherwise+ = let picture = makePicture render zoomX zoomY (makeArray . the)+ . fromList Z+ . return+ in+#if MIN_VERSION_gloss(1,10,0)+ animateFixedIO display G.black (return . picture) (\_ -> return ())+#else+ animateFixedIO display G.black (return . picture)+#endif+++-- | Animate a bitmap generated by an Accelerate computation and IO actions, specifying the+-- backend used to render the image.+--+animateArrayIOWith+ :: Arrays world+ => Render -- ^ Method to render the array (backend 'run1' function)+ -> Display -- ^ Display mode+ -> (Int, Int) -- ^ Number of pixels to draw per point+ -> (Float -> IO world) -- ^ Extract world from time in seconds+ -- since the program started+ -> (Acc world -> Acc (Array DIM2 Colour))+ -- ^ A function to construct an array of colours. The function+ -- should return an array of the same extent every time it is+ -- applied.+ --+ -- It is passed the world+ -> IO ()+animateArrayIOWith render display (zoomX, zoomY) makeWorld makeArray+ | zoomX P.< 1 P.|| zoomY P.< 1+ = error "Graphics.Gloss.Raster: invalid pixel scalar factor"++ | otherwise+ = let picture = fmap (makePicture render zoomX zoomY makeArray)+ . makeWorld+ in+#if MIN_VERSION_gloss(1,10,0)+ animateFixedIO display G.black picture (\_ -> return ())+#else+ animateFixedIO display G.black picture+#endif+++-- | Play with a bitmap generated by an Accelerate computation, specifying the+-- method used to render the world.+--+playArrayWith+ :: Arrays world+ => Render -- ^ Method to render the world (backend 'run1' function)+ -> 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+ -> state -- ^ The initial state+ -> (state -> world) -- ^ Extract the world state+ -> (Acc world -> Acc (Array DIM2 Colour))+ -- ^ Compute the colour of the world+ -> (Event -> state -> state)+ -- ^ Handle input events+ -> (Float -> state -> state)+ -- ^ Step the world one iteration.+ -- It is passed the time in seconds since the program started.+ -> IO ()+playArrayWith render display (zoomX, zoomY) stepRate+ initState makeWorld makeArray handleEvent stepState+ | zoomX P.< 1 P.|| zoomY P.< 1+ = error "Graphics.Gloss.Raster: invalid pixel scalar factor"++ | otherwise+ = let picture = makePicture render zoomX zoomY makeArray+ . makeWorld+ in+ play display G.black stepRate initState picture handleEvent stepState+++-- | Play with a bitmap generated by an Accelerate computation and IO actions, specifying the+-- method used to render the world.+--+playArrayIOWith+ :: Arrays world+ => Render -- ^ Method to render the world (backend 'run1' function)+ -> 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+ -> state -- ^ The initial state+ -> (state -> IO world) -- ^ Extract the world state+ -> (Acc world -> Acc (Array DIM2 Colour))+ -- ^ Compute the colour of the world+ -> (Event -> state -> IO state)+ -- ^ Handle input events+ -> (Float -> state -> IO state)+ -- ^ Step the world one iteration.+ -- It is passed the time in seconds since the program started.+ -> IO ()+playArrayIOWith render display (zoomX, zoomY) stepRate+ initState makeWorld makeArray handleEvent stepState+ | zoomX P.< 1 P.|| zoomY P.< 1+ = error "Graphics.Gloss.Raster: invalid pixel scalar factor"++ | otherwise+ = let picture = fmap (makePicture render zoomX zoomY makeArray)+ . makeWorld+ in+ G.playIO display G.black stepRate initState picture handleEvent stepState+++-- Internals+-- ---------++-- | Lift an Accelerate computation from a 'world' to an image into a real+-- Haskell-land function that executes the computation of the image and wraps+-- it as a Gloss picture ready for display.+--+makePicture+ :: Arrays world+ => Render -- ^ method to compute the image+ -> Int -- ^ pixel width+ -> Int -- ^ pixel height+ -> (Acc world -> Acc (Array DIM2 Colour)) -- ^ function to create the image+ -> (world -> Picture) -- ^ new function that generates the picture+makePicture render zoomX zoomY makeArray+ = let -- compute the image+ -- assume the host is a little-endian architecture+ pixels = render (A.map (packRGBA . opaque) . makeArray)++ -- Turn the array into a Gloss picture+ picture world = bitmapOfArray (pixels world) False+ in+ Scale (P.fromIntegral zoomX) (P.fromIntegral zoomY) . picture+
+ Graphics/Gloss/Accelerate/Raster/Field.hs view
@@ -0,0 +1,224 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RankNTypes #-}+-- |+-- Module : Graphics.Gloss.Accelerate.Raster.Field+-- Copyright : [2013..2017] Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--+-- Rendering of 2D functions as raster fields+--+module Graphics.Gloss.Accelerate.Raster.Field (++ module Graphics.Gloss.Accelerate.Data.Point,+ module Data.Array.Accelerate.Data.Colour.RGBA,++ -- * Display functions+ Render, Display(..),+ animateFieldWith,+ animateFieldIOWith,+ playFieldWith,+ playFieldIOWith,++ -- * Field creation+ makeField,++) where++-- Friends+import Graphics.Gloss.Accelerate.Render+import Graphics.Gloss.Accelerate.Data.Point+import Graphics.Gloss.Accelerate.Raster.Array+import Data.Array.Accelerate.Data.Colour.RGBA++-- Standard library+import Prelude as P+#if MIN_VERSION_gloss(1,11,0)+import System.IO.Unsafe+#endif++-- Gloss+import Graphics.Gloss.Interface.Pure.Game ( Event )+#if MIN_VERSION_gloss(1,11,0)+import Graphics.Gloss.Interface.Environment+#endif++-- Accelerate+import Data.Array.Accelerate as A+++-- Animate --------------------------------------------------------------------+-- -------++-- | Animate a continuous 2D function, specifying the backend used to render+-- the field.+--+animateFieldWith+ :: Render -- ^ Method to render the field+ -> Display -- ^ Display mode+ -> (Int, Int) -- ^ Number of pixels to draw per point+ -> (Exp Float -> Exp Point -> Exp Colour)+ -- ^ A function to compute the colour 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 ()+animateFieldWith render display zoom@(zoomX, zoomY) makePixel+ = let -- size of the window+ (winSizeX, winSizeY) = sizeOfDisplay display++ -- size of the raw image to render+ sizeX = winSizeX `div` zoomX+ sizeY = winSizeY `div` zoomY+ in+ animateArrayWith+ render+ display+ zoom+ (makeField sizeX sizeY makePixel)+++-- | Animate a continuous 2D function using IO actions, specifying the backend used to render+-- the field.+--+animateFieldIOWith+ :: Arrays world+ => Render -- ^ Method to render the field+ -> Display -- ^ Display mode+ -> (Int, Int) -- ^ Number of pixels to draw per point+ -> (Float -> IO world) -- ^ Extract world from time in seconds+ -- since the program started+ -> (Acc world -> Exp Point -> Exp Colour)+ -- ^ A function to compute the colour at a particular point.+ --+ -- It is passed the world, and+ -- a point between (-1,1) and (+1,1).+ -> IO ()+animateFieldIOWith render display zoom@(zoomX, zoomY) makeWorld makePixel+ = let -- size of the window+ (winSizeX, winSizeY) = sizeOfDisplay display++ -- size of the raw image to render+ sizeX = winSizeX `div` zoomX+ sizeY = winSizeY `div` zoomY+ in+ animateArrayIOWith+ render+ display+ zoom+ makeWorld+ (makeField sizeX sizeY makePixel)+++-- | Play a game with a continuous 2D function, specifying the method used to+-- render the field.+--+playFieldWith+ :: Arrays world+ => Render -- ^ Method to render the field+ -> 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+ -> state -- ^ The initial state+ -> (state -> world) -- ^ Extract the world state+ -> (Acc world -> Exp Point -> Exp Colour)+ -- ^ Compute the colour of the world at a given point+ -> (Event -> state -> state)+ -- ^ Handle input events+ -> (Float -> state -> state)+ -- ^ Step the world one iteration.+ -- It is passed the time in seconds since the program started.+ -> IO ()+playFieldWith render display zoom@(zoomX, zoomY) stepRate+ initState makeWorld makePixel handleEvent stepState+ = let -- size of the window+ (winSizeX, winSizeY) = sizeOfDisplay display++ -- size of the raw image to render+ sizeX = winSizeX `div` zoomX+ sizeY = winSizeY `div` zoomY+ in+ playArrayWith+ render+ display+ zoom+ stepRate+ initState+ makeWorld+ (makeField sizeX sizeY makePixel)+ handleEvent+ stepState++-- | Play a game with a continuous 2D function using IO actions, specifying the method used to+-- render the field.+--+playFieldIOWith+ :: Arrays world+ => Render -- ^ Method to render the field+ -> 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+ -> state -- ^ The initial state+ -> (state -> IO world) -- ^ Extract the world state+ -> (Acc world -> Exp Point -> Exp Colour)+ -- ^ Compute the colour of the world at a given point+ -> (Event -> state -> IO state)+ -- ^ Handle input events+ -> (Float -> state -> IO state)+ -- ^ Step the world one iteration.+ -- It is passed the time in seconds since the program started.+ -> IO ()+playFieldIOWith render display zoom@(zoomX, zoomY) stepRate+ initState makeWorld makePixel handleEvent stepState+ = let -- size of the window+ (winSizeX, winSizeY) = sizeOfDisplay display++ -- size of the raw image to render+ sizeX = winSizeX `div` zoomX+ sizeY = winSizeY `div` zoomY+ in+ playArrayIOWith+ render+ display+ zoom+ stepRate+ initState+ makeWorld+ (makeField sizeX sizeY makePixel)+ handleEvent+ stepState+++-- Internals+-- ---------++sizeOfDisplay :: Display -> (Int, Int)+sizeOfDisplay display+ = case display of+ InWindow _ s _ -> s+#if MIN_VERSION_gloss(1,11,0)+ FullScreen -> unsafePerformIO getScreenSize+#else+ FullScreen s -> s+#endif+++-- | Lift a point-wise colouring function into an image creation function.+--+-- The parameter 'world' at this point can be arbitrary. However if you use+-- this function standalone, you will probably at some point want the result+-- of this function to plug into 'makePicture' and thus 'Render', and thus be+-- a unary function from 'Arrays' to 'Arrays'.+--+makeField+ :: Int -- ^ image width+ -> Int -- ^ image height+ -> (world -> Exp Point -> Exp Colour) -- ^ function to apply at each point+ -> (world -> Acc (Array DIM2 Colour)) -- ^ new function that generates the field+makeField sizeX sizeY makePixel world+ = A.generate (constant (Z :. sizeY :. sizeX))+ (makePixel world . pointOfIndex sizeX sizeY)+
+ Graphics/Gloss/Accelerate/Render.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RankNTypes #-}+-- |+-- Module : Graphics.Gloss.Accelerate.Render+-- Copyright : [2013..2017] Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Graphics.Gloss.Accelerate.Render+ where++import Data.Array.Accelerate+++-- | The type for executing Accelerate computations. This matches the 'run1'+-- style of executing programs.+--+-- Some variants of the display functions take an argument of this type, which+-- determine how computations are executed.+--+type Render = forall a b. (Arrays a, Arrays b) => (Acc a -> Acc b) -> a -> b+
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013, Trevor L. McDonell++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Trevor L. McDonell nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ gloss-raster-accelerate.cabal view
@@ -0,0 +1,42 @@+Name: gloss-raster-accelerate+Version: 0.2.0.0+Synopsis: Parallel rendering of raster images using Accelerate+Description: Parallel rendering of raster images using Accelerate+License: BSD3+License-file: LICENSE+Author: Trevor L. McDonell+Maintainer: Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+Category: Graphics+Build-type: Simple+Cabal-version: >=1.10+++Library+ Exposed-modules:+ Graphics.Gloss.Accelerate.Render+ Graphics.Gloss.Accelerate.Raster.Array+ Graphics.Gloss.Accelerate.Raster.Field++ build-depends:+ base >= 4.6 && < 4.10+ , accelerate >= 0.16+ , colour-accelerate >= 0.1+ , gloss >= 1.9+ , gloss-accelerate >= 0.2++ ghc-options:+ -Wall -O2++ default-language:+ Haskell2010++source-repository head+ type: git+ location: https://github.com/tmcdonell/gloss-raster-accelerate++source-repository this+ type: git+ tag: 0.2.0.0+ location: https://github.com/tmcdonell/gloss-raster-accelerate++-- vim: nospell