{-# LANGUAGE PatternSynonyms #-}
-- For HasCallStack compatibility
{-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module JSDOM.Generated.OESVertexArrayObject
       (createVertexArrayOES, createVertexArrayOES_, deleteVertexArrayOES,
        isVertexArrayOES, isVertexArrayOES_, bindVertexArrayOES,
        pattern VERTEX_ARRAY_BINDING_OES, OESVertexArrayObject(..),
        gTypeOESVertexArrayObject)
       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/OESVertexArrayObject.createVertexArrayOES Mozilla OESVertexArrayObject.createVertexArrayOES documentation> 
createVertexArrayOES ::
                     (MonadDOM m) => OESVertexArrayObject -> m WebGLVertexArrayObjectOES
createVertexArrayOES :: OESVertexArrayObject -> m WebGLVertexArrayObjectOES
createVertexArrayOES OESVertexArrayObject
self
  = DOM WebGLVertexArrayObjectOES -> m WebGLVertexArrayObjectOES
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((OESVertexArrayObject
self OESVertexArrayObject
-> Getting (JSM JSVal) OESVertexArrayObject (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"createVertexArrayOES" ()) JSM JSVal
-> (JSVal -> DOM WebGLVertexArrayObjectOES)
-> DOM WebGLVertexArrayObjectOES
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM WebGLVertexArrayObjectOES
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/OESVertexArrayObject.createVertexArrayOES Mozilla OESVertexArrayObject.createVertexArrayOES documentation> 
createVertexArrayOES_ ::
                      (MonadDOM m) => OESVertexArrayObject -> m ()
createVertexArrayOES_ :: OESVertexArrayObject -> m ()
createVertexArrayOES_ OESVertexArrayObject
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 (OESVertexArrayObject
self OESVertexArrayObject
-> Getting (JSM JSVal) OESVertexArrayObject (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"createVertexArrayOES" ()))

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

-- | <https://developer.mozilla.org/en-US/docs/Web/API/OESVertexArrayObject.isVertexArrayOES Mozilla OESVertexArrayObject.isVertexArrayOES documentation> 
isVertexArrayOES ::
                 (MonadDOM m) =>
                   OESVertexArrayObject -> Maybe WebGLVertexArrayObjectOES -> m Bool
isVertexArrayOES :: OESVertexArrayObject -> Maybe WebGLVertexArrayObjectOES -> m Bool
isVertexArrayOES OESVertexArrayObject
self Maybe WebGLVertexArrayObjectOES
arrayObject
  = DOM Bool -> m Bool
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((OESVertexArrayObject
self OESVertexArrayObject
-> Getting (JSM JSVal) OESVertexArrayObject (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"isVertexArrayOES" [Maybe WebGLVertexArrayObjectOES -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe WebGLVertexArrayObjectOES
arrayObject]) JSM JSVal -> (JSVal -> DOM Bool) -> DOM Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         JSVal -> DOM Bool
forall value. ToJSVal value => value -> DOM Bool
valToBool)

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

-- | <https://developer.mozilla.org/en-US/docs/Web/API/OESVertexArrayObject.bindVertexArrayOES Mozilla OESVertexArrayObject.bindVertexArrayOES documentation> 
bindVertexArrayOES ::
                   (MonadDOM m) =>
                     OESVertexArrayObject -> Maybe WebGLVertexArrayObjectOES -> m ()
bindVertexArrayOES :: OESVertexArrayObject -> Maybe WebGLVertexArrayObjectOES -> m ()
bindVertexArrayOES OESVertexArrayObject
self Maybe WebGLVertexArrayObjectOES
arrayObject
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (OESVertexArrayObject
self OESVertexArrayObject
-> Getting (JSM JSVal) OESVertexArrayObject (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"bindVertexArrayOES" [Maybe WebGLVertexArrayObjectOES -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe WebGLVertexArrayObjectOES
arrayObject]))
pattern $bVERTEX_ARRAY_BINDING_OES :: a
$mVERTEX_ARRAY_BINDING_OES :: forall r a. (Eq a, Num a) => a -> (Void# -> r) -> (Void# -> r) -> r
VERTEX_ARRAY_BINDING_OES = 34229