module Graphics.Gloss.Internals.Interface.Display
        (displayWithBackend)
where
import Graphics.Gloss.Data.Color
import Graphics.Gloss.Data.Controller
import Graphics.Gloss.Data.Picture
import Graphics.Gloss.Data.ViewPort
import Graphics.Gloss.Data.ViewState
import Graphics.Gloss.Rendering
import Graphics.Gloss.Internals.Interface.Backend
import Graphics.Gloss.Internals.Interface.Window
import Graphics.Gloss.Internals.Interface.Common.Exit
import Graphics.Gloss.Internals.Interface.ViewState.KeyMouse
import Graphics.Gloss.Internals.Interface.ViewState.Motion
import Graphics.Gloss.Internals.Interface.ViewState.Reshape
import qualified Graphics.Gloss.Internals.Interface.Callback as Callback
import Data.IORef
import System.Mem


displayWithBackend
        :: Backend a
        => a                            -- ^ Initial state of the backend.
        -> Display                      -- ^ Display config.
        -> Color                        -- ^ Background color.
        -> IO Picture                   -- ^ Make the picture to draw.
        -> (Controller -> IO ())        -- ^ Eat the controller
        -> IO ()

displayWithBackend :: forall a.
Backend a =>
a
-> Display -> Color -> IO Picture -> (Controller -> IO ()) -> IO ()
displayWithBackend
        a
backend Display
displayMode Color
background
        IO Picture
makePicture
        Controller -> IO ()
eatController

 =  do  viewSR          <- ViewState -> IO (IORef ViewState)
forall a. a -> IO (IORef a)
newIORef ViewState
viewStateInit
        renderS         <- initState
        renderSR        <- newIORef renderS

        let renderFun IORef a
backendRef = do
                port       <- ViewState -> ViewPort
viewStateViewPort (ViewState -> ViewPort) -> IO ViewState -> IO ViewPort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef ViewState -> IO ViewState
forall a. IORef a -> IO a
readIORef IORef ViewState
viewSR
                options    <- readIORef renderSR
                windowSize <- getWindowDimensions backendRef
                picture    <- makePicture

                displayPicture
                        windowSize
                        background
                        options
                        (viewPortScale port)
                        (applyViewPortToPicture port picture)

                -- perform GC every frame to try and avoid long pauses
                performGC

        let callbacks
             =  [ DisplayCallback -> Callback
Callback.Display IORef a -> IO ()
DisplayCallback
renderFun

                -- Escape exits the program
                , () -> Callback
forall a. a -> Callback
callback_exit ()

                -- Viewport control with mouse
                , IORef ViewState -> Callback
callback_viewState_keyMouse IORef ViewState
viewSR
                , IORef ViewState -> Callback
callback_viewState_motion   IORef ViewState
viewSR
                , Callback
callback_viewState_reshape ]

        -- When we create the window we can pass a function to get a
        -- reference to the backend state. Using this we make a controller
        -- so the client can control the window asynchronously.
        createWindow backend displayMode background callbacks
         $ \  IORef a
backendRef
           -> Controller -> IO ()
eatController
                (Controller -> IO ()) -> Controller -> IO ()
forall a b. (a -> b) -> a -> b
$ Controller
                { controllerSetRedraw :: IO ()
controllerSetRedraw
                   = do IORef a -> IO ()
DisplayCallback
postRedisplay IORef a
backendRef

                , controllerModifyViewPort :: (ViewPort -> IO ViewPort) -> IO ()
controllerModifyViewPort
                   = \ViewPort -> IO ViewPort
modViewPort
                     -> do viewState       <- IORef ViewState -> IO ViewState
forall a. IORef a -> IO a
readIORef IORef ViewState
viewSR
                           port'           <- modViewPort $ viewStateViewPort viewState
                           let viewState'  =  ViewState
viewState { viewStateViewPort = port' }
                           writeIORef viewSR viewState'
                           postRedisplay backendRef
                }