Window.hs

module Mischief.SDL.Window where

import Control.Monad.IO.Class
import Data.Bits ((.|.))
import Data.Default
import Data.Foldable (for_)
import Foreign.C
import Foreign.C.ConstPtr (ConstPtr (..))
import Mischief.ECS
import Mischief.ECS.App.Schedules (First)
import Mischief.ECS.Messages qualified as Messages
import Mischief.SDL.Events
import SDL3.Sys qualified as SDL3
import SDL3.Sys.Video

-- | A component that will create a new window when added to an entity, and destroy it when removed.
--
-- Windows can be configured by inserting a 'WindowSize', 'WindowTitle', 'WindowFlags' alongside this component.
data Window = Window

instance Component Window where
  onAdd = [hook handleNewWindow]
  onRemove = [hook handleWindowRemove]
  required = require @(WindowSize, WindowTitle, WindowFlags)

-- | The size of a window in pixels.
data WindowSize = WindowSize {width :: Int, height :: Int} deriving (Component)

instance Default WindowSize where
  def = WindowSize 600 400

-- | The displayed title (or name) of a window.
newtype WindowTitle = WindowTitle String deriving anyclass (Component)

instance Default WindowTitle where
  def = WindowTitle "Mischief Window"

handleNewWindow :: HookContext -> System ()
handleNewWindow (HookContext entity) = do
  Just (WindowSize w h, WindowTitle title, flags) <- single [q|entity. WindowSize, WindowTitle, WindowFlags|]
  window <- liftIO $ withCString title $ \title -> SDL3.createWindow (ConstPtr title) (fromIntegral w) (fromIntegral h) (flagsToBit flags)
  insert (SDLWindow window) entity

handleWindowRemove :: HookContext -> System ()
handleWindowRemove (HookContext entity) = do
  Just (SDLWindow p) <- single [q|entity. SDLWindow|]
  liftIO $ SDL3.destroyWindow p

-- | These correspond to the [SDL3 Window Flags](https://wiki.libsdl.org/SDL3/SDL_WindowFlags).
--
-- The most important ones are 'WindowFullscreen' and 'WindowResizable'.
data WindowFlag
  = WindowFullscreen
  | WindowHidden
  | WindowBorderless
  | WindowResizable
  | WindowMinimized
  | WindowMaximized
  | WindowModal
  | WindowHighPixelDensity
  | WindowMouseRelativeMode
  | WindowAlwaysOnTop
  | WindowUtility
  | WindowTooltip
  | WindowPopupMenu
  | WindowTransparent
  | WindowNotFocuable
  | WindowMetal

flagToBit :: WindowFlag -> SDL_WindowFlags
flagToBit WindowFullscreen = SDL_WINDOW_FULLSCREEN
flagToBit WindowHidden = SDL_WINDOW_HIDDEN
flagToBit WindowBorderless = SDL_WINDOW_BORDERLESS
flagToBit WindowResizable = SDL_WINDOW_RESIZABLE
flagToBit WindowMinimized = SDL_WINDOW_MINIMIZED
flagToBit WindowMaximized = SDL_WINDOW_MAXIMIZED
flagToBit WindowModal = SDL_WINDOW_MODAL
flagToBit WindowHighPixelDensity = SDL_WINDOW_HIGH_PIXEL_DENSITY
flagToBit WindowMouseRelativeMode = SDL_WINDOW_MOUSE_RELATIVE_MODE
flagToBit WindowAlwaysOnTop = SDL_WINDOW_ALWAYS_ON_TOP
flagToBit WindowUtility = SDL_WINDOW_UTILITY
flagToBit WindowTooltip = SDL_WINDOW_TOOLTIP
flagToBit WindowPopupMenu = SDL_WINDOW_POPUP_MENU
flagToBit WindowTransparent = SDL_WINDOW_TRANSPARENT
flagToBit WindowNotFocuable = SDL_WINDOW_NOT_FOCUSABLE
flagToBit WindowMetal = SDL_WINDOW_METAL

-- | A list of 'WindowFlag's specifying various configurations for the window. The only one set by default is 'WindowResizable'.
newtype WindowFlags = WindowFlags [WindowFlag] deriving anyclass (Component)

instance Default WindowFlags where
  def = WindowFlags [WindowResizable]

flagsToBit :: WindowFlags -> SDL_WindowFlags
flagsToBit (WindowFlags a) = foldr (\a b -> b .|. flagToBit a) 0 a

-- | Plugin adding windowing functionality.
data WindowPlugin

instance Plugin WindowPlugin where
  init = do
    systems handleWindowEvents
      & after handleEvents
      & schedule @First

handleWindowEvents :: System ()
handleWindowEvents = do
  messages <- Messages.read @(SDLMessage SDL3.SDL_WindowEvent)
  for_ messages handleWindowEvent

handleWindowEvent :: SDLMessage SDL3.SDL_WindowEvent -> System ()
handleWindowEvent (SDLMessage SDL3.SDL_EVENT_WINDOW_RESIZED w) = do
  let width :: Int = fromIntegral w.data1
  let height :: Int = fromIntegral w.data2

  window <- liftIO $ SDL3.getWindowFromID w.windowID

  [q|(Entity, SDLWindow) / With SDLWindow|]
    & qfilter (\(_, SDLWindow p) -> p == window)
    & qinsert (const $ WindowSize width height)
    & query_
handleWindowEvent _ = pure ()