    {-# LANGUAGE RankNTypes #-}

    module Graphics.Gloss.Internals.Interface.Game
            ( playWithBackendIO
            , Event(..) )
    where
    import Graphics.Gloss.Data.Color
    import Graphics.Gloss.Data.Picture
    import Graphics.Gloss.Data.ViewPort
    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.Common.Exit
    import Graphics.Gloss.Internals.Interface.ViewState.Reshape
    import Graphics.Gloss.Internals.Interface.Animate.Timing
    import Graphics.Gloss.Internals.Interface.Simulate.Idle
    import qualified Graphics.Gloss.Internals.Interface.Callback            as Callback
    import qualified Graphics.Gloss.Internals.Interface.Simulate.State      as SM
    import qualified Graphics.Gloss.Internals.Interface.Animate.State       as AN
    import Data.IORef
    import System.Mem

    playWithBackendIO
            :: forall world a
            .  Backend a
            => a            -- ^ Initial state of the backend
            -> Display      -- ^ Display mode.
            -> Color        -- ^ Background color.
            -> Int          -- ^ Number of simulation steps to take for each second of real time.
            -> world        -- ^ The initial world.
            -> (world -> IO Picture)
                            -- ^ A function to convert the world to a picture.
            -> (Event -> world -> IO world)
                            -- ^ A function to handle input events.
            -> (Float -> world -> IO world)
                            -- ^ A function to step the world one iteration.
                            --   It is passed the period of time (in seconds) needing to be advanced.
            -> Bool         -- ^ Whether to use the callback_exit or not.
            -> IO ()

    playWithBackendIO :: forall world a.
    Backend a =>
    a
    -> Display
    -> Color
    -> Int
    -> world
    -> (world -> IO Picture)
    -> (Event -> world -> IO world)
    -> (Float -> world -> IO world)
    -> Bool
    -> IO ()
    playWithBackendIO
            a
    backend
            Display
    display
            Color
    backgroundColor
            Int
    simResolution
            world
    worldStart
            world -> IO Picture
    worldToPicture
            Event -> world -> IO world
    worldHandleEvent
            Float -> world -> IO world
    worldAdvance
            Bool
    withCallbackExit
     = do
            let singleStepTime :: Float
    singleStepTime      = Float
    1

            -- make the simulation state
            stateSR         <- State -> IO (IORef State)
    forall a. a -> IO (IORef a)
    newIORef (State -> IO (IORef State)) -> State -> IO (IORef State)
    forall a b. (a -> b) -> a -> b
    $ Int -> State
    SM.stateInit Int
    simResolution

            -- make a reference to the initial world
            worldSR         <- newIORef worldStart

            -- make the initial GL view and render states
            viewSR          <- newIORef viewPortInit
            animateSR       <- newIORef AN.stateInit
            renderS_        <- initState
            renderSR        <- newIORef renderS_

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

                    -- display the picture in the current view
                    renderS         <- readIORef renderSR
                    viewPort        <- readIORef viewSR

                    windowSize <- getWindowDimensions backendRef

                    -- render the frame
                    displayPicture
                            windowSize
                            backgroundColor
                            renderS
                            (viewPortScale viewPort)
                            (applyViewPortToPicture viewPort picture)

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

            let callbacks
                 =  [ DisplayCallback -> Callback
    Callback.Display      (IORef State -> DisplayCallback
    animateBegin IORef State
    animateSR)
                    , DisplayCallback -> Callback
    Callback.Display      IORef a -> IO ()
    DisplayCallback
    displayFun
                    , DisplayCallback -> Callback
    Callback.Display      (IORef State -> DisplayCallback
    animateEnd   IORef State
    animateSR)
                    , DisplayCallback -> Callback
    Callback.Idle         (IORef State
    -> IORef State
    -> IO ViewPort
    -> IORef world
    -> (ViewPort -> Float -> world -> IO world)
    -> Float
    -> DisplayCallback
    forall world.
    IORef State
    -> IORef State
    -> IO ViewPort
    -> IORef world
    -> (ViewPort -> Float -> world -> IO world)
    -> Float
    -> DisplayCallback
    callback_simulate_idle
                                                    IORef State
    stateSR IORef State
    animateSR (IORef ViewPort -> IO ViewPort
    forall a. IORef a -> IO a
    readIORef IORef ViewPort
    viewSR)
                                                    IORef world
    worldSR (\ViewPort
    _ -> Float -> world -> IO world
    worldAdvance)
                                                    Float
    singleStepTime)
                    , IORef world
    -> IORef ViewPort -> (Event -> world -> IO world) -> Callback
    forall world.
    IORef world
    -> IORef ViewPort -> (Event -> world -> IO world) -> Callback
    callback_keyMouse IORef world
    worldSR IORef ViewPort
    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]

            let exitCallback
                     = if Bool
    withCallbackExit then [() -> Callback
    forall a. a -> Callback
    callback_exit ()] else []

            createWindow
                    backend
                    display
                    backgroundColor
                    (callbacks ++ exitCallback)
                    (\IORef a
    _ -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())

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

    callback_keyMouse :: forall world.
    IORef world
    -> IORef ViewPort -> (Event -> world -> IO world) -> Callback
    callback_keyMouse IORef world
    worldRef IORef ViewPort
    viewRef Event -> world -> IO world
    eventFn
            = KeyboardMouseCallback -> Callback
    KeyMouse (IORef world
    -> IORef ViewPort
    -> (Event -> world -> IO world)
    -> KeyboardMouseCallback
    forall a t.
    IORef a -> t -> (Event -> a -> IO a) -> KeyboardMouseCallback
    handle_keyMouse IORef world
    worldRef IORef ViewPort
    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'

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

    -- | 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
    stateRef (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 stateRef (width, height)