{-# LANGUAGE CPP #-}

module WGPU.Raw.SDLSurface where

import Control.Monad.IO.Class (MonadIO, liftIO)
import Foreign (Ptr, alloca, castPtr, nullPtr, poke)
import qualified SDL
import Unsafe.Coerce (unsafeCoerce)
import qualified WGPU.Raw.Generated.Enum.WGPUSType as WGPUSType
import WGPU.Raw.Generated.Fun (WGPUHsInstance, wgpuInstanceCreateSurface)
import WGPU.Raw.Generated.Struct.WGPUChainedStruct
import WGPU.Raw.Generated.Struct.WGPUSurfaceDescriptor
import WGPU.Raw.Types (WGPUInstance (WGPUInstance), WGPUSurface)

#ifdef WGPUHS_TARGET_MACOS

import WGPU.Raw.Generated.Struct.WGPUSurfaceDescriptorFromMetalLayer

createSurface ::
  MonadIO m =>
  WGPUHsInstance ->
  SDL.Window ->
  m WGPUSurface
createSurface inst window = liftIO $ do
  nsWindow <- wgpuHsSDLToNSWindow (unsafeCoerce window)
  metalLayer <- wgpuHsMetalLayer nsWindow

  alloca $ \ptr_surfaceDescriptor -> do
    alloca $ \ptr_chainedStruct -> do
      alloca $ \ptr_surfaceDescriptorFromMetalLayer -> do

        let surfaceDescriptorFromMetalLayer =
              WGPUSurfaceDescriptorFromMetalLayer
              { chain =
                  WGPUChainedStruct
                  { next = nullPtr,
                    sType = WGPUSType.SurfaceDescriptorFromMetalLayer
                  },
                layer = metalLayer
              }
        poke ptr_surfaceDescriptorFromMetalLayer surfaceDescriptorFromMetalLayer

        let chainedStruct =
              WGPUChainedStruct
              { next = castPtr ptr_surfaceDescriptorFromMetalLayer,
                sType = WGPUSType.SurfaceDescriptorFromMetalLayer
              }
        poke ptr_chainedStruct chainedStruct

        let surfaceDescriptor =
              WGPUSurfaceDescriptor
              { nextInChain = ptr_chainedStruct,
                label = nullPtr
              }
        poke ptr_surfaceDescriptor surfaceDescriptor

        wgpuInstanceCreateSurface
          inst
          (WGPUInstance nullPtr)
          ptr_surfaceDescriptor

wgpuHsSDLToNSWindow :: MonadIO m => Ptr () -> m (Ptr ())
wgpuHsSDLToNSWindow = liftIO . wgpu_sdl_to_ns_window_IO

foreign import ccall "wgpuhs_sdl_to_ns_window"
  wgpu_sdl_to_ns_window_IO ::
    Ptr () ->
    IO (Ptr ())

wgpuHsMetalLayer :: MonadIO m => Ptr () -> m (Ptr ())
wgpuHsMetalLayer = liftIO . wgpuhs_metal_layer_IO

foreign import ccall "wgpuhs_metal_layer"
  wgpuhs_metal_layer_IO ::
    Ptr () ->
    IO (Ptr ())

#endif

#ifdef WGPUHS_TARGET_LINUX

import Data.Word (Word32)
import WGPU.Raw.Generated.Struct.WGPUSurfaceDescriptorFromXlib

createSurface ::
  MonadIO m =>
  WGPUHsInstance ->
  SDL.Window ->
  m WGPUSurface
createSurface :: WGPUHsInstance -> Window -> m WGPUSurface
createSurface WGPUHsInstance
inst Window
sdlWin = IO WGPUSurface -> m WGPUSurface
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO WGPUSurface -> m WGPUSurface)
-> IO WGPUSurface -> m WGPUSurface
forall a b. (a -> b) -> a -> b
$ do
  Ptr ()
x11Display <- Ptr () -> IO (Ptr ())
forall (m :: * -> *). MonadIO m => Ptr () -> m (Ptr ())
wgpuHsSDLToX11Display (Window -> Ptr ()
forall a b. a -> b
unsafeCoerce Window
sdlWin)
  Word32
x11Window <- Ptr () -> IO Word32
forall (m :: * -> *). MonadIO m => Ptr () -> m Word32
wgpuHsSDLToX11Window (Window -> Ptr ()
forall a b. a -> b
unsafeCoerce Window
sdlWin)

  (Ptr WGPUSurfaceDescriptor -> IO WGPUSurface) -> IO WGPUSurface
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr WGPUSurfaceDescriptor -> IO WGPUSurface) -> IO WGPUSurface)
-> (Ptr WGPUSurfaceDescriptor -> IO WGPUSurface) -> IO WGPUSurface
forall a b. (a -> b) -> a -> b
$ \Ptr WGPUSurfaceDescriptor
ptr_surfaceDescriptor -> do
    (Ptr WGPUChainedStruct -> IO WGPUSurface) -> IO WGPUSurface
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr WGPUChainedStruct -> IO WGPUSurface) -> IO WGPUSurface)
-> (Ptr WGPUChainedStruct -> IO WGPUSurface) -> IO WGPUSurface
forall a b. (a -> b) -> a -> b
$ \Ptr WGPUChainedStruct
ptr_chainedStruct -> do
      (Ptr WGPUSurfaceDescriptorFromXlib -> IO WGPUSurface)
-> IO WGPUSurface
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr WGPUSurfaceDescriptorFromXlib -> IO WGPUSurface)
 -> IO WGPUSurface)
-> (Ptr WGPUSurfaceDescriptorFromXlib -> IO WGPUSurface)
-> IO WGPUSurface
forall a b. (a -> b) -> a -> b
$ \Ptr WGPUSurfaceDescriptorFromXlib
ptr_surfaceDescriptorFromXlib -> do

        let surfaceDescriptorFromXlib :: WGPUSurfaceDescriptorFromXlib
surfaceDescriptorFromXlib =
              WGPUSurfaceDescriptorFromXlib :: WGPUChainedStruct
-> Ptr () -> Word32 -> WGPUSurfaceDescriptorFromXlib
WGPUSurfaceDescriptorFromXlib
              { chain :: WGPUChainedStruct
chain =
                  WGPUChainedStruct :: Ptr WGPUChainedStruct -> WGPUSType -> WGPUChainedStruct
WGPUChainedStruct
                  { next :: Ptr WGPUChainedStruct
next = Ptr WGPUChainedStruct
forall a. Ptr a
nullPtr,
                    sType :: WGPUSType
sType = WGPUSType
forall a. (Eq a, Num a) => a
WGPUSType.SurfaceDescriptorFromXlib
                  },
                display :: Ptr ()
display = Ptr ()
x11Display,
                window :: Word32
window = Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
x11Window
              }
        Ptr WGPUSurfaceDescriptorFromXlib
-> WGPUSurfaceDescriptorFromXlib -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke
          Ptr WGPUSurfaceDescriptorFromXlib
ptr_surfaceDescriptorFromXlib
          WGPUSurfaceDescriptorFromXlib
surfaceDescriptorFromXlib

        let chainedStruct :: WGPUChainedStruct
chainedStruct =
             WGPUChainedStruct :: Ptr WGPUChainedStruct -> WGPUSType -> WGPUChainedStruct
WGPUChainedStruct
               { next :: Ptr WGPUChainedStruct
next = Ptr WGPUSurfaceDescriptorFromXlib -> Ptr WGPUChainedStruct
forall a b. Ptr a -> Ptr b
castPtr Ptr WGPUSurfaceDescriptorFromXlib
ptr_surfaceDescriptorFromXlib,
                 sType :: WGPUSType
sType = WGPUSType
forall a. (Eq a, Num a) => a
WGPUSType.SurfaceDescriptorFromXlib
               }
        Ptr WGPUChainedStruct -> WGPUChainedStruct -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr WGPUChainedStruct
ptr_chainedStruct WGPUChainedStruct
chainedStruct

        let surfaceDescriptor :: WGPUSurfaceDescriptor
surfaceDescriptor =
              WGPUSurfaceDescriptor :: Ptr WGPUChainedStruct -> Ptr CChar -> WGPUSurfaceDescriptor
WGPUSurfaceDescriptor
                { nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
ptr_chainedStruct,
                  label :: Ptr CChar
label = Ptr CChar
forall a. Ptr a
nullPtr
                }
        Ptr WGPUSurfaceDescriptor -> WGPUSurfaceDescriptor -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr WGPUSurfaceDescriptor
ptr_surfaceDescriptor WGPUSurfaceDescriptor
surfaceDescriptor

        WGPUHsInstance
-> WGPUInstance -> Ptr WGPUSurfaceDescriptor -> IO WGPUSurface
forall (m :: * -> *).
MonadIO m =>
WGPUHsInstance
-> WGPUInstance -> Ptr WGPUSurfaceDescriptor -> m WGPUSurface
wgpuInstanceCreateSurface
          WGPUHsInstance
inst
          (Ptr () -> WGPUInstance
WGPUInstance Ptr ()
forall a. Ptr a
nullPtr)
          Ptr WGPUSurfaceDescriptor
ptr_surfaceDescriptor

wgpuHsSDLToX11Window :: MonadIO m => Ptr () -> m Word32
wgpuHsSDLToX11Window :: Ptr () -> m Word32
wgpuHsSDLToX11Window = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32)
-> (Ptr () -> IO Word32) -> Ptr () -> m Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr () -> IO Word32
wgpu_sdl_to_x11_window_IO

foreign import ccall "wgpuhs_sdl_to_x11_window"
  wgpu_sdl_to_x11_window_IO ::
    Ptr () ->
    IO Word32

wgpuHsSDLToX11Display :: MonadIO m => Ptr () -> m (Ptr ())
wgpuHsSDLToX11Display :: Ptr () -> m (Ptr ())
wgpuHsSDLToX11Display = IO (Ptr ()) -> m (Ptr ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr ()) -> m (Ptr ()))
-> (Ptr () -> IO (Ptr ())) -> Ptr () -> m (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr () -> IO (Ptr ())
wgpu_sdl_to_x11_display_IO

foreign import ccall "wgpuhs_sdl_to_x11_display"
  wgpu_sdl_to_x11_display_IO ::
    Ptr () ->
    IO (Ptr ())

#endif

#ifdef WGPUHS_TARGET_WINDOWS

import System.Win32.DLL (getModuleHandle)
import WGPU.Raw.Generated.Struct.WGPUSurfaceDescriptorFromWindowsHWND

createSurface ::
  MonadIO m =>
  WGPUHsInstance ->
  SDL.Window ->
  m WGPUSurface
createSurface inst window = liftIO $ do
  hWnd <- wgpuHsSDLToHWnd (unsafeCoerce window)
  hInstance <- getModuleHandle Nothing

  alloca $ \ptr_surfaceDescriptor -> do
    alloca $ \ptr_chainedStruct -> do
      alloca $ \ptr_surfaceDescriptorFromWindowsHWND -> do

        let surfaceDescriptorFromWindowsHWND =
              WGPUSurfaceDescriptorFromWindowsHWND
              { chain =
                  WGPUChainedStruct
                  { next = nullPtr,
                    sType = WGPUSType.SurfaceDescriptorFromWindowsHWND
                  },
                hinstance = hInstance,
                hwnd = hWnd
              }
        poke
          ptr_surfaceDescriptorFromWindowsHWND
          surfaceDescriptorFromWindowsHWND

        let chainedStruct =
              WGPUChainedStruct
              { next = castPtr ptr_surfaceDescriptorFromWindowsHWND,
                sType = WGPUSType.SurfaceDescriptorFromWindowsHWND
              }
        poke ptr_chainedStruct chainedStruct

        let surfaceDescriptor =
              WGPUSurfaceDescriptor
              { nextInChain = ptr_chainedStruct,
                label = nullPtr
              }
        poke ptr_surfaceDescriptor surfaceDescriptor

        wgpuInstanceCreateSurface
          inst
          (WGPUInstance nullPtr)
          ptr_surfaceDescriptor

wgpuHsSDLToHWnd :: MonadIO m => Ptr () -> m (Ptr ())
wgpuHsSDLToHWnd = liftIO . wgpuhs_sdl_to_hwnd_IO

foreign import ccall "wgpuhs_sdl_to_hwnd"
  wgpuhs_sdl_to_hwnd_IO ::
    Ptr () ->
    IO (Ptr ())

#endif