diff --git a/Graphics/Gloss/Accelerate/Raster/Array.hs b/Graphics/Gloss/Accelerate/Raster/Array.hs deleted file mode 100644 --- a/Graphics/Gloss/Accelerate/Raster/Array.hs +++ /dev/null @@ -1,201 +0,0 @@ -{-# 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 --- -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 - diff --git a/Graphics/Gloss/Accelerate/Raster/Field.hs b/Graphics/Gloss/Accelerate/Raster/Field.hs deleted file mode 100644 --- a/Graphics/Gloss/Accelerate/Raster/Field.hs +++ /dev/null @@ -1,224 +0,0 @@ -{-# 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 --- -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) - diff --git a/Graphics/Gloss/Accelerate/Render.hs b/Graphics/Gloss/Accelerate/Render.hs deleted file mode 100644 --- a/Graphics/Gloss/Accelerate/Render.hs +++ /dev/null @@ -1,26 +0,0 @@ -{-# 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 - - --- | 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 - diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2013, Trevor L. McDonell +Copyright (c) [2013..2020], Trevor L. McDonell All rights reserved. diff --git a/gloss-raster-accelerate.cabal b/gloss-raster-accelerate.cabal --- a/gloss-raster-accelerate.cabal +++ b/gloss-raster-accelerate.cabal @@ -1,28 +1,27 @@ -Name: gloss-raster-accelerate -Version: 2.0.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 -Category: Graphics -Build-type: Simple -Cabal-version: >=1.10 - +name: gloss-raster-accelerate +version: 2.1.0.0 +synopsis: Parallel rendering of raster images using Accelerate +description: Please see the README on GitHub at +license: BSD3 +license-file: LICENSE +author: Trevor L. McDonell +maintainer: Trevor L. McDonell +category: Accelerate, Graphics +build-type: Simple +cabal-version: >=1.10 -Library - Exposed-modules: +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 + base >= 4.6 && < 5 + , accelerate >= 1.3 , colour-accelerate >= 0.1 , gloss >= 1.9 - , gloss-accelerate >= 0.2 + , gloss-accelerate >= 2.0 ghc-options: -Wall -O2 @@ -30,13 +29,16 @@ default-language: Haskell2010 + hs-source-dirs: + src + source-repository head type: git location: https://github.com/tmcdonell/gloss-raster-accelerate source-repository this type: git - tag: v2.0.0.0 + tag: v2.1.0.0 location: https://github.com/tmcdonell/gloss-raster-accelerate -- vim: nospell diff --git a/src/Graphics/Gloss/Accelerate/Raster/Array.hs b/src/Graphics/Gloss/Accelerate/Raster/Array.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Gloss/Accelerate/Raster/Array.hs @@ -0,0 +1,201 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE RankNTypes #-} +-- | +-- Module : Graphics.Gloss.Accelerate.Raster.Array +-- Copyright : [2013..2020] Trevor L. McDonell +-- License : BSD3 +-- +-- Maintainer : Trevor L. McDonell +-- 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 + diff --git a/src/Graphics/Gloss/Accelerate/Raster/Field.hs b/src/Graphics/Gloss/Accelerate/Raster/Field.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Gloss/Accelerate/Raster/Field.hs @@ -0,0 +1,224 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE RankNTypes #-} +-- | +-- Module : Graphics.Gloss.Accelerate.Raster.Field +-- Copyright : [2013..2020] Trevor L. McDonell +-- License : BSD3 +-- +-- Maintainer : Trevor L. McDonell +-- 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) + diff --git a/src/Graphics/Gloss/Accelerate/Render.hs b/src/Graphics/Gloss/Accelerate/Render.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Gloss/Accelerate/Render.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE RankNTypes #-} +-- | +-- Module : Graphics.Gloss.Accelerate.Render +-- Copyright : [2013..2020] 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 + + +-- | 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 +