diff --git a/Graphics/Gloss/Accelerate/Raster/Array.hs b/Graphics/Gloss/Accelerate/Raster/Array.hs --- a/Graphics/Gloss/Accelerate/Raster/Array.hs +++ b/Graphics/Gloss/Accelerate/Raster/Array.hs @@ -1,27 +1,16 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE RankNTypes #-} --- | --- Module : Graphics.Gloss.Accelerate.Raster.Array --- Copyright : [2013..2017] Trevor L. McDonell --- License : BSD3 --- --- Maintainer : Trevor L. McDonell --- Stability : experimental --- Portability : non-portable (GHC extensions) --- --- Rendering of Accelerate arrays as raster images + +-- | 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, + module Graphics.Gloss.Accelerate.Data.Color, -- * Display functions Render, Display(..), - animateArrayWith, - animateArrayIOWith, - playArrayWith, - playArrayIOWith, + animateArray, animateArrayWith, + playArray, playArrayWith, -- * Picture creation makePicture, @@ -30,9 +19,9 @@ -- Friends import Graphics.Gloss.Accelerate.Render +import Graphics.Gloss.Accelerate.Data.Color 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 @@ -42,7 +31,6 @@ 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 @@ -51,80 +39,58 @@ -- Animate -------------------------------------------------------------------- -- ------- --- | Animate a bitmap generated by an Accelerate computation, specifying the --- backend used to render the image. +-- | Animate a bitmap generated by an Accelerate computation, using the default +-- backend. -- -animateArrayWith - :: Render -- ^ Method to render the array (backend 'run1' function to use) - -> Display -- ^ Display mode +animateArray + :: Display -- ^ Display mode -> (Int, Int) -- ^ Number of pixels to draw per point - -> (Exp Float -> Acc (Array DIM2 Colour)) + -> (Exp Float -> Acc (Array DIM2 Color)) -- ^ 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 +animateArray = animateArrayWith defaultRender --- | Animate a bitmap generated by an Accelerate computation and IO actions, specifying the +-- | Animate a bitmap generated by an Accelerate computation, specifying the -- backend used to render the image. -- -animateArrayIOWith - :: Arrays world - => Render -- ^ Method to render the array (backend 'run1' function) +animateArrayWith + :: Render -- ^ Method to render the array -> 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)) + -> (Exp Float -> Acc (Array DIM2 Color)) -- ^ 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 + -- It is passed the time in seconds since the program started. -> IO () -animateArrayIOWith render display (zoomX, zoomY) makeWorld makeArray - | zoomX P.< 1 P.|| zoomY P.< 1 +animateArrayWith render display (zoomX, zoomY) makeArray + | zoomX < 1 || zoomY < 1 = error "Graphics.Gloss.Raster: invalid pixel scalar factor" | otherwise - = let picture = fmap (makePicture render zoomX zoomY makeArray) - . makeWorld + = let picture time = makePicture render zoomX zoomY (makeArray . the) + $ fromList Z [time] in -#if MIN_VERSION_gloss(1,10,0) - animateFixedIO display G.black picture (\_ -> return ()) -#else - animateFixedIO display G.black picture -#endif + animateFixedIO display G.black (return . picture) --- | Play with a bitmap generated by an Accelerate computation, specifying the --- method used to render the world. +-- | Play with a bitmap generated by an Accelerate computation, using the +-- default backend. -- -playArrayWith +playArray :: Arrays world - => Render -- ^ Method to render the world (backend 'run1' function) - -> Display -- ^ Display mode + => 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)) + -> (Acc world -> Acc (Array DIM2 Color)) -- ^ Compute the colour of the world -> (Event -> state -> state) -- ^ Handle input events @@ -132,47 +98,38 @@ -- ^ 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 +playArray = playArrayWith defaultRender --- | Play with a bitmap generated by an Accelerate computation and IO actions, specifying the +-- | Play with a bitmap generated by an Accelerate computation, specifying the -- method used to render the world. -- -playArrayIOWith +playArrayWith :: Arrays world - => Render -- ^ Method to render the world (backend 'run1' function) + => Render -- ^ Method to render the world -> 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)) + -> (state -> world) -- ^ Extract the world state + -> (Acc world -> Acc (Array DIM2 Color)) -- ^ Compute the colour of the world - -> (Event -> state -> IO state) + -> (Event -> state -> state) -- ^ Handle input events - -> (Float -> state -> IO state) + -> (Float -> state -> state) -- ^ Step the world one iteration. -- It is passed the time in seconds since the program started. -> IO () -playArrayIOWith render display (zoomX, zoomY) stepRate +playArrayWith render display (zoomX, zoomY) stepRate initState makeWorld makeArray handleEvent stepState - | zoomX P.< 1 P.|| zoomY P.< 1 + | zoomX < 1 || zoomY < 1 = error "Graphics.Gloss.Raster: invalid pixel scalar factor" | otherwise - = let picture = fmap (makePicture render zoomX zoomY makeArray) + = let picture = makePicture render zoomX zoomY makeArray . makeWorld in - G.playIO display G.black stepRate initState picture handleEvent stepState + play display G.black stepRate initState picture handleEvent stepState -- Internals @@ -187,11 +144,10 @@ => Render -- ^ method to compute the image -> Int -- ^ pixel width -> Int -- ^ pixel height - -> (Acc world -> Acc (Array DIM2 Colour)) -- ^ function to create the image + -> (Acc world -> Acc (Array DIM2 Color)) -- ^ 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 diff --git a/Graphics/Gloss/Accelerate/Raster/Field.hs b/Graphics/Gloss/Accelerate/Raster/Field.hs --- a/Graphics/Gloss/Accelerate/Raster/Field.hs +++ b/Graphics/Gloss/Accelerate/Raster/Field.hs @@ -1,27 +1,16 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE RankNTypes #-} --- | --- Module : Graphics.Gloss.Accelerate.Raster.Field --- Copyright : [2013..2017] Trevor L. McDonell --- License : BSD3 --- --- Maintainer : Trevor L. McDonell --- Stability : experimental --- Portability : non-portable (GHC extensions) --- --- Rendering of 2D functions as raster fields + +-- | 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, + module Graphics.Gloss.Accelerate.Data.Color, -- * Display functions Render, Display(..), - animateFieldWith, - animateFieldIOWith, - playFieldWith, - playFieldIOWith, + animateField, animateFieldWith, + playField, playFieldWith, -- * Field creation makeField, @@ -30,21 +19,15 @@ -- Friends import Graphics.Gloss.Accelerate.Render +import Graphics.Gloss.Accelerate.Data.Color 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 @@ -53,51 +36,34 @@ -- Animate -------------------------------------------------------------------- -- ------- --- | Animate a continuous 2D function, specifying the backend used to render --- the field. +-- | Animate a continuous 2D function using the default backend -- -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) +animateField + :: Display -- ^ Display mode + -> (Int, Int) -- ^ Number of pixels to draw per point + -> (Exp Float -> Exp Point -> Exp Color) -- ^ 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) +animateField = animateFieldWith defaultRender --- | Animate a continuous 2D function using IO actions, specifying the backend used to render +-- | Animate a continuous 2D function, specifying the backend used to render -- the field. -- -animateFieldIOWith - :: Arrays world - => Render -- ^ Method to render the field +animateFieldWith + :: 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) + -> (Exp Float -> Exp Point -> Exp Color) -- ^ A function to compute the colour at a particular point. -- - -- It is passed the world, and + -- It is passed the time in seconds since the program started, and -- a point between (-1,1) and (+1,1). -> IO () -animateFieldIOWith render display zoom@(zoomX, zoomY) makeWorld makePixel +animateFieldWith render display zoom@(zoomX, zoomY) makePixel = let -- size of the window (winSizeX, winSizeY) = sizeOfDisplay display @@ -105,26 +71,23 @@ sizeX = winSizeX `div` zoomX sizeY = winSizeY `div` zoomY in - animateArrayIOWith + animateArrayWith render display zoom - makeWorld (makeField sizeX sizeY makePixel) --- | Play a game with a continuous 2D function, specifying the method used to --- render the field. +-- | Play a game with a continuous 2D function using the default backend. -- -playFieldWith +playField :: Arrays world - => Render -- ^ Method to render the field - -> Display -- ^ Display mode + => 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) + -> (Acc world -> Exp Point -> Exp Color) -- ^ Compute the colour of the world at a given point -> (Event -> state -> state) -- ^ Handle input events @@ -132,46 +95,29 @@ -- ^ 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 +playField = playFieldWith defaultRender - -- 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 +-- | Play a game with a continuous 2D function, specifying the method used to -- render the field. -- -playFieldIOWith +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 -> IO world) -- ^ Extract the world state - -> (Acc world -> Exp Point -> Exp Colour) + -> (state -> world) -- ^ Extract the world state + -> (Acc world -> Exp Point -> Exp Color) -- ^ Compute the colour of the world at a given point - -> (Event -> state -> IO state) + -> (Event -> state -> state) -- ^ Handle input events - -> (Float -> state -> IO state) + -> (Float -> state -> 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 +playFieldWith render display zoom@(zoomX, zoomY) stepRate initState makeWorld makePixel handleEvent stepState = let -- size of the window (winSizeX, winSizeY) = sizeOfDisplay display @@ -180,7 +126,7 @@ sizeX = winSizeX `div` zoomX sizeY = winSizeY `div` zoomY in - playArrayIOWith + playArrayWith render display zoom @@ -199,11 +145,7 @@ 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. @@ -216,8 +158,8 @@ 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 + -> (world -> Exp Point -> Exp Color) -- ^ function to apply at each point + -> (world -> Acc (Array DIM2 Color)) -- ^ new function that generates the field makeField sizeX sizeY makePixel world = A.generate (constant (Z :. sizeY :. sizeX)) (makePixel world . pointOfIndex sizeX sizeY) diff --git a/Graphics/Gloss/Accelerate/Render.hs b/Graphics/Gloss/Accelerate/Render.hs --- a/Graphics/Gloss/Accelerate/Render.hs +++ b/Graphics/Gloss/Accelerate/Render.hs @@ -1,26 +1,30 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE RankNTypes #-} --- | --- Module : Graphics.Gloss.Accelerate.Render --- Copyright : [2013..2017] Trevor L. McDonell --- License : BSD3 --- --- Maintainer : Trevor L. McDonell --- Stability : experimental --- Portability : non-portable (GHC extensions) --- module Graphics.Gloss.Accelerate.Render where import Data.Array.Accelerate +#ifdef ACCELERATE_CUDA_BACKEND +import Data.Array.Accelerate.CUDA +#else +import Data.Array.Accelerate.Interpreter +#endif --- | The type for executing Accelerate computations. This matches the 'run1' --- style of executing programs. +-- | The type of executing Accelerate computations. The CUDA and Interpreter +-- backends both provide a function 'run1' that can be used. -- -- 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 + + +-- | The set of backends available to execute Accelerate programs. The default +-- chooses the fastest available, which is currently the CUDA backend. This is +-- controlled via the import statements. +-- +defaultRender :: Render +defaultRender = run1 diff --git a/gloss-raster-accelerate.cabal b/gloss-raster-accelerate.cabal --- a/gloss-raster-accelerate.cabal +++ b/gloss-raster-accelerate.cabal @@ -1,16 +1,20 @@ Name: gloss-raster-accelerate -Version: 0.2.0.0 +Version: 1.8.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 +Maintainer: tmcdonell@cse.unsw.edu.au Category: Graphics Build-type: Simple Cabal-version: >=1.10 +Flag cuda + Description: Enable the CUDA parallel backend for NVIDIA GPUs + Default: True + Library Exposed-modules: Graphics.Gloss.Accelerate.Render @@ -18,12 +22,16 @@ 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 + base == 4.6.*, + accelerate == 0.14.*, + gloss == 1.8.*, + gloss-accelerate == 1.8.* + if flag(cuda) + cpp-options: -DACCELERATE_CUDA_BACKEND + Build-depends: + accelerate-cuda == 0.14.* + ghc-options: -Wall -O2 @@ -32,11 +40,6 @@ 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