{-# LANGUAGE MultiParamTypeClasses #-}

-- |
-- Module      : WGPU.Internal.Surface
-- Description : Platform-specific surfaces.
--
-- Device-specific surfaces.
module WGPU.Internal.Surface
  ( -- * Types
    Surface (..),

    -- * Functions
    createGLFWSurface,
  )
where

import qualified Graphics.UI.GLFW as GLFW
import WGPU.Internal.Instance (Instance, wgpuHsInstance)
import WGPU.Internal.Memory (ToRaw, raw, showWithPtr)
import qualified WGPU.Raw.GLFWSurface
import WGPU.Raw.Types (WGPUSurface (WGPUSurface))

-------------------------------------------------------------------------------

-- | Handle to a presentable surface.
--
-- A 'Surface' presents a platform-specific surface (eg. a window) on to which
-- rendered images may be presented. A 'Surface' can be created for a GLFW
-- window using 'createGLFWSurface'.
data Surface = Surface
  { Surface -> Instance
surfaceInst :: !Instance,
    Surface -> WGPUSurface
wgpuSurface :: !WGPUSurface
  }

instance Show Surface where
  show :: Surface -> String
show Surface
s =
    let Surface Instance
_ (WGPUSurface Ptr ()
ptr) = Surface
s
     in String -> Ptr () -> String
forall a. String -> Ptr a -> String
showWithPtr String
"Surface" Ptr ()
ptr

instance Eq Surface where
  == :: Surface -> Surface -> Bool
(==) Surface
s1 Surface
s2 =
    let Surface Instance
_ (WGPUSurface Ptr ()
s1_ptr) = Surface
s1
        Surface Instance
_ (WGPUSurface Ptr ()
s2_ptr) = Surface
s2
     in Ptr ()
s1_ptr Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
s2_ptr

instance ToRaw Surface WGPUSurface where
  raw :: Surface -> ContT c IO WGPUSurface
raw = WGPUSurface -> ContT c IO WGPUSurface
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUSurface -> ContT c IO WGPUSurface)
-> (Surface -> WGPUSurface) -> Surface -> ContT c IO WGPUSurface
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Surface -> WGPUSurface
wgpuSurface

-------------------------------------------------------------------------------

-- | Create a WGPU 'Surface' for a GLFW 'GLFW.Window'.
--
-- This function is not part of the @wgpu-native@ API, but is part of the
-- Haskell API until the native WGPU API has a better story around windowing.
createGLFWSurface ::
  -- | API instance.
  Instance ->
  -- | GLFW window for which the surface will be created.
  GLFW.Window ->
  -- | IO action to create the surface.
  IO Surface
createGLFWSurface :: Instance -> Window -> IO Surface
createGLFWSurface Instance
inst Window
window = do
  Instance -> WGPUSurface -> Surface
Surface Instance
inst
    (WGPUSurface -> Surface) -> IO WGPUSurface -> IO Surface
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WGPUHsInstance -> Window -> IO WGPUSurface
WGPU.Raw.GLFWSurface.createSurface (Instance -> WGPUHsInstance
wgpuHsInstance Instance
inst) Window
window