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 @@ -10,7 +10,9 @@ -- * Display functions Render, Display(..), animateArray, animateArrayWith, + animateArrayIO, animateArrayIOWith, playArray, playArrayWith, + playArrayIO, playArrayIOWith, -- * Picture creation makePicture, @@ -31,6 +33,7 @@ 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 @@ -74,12 +77,60 @@ = error "Graphics.Gloss.Raster: invalid pixel scalar factor" | otherwise - = let picture time = makePicture render zoomX zoomY (makeArray . the) - $ fromList Z [time] + = let picture = makePicture render zoomX zoomY (makeArray . the) + . fromList Z + . return in animateFixedIO display G.black (return . picture) +-- | Animate a bitmap generated by an Accelerate computation and IO actions, using the default +-- backend. +-- +animateArrayIO + :: Arrays world + => 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 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 + -> IO () +animateArrayIO = animateArrayIOWith defaultRender + + +-- | 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 + -> 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 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 + -> IO () +animateArrayIOWith render display (zoomX, zoomY) makeWorld makeArray + | zoomX < 1 || zoomY < 1 + = error "Graphics.Gloss.Raster: invalid pixel scalar factor" + + | otherwise + = let picture = fmap (makePicture render zoomX zoomY makeArray) + . makeWorld + in + animateFixedIO display G.black picture + + -- | Play with a bitmap generated by an Accelerate computation, using the -- default backend. -- @@ -130,6 +181,58 @@ . makeWorld in play display G.black stepRate initState picture handleEvent stepState + + +-- | Play with a bitmap generated by an Accelerate computation and IO actions, using the +-- default backend. +-- +playArrayIO + :: Arrays 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 Color)) + -- ^ 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 () +playArrayIO = playArrayIOWith defaultRender + + +-- | 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 + -> 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 Color)) + -- ^ 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 < 1 || zoomY < 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 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 @@ -10,7 +10,9 @@ -- * Display functions Render, Display(..), animateField, animateFieldWith, + animateFieldIO, animateFieldIOWith, playField, playFieldWith, + playFieldIO, playFieldIOWith, -- * Field creation makeField, @@ -78,6 +80,55 @@ (makeField sizeX sizeY makePixel) +-- | Animate a continuous 2D function using IO actions and the default backend +-- +animateFieldIO + :: Arrays world + => 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 Color) + -- ^ 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 () +animateFieldIO = animateFieldIOWith defaultRender + + +-- | 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 Color) + -- ^ 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 using the default backend. -- playField @@ -127,6 +178,65 @@ 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, and the default backend. +-- +playFieldIO + :: Arrays 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 -> Exp Point -> Exp Color) + -- ^ 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 () +playFieldIO = playFieldIOWith defaultRender + + +-- | 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 Color) + -- ^ 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 diff --git a/gloss-raster-accelerate.cabal b/gloss-raster-accelerate.cabal --- a/gloss-raster-accelerate.cabal +++ b/gloss-raster-accelerate.cabal @@ -1,5 +1,5 @@ Name: gloss-raster-accelerate -Version: 1.8.0.0 +Version: 1.8.15.0 Synopsis: Parallel rendering of raster images using Accelerate Description: Parallel rendering of raster images using Accelerate License: BSD3 @@ -22,15 +22,15 @@ Graphics.Gloss.Accelerate.Raster.Field build-depends: - base == 4.6.*, - accelerate == 0.14.*, + base >= 4.6 && < 4.8, + accelerate == 0.15.*, gloss == 1.8.*, gloss-accelerate == 1.8.* if flag(cuda) cpp-options: -DACCELERATE_CUDA_BACKEND Build-depends: - accelerate-cuda == 0.14.* + accelerate-cuda == 0.15.* ghc-options: -Wall -O2