{-# OPTIONS_HADDOCK hide #-}

module Graphics.Gloss.Internals.Rendering.Common
        ( gf, gsizei
        , withModelview
        , withClearBuffer)
where
import Unsafe.Coerce
import Graphics.Gloss.Internals.Data.Color
import Graphics.Gloss.Internals.Rendering.Color
import Graphics.Rendering.OpenGL               (($=))
import qualified Graphics.Rendering.OpenGL.GL   as GL


-- | The OpenGL library doesn't seem to provide a nice way convert
--      a Float to a GLfloat, even though they're the same thing
--      under the covers.
--
--  Using realToFrac is too slow, as it doesn't get fused in at
--      least GHC 6.12.1
--
gf :: Float -> GL.GLfloat
gf :: GLfloat -> GLfloat
gf GLfloat
x = GLfloat -> GLfloat
forall a b. a -> b
unsafeCoerce GLfloat
x
{-# INLINE gf #-}


-- | Used for similar reasons to above
gsizei :: Int -> GL.GLsizei
gsizei :: Int -> GLsizei
gsizei Int
x = Int -> GLsizei
forall a b. a -> b
unsafeCoerce Int
x
{-# INLINE gsizei #-}


-- | Set up the OpenGL rendering context for orthographic projection and run an
--   action to draw the model.
withModelview
        :: (Int, Int)  -- ^ Width and height of window.
        -> IO ()       -- ^ Action to perform.
        -> IO ()

withModelview :: (Int, Int) -> IO () -> IO ()
withModelview (Int
sizeX, Int
sizeY) IO ()
action
 = do
        StateVar MatrixMode
GL.matrixMode   StateVar MatrixMode -> MatrixMode -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *).
MonadIO m =>
StateVar MatrixMode -> MatrixMode -> m ()
$= MatrixMode
GL.Projection
        IO () -> IO ()
forall a. IO a -> IO a
GL.preservingMatrix
         (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                -- setup the co-ordinate system
                IO ()
GL.loadIdentity
                let (GLdouble
sx, GLdouble
sy)    = (Int -> GLdouble
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sizeX GLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/ GLdouble
2, Int -> GLdouble
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sizeY GLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/ GLdouble
2)
                GLdouble
-> GLdouble
-> GLdouble
-> GLdouble
-> GLdouble
-> GLdouble
-> IO ()
GL.ortho (-GLdouble
sx) GLdouble
sx (-GLdouble
sy) GLdouble
sy GLdouble
0 (-GLdouble
100)

                -- draw the world
                StateVar MatrixMode
GL.matrixMode   StateVar MatrixMode -> MatrixMode -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *).
MonadIO m =>
StateVar MatrixMode -> MatrixMode -> m ()
$= GLsizei -> MatrixMode
GL.Modelview GLsizei
0
                IO ()
action

                StateVar MatrixMode
GL.matrixMode   StateVar MatrixMode -> MatrixMode -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *).
MonadIO m =>
StateVar MatrixMode -> MatrixMode -> m ()
$= MatrixMode
GL.Projection

        StateVar MatrixMode
GL.matrixMode   StateVar MatrixMode -> MatrixMode -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *).
MonadIO m =>
StateVar MatrixMode -> MatrixMode -> m ()
$= GLsizei -> MatrixMode
GL.Modelview GLsizei
0


-- | Clear the OpenGL buffer with the given background color and run
--   an action to draw the model.
withClearBuffer
        :: Color        -- ^ Background color
        -> IO ()        -- ^ Action to perform
        -> IO ()

withClearBuffer :: Color -> IO () -> IO ()
withClearBuffer Color
clearColor IO ()
action
 = do
        -- initialization (done every time in this case)
        -- we don't need the depth buffer for 2d.
        StateVar (Maybe ComparisonFunction)
GL.depthFunc    StateVar (Maybe ComparisonFunction)
-> Maybe ComparisonFunction -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *).
MonadIO m =>
StateVar (Maybe ComparisonFunction)
-> Maybe ComparisonFunction -> m ()
GL.$= ComparisonFunction -> Maybe ComparisonFunction
forall a. a -> Maybe a
Just ComparisonFunction
GL.Always

        -- always clear the buffer to white
        StateVar (Color4 GLfloat)
GL.clearColor   StateVar (Color4 GLfloat) -> Color4 GLfloat -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *).
MonadIO m =>
StateVar (Color4 GLfloat) -> Color4 GLfloat -> m ()
GL.$= Color -> Color4 GLfloat
forall a. Color -> Color4 a
glColor4OfColor Color
clearColor

        -- on every loop
        [ClearBuffer] -> IO ()
GL.clear [ClearBuffer
GL.ColorBuffer, ClearBuffer
GL.DepthBuffer]
        Color4 GLfloat -> IO ()
forall a. Color a => a -> IO ()
GL.color (Color4 GLfloat -> IO ()) -> Color4 GLfloat -> IO ()
forall a b. (a -> b) -> a -> b
$ GLfloat -> GLfloat -> GLfloat -> GLfloat -> Color4 GLfloat
forall a. a -> a -> a -> a -> Color4 a
GL.Color4 GLfloat
0 GLfloat
0 GLfloat
0 (GLfloat
1 :: GL.GLfloat)

        IO ()
action