    {-# LANGUAGE RankNTypes #-}

    module Graphics.Gloss.Internals.Interface.Interact
            (interactWithBackend)
    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.Event
    import Graphics.Gloss.Internals.Interface.Backend
    import Graphics.Gloss.Internals.Interface.Window
    import Graphics.Gloss.Internals.Interface.ViewState.Reshape
    import qualified Graphics.Gloss.Internals.Interface.Callback as Callback
    import Data.IORef
    import System.Mem

    interactWithBackend
            :: Backend a
            => a                            -- ^ Initial state of the backend.
            -> Display                      -- ^ Display config.
            -> Color                        -- ^ Background color.
            -> world                        -- ^ The initial world.
            -> (world -> IO Picture)        -- ^ A function to produce the current picture.
            -> (Event -> world -> IO world) -- ^ A function to handle input events.
            -> (Controller -> IO ())        -- ^ Eat the controller
            -> IO ()

    interactWithBackend :: forall a world.
    Backend a =>
    a
    -> Display
    -> Color
    -> world
    -> (world -> IO Picture)
    -> (Event -> world -> IO world)
    -> (Controller -> IO ())
    -> IO ()
    interactWithBackend
            a
    backend Display
    displayMode Color
    background
            world
    worldStart
            world -> IO Picture
    worldToPicture
            Event -> world -> IO world
    worldHandleEvent
            Controller -> IO ()
    eatController

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

            let displayFun IORef a
    backendRef = do
                    world      <- IORef world -> IO world
    forall a. IORef a -> IO a
    readIORef IORef world
    worldSR
                    picture    <- worldToPicture world

                    renderS'      <- readIORef renderSR
                    viewState     <- readIORef viewSR
                    let viewPort  =  ViewState -> ViewPort
    viewStateViewPort ViewState
    viewState

                    windowSize <- getWindowDimensions backendRef

                    displayPicture
                            windowSize
                            background
                            renderS'
                            (viewPortScale viewPort)
                            (applyViewPortToPicture viewPort picture)

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

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

                    -- Viewport control with mouse
                    , IORef world
    -> IORef ViewState -> (Event -> world -> IO world) -> Callback
    forall world.
    IORef world
    -> IORef ViewState -> (Event -> world -> IO world) -> Callback
    callback_keyMouse IORef world
    worldSR IORef ViewState
    viewSR Event -> world -> IO world
    worldHandleEvent
                    , IORef world -> (Event -> world -> IO world) -> Callback
    forall world.
    IORef world -> (Event -> world -> IO world) -> Callback
    callback_motion   IORef world
    worldSR Event -> world -> IO world
    worldHandleEvent
                    , IORef world -> (Event -> world -> IO world) -> Callback
    forall world.
    IORef world -> (Event -> world -> IO world) -> Callback
    callback_reshape  IORef world
    worldSR Event -> world -> IO world
    worldHandleEvent ]

            -- 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
                    }

    -- | Callback for KeyMouse events.
    callback_keyMouse
            :: IORef world                  -- ^ ref to world state
            -> IORef ViewState
            -> (Event -> world -> IO world) -- ^ fn to handle input events
            -> Callback

    callback_keyMouse :: forall world.
    IORef world
    -> IORef ViewState -> (Event -> world -> IO world) -> Callback
    callback_keyMouse IORef world
    worldRef IORef ViewState
    viewRef Event -> world -> IO world
    eventFn
            = KeyboardMouseCallback -> Callback
    KeyMouse (IORef world
    -> IORef ViewState
    -> (Event -> world -> IO world)
    -> KeyboardMouseCallback
    forall a t.
    IORef a -> t -> (Event -> a -> IO a) -> KeyboardMouseCallback
    handle_keyMouse IORef world
    worldRef IORef ViewState
    viewRef Event -> world -> IO world
    eventFn)

    handle_keyMouse
            :: IORef a
            -> t
            -> (Event -> a -> IO a)
            -> KeyboardMouseCallback

    handle_keyMouse :: forall a t.
    IORef a -> t -> (Event -> a -> IO a) -> KeyboardMouseCallback
    handle_keyMouse IORef a
    worldRef t
    _ Event -> a -> IO a
    eventFn IORef a
    backendRef Key
    key KeyState
    keyState Modifiers
    keyMods (Int, Int)
    pos
     = do   ev         <- IORef a -> Key -> KeyState -> Modifiers -> (Int, Int) -> IO Event
    forall a.
    Backend a =>
    IORef a -> Key -> KeyState -> Modifiers -> (Int, Int) -> IO Event
    keyMouseEvent IORef a
    backendRef Key
    key KeyState
    keyState Modifiers
    keyMods (Int, Int)
    pos
            world      <- readIORef worldRef
            world'     <- eventFn ev world
            writeIORef worldRef world'
            postRedisplay backendRef

    -- | Callback for Motion events.
    callback_motion
            :: IORef world                  -- ^ ref to world state
            -> (Event -> world -> IO world) -- ^ fn to handle input events
            -> Callback

    callback_motion :: forall world.
    IORef world -> (Event -> world -> IO world) -> Callback
    callback_motion IORef world
    worldRef Event -> world -> IO world
    eventFn
            = MotionCallback -> Callback
    Motion (IORef world -> (Event -> world -> IO world) -> MotionCallback
    forall a. IORef a -> (Event -> a -> IO a) -> MotionCallback
    handle_motion IORef world
    worldRef Event -> world -> IO world
    eventFn)

    handle_motion
            :: IORef a
            -> (Event -> a -> IO a)
            -> MotionCallback

    handle_motion :: forall a. IORef a -> (Event -> a -> IO a) -> MotionCallback
    handle_motion IORef a
    worldRef Event -> a -> IO a
    eventFn IORef a
    backendRef (Int, Int)
    pos
     = do   ev       <- IORef a -> (Int, Int) -> IO Event
    forall a. Backend a => IORef a -> (Int, Int) -> IO Event
    motionEvent IORef a
    backendRef (Int, Int)
    pos
            world    <- readIORef worldRef
            world'   <- eventFn ev world
            writeIORef worldRef world'
            postRedisplay backendRef

    -- | Callback for Handle reshape event.
    callback_reshape
            :: IORef world
            -> (Event -> world -> IO world)
            -> Callback

    callback_reshape :: forall world.
    IORef world -> (Event -> world -> IO world) -> Callback
    callback_reshape IORef world
    worldRef Event -> world -> IO world
    eventFN
            = MotionCallback -> Callback
    Reshape (IORef world -> (Event -> world -> IO world) -> MotionCallback
    forall a. IORef a -> (Event -> a -> IO a) -> MotionCallback
    handle_reshape IORef world
    worldRef Event -> world -> IO world
    eventFN)

    handle_reshape
            :: IORef world
            -> (Event -> world -> IO world)
            -> ReshapeCallback
    handle_reshape :: forall a. IORef a -> (Event -> a -> IO a) -> MotionCallback
    handle_reshape IORef world
    worldRef Event -> world -> IO world
    eventFn IORef a
    backendRef (Int
    width,Int
    height)
     = do   world  <- IORef world -> IO world
    forall a. IORef a -> IO a
    readIORef IORef world
    worldRef
            world' <- eventFn (EventResize (width, height)) world
            writeIORef worldRef world'
            viewState_reshape backendRef (width, height)
            postRedisplay backendRef