content: {-# 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
          backend displayMode background
          worldStart
          worldToPicture
          worldHandleEvent
          eatController
  
   =  do  viewSR          <- newIORef viewStateInit
          worldSR         <- newIORef worldStart
          renderS         <- initState
          renderSR        <- newIORef renderS
  
          let displayFun backendRef = do
                  world      <- readIORef worldSR
                  picture    <- worldToPicture world
  
                  renderS'      <- readIORef renderSR
                  viewState     <- readIORef viewSR
                  let viewPort  =  viewStateViewPort 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
               =  [ Callback.Display displayFun
  
                  -- Viewport control with mouse
                  , callback_keyMouse worldSR viewSR worldHandleEvent
                  , callback_motion   worldSR worldHandleEvent
                  , callback_reshape  worldSR 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
           $ \  backendRef
             -> eatController
                  $ Controller
                  { controllerSetRedraw
                     = do postRedisplay backendRef
  
                  , controllerModifyViewPort
                     = \modViewPort
                       -> do viewState       <- readIORef viewSR
                             port'           <- modViewPort $ viewStateViewPort viewState
                             let 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 worldRef viewRef eventFn
          = KeyMouse (handle_keyMouse worldRef viewRef eventFn)
  
  
  handle_keyMouse
          :: IORef a
          -> t
          -> (Event -> a -> IO a)
          -> KeyboardMouseCallback
  
  handle_keyMouse worldRef _ eventFn backendRef key keyState keyMods pos
   = do   ev         <- keyMouseEvent backendRef key keyState keyMods 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 worldRef eventFn
          = Motion (handle_motion worldRef eventFn)
  
  
  handle_motion
          :: IORef a
          -> (Event -> a -> IO a)
          -> MotionCallback
  
  handle_motion worldRef eventFn backendRef pos
   = do   ev       <- motionEvent backendRef 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 worldRef eventFN
          = Reshape (handle_reshape worldRef eventFN)
  
  
  handle_reshape
          :: IORef world
          -> (Event -> world -> IO world)
          -> ReshapeCallback
  handle_reshape worldRef eventFn backendRef (width,height)
   = do   world  <- readIORef worldRef
          world' <- eventFn (EventResize (width, height)) world
          writeIORef worldRef world'
          viewState_reshape backendRef (width, height)
          postRedisplay backendRef
  
  