Vector.hs

module Sound.Csound.Vector (
 -- * Types
  BufferWriteStatus (..)
 ,CsVector

 -- *Input/output functions
 -- ** Spin/spout
 ,unsafeVec2Spin
 ,vec2Spin
 ,readSpout

 -- ** ibuf/obuf
 ,unsafeVec2Ibuf
 ,vec2Ibuf
 ,readObuf

)

where

import Sound.Csound.Interface

import Data.Vector.Storable (Vector)
import qualified Data.Vector.Storable as V

import Control.Monad
import Control.Monad.IO.Class
import Foreign

type CsVector = V.Vector CsndFlt

-- copy data from first buffer to second
cpPtr :: Storable a => Int -> Ptr a -> Ptr a -> IO ()
cpPtr 0 ibuf obuf = return ()
cpPtr n ibuf obuf = do
  x <- peek ibuf
  poke obuf x
  cpPtr (n-1) (ibuf `advancePtr` 1) (obuf `advancePtr` 1)

-- |Result of a buffer write operation
data BufferWriteStatus =
    BufOk
  | BufferNotFull Int
  | DataRemaining CsVector
  deriving (Eq, Show)

-- |Writes a vector to the input buffer.  This function doesn't check the
-- length of the buffer before writing.
unsafeVec2Ibuf :: CsVector -> Csound ()
unsafeVec2Ibuf vec = do
  ibuf <- getInputBuffer
  let (vbuf, off, len) = V.unsafeToForeignPtr vec
  liftIO . withForeignPtr vbuf $ \ptr -> cpPtr len (ptr `advancePtr` off) ibuf

-- |Writes a vector to the input buffer.  Returns any data remaining in the
-- vector.
vec2Ibuf :: CsVector -> Csound BufferWriteStatus
vec2Ibuf vec = do
  isz <- getInputBufferSize
  let len = V.length vec
  case (len == isz, len > isz) of
    (True, _) -> do
      unsafeVec2Ibuf vec
      return BufOk
    (False, True) -> do
      unsafeVec2Ibuf $ V.unsafeTake isz vec
      return . DataRemaining $ V.unsafeDrop isz vec
    (False, False) -> do
      unsafeVec2Ibuf vec
      return . BufferNotFull $ isz - len

-- |Reads from obuf to a vector.
readObuf :: Csound CsVector
readObuf = do
  bufsz <- getOutputBufferSize
  fptr <- liftIO $ mallocForeignPtrArray bufsz
  obuf <- getOutputBuffer
  liftIO $ withForeignPtr fptr (cpPtr bufsz obuf)
  return $ V.unsafeFromForeignPtr fptr 0 bufsz

-- ----------------------------------
-- Spin/spout

-- |Writes a vector to the spin buffer.  Doesn't check the buffer length
-- before writing.
unsafeVec2Spin :: CsVector -> Csound ()
unsafeVec2Spin vec = do
  ibuf <- getSpin
  let (vbuf, off, len) = V.unsafeToForeignPtr vec
  liftIO . withForeignPtr vbuf $ \ptr -> cpPtr len (ptr `advancePtr` off) ibuf

-- |Writes a vector to Spin.  Returns any data remaining in the vector.
vec2Spin :: CsVector -> Csound BufferWriteStatus
vec2Spin vec = do
  ik <- getKsmps
  inch <- getNchnls
  let isz = ik * inch
  let len = V.length vec
  case (len == isz, len > isz) of
    (True, _) -> do
      unsafeVec2Spin vec
      return BufOk
    (False, True) -> do
      unsafeVec2Spin $ V.unsafeTake isz vec
      return . DataRemaining $ V.unsafeDrop isz vec
    (False, False) -> do
      unsafeVec2Spin vec
      return . BufferNotFull $ isz - len

-- |Reads from Spout to a vector.
readSpout :: Csound CsVector
readSpout = do
  ik <- getKsmps
  inch <- getNchnls
  let bufsz = ik * inch
  fptr <- liftIO $ mallocForeignPtrArray bufsz
  spout <- getSpout
  liftIO $ withForeignPtr fptr (cpPtr bufsz spout)
  return $ V.unsafeFromForeignPtr fptr 0 bufsz