{-# LANGUAGE FlexibleContexts, ConstraintKinds #-} ----------------------------------------------------------------------------- -- | -- Module : Call.Util.Deck -- Copyright : (c) Fumiaki Kinoshita 2014 -- License : BSD3 -- -- Maintainer : Fumiaki Kinoshita -- Stability : experimental -- Portability : non-portable -- -- Polyphonic sampler -- ----------------------------------------------------------------------------- module Call.Util.Sampler where import qualified Data.Vector.Storable as V import qualified Data.Vector.Storable.Mutable as MV import Control.Monad.ST import Control.Monad.State.Strict import Call.Types import Call.Data.Wave import Control.Object data Sampler = Sampler [(Sample Stereo, Time)] empty :: Sampler empty = Sampler [] playback :: MonadState Sampler m => Time -> Int -> m (V.Vector Stereo) playback dt n = do Sampler vs <- get let (vs'', r) = runST $ do v <- MV.new n vs' <- forM vs $ \(s0@(Sample d (Source s)), t0) -> do if d > t0 then return [] else do forM_ [0..n-1] $ \i -> do z <- MV.unsafeRead v i MV.unsafeWrite v i $ z + s (t0 + f * fromIntegral i) return [(s0, t0 + dt)] v' <- V.unsafeFreeze v return (vs', v') put $ Sampler $ concat vs'' return r where f = dt / fromIntegral n play :: MonadState Sampler m => Sample Stereo -> m () play s = modify $ \(Sampler xs) -> Sampler $ (s, 0) : xs playbackOf :: (MonadIO m, MonadState Sampler b) => Instance b m -> Time -> Int -> m (V.Vector Stereo) playbackOf i = \dt n -> i .- playback dt n