{-# LANGUAGE RankNTypes #-}

module Brillo.Internals.Interface.Interact (interactWithBackend)
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.Event
import Brillo.Internals.Interface.ViewState.Reshape
import Brillo.Internals.Interface.Window
import Brillo.Rendering
import Data.IORef
import System.Mem


interactWithBackend
  :: (Backend a)
  => a
  -- ^ Initial state of the backend.
  -> Display
  -- ^ Display config.
  -> Color
  -- ^ Background color.
  -> world
  -- ^ The initial world.
  -> (world -> IO Picture)
  -- ^ A function to produce the current picture.
  -> (Event -> world -> IO world)
  -- ^ A function to handle input events.
  -> (Controller -> IO ())
  -- ^ Eat the controller
  -> IO ()
interactWithBackend :: forall a world.
Backend a =>
a
-> Display
-> Color
-> world
-> (world -> IO Picture)
-> (Event -> world -> IO world)
-> (Controller -> IO ())
-> IO ()
interactWithBackend
  a
backend
  Display
displayMode
  Color
background
  world
worldStart
  world -> IO Picture
worldToPicture
  Event -> world -> IO world
worldHandleEvent
  Controller -> IO ()
eatController =
    do
      IORef ViewState
viewSR <- ViewState -> IO (IORef ViewState)
forall a. a -> IO (IORef a)
newIORef ViewState
viewStateInit
      IORef world
worldSR <- world -> IO (IORef world)
forall a. a -> IO (IORef a)
newIORef world
worldStart
      State
renderS <- IO State
initState
      IORef State
renderSR <- State -> IO (IORef State)
forall a. a -> IO (IORef a)
newIORef State
renderS

      let displayFun :: IORef a -> IO ()
displayFun IORef a
backendRef = do
            world
world <- IORef world -> IO world
forall a. IORef a -> IO a
readIORef IORef world
worldSR
            Picture
picture <- world -> IO Picture
worldToPicture world
world

            State
renderS' <- IORef State -> IO State
forall a. IORef a -> IO a
readIORef IORef State
renderSR
            ViewState
viewState <- IORef ViewState -> IO ViewState
forall a. IORef a -> IO a
readIORef IORef ViewState
viewSR
            let viewPort :: ViewPort
viewPort = ViewState -> ViewPort
viewStateViewPort ViewState
viewState

            (Int, Int)
windowSize <- IORef a -> IO (Int, Int)
forall a. Backend a => IORef a -> IO (Int, Int)
getWindowDimensions IORef a
backendRef

            (Int, Int) -> Color -> State -> Float -> Picture -> IO ()
displayPicture
              (Int, Int)
windowSize
              Color
background
              State
renderS'
              (ViewPort -> Float
viewPortScale ViewPort
viewPort)
              (ViewPort -> Picture -> Picture
applyViewPortToPicture ViewPort
viewPort 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
displayFun
            , -- Viewport control with mouse
              IORef world
-> IORef ViewState -> (Event -> world -> IO world) -> Callback
forall world.
IORef world
-> IORef ViewState -> (Event -> world -> IO world) -> Callback
callback_keyMouse IORef world
worldSR IORef ViewState
viewSR Event -> world -> IO world
worldHandleEvent
            , IORef world -> (Event -> world -> IO world) -> Callback
forall world.
IORef world -> (Event -> world -> IO world) -> Callback
callback_motion IORef world
worldSR Event -> world -> IO world
worldHandleEvent
            , IORef world -> (Event -> world -> IO world) -> Callback
forall world.
IORef world -> (Event -> world -> IO world) -> Callback
callback_reshape IORef world
worldSR Event -> world -> IO world
worldHandleEvent
            ]

      -- 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
              }


-- | Callback for KeyMouse events.
callback_keyMouse
  :: IORef world
  -- ^ ref to world state
  -> IORef ViewState
  -> (Event -> world -> IO world)
  -- ^ fn to handle input events
  -> Callback
callback_keyMouse :: forall world.
IORef world
-> IORef ViewState -> (Event -> world -> IO world) -> Callback
callback_keyMouse IORef world
worldRef IORef ViewState
viewRef Event -> world -> IO world
eventFn =
  KeyboardMouseCallback -> Callback
KeyMouse (IORef world
-> IORef ViewState
-> (Event -> world -> IO world)
-> KeyboardMouseCallback
forall a t.
IORef a -> t -> (Event -> a -> IO a) -> KeyboardMouseCallback
handle_keyMouse IORef world
worldRef IORef ViewState
viewRef Event -> world -> IO world
eventFn)


handle_keyMouse
  :: IORef a
  -> t
  -> (Event -> a -> IO a)
  -> KeyboardMouseCallback
handle_keyMouse :: forall a t.
IORef a -> t -> (Event -> a -> IO a) -> KeyboardMouseCallback
handle_keyMouse IORef a
worldRef t
_ Event -> a -> IO a
eventFn IORef a
backendRef Key
key KeyState
keyState Modifiers
keyMods (Int, Int)
pos =
  do
    Event
ev <- IORef a -> Key -> KeyState -> Modifiers -> (Int, Int) -> IO Event
forall a.
Backend a =>
IORef a -> Key -> KeyState -> Modifiers -> (Int, Int) -> IO Event
keyMouseEvent IORef a
backendRef Key
key KeyState
keyState Modifiers
keyMods (Int, Int)
pos
    a
world <- IORef a -> IO a
forall a. IORef a -> IO a
readIORef IORef a
worldRef
    a
world' <- Event -> a -> IO a
eventFn Event
ev a
world
    IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef a
worldRef a
world'
    IORef a -> IO ()
DisplayCallback
postRedisplay IORef a
backendRef


-- | Callback for Motion events.
callback_motion
  :: IORef world
  -- ^ ref to world state
  -> (Event -> world -> IO world)
  -- ^ fn to handle input events
  -> Callback
callback_motion :: forall world.
IORef world -> (Event -> world -> IO world) -> Callback
callback_motion IORef world
worldRef Event -> world -> IO world
eventFn =
  MotionCallback -> Callback
Motion (IORef world -> (Event -> world -> IO world) -> MotionCallback
forall a. IORef a -> (Event -> a -> IO a) -> MotionCallback
handle_motion IORef world
worldRef Event -> world -> IO world
eventFn)


handle_motion
  :: IORef a
  -> (Event -> a -> IO a)
  -> MotionCallback
handle_motion :: forall a. IORef a -> (Event -> a -> IO a) -> MotionCallback
handle_motion IORef a
worldRef Event -> a -> IO a
eventFn IORef a
backendRef (Int, Int)
pos =
  do
    Event
ev <- IORef a -> (Int, Int) -> IO Event
forall a. Backend a => IORef a -> (Int, Int) -> IO Event
motionEvent IORef a
backendRef (Int, Int)
pos
    a
world <- IORef a -> IO a
forall a. IORef a -> IO a
readIORef IORef a
worldRef
    a
world' <- Event -> a -> IO a
eventFn Event
ev a
world
    IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef a
worldRef a
world'
    IORef a -> IO ()
DisplayCallback
postRedisplay IORef a
backendRef


-- | Callback for Handle reshape event.
callback_reshape
  :: IORef world
  -> (Event -> world -> IO world)
  -> Callback
callback_reshape :: forall world.
IORef world -> (Event -> world -> IO world) -> Callback
callback_reshape IORef world
worldRef Event -> world -> IO world
eventFN =
  MotionCallback -> Callback
Reshape (IORef world -> (Event -> world -> IO world) -> MotionCallback
forall a. IORef a -> (Event -> a -> IO a) -> MotionCallback
handle_reshape IORef world
worldRef Event -> world -> IO world
eventFN)


handle_reshape
  :: IORef world
  -> (Event -> world -> IO world)
  -> ReshapeCallback
handle_reshape :: forall a. IORef a -> (Event -> a -> IO a) -> MotionCallback
handle_reshape IORef world
worldRef Event -> world -> IO world
eventFn IORef a
backendRef (Int
width, Int
height) =
  do
    world
world <- IORef world -> IO world
forall a. IORef a -> IO a
readIORef IORef world
worldRef
    world
world' <- Event -> world -> IO world
eventFn ((Int, Int) -> Event
EventResize (Int
width, Int
height)) world
world
    IORef world -> world -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef world
worldRef world
world'
    IORef a -> (Int, Int) -> IO ()
MotionCallback
viewState_reshape IORef a
backendRef (Int
width, Int
height)
    IORef a -> IO ()
DisplayCallback
postRedisplay IORef a
backendRef