{-# LANGUAGE PatternSynonyms, ForeignFunctionInterface, JavaScriptFFI #-} module GHCJS.DOM.JSFFI.Generated.AudioBuffer (js_getChannelData, getChannelData, js_getLength, getLength, js_getDuration, getDuration, js_getSampleRate, getSampleRate, js_setGain, setGain, js_getGain, getGain, js_getNumberOfChannels, getNumberOfChannels, AudioBuffer, castToAudioBuffer, gTypeAudioBuffer) where import Prelude ((.), (==), (>>=), return, IO, Int, Float, Double, Bool(..), Maybe, maybe, fromIntegral, round, fmap, Show, Read, Eq, Ord) import Data.Typeable (Typeable) import GHCJS.Types (JSRef(..), JSString, castRef) import GHCJS.Foreign (jsNull) import GHCJS.Foreign.Callback (syncCallback, asyncCallback, syncCallback1, asyncCallback1, syncCallback2, asyncCallback2, OnBlocked(..)) import GHCJS.Marshal (ToJSRef(..), FromJSRef(..)) import GHCJS.Marshal.Pure (PToJSRef(..), PFromJSRef(..)) import Control.Monad.IO.Class (MonadIO(..)) import Data.Int (Int64) import Data.Word (Word, Word64) import GHCJS.DOM.Types import Control.Applicative ((<$>)) import GHCJS.DOM.EventTargetClosures (EventName, unsafeEventName) import GHCJS.DOM.Enums foreign import javascript unsafe "$1[\"getChannelData\"]($2)" js_getChannelData :: JSRef AudioBuffer -> Word -> IO (JSRef Float32Array) -- | getChannelData :: (MonadIO m) => AudioBuffer -> Word -> m (Maybe Float32Array) getChannelData self channelIndex = liftIO ((js_getChannelData (unAudioBuffer self) channelIndex) >>= fromJSRef) foreign import javascript unsafe "$1[\"length\"]" js_getLength :: JSRef AudioBuffer -> IO Int -- | getLength :: (MonadIO m) => AudioBuffer -> m Int getLength self = liftIO (js_getLength (unAudioBuffer self)) foreign import javascript unsafe "$1[\"duration\"]" js_getDuration :: JSRef AudioBuffer -> IO Float -- | getDuration :: (MonadIO m) => AudioBuffer -> m Float getDuration self = liftIO (js_getDuration (unAudioBuffer self)) foreign import javascript unsafe "$1[\"sampleRate\"]" js_getSampleRate :: JSRef AudioBuffer -> IO Float -- | getSampleRate :: (MonadIO m) => AudioBuffer -> m Float getSampleRate self = liftIO (js_getSampleRate (unAudioBuffer self)) foreign import javascript unsafe "$1[\"gain\"] = $2;" js_setGain :: JSRef AudioBuffer -> Float -> IO () -- | setGain :: (MonadIO m) => AudioBuffer -> Float -> m () setGain self val = liftIO (js_setGain (unAudioBuffer self) val) foreign import javascript unsafe "$1[\"gain\"]" js_getGain :: JSRef AudioBuffer -> IO Float -- | getGain :: (MonadIO m) => AudioBuffer -> m Float getGain self = liftIO (js_getGain (unAudioBuffer self)) foreign import javascript unsafe "$1[\"numberOfChannels\"]" js_getNumberOfChannels :: JSRef AudioBuffer -> IO Word -- | getNumberOfChannels :: (MonadIO m) => AudioBuffer -> m Word getNumberOfChannels self = liftIO (js_getNumberOfChannels (unAudioBuffer self))