------------------------------------------------------------------------------

-- Sampler.hs
-- created: Sat Oct  2 01:10:27 JST 2010

------------------------------------------------------------------------------

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

-- initialization loads sounds starting from scserver buffer 10

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