{-# LANGUAGE RankNTypes #-}

-- We export this stuff separately so we don't clutter up the
-- API of the Graphics.Gloss module.

-- | Simulate mode is for producing an animation of some model who's picture
--   changes over finite time steps. The behavior of the model can also depent
--   on the current `ViewPort`.
module Graphics.Gloss.Interface.Pure.Simulate
        ( module Graphics.Gloss.Data.Display
        , module Graphics.Gloss.Data.Picture
        , module Graphics.Gloss.Data.Color
        , simulate
        , ViewPort(..))
where
import Graphics.Gloss.Data.Display
import Graphics.Gloss.Data.Picture
import Graphics.Gloss.Data.Color
import Graphics.Gloss.Data.ViewPort
import Graphics.Gloss.Internals.Interface.Simulate
import Graphics.Gloss.Internals.Interface.Backend


-- | Run a finite-time-step simulation in a window. You decide how the model is represented,
--      how to convert the model to a picture, and how to advance the model for each unit of time.
--      This function does the rest.
--
--   Once the window is open you can use the same commands as with `display`.
--
simulate
        :: Display      -- ^ Display mode.
        -> Color        -- ^ Background color.
        -> Int          -- ^ Number of simulation steps to take for each second of real time.
        -> model        -- ^ The initial model.
        -> (model -> Picture)
                -- ^ A function to convert the model to a picture.
        -> (ViewPort -> Float -> model -> model)
                -- ^ A function to step the model one iteration. It is passed the
                --     current viewport and the amount of time for this simulation
                --     step (in seconds).
        -> IO ()

simulate :: Display
-> Color
-> Int
-> model
-> (model -> Picture)
-> (ViewPort -> Float -> model -> model)
-> IO ()
simulate Display
display Color
backColor Int
simResolution
         model
modelStart model -> Picture
modelToPicture ViewPort -> Float -> model -> model
modelStep

 = do   ()
_       <- GLUTState
-> Display
-> Color
-> Int
-> model
-> (model -> IO Picture)
-> (ViewPort -> Float -> model -> IO model)
-> IO ()
forall model a.
Backend a =>
a
-> Display
-> Color
-> Int
-> model
-> (model -> IO Picture)
-> (ViewPort -> Float -> model -> IO model)
-> IO ()
simulateWithBackendIO GLUTState
defaultBackendState
                        Display
display Color
backColor Int
simResolution
                        model
modelStart
                        (Picture -> IO Picture
forall (m :: * -> *) a. Monad m => a -> m a
return (Picture -> IO Picture)
-> (model -> Picture) -> model -> IO Picture
forall b c a. (b -> c) -> (a -> b) -> a -> c
. model -> Picture
modelToPicture)
                        (\ViewPort
view Float
time model
model -> model -> IO model
forall (m :: * -> *) a. Monad m => a -> m a
return (model -> IO model) -> model -> IO model
forall a b. (a -> b) -> a -> b
$ ViewPort -> Float -> model -> model
modelStep ViewPort
view Float
time model
model)
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()