{-# 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