{-# LANGUAGE PatternSynonyms #-}
-- For HasCallStack compatibility
{-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module JSDOM.Generated.WebGPUComputeCommandEncoder
       (setComputePipelineState, setBuffer, dispatch, endEncoding,
        WebGPUComputeCommandEncoder(..), gTypeWebGPUComputeCommandEncoder)
       where
import Prelude ((.), (==), (>>=), return, IO, Int, Float, Double, Bool(..), Maybe, maybe, fromIntegral, round, realToFrac, fmap, Show, Read, Eq, Ord, Maybe(..))
import qualified Prelude (error)
import Data.Typeable (Typeable)
import Data.Traversable (mapM)
import Language.Javascript.JSaddle (JSM(..), JSVal(..), JSString, strictEqual, toJSVal, valToStr, valToNumber, valToBool, js, jss, jsf, jsg, function, asyncFunction, new, array, jsUndefined, (!), (!!))
import Data.Int (Int64)
import Data.Word (Word, Word64)
import JSDOM.Types
import Control.Applicative ((<$>))
import Control.Monad (void)
import Control.Lens.Operators ((^.))
import JSDOM.EventTargetClosures (EventName, unsafeEventName, unsafeEventNameAsync)
import JSDOM.Enums

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPUComputeCommandEncoder.setComputePipelineState Mozilla WebGPUComputeCommandEncoder.setComputePipelineState documentation> 
setComputePipelineState ::
                        (MonadDOM m) =>
                          WebGPUComputeCommandEncoder -> WebGPUComputePipelineState -> m ()
setComputePipelineState :: forall (m :: * -> *).
MonadDOM m =>
WebGPUComputeCommandEncoder -> WebGPUComputePipelineState -> m ()
setComputePipelineState WebGPUComputeCommandEncoder
self WebGPUComputePipelineState
pipelineState
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         (WebGPUComputeCommandEncoder
self WebGPUComputeCommandEncoder
-> Getting (JSM JSVal) WebGPUComputeCommandEncoder (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"setComputePipelineState" [WebGPUComputePipelineState -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal WebGPUComputePipelineState
pipelineState]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPUComputeCommandEncoder.setBuffer Mozilla WebGPUComputeCommandEncoder.setBuffer documentation> 
setBuffer ::
          (MonadDOM m) =>
            WebGPUComputeCommandEncoder -> WebGPUBuffer -> Word -> Word -> m ()
setBuffer :: forall (m :: * -> *).
MonadDOM m =>
WebGPUComputeCommandEncoder -> WebGPUBuffer -> Word -> Word -> m ()
setBuffer WebGPUComputeCommandEncoder
self WebGPUBuffer
buffer Word
offset Word
index
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         (WebGPUComputeCommandEncoder
self WebGPUComputeCommandEncoder
-> Getting (JSM JSVal) WebGPUComputeCommandEncoder (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"setBuffer"
            [WebGPUBuffer -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal WebGPUBuffer
buffer, Word -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Word
offset, Word -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Word
index]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPUComputeCommandEncoder.dispatch Mozilla WebGPUComputeCommandEncoder.dispatch documentation> 
dispatch ::
         (MonadDOM m) =>
           WebGPUComputeCommandEncoder -> WebGPUSize -> WebGPUSize -> m ()
dispatch :: forall (m :: * -> *).
MonadDOM m =>
WebGPUComputeCommandEncoder -> WebGPUSize -> WebGPUSize -> m ()
dispatch WebGPUComputeCommandEncoder
self WebGPUSize
threadgroupsPerGrid WebGPUSize
threadsPerThreadgroup
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         (WebGPUComputeCommandEncoder
self WebGPUComputeCommandEncoder
-> Getting (JSM JSVal) WebGPUComputeCommandEncoder (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"dispatch"
            [WebGPUSize -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal WebGPUSize
threadgroupsPerGrid, WebGPUSize -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal WebGPUSize
threadsPerThreadgroup]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGPUComputeCommandEncoder.endEncoding Mozilla WebGPUComputeCommandEncoder.endEncoding documentation> 
endEncoding :: (MonadDOM m) => WebGPUComputeCommandEncoder -> m ()
endEncoding :: forall (m :: * -> *).
MonadDOM m =>
WebGPUComputeCommandEncoder -> m ()
endEncoding WebGPUComputeCommandEncoder
self = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (WebGPUComputeCommandEncoder
self WebGPUComputeCommandEncoder
-> Getting (JSM JSVal) WebGPUComputeCommandEncoder (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"endEncoding" ()))