{-# 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