module Csound.Air.Wav(
readSnd, loopSnd, loopSndBy,
readWav, loopWav, readSegWav,
tempoLoopWav, tempoReadWav,
readSnd1, loopSnd1, loopSndBy1,
readWav1, loopWav1, readSegWav1,
tempoLoopWav1, tempoReadWav1,
LoopMode(..), ramSnd, ramSnd1,
ramTab, mincer, temposcal,
Phsr(..), lphase, relPhsr, sndPhsr, phsrBounce, phsrOnce,
ram, ram1,
Fidelity, TempoSig, PitchSig,
readRam, loopRam, readSeg, loopSeg, readRel, loopRel,
readRam1, loopRam1, readSeg1, loopSeg1, readRel1, loopRel1,
scaleDrum, scaleHarm, scaleDrum1, scaleHarm1, scaleWav1, scaleWav,
SampleFormat(..),
writeSigs, writeWav, writeAiff, writeWav1, writeAiff1,
dumpWav, dumpWav1,
lengthSnd, segments,
takeSnd, delaySnd, afterSnd, lineSnd, loopLineSnd, segmentSnd, repeatSnd, toMono
) where
import Data.List(isSuffixOf)
import Data.Default
import Data.Boolean
import Control.Applicative hiding((<*))
import Temporal.Media
import Control.Monad.Trans.Class
import Csound.Dynamic hiding (int, Sco)
import Csound.Typed
import Csound.Typed.Opcode
import Csound.Tab(mp3s, mp3Left, wavs, wavLeft, WavChn(..), Mp3Chn(..))
import Csound.Control.Instr(withDur, sched)
import Csound.SigSpace(mapSig)
import Csound.Control.Evt(metroE, loadbang)
import Csound.Air.Spec
takeSnd :: Sigs a => D -> a -> a
takeSnd dt asig = sched (const $ return asig) $ withDur dt $ loadbang
delaySnd :: Sigs a => D -> a -> a
delaySnd dt = segmentSnd dt infiniteDur
segmentSnd ::Sigs a => D -> D -> a -> a
segmentSnd dt dur asig = sched (const $ return asig) $ fmap (del dt) $ withDur dur $ loadbang
repeatSnd :: Sigs a => D -> a -> a
repeatSnd dt asig = sched (const $ return asig) $ segments dt
afterSnd :: (Num b, Sigs b) => D -> b -> b -> b
afterSnd dt a b = takeSnd dt a + delaySnd dt b
lineSnd :: (Num a, Sigs a) => D -> [a] -> a
lineSnd dt xs = foldr1 go xs
where
go a b = afterSnd dt a b
loopLineSnd :: (Num a, Sigs a) => D -> [a] -> a
loopLineSnd dt xs = repeatSnd (dt * (int $ length xs)) $ lineSnd dt xs
isMp3 :: String -> Bool
isMp3 name = ".mp3" `isSuffixOf` name
toMono :: (Sig, Sig) -> Sig
toMono (a, b) = 0.5 * a + 0.5 * b
lengthSnd :: String -> D
lengthSnd fileName
| isMp3 fileName = mp3len $ text fileName
| otherwise = filelen $ text fileName
segments :: D -> Evt (Sco Unit)
segments dt = withDur dt $ metroE (sig $ recip dt)
readSnd :: String -> (Sig, Sig)
readSnd fileName
| isMp3 fileName = mp3in (text fileName)
| otherwise = diskin2 (text fileName)
loopSndBy :: D -> String -> (Sig, Sig)
loopSndBy dt fileName = repeatSnd dt $ readSnd fileName
loopSnd :: String -> (Sig, Sig)
loopSnd fileName = loopSndBy (lengthSnd fileName) fileName
readWav :: Sig -> String -> (Sig, Sig)
readWav speed fileName = diskin2 (text fileName) `withSig` speed
loopWav :: Sig -> String -> (Sig, Sig)
loopWav speed fileName = flip withDs [0, 1] $ ar2 $ diskin2 (text fileName) `withSig` speed
readSegWav :: D -> D -> Sig -> String -> (Sig, Sig)
readSegWav start end speed fileName = takeSnd (end - start) $ (diskin2 (text fileName) `withSig` speed) `withDs` [start, 1]
tempoReadWav :: Sig -> String -> (Sig, Sig)
tempoReadWav speed fileName = mapSig (scaleSpec (1 / abs speed)) $ diskin2 (text fileName) `withSig` speed
tempoLoopWav :: Sig -> String -> (Sig, Sig)
tempoLoopWav speed fileName = mapSig (scaleSpec (1 / abs speed)) $ flip withDs [0, 1] $ ar2 $ diskin2 (text fileName) `withSig` speed
readSnd1 :: String -> Sig
readSnd1 fileName
| isMp3 fileName = toMono $ readSnd fileName
| otherwise = diskin2 (text fileName)
loopSndBy1 :: D -> String -> Sig
loopSndBy1 dt fileName = repeatSnd dt $ readSnd1 fileName
loopSnd1 :: String -> Sig
loopSnd1 fileName = loopSndBy1 (lengthSnd fileName) fileName
readWav1 :: Sig -> String -> Sig
readWav1 speed fileName = diskin2 (text fileName) `withSig` speed
loopWav1 :: Sig -> String -> Sig
loopWav1 speed fileName = flip withDs [0, 1] $ diskin2 (text fileName) `withSig` speed
readSegWav1 :: D -> D -> Sig -> String -> Sig
readSegWav1 start end speed fileName = takeSnd (end - start) $ diskin2 (text fileName) `withSig` speed `withDs` [start, 1]
tempoReadWav1 :: Sig -> String -> Sig
tempoReadWav1 speed fileName = scaleSpec (1 / abs speed) $ readWav1 speed fileName
tempoLoopWav1 :: Sig -> String -> Sig
tempoLoopWav1 speed fileName = scaleSpec (1 / abs speed) $ loopWav1 speed fileName
data LoopMode = Once | Loop | Bounce
deriving (Show, Eq, Enum)
ramSnd :: LoopMode -> Sig -> String -> Sig2
ramSnd loopMode speed file = loscil3 1 speed t `withDs` [1, int $ fromEnum loopMode]
where t
| isMp3 file = mp3s file 0 def
| otherwise = wavs file 0 def
ramSnd1 :: LoopMode -> Sig -> String -> Sig
ramSnd1 loopMode speed file
| isMp3 file = (\(aleft, aright) -> 0.5 * (aleft + aright)) $ loscil3 1 speed (mp3s file 0 def) `withDs` [1, int $ fromEnum loopMode]
| otherwise = loscil3 1 speed (wavs file 0 WavLeft) `withDs` [1, int $ fromEnum loopMode]
data SampleFormat
= NoHeaderFloat32
| NoHeaderInt16
| HeaderInt16
| UlawSamples
| Int16
| Int32
| Float32
| Uint8
| Int24
| Float64
deriving (Eq, Ord, Enum)
writeSigs :: FormatType -> SampleFormat -> String -> [Sig] -> SE ()
writeSigs fmt sample file = fout (text file) formatToInt
where
formatToInt = int $ formatTypeToInt fmt * 10 + fromEnum sample
formatTypeToInt :: FormatType -> Int
formatTypeToInt x = case x of
Wav -> 1
Aiff -> 2
Raw -> 3
Ircam -> 4
_ -> error $ "Format " ++ (show x) ++ " is not supported in the writeSnd."
writeWav :: String -> (Sig, Sig) -> SE ()
writeWav file = writeSigs Wav Int16 file . \(a, b) -> [a, b]
dumpWav :: String -> (Sig, Sig) -> SE (Sig, Sig)
dumpWav file asig = writeWav file asig >> return asig
dumpWav1 :: String -> Sig -> SE Sig
dumpWav1 file asig = writeWav file (asig, asig) >> return asig
writeAiff :: String -> (Sig, Sig) -> SE ()
writeAiff file = writeSigs Aiff Int16 file . \(a, b) -> [a, b]
writeWav1 :: String -> Sig -> SE ()
writeWav1 file = writeWav file . \x -> (x, x)
writeAiff1 :: String -> Sig -> SE ()
writeAiff1 file = writeAiff file . \x -> (x, x)
ramTab :: Fidelity -> Tab -> Sig -> Sig -> Sig
ramTab winSizePowerOfTwo tab aptr pitch = mincer aptr 1 pitch tab 1 `withD` (2 ** (winSizePowerOfTwo + 11))
lphase :: D -> Sig -> Sig -> Sig -> Sig
lphase irefdur kloopstart kloopend kspeed = atimpt
where
kfqrel = kspeed / (kloopend - kloopstart)
andxrel = phasor kfqrel
atimpt = andxrel * (kloopend-kloopstart) + kloopstart
data Phsr = Phsr
{ phsrFile :: String
, phsrStart :: Sig
, phsrEnd :: Sig
, phsrSpeed :: Sig
}
phsrOnce :: Phsr -> Phsr
phsrOnce a = a { phsrSpeed = phsrSpeed a * linseg [1, dt, 1, 0.01, 0] }
where dt = ir $ abs $ (phsrEnd a - phsrStart a) / phsrSpeed a
phsrBounce :: Phsr -> Phsr
phsrBounce a = a { phsrSpeed = phsrSpeed a * sqr (1 / dt) }
where dt = abs $ (phsrEnd a - phsrStart a) / phsrSpeed a
relPhsr :: String -> Sig -> Sig -> Sig -> Phsr
relPhsr file start end speed = Phsr
{ phsrFile = file
, phsrStart = start * sig len
, phsrEnd = end * sig len
, phsrSpeed = speed }
where
len = (filelen $ text file) / srFactor
srFactor = getSampleRate / filesr (text file)
sndPhsr :: String -> Sig -> Phsr
sndPhsr file speed = relPhsr file 0 1 speed
ram1 :: Fidelity -> Phsr -> Sig -> Sig
ram1 = ramChn True 1
ram :: Fidelity -> Phsr -> Sig -> Sig2
ram winSize phsr pitch = (ramChn False 1 winSize phsr pitch, ramChn False 2 winSize phsr pitch)
ramChn :: Bool -> Int -> Fidelity -> Phsr -> Sig -> Sig
ramChn isMono n winSize (Phsr file start end speed) pitch =
ifB (abs speed `lessThan` 0.001) 0 $
ramTab winSize (mkTab isMono n file ) (lphase (filelen $ text file) start end (speed * srFactor)) (pitch * srFactor)
where srFactor = sig $ (filesr $ text file) / getSampleRate
mkTab :: Bool -> Int -> String -> Tab
mkTab isMono chn file
| mp3 && isMono = mp3s file 0 Mp3Mono
| mp3 && isStereo = mp3s file 0 (if chn == 1 then Mp3Left else Mp3Right)
| otherwise = wavs file 0 (if chn == 1 then WavLeft else WavRight)
where
mp3 = isMp3 file
isStereo = not isMono
type Fidelity = D
type TempoSig = Sig
type PitchSig = Sig
readRam :: Fidelity -> TempoSig-> PitchSig -> String -> Sig2
readRam winSize tempo pitch file = ram winSize (phsrOnce $ sndPhsr file tempo) pitch
loopRam :: Fidelity -> TempoSig-> PitchSig -> String -> Sig2
loopRam winSize tempo pitch file = ram winSize (sndPhsr file tempo) pitch
readSeg :: Fidelity -> (Sig, Sig) -> TempoSig-> PitchSig -> String -> Sig2
readSeg winSize (kmin, kmax) tempo pitch file = ram winSize (phsrOnce $ Phsr file kmin kmax tempo) pitch
loopSeg :: Fidelity -> (Sig, Sig) -> TempoSig-> PitchSig -> String -> Sig2
loopSeg winSize (kmin, kmax) tempo pitch file = ram winSize (Phsr file kmin kmax tempo) pitch
readRel :: Fidelity -> (Sig, Sig) -> TempoSig-> PitchSig -> String -> Sig2
readRel winSize (kmin, kmax) tempo pitch file = ram winSize (phsrOnce $ relPhsr file kmin kmax tempo) pitch
loopRel :: Fidelity -> (Sig, Sig) -> TempoSig-> PitchSig -> String -> Sig2
loopRel winSize (kmin, kmax) tempo pitch file = ram winSize (relPhsr file kmin kmax tempo) pitch
readRam1 :: Fidelity -> TempoSig-> PitchSig -> String -> Sig
readRam1 winSize tempo pitch file = ram1 winSize (phsrOnce $ sndPhsr file tempo) pitch
loopRam1 :: Fidelity -> TempoSig-> PitchSig -> String -> Sig
loopRam1 winSize tempo pitch file = ram1 winSize (sndPhsr file tempo) pitch
readSeg1 :: Fidelity -> (Sig, Sig) -> TempoSig-> PitchSig -> String -> Sig
readSeg1 winSize (kmin, kmax) tempo pitch file = ram1 winSize (phsrOnce $ Phsr file kmin kmax tempo) pitch
loopSeg1 :: Fidelity -> (Sig, Sig) -> TempoSig-> PitchSig -> String -> Sig
loopSeg1 winSize (kmin, kmax) tempo pitch file = ram1 winSize (Phsr file kmin kmax tempo) pitch
readRel1 :: Fidelity -> (Sig, Sig) -> TempoSig-> PitchSig -> String -> Sig
readRel1 winSize (kmin, kmax) tempo pitch file = ram1 winSize (phsrOnce $ relPhsr file kmin kmax tempo) pitch
loopRel1 :: Fidelity -> (Sig, Sig) -> TempoSig-> PitchSig -> String -> Sig
loopRel1 winSize (kmin, kmax) tempo pitch file = ram1 winSize (relPhsr file kmin kmax tempo) pitch
scaleDrum :: TempoSig -> PitchSig -> String -> Sig2
scaleDrum = scaleWav (-2)
scaleHarm :: TempoSig -> PitchSig -> String -> Sig2
scaleHarm = scaleWav 0
scaleDrum1 :: TempoSig -> PitchSig -> String -> Sig
scaleDrum1 = scaleWav1 (-2)
scaleHarm1 :: TempoSig -> PitchSig -> String -> Sig
scaleHarm1 = scaleWav1 0
scaleWav1 :: Fidelity -> TempoSig -> PitchSig -> String -> Sig
scaleWav1 winSizePowerOfTwo tempo pitch filename = go $ if mp3 then mp3Left filename else wavLeft filename
where
go = simpleTempoScale winSizePowerOfTwo tempo pitch
mp3 = isMp3 filename
scaleWav :: Fidelity -> TempoSig -> PitchSig -> String -> Sig2
scaleWav winSizePowerOfTwo tempo pitch filename = (go $ mkTab False 0 filename, go $ mkTab False 1 filename)
where go = simpleTempoScale winSizePowerOfTwo tempo pitch
simpleTempoScale winSizePowerOfTwo tempo pitch t = temposcal tempo 1 pitch t 1 `withD` (2 ** (winSizePowerOfTwo + 11))