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