Buffer.hs

module Sound.MusicW.Buffer (
  Buffer(..),
  BufferStatus(..),
  bufferStatus,
  createBuffer,
  startLoadingAndDecodingWithCallback,
  js_getAudioBuffer,
  js_createBufferFromURL,
  js_startLoadingAndDecodingMultiple,
  isBufferLoaded
) where

import Control.Monad.IO.Class
import Control.Monad (forM,liftM)
import Data.Map
import Data.JSString(JSString, unpack)

import GHCJS.DOM.File
import GHCJS.Types
import GHCJS.Marshal.Pure
import GHCJS.Marshal.Internal
import GHCJS.Foreign.Callback

import Sound.MusicW.AudioContext
import Sound.MusicW.AudioBuffer

newtype Buffer = Buffer JSVal

instance Show Buffer where show _ = "a Buffer"

instance PToJSVal Buffer where pToJSVal (Buffer val) = val

instance ToJSVal Buffer where toJSVal (Buffer v) = return v
-- instance ToJSVal [Buffer] where toJSVal bufs= toJSValListOf

  --  toJSValListOf :: [a] -> IO JSVal

data BufferStatus
  = BufferUnderspecified
  | BufferLoading
  | BufferError String
  | BufferLoaded AudioBuffer

isBufferLoaded :: BufferStatus -> Bool
isBufferLoaded (BufferLoaded _) = True
isBufferLoaded _ = False

bufferStatus :: Buffer -> IO (Maybe BufferStatus)
bufferStatus buffer = do
  rawStatus <- js_getBufferStatus buffer
  case unpack rawStatus of
    "loading" -> return $ Just BufferLoading
    "decoding" -> return $ Just BufferLoading
    "error" -> do
      err <- js_getBufferError buffer
      return $ Just $ BufferError $ unpack err
    "decoded" -> do
      audioBuffer <- js_getAudioBuffer buffer
      return $ Just $ BufferLoaded audioBuffer
    otherwise -> return Nothing

createBuffer :: File -> IO Buffer
createBuffer file = do
  ctx <- getGlobalAudioContext
  js_createBuffer file ctx

startLoadingAndDecodingWithCallback :: Buffer -> (Buffer -> IO ()) -> IO ()
startLoadingAndDecodingWithCallback buffer evTrigger = do
  cb <- asyncCallback1 $ \buf -> evTrigger (Buffer buf)
  js_startLoadingAndDecoding buffer cb
  releaseCallback cb

foreign import javascript safe
  "new Buffer($1, $2)"
  js_createBuffer :: File -> AudioContext -> IO Buffer

foreign import javascript safe
  "new Buffer($1, $2)"
  js_createBufferFromURL :: JSString -> AudioContext -> IO Buffer

foreign import javascript safe
  "$1.startLoadingAndDecoding($2);"
  js_startLoadingAndDecoding :: Buffer -> Callback (JSVal -> IO ()) -> IO ()
  --                                                 ^ actually Buffer
foreign import javascript safe
  "startLoadingAndDecodingMultiple($1, $2)"
  js_startLoadingAndDecodingMultiple:: JSVal -> Callback (JSVal -> IO ()) -> IO ()

foreign import javascript safe
  "$1.status"
  js_getBufferStatus :: Buffer -> IO JSString

foreign import javascript safe
  "$1.error"
  js_getBufferError :: Buffer -> IO JSString

foreign import javascript safe
  "$1.buffer"
  js_getAudioBuffer :: Buffer -> IO AudioBuffer