{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}

module WGPU.Raw.GLFWSurface where

import Foreign (Ptr, alloca, castPtr, nullPtr, poke)
import qualified Graphics.UI.GLFW as GLFW
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 ::
  WGPUHsInstance ->
  GLFW.Window ->
  IO WGPUSurface
createSurface inst window = do
  nsWindow <- GLFW.getCocoaWindow window
  metalLayer <- wgpuhs_metal_layer 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

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

#endif

#ifdef WGPUHS_TARGET_LINUX

import WGPU.Raw.Generated.Struct.WGPUSurfaceDescriptorFromXlib

createSurface ::
  WGPUHsInstance ->
  GLFW.Window ->
  IO WGPUSurface
createSurface :: WGPUHsInstance -> Window -> IO WGPUSurface
createSurface WGPUHsInstance
inst Window
glfwWin = do
  Ptr ()
x11Display <- Window -> IO (Ptr ())
forall display. Window -> IO (Ptr display)
GLFW.getX11Display Window
glfwWin
  Word64
x11Window <- Window -> IO Word64
GLFW.getX11Window Window
glfwWin

  (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 = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
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

#endif

#ifdef WGPUHS_TARGET_WINDOWS

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

createSurface ::
  WGPUHsInstance ->
  GLFW.Window ->
  IO WGPUSurface
createSurface inst window = do
  hWnd <- GLFW.getWin32Window window
  hInstance <- getModuleHandle Nothing

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

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

        let chainedStruct =
             WGPUChainedStruct
               { next = castPtr ptr_surfaceDescriptorFromWindowHWND,
                 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

#endif