{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
module Graphics.Gloss.Accelerate.Raster.Field (
module Graphics.Gloss.Accelerate.Data.Point,
module Data.Array.Accelerate.Data.Colour.RGBA,
Render, Display(..),
animateFieldWith,
animateFieldIOWith,
playFieldWith,
playFieldIOWith,
makeField,
) where
import Graphics.Gloss.Accelerate.Render
import Graphics.Gloss.Accelerate.Data.Point
import Graphics.Gloss.Accelerate.Raster.Array
import Data.Array.Accelerate.Data.Colour.RGBA
import Prelude as P
#if MIN_VERSION_gloss(1,11,0)
import System.IO.Unsafe
#endif
import Graphics.Gloss.Interface.Pure.Game ( Event )
#if MIN_VERSION_gloss(1,11,0)
import Graphics.Gloss.Interface.Environment
#endif
import Data.Array.Accelerate as A
animateFieldWith
:: Render
-> Display
-> (Int, Int)
-> (Exp Float -> Exp Point -> Exp Colour)
-> IO ()
animateFieldWith render display zoom@(zoomX, zoomY) makePixel
= let
(winSizeX, winSizeY) = sizeOfDisplay display
sizeX = winSizeX `div` zoomX
sizeY = winSizeY `div` zoomY
in
animateArrayWith
render
display
zoom
(makeField sizeX sizeY makePixel)
animateFieldIOWith
:: Arrays world
=> Render
-> Display
-> (Int, Int)
-> (Float -> IO world)
-> (Acc world -> Exp Point -> Exp Colour)
-> IO ()
animateFieldIOWith render display zoom@(zoomX, zoomY) makeWorld makePixel
= let
(winSizeX, winSizeY) = sizeOfDisplay display
sizeX = winSizeX `div` zoomX
sizeY = winSizeY `div` zoomY
in
animateArrayIOWith
render
display
zoom
makeWorld
(makeField sizeX sizeY makePixel)
playFieldWith
:: Arrays world
=> Render
-> Display
-> (Int, Int)
-> Int
-> state
-> (state -> world)
-> (Acc world -> Exp Point -> Exp Colour)
-> (Event -> state -> state)
-> (Float -> state -> state)
-> IO ()
playFieldWith render display zoom@(zoomX, zoomY) stepRate
initState makeWorld makePixel handleEvent stepState
= let
(winSizeX, winSizeY) = sizeOfDisplay display
sizeX = winSizeX `div` zoomX
sizeY = winSizeY `div` zoomY
in
playArrayWith
render
display
zoom
stepRate
initState
makeWorld
(makeField sizeX sizeY makePixel)
handleEvent
stepState
playFieldIOWith
:: Arrays world
=> Render
-> Display
-> (Int, Int)
-> Int
-> state
-> (state -> IO world)
-> (Acc world -> Exp Point -> Exp Colour)
-> (Event -> state -> IO state)
-> (Float -> state -> IO state)
-> IO ()
playFieldIOWith render display zoom@(zoomX, zoomY) stepRate
initState makeWorld makePixel handleEvent stepState
= let
(winSizeX, winSizeY) = sizeOfDisplay display
sizeX = winSizeX `div` zoomX
sizeY = winSizeY `div` zoomY
in
playArrayIOWith
render
display
zoom
stepRate
initState
makeWorld
(makeField sizeX sizeY makePixel)
handleEvent
stepState
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
makeField
:: Int
-> Int
-> (world -> Exp Point -> Exp Colour)
-> (world -> Acc (Array DIM2 Colour))
makeField sizeX sizeY makePixel world
= A.generate (constant (Z :. sizeY :. sizeX))
(makePixel world . pointOfIndex sizeX sizeY)