    {-# 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  IORef ViewState
    viewSR          <- ViewState -> IO (IORef ViewState)
    forall a. a -> IO (IORef a)
    newIORef ViewState
    viewStateInit
            IORef world
    worldSR         <- world -> IO (IORef world)
    forall a. a -> IO (IORef a)
    newIORef world
    worldStart
            State
    renderS         <- IO State
    initState
            IORef State
    renderSR        <- State -> IO (IORef State)
    forall a. a -> IO (IORef a)
    newIORef State
    renderS

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

                    State
    renderS'      <- IORef State -> IO State
    forall a. IORef a -> IO a
    readIORef IORef State
    renderSR
                    ViewState
    viewState     <- IORef ViewState -> IO ViewState
    forall a. IORef a -> IO a
    readIORef IORef ViewState
    viewSR
                    let viewPort :: ViewPort
    viewPort  =  ViewState -> ViewPort
    viewStateViewPort ViewState
    viewState

                    (Int, Int)
    windowSize <- IORef a -> IO (Int, Int)
    forall a. Backend a => IORef a -> IO (Int, Int)
    getWindowDimensions IORef a
    backendRef

                    (Int, Int) -> Color -> State -> Float -> Picture -> IO ()
    displayPicture
                            (Int, Int)
    windowSize
                            Color
    background
                            State
    renderS'
                            (ViewPort -> Float
    viewPortScale ViewPort
    viewPort)
                            (ViewPort -> Picture -> Picture
    applyViewPortToPicture ViewPort
    viewPort Picture
    picture)

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

            let callbacks :: [Callback]
    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.
            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
                    { 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
                    }

    -- | 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   Event
    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
            a
    world      <- IORef a -> IO a
    forall a. IORef a -> IO a
    readIORef IORef a
    worldRef
            a
    world'     <- Event -> a -> IO a
    eventFn Event
    ev a
    world
            IORef a -> a -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef a
    worldRef a
    world'
            IORef a -> IO ()
    DisplayCallback
    postRedisplay IORef a
    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   Event
    ev       <- IORef a -> (Int, Int) -> IO Event
    forall a. Backend a => IORef a -> (Int, Int) -> IO Event
    motionEvent IORef a
    backendRef (Int, Int)
    pos
            a
    world    <- IORef a -> IO a
    forall a. IORef a -> IO a
    readIORef IORef a
    worldRef
            a
    world'   <- Event -> a -> IO a
    eventFn Event
    ev a
    world
            IORef a -> a -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef a
    worldRef a
    world'
            IORef a -> IO ()
    DisplayCallback
    postRedisplay IORef a
    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
    world  <- IORef world -> IO world
    forall a. IORef a -> IO a
    readIORef IORef world
    worldRef
            world
    world' <- Event -> world -> IO world
    eventFn ((Int, Int) -> Event
    EventResize (Int
    width, Int
    height)) world
    world
            IORef world -> world -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef world
    worldRef world
    world'
            IORef a -> (Int, Int) -> IO ()
    MotionCallback
    viewState_reshape IORef a
    backendRef (Int
    width, Int
    height)
            IORef a -> IO ()
    DisplayCallback
    postRedisplay IORef a
    backendRef