module Brillo.Internals.Interface.Display (displayWithBackend)
where

import Brillo.Data.Color
import Brillo.Data.Controller
import Brillo.Data.Picture
import Brillo.Data.ViewPort
import Brillo.Data.ViewState
import Brillo.Internals.Interface.Backend
import Brillo.Internals.Interface.Callback qualified as Callback
import Brillo.Internals.Interface.Common.Exit
import Brillo.Internals.Interface.ViewState.KeyMouse
import Brillo.Internals.Interface.ViewState.Motion
import Brillo.Internals.Interface.ViewState.Reshape
import Brillo.Internals.Interface.Window
import Brillo.Rendering
import Data.IORef
import System.Mem


displayWithBackend
  :: (Backend a)
  => a
  -- ^ Initial state of the backend.
  -> Display
  -- ^ Display config.
  -> Color
  -- ^ Background color.
  -> IO Picture
  -- ^ Make the picture to draw.
  -> (Controller -> IO ())
  -- ^ Eat the controller
  -> IO ()
displayWithBackend :: forall a.
Backend a =>
a
-> Display -> Color -> IO Picture -> (Controller -> IO ()) -> IO ()
displayWithBackend
  a
backend
  Display
displayMode
  Color
background
  IO Picture
makePicture
  Controller -> IO ()
eatController =
    do
      IORef ViewState
viewSR <- ViewState -> IO (IORef ViewState)
forall a. a -> IO (IORef a)
newIORef ViewState
viewStateInit
      State
renderS <- IO State
initState
      IORef State
renderSR <- State -> IO (IORef State)
forall a. a -> IO (IORef a)
newIORef State
renderS

      let renderFun :: IORef a -> IO ()
renderFun IORef a
backendRef = do
            ViewPort
port <- ViewState -> ViewPort
viewStateViewPort (ViewState -> ViewPort) -> IO ViewState -> IO ViewPort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef ViewState -> IO ViewState
forall a. IORef a -> IO a
readIORef IORef ViewState
viewSR
            State
options <- IORef State -> IO State
forall a. IORef a -> IO a
readIORef IORef State
renderSR
            (Int, Int)
windowSize <- IORef a -> IO (Int, Int)
forall a. Backend a => IORef a -> IO (Int, Int)
getWindowDimensions IORef a
backendRef
            Picture
picture <- IO Picture
makePicture

            (Int, Int) -> Color -> State -> Float -> Picture -> IO ()
displayPicture
              (Int, Int)
windowSize
              Color
background
              State
options
              (ViewPort -> Float
viewPortScale ViewPort
port)
              (ViewPort -> Picture -> Picture
applyViewPortToPicture ViewPort
port Picture
picture)

            -- perform GC every frame to try and avoid long pauses
            IO ()
performGC

      let callbacks :: [Callback]
callbacks =
            [ DisplayCallback -> Callback
Callback.Display IORef a -> IO ()
DisplayCallback
renderFun
            , -- Escape exits the program
              () -> Callback
forall a. a -> Callback
callback_exit ()
            , -- Viewport control with mouse
              IORef ViewState -> Callback
callback_viewState_keyMouse IORef ViewState
viewSR
            , IORef ViewState -> Callback
callback_viewState_motion IORef ViewState
viewSR
            , Callback
callback_viewState_reshape
            ]

      -- When we create the window we can pass a function to get a
      -- reference to the backend state. Using this we make a controller
      -- so the client can control the window asynchronously.
      a -> Display -> Color -> [Callback] -> (IORef a -> IO ()) -> IO ()
forall a.
Backend a =>
a -> Display -> Color -> [Callback] -> (IORef a -> IO ()) -> IO ()
createWindow a
backend Display
displayMode Color
background [Callback]
callbacks ((IORef a -> IO ()) -> IO ()) -> (IORef a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
        \IORef a
backendRef ->
          Controller -> IO ()
eatController (Controller -> IO ()) -> Controller -> IO ()
forall a b. (a -> b) -> a -> b
$
            Controller
              { controllerSetRedraw :: IO ()
controllerSetRedraw =
                  do IORef a -> IO ()
DisplayCallback
postRedisplay IORef a
backendRef
              , controllerModifyViewPort :: (ViewPort -> IO ViewPort) -> IO ()
controllerModifyViewPort =
                  \ViewPort -> IO ViewPort
modViewPort ->
                    do
                      ViewState
viewState <- IORef ViewState -> IO ViewState
forall a. IORef a -> IO a
readIORef IORef ViewState
viewSR
                      ViewPort
port' <- ViewPort -> IO ViewPort
modViewPort (ViewPort -> IO ViewPort) -> ViewPort -> IO ViewPort
forall a b. (a -> b) -> a -> b
$ ViewState -> ViewPort
viewStateViewPort ViewState
viewState
                      let viewState' :: ViewState
viewState' = ViewState
viewState{viewStateViewPort = port'}
                      IORef ViewState -> ViewState -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef ViewState
viewSR ViewState
viewState'
                      IORef a -> IO ()
DisplayCallback
postRedisplay IORef a
backendRef
              }