{-# OPTIONS_HADDOCK hide #-}

module Graphics.Gloss.Internals.Interface.ViewState.Reshape
        (callback_viewState_reshape, viewState_reshape)
where
import Graphics.Gloss.Internals.Interface.Callback
import Graphics.Gloss.Internals.Interface.Backend
import Graphics.Rendering.OpenGL                        (($=))
import qualified Graphics.Rendering.OpenGL.GL           as GL


-- | Callback to handle keyboard and mouse button events
--      for controlling the viewport.
callback_viewState_reshape :: Callback
callback_viewState_reshape :: Callback
callback_viewState_reshape
        = ReshapeCallback -> Callback
Reshape (IORef a -> (Int, Int) -> IO ()
ReshapeCallback
viewState_reshape)


viewState_reshape :: ReshapeCallback
viewState_reshape :: IORef a -> (Int, Int) -> IO ()
viewState_reshape IORef a
stateRef (Int
width,Int
height)
 = do
        -- Setup the viewport
        --      This controls what part of the window openGL renders to.
        --      We'll use the whole window.
        --
        StateVar (Position, Size)
GL.viewport     StateVar (Position, Size) -> (Position, Size) -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= ( GLint -> GLint -> Position
GL.Position GLint
0 GLint
0
                           , GLint -> GLint -> Size
GL.Size (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height))
        IORef a -> IO ()
forall a. Backend a => IORef a -> IO ()
postRedisplay IORef a
stateRef