module Montis.Core.Runtime
  ( ToplevelHandle,
    focusToplevel,
    getSeat,
    getToplevelGeometry,
    setToplevelGeometry,
    setToplevelPosition,
    toplevelAt,
    warpCursor,
    requestRebirth,
    requestExit,
  )
where

import Control.Monad.IO.Class (liftIO)
import Data.Void (Void)
import Foreign (Ptr)
import Foreign.C (CDouble (..))
import Foreign.Marshal.Alloc (alloca)
import Foreign.Ptr (castPtr, nullPtr)
import Foreign.Storable (peek)
import Montis.Base.Foreign.Runtime
import Montis.Base.Foreign.WlRoots.Types (ForeignWlrSeat, WlrSeat (WlrSeat))
import Montis.Core.Monad (Montis, getSelfPtr)
import Montis.Core.State (SelfPtr (..))

type ToplevelHandle = Ptr ForeignMontisToplevel

unwrapSelf :: SelfPtr -> Ptr Void
unwrapSelf (SelfPtr p) = p

requestRebirth :: Montis ()
requestRebirth = do
  (SelfPtr p) <- getSelfPtr
  liftIO $ foreign_doRequestHotReload p

requestExit :: Montis ()
requestExit = do
  (SelfPtr p) <- getSelfPtr
  liftIO $ foreign_doRequestExit p 0

getSeat :: Montis (Maybe WlrSeat)
getSeat = do
  self <- getSelfPtr
  seatPtr <- liftIO $ foreign_getSeat (unwrapSelf self)
  if seatPtr == nullPtr
    then return Nothing
    else return $ Just (WlrSeat (castPtr seatPtr :: Ptr ForeignWlrSeat))

toplevelAt :: Double -> Double -> Montis (Maybe ToplevelHandle)
toplevelAt lx ly = do
  self <- getSelfPtr
  tl <- liftIO $ foreign_toplevelAt (unwrapSelf self) (realToFrac lx) (realToFrac ly)
  if tl == nullPtr
    then return Nothing
    else return (Just tl)

getToplevelGeometry :: ToplevelHandle -> Montis (Double, Double, Double, Double)
getToplevelGeometry tl =
  liftIO $
    alloca $ \xPtr -> alloca $ \yPtr -> alloca $ \wPtr -> alloca $ \hPtr -> do
      foreign_getToplevelGeometry tl xPtr yPtr wPtr hPtr
      x <- peek xPtr
      y <- peek yPtr
      w <- peek wPtr
      h <- peek hPtr
      return
        ( realToFrac (x :: CDouble),
          realToFrac (y :: CDouble),
          realToFrac (w :: CDouble),
          realToFrac (h :: CDouble)
        )

setToplevelGeometry :: ToplevelHandle -> Double -> Double -> Double -> Double -> Montis ()
setToplevelGeometry tl x y w h =
  liftIO $
    foreign_setToplevelGeometry
      tl
      (realToFrac x)
      (realToFrac y)
      (realToFrac w)
      (realToFrac h)

setToplevelPosition :: ToplevelHandle -> Double -> Double -> Montis ()
setToplevelPosition tl x y =
  liftIO $ foreign_setToplevelPosition tl (realToFrac x) (realToFrac y)

focusToplevel :: ToplevelHandle -> Montis ()
focusToplevel tl = liftIO $ foreign_focusToplevel tl

warpCursor :: Double -> Double -> Montis ()
warpCursor lx ly = do
  self <- getSelfPtr
  liftIO $ foreign_warpCursor (unwrapSelf self) (realToFrac lx) (realToFrac ly)