module Sound.Conductive.Sampler where
import Control.Concurrent.MVar
import Data.List
import qualified Data.Map as M
import Sound.Conductive.ConductiveBaseData
import Sound.Conductive.Generator
import Sound.Conductive.MiscListUtils
import Sound.Conductive.MusicalEnvironment
import Sound.Conductive.MVarUtils
import Sound.Conductive.Player
import Sound.Conductive.Table
import Sound.OpenSoundControl
import Sound.SC3
import System.Path.Glob
import System.Path.NameManip
data SamplerData = SamplerData
{ sampleNames :: [String]
, sampleParameters :: MVar (M.Map [Char] Double)
, samplerSample :: MVar (M.Map [Char] [Char])
}
getSampleParameters
:: SamplerData -> IO (M.Map [Char] Double)
getSampleParameters sd = wm (sampleParameters sd) id
getSamplerSamples :: SamplerData -> IO (M.Map [Char] [Char])
getSamplerSamples sd = wm (samplerSample sd) id
showSampler :: SamplerData -> IO ()
showSampler sd = let
columns = ["sampler","sample","amp","pitch"]
in do ss <- getSamplerSamples sd
sp <- getSampleParameters sd
let c1 = M.keys ss
let c2 = M.elems ss
let ampKeys = filter ("amp" `isSuffixOf`) $ M.keys sp
let pKeys = filter ("pitch" `isSuffixOf`) $ M.keys sp
let c3 = map show $ map (\x -> M.findWithDefault 0 x sp) ampKeys
let c4 = map show $ map (\x -> M.findWithDefault 0 x sp) pKeys
asciiTable columns "=" [c1,c2,c3,c4] " "
loader :: (String, Int) -> IO OSC
loader (s,n) = do withSC3 (\fd -> async fd (b_allocRead n s 0 0))
sampleDef :: (String, Double) -> IO OSC
sampleDef (defName,buf) =
let r = bufRateScale KR 10
p = control IR "p" 1
a = control IR "a" 1
b1 = control IR "b1" 0
a1 = tr_control "a1" 0
e = envGen KR 1 1 0 1 RemoveSynth $ envPerc 0.001 1
samplePlayer r = (playBuf 1 (Constant buf) r a1 0 NoLoop RemoveSynth)
sampleOut = (out b1 $ (samplePlayer $ mce [p,p*1.01]) * a * e)
i fd = do async fd (d_recv (synthdef defName sampleOut))
in withSC3 i
loadSounds :: Int -> FilePath -> IO [String]
loadSounds startingBuffer dir =
let buffersNNames sb ss = zip ss [sb..sb + length ss]
name (p,n,e) = n
in do files <- glob dir
let b = buffersNNames startingBuffer files
mapM loader b
let defNames = map name $ map split3 files
let bs = map fromIntegral [startingBuffer..startingBuffer + length defNames]
let defNamesNBuffers = zip defNames bs
mapM sampleDef defNamesNBuffers
return defNames
playSample :: String -> Double -> Double -> IO ()
playSample defName a p =
let parameters = [("a",a)
,("p",p)
]
in withSC3 (\fd -> send fd (s_new defName (1) AddToTail 1 parameters))
playSampleWithPs :: SamplerData -> [Char] -> IO ()
playSampleWithPs sd p = do
sAmp <- wm (sampleParameters sd) $ M.findWithDefault 0 (p ++ "-amp")
sPitch <- wm (sampleParameters sd) $ M.findWithDefault 0 (p ++ "-pitch")
sampleName <- wm (samplerSample sd) $ M.findWithDefault "" p
playSample sampleName sAmp sPitch
addPlaySampleAction
:: SamplerData
-> MVar MusicalEnvironment
-> String
-> IO MusicalEnvironment
addPlaySampleAction sd e p = addAction e (p,(\env pla -> playSampleWithPs sd p))
defaultParameters
:: (Fractional t) => [Char] -> IO (MVar (M.Map [Char] t))
defaultParameters n = newMVar $ M.fromList [(n++"-amp",1.0),(n++"-pitch",1.0)]
addDefaultParameters
:: (Fractional t) =>
MVar (M.Map [Char] t)
-> [Char]
-> IO (M.Map [Char] t)
addDefaultParameters sp n = do
wcm sp $ M.insert (n++"-amp") 1.0
wcm sp $ M.insert (n++"-pitch") 1.0
initializeSamplePlayers
:: SamplerData -> MVar MusicalEnvironment -> IO ()
initializeSamplePlayers sd e = do
ss <- getSamplerSamples sd
let ns = map fst $ M.toList ss
let ap (s1,s2) = addNewPlayer e (s1,("default","defaultIOI",s2,0))
mapM_ ap $ zip ns ns
initializeSampler
:: FilePath -> MVar MusicalEnvironment -> IO SamplerData
initializeSampler dir e = let
startingBuffer = 10
in do s <- loadSounds startingBuffer dir
let sNames = map (\x -> "sampler"++x) $ map show [1..length s]
psm <- newMVar $ M.fromList $ zip sNames s
sp <- newMVar $ (M.empty :: (M.Map [Char] Double))
let sd = SamplerData { sampleNames = s
, sampleParameters = sp
, samplerSample = psm
}
mapM_ (addDefaultParameters (sampleParameters sd)) sNames
mapM_ (addPlaySampleAction sd e) sNames
initializeSamplePlayers sd e
return sd