gloss-raster-accelerate 2.0.0.0 → 2.1.0.0
raw patch · 8 files changed
+472/−470 lines, 8 filesdep ~acceleratedep ~base
Dependency ranges changed: accelerate, base
Files
- Graphics/Gloss/Accelerate/Raster/Array.hs +0/−201
- Graphics/Gloss/Accelerate/Raster/Field.hs +0/−224
- Graphics/Gloss/Accelerate/Render.hs +0/−26
- LICENSE +1/−1
- gloss-raster-accelerate.cabal +20/−18
- src/Graphics/Gloss/Accelerate/Raster/Array.hs +201/−0
- src/Graphics/Gloss/Accelerate/Raster/Field.hs +224/−0
- src/Graphics/Gloss/Accelerate/Render.hs +26/−0
− Graphics/Gloss/Accelerate/Raster/Array.hs
@@ -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 <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
@@ -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 <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
@@ -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 <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
@@ -1,4 +1,4 @@-Copyright (c) 2013, Trevor L. McDonell+Copyright (c) [2013..2020], Trevor L. McDonell All rights reserved.
gloss-raster-accelerate.cabal view
@@ -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 <tmcdonell@cse.unsw.edu.au>-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 <https://github.com/tmcdonell/gloss-raster-accelerate#readme>+license: BSD3+license-file: LICENSE+author: Trevor L. McDonell+maintainer: Trevor L. McDonell <trevor.mcdonell@gmail.com>+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
+ src/Graphics/Gloss/Accelerate/Raster/Array.hs view
@@ -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 <trevor.mcdonell@gmail.com>+-- 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+
+ src/Graphics/Gloss/Accelerate/Raster/Field.hs view
@@ -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 <trevor.mcdonell@gmail.com>+-- 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)+
+ src/Graphics/Gloss/Accelerate/Render.hs view
@@ -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 <trevor.mcdonell@gmail.com>+-- 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+