{-# OPTIONS_HADDOCK hide #-}

module Brillo.Internals.Rendering.Common (
  gf,
  gsizei,
  withModelview,
  withClearBuffer,
)
where

import Brillo.Internals.Data.Color (Color)
import Brillo.Internals.Rendering.Color (glColor4OfColor)
import Graphics.Rendering.OpenGL (($=))
import Graphics.Rendering.OpenGL.GL qualified as GL
import Unsafe.Coerce (unsafeCoerce)


{-| 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 -> GLfloat
forall a b. a -> b
unsafeCoerce
{-# INLINE gf #-}


-- | Used for similar reasons to above
gsizei :: Int -> GL.GLsizei
gsizei :: Int -> GLsizei
gsizei = Int -> GLsizei
forall a b. a -> b
unsafeCoerce
{-# 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