{-# OPTIONS_HADDOCK hide #-}

-- |    The main display function.
module Brillo.Internals.Interface.Window (createWindow)
where

import Brillo.Data.Color
import Brillo.Internals.Color
import Brillo.Internals.Interface.Backend
import Brillo.Internals.Interface.Debug
import Control.Monad
import Data.IORef (IORef, newIORef)
import Graphics.Rendering.OpenGL (($=))
import Graphics.Rendering.OpenGL.GL qualified as GL


-- | Open a window and use the supplied callbacks to handle window events.
createWindow
  :: (Backend a)
  => a
  -> Display
  -> Color
  -- ^ Color to use when clearing.
  -> [Callback]
  -- ^ Callbacks to use.
  -> (IORef a -> IO ())
  -- ^ Give the backend back to the caller before
  --   entering the main loop.
  -> IO ()
createWindow :: forall a.
Backend a =>
a -> Display -> Color -> [Callback] -> (IORef a -> IO ()) -> IO ()
createWindow
  a
backend
  Display
display
  Color
clearColor
  [Callback]
callbacks
  IORef a -> IO ()
eatBackend =
    do
      -- Turn this on to spew debugging info to stdout
      let debug :: Bool
debug = Bool
False

      -- Initialize backend state
      IORef a
backendStateRef <- a -> IO (IORef a)
forall a. a -> IO (IORef a)
newIORef a
backend

      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        do String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"* displayInWindow\n"

      -- Intialize backend
      IORef a -> Bool -> IO ()
forall a. Backend a => IORef a -> Bool -> IO ()
initializeBackend IORef a
backendStateRef Bool
debug

      -- Here we go!
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        do String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"* c window\n\n"

      -- Open window
      IORef a -> Display -> IO ()
forall a. Backend a => IORef a -> Display -> IO ()
openWindow IORef a
backendStateRef Display
display

      -- Setup callbacks
      IORef a -> [Callback] -> IO ()
forall a. Backend a => IORef a -> [Callback] -> IO ()
installDisplayCallback IORef a
backendStateRef [Callback]
callbacks
      IORef a -> IO ()
forall a. Backend a => IORef a -> IO ()
installWindowCloseCallback IORef a
backendStateRef
      IORef a -> [Callback] -> IO ()
forall a. Backend a => IORef a -> [Callback] -> IO ()
installReshapeCallback IORef a
backendStateRef [Callback]
callbacks
      IORef a -> [Callback] -> IO ()
forall a. Backend a => IORef a -> [Callback] -> IO ()
installKeyMouseCallback IORef a
backendStateRef [Callback]
callbacks
      IORef a -> [Callback] -> IO ()
forall a. Backend a => IORef a -> [Callback] -> IO ()
installMotionCallback IORef a
backendStateRef [Callback]
callbacks
      IORef a -> [Callback] -> IO ()
forall a. Backend a => IORef a -> [Callback] -> IO ()
installIdleCallback IORef a
backendStateRef [Callback]
callbacks

      -- 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 ()
$= 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 ()
$= Color -> Color4 GLfloat
forall a. Color -> Color4 a
glColor4OfColor Color
clearColor

      -- Dump some debugging info
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        do
          IORef a -> IO ()
forall a. Backend a => IORef a -> IO ()
dumpBackendState IORef a
backendStateRef
          IO ()
dumpFramebufferState
          IO ()
dumpFragmentState

      IORef a -> IO ()
eatBackend IORef a
backendStateRef

      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        do String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"* entering mainloop..\n"

      -- Start the main backend loop
      IORef a -> IO ()
forall a. Backend a => IORef a -> IO ()
runMainLoop IORef a
backendStateRef

      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
          String
"* all done\n"