{-# LANGUAGE PatternSynonyms #-} -- For HasCallStack compatibility {-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} module JSDOM.Generated.WebGPUCommandBuffer (createRenderCommandEncoderWithDescriptor, createRenderCommandEncoderWithDescriptor_, createComputeCommandEncoder, createComputeCommandEncoder_, commit, presentDrawable, getCompleted, WebGPUCommandBuffer(..), gTypeWebGPUCommandBuffer) 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 -- | createRenderCommandEncoderWithDescriptor :: (MonadDOM m) => WebGPUCommandBuffer -> WebGPURenderPassDescriptor -> m WebGPURenderCommandEncoder createRenderCommandEncoderWithDescriptor self descriptor = liftDOM ((self ^. jsf "createRenderCommandEncoderWithDescriptor" [toJSVal descriptor]) >>= fromJSValUnchecked) -- | createRenderCommandEncoderWithDescriptor_ :: (MonadDOM m) => WebGPUCommandBuffer -> WebGPURenderPassDescriptor -> m () createRenderCommandEncoderWithDescriptor_ self descriptor = liftDOM (void (self ^. jsf "createRenderCommandEncoderWithDescriptor" [toJSVal descriptor])) -- | createComputeCommandEncoder :: (MonadDOM m) => WebGPUCommandBuffer -> m WebGPUComputeCommandEncoder createComputeCommandEncoder self = liftDOM ((self ^. jsf "createComputeCommandEncoder" ()) >>= fromJSValUnchecked) -- | createComputeCommandEncoder_ :: (MonadDOM m) => WebGPUCommandBuffer -> m () createComputeCommandEncoder_ self = liftDOM (void (self ^. jsf "createComputeCommandEncoder" ())) -- | commit :: (MonadDOM m) => WebGPUCommandBuffer -> m () commit self = liftDOM (void (self ^. jsf "commit" ())) -- | presentDrawable :: (MonadDOM m) => WebGPUCommandBuffer -> WebGPUDrawable -> m () presentDrawable self drawable = liftDOM (void (self ^. jsf "presentDrawable" [toJSVal drawable])) -- | getCompleted :: (MonadDOM m) => WebGPUCommandBuffer -> m () getCompleted self = liftDOM (void ((self ^. js "completed") >>= readPromise))