AudioBuffer.hs

{-# LANGUAGE JavaScriptFFI #-}
module Sound.MusicW.AudioBuffer where

import GHCJS.Types
import GHCJS.Marshal.Pure
import Control.Monad
import GHCJS.Prim (toJSArray, fromJSInt, getProp)

import Sound.MusicW.AudioContext
import Sound.MusicW.FloatArraySpec

newtype AudioBuffer = AudioBuffer JSVal
instance Show AudioBuffer where show _ = "an AudioBuffer"
instance PToJSVal AudioBuffer where pToJSVal (AudioBuffer val) = val
instance PFromJSVal AudioBuffer where pFromJSVal = AudioBuffer

newtype Float32Array = Float32Array JSVal
instance Show Float32Array where show _ = "a Float32Array"
instance PToJSVal Float32Array where pToJSVal (Float32Array val) = val
instance PFromJSVal Float32Array where pFromJSVal = Float32Array

instantiateArraySpec :: Either Float32Array FloatArraySpec -> IO Float32Array
instantiateArraySpec (Left f32Arr) = return f32Arr
instantiateArraySpec (Right spec) = do
  array <- js_createTypedArray $ arraySpecSize spec
  fillArray 0 spec array
  return array

fillArray :: Int -> FloatArraySpec -> Float32Array -> IO ()
fillArray _ EmptyArray _ = return ()
fillArray i (Const n x tl) arr = do
  js_typedArraySetConst i (i + n) x arr
  fillArray (i + n) tl arr
fillArray i (Segment xs tl) arr = do
  jsArray <- toJSArray $ fmap pToJSVal xs
  len <- fmap fromJSInt $ getProp jsArray "length"
  js_typedArraySet i jsArray arr
  fillArray (i + len) tl arr
fillArray i (Repeated rep xs tl) arr = do
  jsArray <- toJSArray $ fmap pToJSVal xs
  len <- fmap fromJSInt $ getProp jsArray "length"
  forM_ [0..rep-1] $ \it -> js_typedArraySet (i + (it * len)) jsArray arr
  fillArray (i + (rep * len)) tl arr


-- TODO: can all (or most?) of the "safe" declarations here be unsafe for efficiency?

foreign import javascript safe
  "if (Float32Array.prototype.fill !== void 0) { \
  \  $2.fill($1); \
  \} else { \
  \  for (var i = 0, len = a.length; i < len; i++) \
  \    $2[i] = $1; \
  \}"
  js_typedArrayFill :: Double -> Float32Array -> IO ()

foreign import javascript safe
  "if (Float32Array.prototype.fill !== void 0) { \
  \  $4.fill($3, $1, $2); \
  \} else { \
  \  for (var i = $1; i < Math.min($2, $4.length); i++) \
  \    $4[i] = $3; \
  \}"
  js_typedArraySetConst :: Int -> Int -> Double -> Float32Array -> IO ()
  -- fromIdx -> toIdx (exclusive) -> value -> array -> IO ()

foreign import javascript safe
  "$3.set($2, $1);"
  js_typedArraySet :: Int -> JSVal -> Float32Array -> IO ()
  -- startIdx -> fillFromJSArray -> array -> IO ()

foreign import javascript safe
  "$2[$1]"
  js_typedArrayGetAt :: Int -> Float32Array -> IO Double

foreign import javascript safe
  "$3[$1] = $2;"
  js_typedArraySetAt :: Int -> Double -> Float32Array -> IO ()

foreign import javascript safe
  "new Float32Array($1)"
  js_typedArrayFromArray :: JSVal -> IO Float32Array

foreign import javascript safe
  "new Float32Array($1)"
  js_createTypedArray :: Int -> IO Float32Array

foreign import javascript safe
  "$1.length"
  js_typedArrayLength :: Float32Array -> IO Int

foreign import javascript safe
  "$4.createBuffer($1, $2, $3)"
  js_createAudioBuffer :: Int -> Int -> Double -> AudioContext -> IO AudioBuffer
  -- numChannels -> length (in samples) -> sampleRate (frames/sec) -> ctx -> buffer

foreign import javascript safe
  "$1.getChannelData($2)"
  js_channelData :: AudioBuffer -> Int -> IO Float32Array
  -- buffer -> channel (0 indexed) -> data

foreign import javascript safe
  "$3.copyToChannel($1, $2);"
  js_copyToChannel :: Float32Array -> Int -> AudioBuffer -> IO ()

foreign import javascript safe
  "$1.length"
  js_bufferLength :: AudioBuffer -> IO Int

foreign import javascript safe
  "$1.duration"
  js_bufferDuration :: AudioBuffer -> IO AudioTime

foreign import javascript safe
  "$1.numberOfChannels"
  js_bufferNumChannels :: AudioBuffer -> IO Int

foreign import javascript safe
  "$1.inputBuffer"
  js_apeInputBuffer :: JSVal -> IO AudioBuffer

foreign import javascript safe
  "$1.outputBuffer"
  js_apeOutputBuffer :: JSVal -> IO AudioBuffer