{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_HADDOCK hide #-}

module Graphics.Gloss.Internals.Interface.ViewState.Motion
        (callback_viewState_motion)
where
import Graphics.Gloss.Data.ViewState
import Graphics.Gloss.Internals.Interface.Callback
import Graphics.Gloss.Internals.Interface.Backend
import Graphics.Gloss.Internals.Interface.Event
import Data.IORef


-- | Callback to handle keyboard and mouse button events
--      for controlling the viewport.
callback_viewState_motion
        :: IORef ViewState
        -> Callback

callback_viewState_motion :: IORef ViewState -> Callback
callback_viewState_motion IORef ViewState
portRef
        = MotionCallback -> Callback
Motion (IORef ViewState -> MotionCallback
viewState_motion IORef ViewState
portRef)


viewState_motion :: IORef ViewState -> MotionCallback
viewState_motion :: IORef ViewState -> MotionCallback
viewState_motion IORef ViewState
viewStateRef IORef a
stateRef (Int, Int)
pos
 = do   ViewState
viewState <- IORef ViewState -> IO ViewState
forall a. IORef a -> IO a
readIORef IORef ViewState
viewStateRef
        Event
ev        <- IORef a -> (Int, Int) -> IO Event
forall a. Backend a => IORef a -> (Int, Int) -> IO Event
motionEvent IORef a
stateRef (Int, Int)
pos
        case Event -> ViewState -> Maybe ViewState
updateViewStateWithEventMaybe Event
ev ViewState
viewState of
                Maybe ViewState
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Just ViewState
viewState'
                 -> do  IORef ViewState
viewStateRef IORef ViewState -> ViewState -> IO ()
forall a. IORef a -> a -> IO ()
`writeIORef` ViewState
viewState'
                        IORef a -> IO ()
forall a. Backend a => IORef a -> IO ()
postRedisplay IORef a
stateRef