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 :: a
-> Display -> Color -> IO Picture -> (Controller -> IO ()) -> IO ()
displayWithBackend
        a
backend Display
displayMode Color
background
        IO Picture
makePicture
        Controller -> IO ()
eatController

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

        let renderFun :: IORef a -> IO ()
renderFun IORef a
backendRef = do
                ViewPort
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
                State
options    <- IORef State -> IO State
forall a. IORef a -> IO a
readIORef IORef State
renderSR
                (Int, Int)
windowSize <- IORef a -> IO (Int, Int)
forall a. Backend a => IORef a -> IO (Int, Int)
getWindowDimensions IORef a
backendRef
                Picture
picture    <- IO Picture
makePicture

                (Int, Int) -> Color -> State -> Float -> Picture -> IO ()
displayPicture
                        (Int, Int)
windowSize
                        Color
background
                        State
options
                        (ViewPort -> Float
viewPortScale ViewPort
port)
                        (ViewPort -> Picture -> Picture
applyViewPortToPicture ViewPort
port Picture
picture)

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

        let callbacks :: [Callback]
callbacks
             =  [ DisplayCallback -> Callback
Callback.Display 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.
        a -> Display -> Color -> [Callback] -> (IORef a -> IO ()) -> IO ()
forall a.
Backend a =>
a -> Display -> Color -> [Callback] -> (IORef a -> IO ()) -> IO ()
createWindow a
backend Display
displayMode Color
background [Callback]
callbacks
         ((IORef a -> IO ()) -> IO ()) -> (IORef a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \  IORef a
backendRef
           -> Controller -> IO ()
eatController
                (Controller -> IO ()) -> Controller -> IO ()
forall a b. (a -> b) -> a -> b
$ Controller :: IO () -> ((ViewPort -> IO ViewPort) -> IO ()) -> Controller
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
viewState       <- IORef ViewState -> IO ViewState
forall a. IORef a -> IO a
readIORef IORef ViewState
viewSR
                           ViewPort
port'           <- ViewPort -> IO ViewPort
modViewPort (ViewPort -> IO ViewPort) -> ViewPort -> IO ViewPort
forall a b. (a -> b) -> a -> b
$ ViewState -> ViewPort
viewStateViewPort ViewState
viewState
                           let viewState' :: ViewState
viewState'  =  ViewState
viewState { viewStateViewPort :: ViewPort
viewStateViewPort = ViewPort
port' }
                           IORef ViewState -> ViewState -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef ViewState
viewSR ViewState
viewState'
                           IORef a -> IO ()
DisplayCallback
postRedisplay IORef a
backendRef
                }