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