-- | Sound file playback
 module Csound.Air.Wav(
    -- * Stereo
    readSnd, loopSnd, loopSndBy,
    readWav, loopWav, readSegWav,
    tempoLoopWav, tempoReadWav,

    -- * Mono
    readSnd1, loopSnd1, loopSndBy1,
    readWav1, loopWav1, readSegWav1,
    tempoLoopWav1, tempoReadWav1,

    -- * Read sound with RAM
    --
    -- Loads the sample in the table and plays it back from RAM. The sample should be short. The size of the table is limited.
    -- It's up to 6 minutes for 44100 sample rate, 5 minutes for 48000 and 2.8 minutes for 96000.
    LoopMode(..), ramSnd, ramSnd1,
    ramTab, mincer, temposcal,
    Phsr(..), lphase, relPhsr, sndPhsr, phsrBounce, phsrOnce,
    ram, ram1,

    -- ** Simple audio reading functions (Stereo)
    Fidelity, TempoSig, PitchSig,

    readRam, loopRam, readSeg, loopSeg, readRel, loopRel,

    -- ** Simple audio reading functions (Mono)

    readRam1, loopRam1, readSeg1, loopSeg1, readRel1, loopRel1,

    -- ** Scaling audio files
    scaleDrum, scaleHarm, scaleDrum1, scaleHarm1, scaleWav1, scaleWav,

    -- * Writing sound files
    SampleFormat(..),
    writeSigs, writeWav, writeAiff, writeWav1, writeAiff1,
    dumpWav, dumpWav1,

    -- * Utility
    lengthSnd, segments,

    -- * Signal manipulation
    takeSnd, delaySnd, afterSnd, lineSnd, loopLineSnd, segmentSnd, repeatSnd, toMono
) where

import Data.List(isSuffixOf)
import Data.Default
import Data.Boolean

import Temporal.Media

import Csound.Dynamic hiding (int, Sco)

import Csound.Typed
import Csound.Typed.Opcode hiding (tempo, pitch, metro, tab)
import Csound.Tab(mp3s, mp3Left, wavs, wavLeft, WavChn(..), Mp3Chn(..))
import Csound.Control.Instr(withDur)

import Csound.Control.Evt(metro, loadbang)

import Csound.Air.Spec

--------------------------------------------------------------------------
-- Signal manipulation

-- | Takes only given amount (in seconds) from the signal (the rest is silence).
takeSnd :: Sigs a => Sig -> a -> a
takeSnd :: forall a. Sigs a => Sig -> a -> a
takeSnd Sig
dt a
asig = (Unit -> SE a) -> Evt (Sco Unit) -> a
forall a b. (Arg a, Sigs b) => (a -> SE b) -> Evt (Sco a) -> b
sched (SE a -> Unit -> SE a
forall a b. a -> b -> a
const (SE a -> Unit -> SE a) -> SE a -> Unit -> SE a
forall a b. (a -> b) -> a -> b
$ a -> SE a
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return a
asig) (Evt (Sco Unit) -> a) -> Evt (Sco Unit) -> a
forall a b. (a -> b) -> a -> b
$ Sig -> Evt Unit -> Evt (Sco Unit)
forall a. Sig -> Evt a -> Evt (Sco a)
withDur Sig
dt (Evt Unit -> Evt (Sco Unit)) -> Evt Unit -> Evt (Sco Unit)
forall a b. (a -> b) -> a -> b
$ Evt Unit
loadbang

-- | Delays signals by the given amount (in seconds).
delaySnd :: Sigs a => Sig -> a -> a
delaySnd :: forall a. Sigs a => Sig -> a -> a
delaySnd Sig
dt = Sig -> Sig -> a -> a
forall a. Sigs a => Sig -> Sig -> a -> a
segmentSnd Sig
dt Sig
forall a. Num a => a
infiniteDur

-- | Delays a signal by the first argument and takes only second argument amount
-- of signal (everything is measured in seconds).
segmentSnd ::Sigs a => Sig -> Sig -> a -> a
segmentSnd :: forall a. Sigs a => Sig -> Sig -> a -> a
segmentSnd Sig
dt Sig
durS a
asig = (Unit -> SE a) -> Evt (Sco Unit) -> a
forall a b. (Arg a, Sigs b) => (a -> SE b) -> Evt (Sco a) -> b
sched (SE a -> Unit -> SE a
forall a b. a -> b -> a
const (SE a -> Unit -> SE a) -> SE a -> Unit -> SE a
forall a b. (a -> b) -> a -> b
$ a -> SE a
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return a
asig) (Evt (Sco Unit) -> a) -> Evt (Sco Unit) -> a
forall a b. (a -> b) -> a -> b
$ (Sco Unit -> Sco Unit) -> Evt (Sco Unit) -> Evt (Sco Unit)
forall a b. (a -> b) -> Evt a -> Evt b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DurOf (Sco Unit) -> Sco Unit -> Sco Unit
forall a. Delay a => DurOf a -> a -> a
del Sig
DurOf (Sco Unit)
dt) (Evt (Sco Unit) -> Evt (Sco Unit))
-> Evt (Sco Unit) -> Evt (Sco Unit)
forall a b. (a -> b) -> a -> b
$ Sig -> Evt Unit -> Evt (Sco Unit)
forall a. Sig -> Evt a -> Evt (Sco a)
withDur Sig
durS (Evt Unit -> Evt (Sco Unit)) -> Evt Unit -> Evt (Sco Unit)
forall a b. (a -> b) -> a -> b
$ Evt Unit
loadbang

-- | Repeats the signal with the given period.
repeatSnd :: Sigs a => Sig -> a -> a
repeatSnd :: forall a. Sigs a => Sig -> a -> a
repeatSnd Sig
dt a
asig = (Unit -> SE a) -> Evt (Sco Unit) -> a
forall a b. (Arg a, Sigs b) => (a -> SE b) -> Evt (Sco a) -> b
sched (SE a -> Unit -> SE a
forall a b. a -> b -> a
const (SE a -> Unit -> SE a) -> SE a -> Unit -> SE a
forall a b. (a -> b) -> a -> b
$ a -> SE a
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return a
asig) (Evt (Sco Unit) -> a) -> Evt (Sco Unit) -> a
forall a b. (a -> b) -> a -> b
$ Sig -> Evt (Sco Unit)
segments Sig
dt

-- | Plays the first signal for some time (in seconds) and then switches to the next one.
--
-- > afterSnd dur sig1 sig2
afterSnd :: (Num b, Sigs b) => Sig -> b -> b -> b
afterSnd :: forall b. (Num b, Sigs b) => Sig -> b -> b -> b
afterSnd Sig
dt b
a b
b = Sig -> b -> b
forall a. Sigs a => Sig -> a -> a
takeSnd Sig
dt b
a b -> b -> b
forall a. Num a => a -> a -> a
+ Sig -> b -> b
forall a. Sigs a => Sig -> a -> a
delaySnd Sig
dt b
b

-- | Creates a sequence of signals. Each segment lasts for
-- fixed amount of time given in the first argument.
lineSnd :: (Num a, Sigs a) => Sig -> [a] -> a
lineSnd :: forall a. (Num a, Sigs a) => Sig -> [a] -> a
lineSnd Sig
dt [a]
xs = (a -> a -> a) -> [a] -> a
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 a -> a -> a
forall {b}. Sigs b => b -> b -> b
go [a]
xs
    where
        go :: b -> b -> b
go b
a b
b = Sig -> b -> b -> b
forall b. (Num b, Sigs b) => Sig -> b -> b -> b
afterSnd Sig
dt b
a b
b

-- | Creates a sequence of signals and loops over the sequence.
-- Each segment lasts for  fixed amount of time given in the first argument.
loopLineSnd :: (Num a, Sigs a) => Sig -> [a] -> a
loopLineSnd :: forall a. (Num a, Sigs a) => Sig -> [a] -> a
loopLineSnd Sig
dt [a]
xs = Sig -> a -> a
forall a. Sigs a => Sig -> a -> a
repeatSnd (Sig
dt Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ Int -> D
int (Int -> D) -> Int -> D
forall a b. (a -> b) -> a -> b
$ [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs)) (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Sig -> [a] -> a
forall a. (Num a, Sigs a) => Sig -> [a] -> a
lineSnd Sig
dt [a]
xs

--------------------------------------------------------------------------
-- sound files playback

isMp3 :: String -> Bool
isMp3 :: [Char] -> Bool
isMp3 [Char]
name = [Char]
".mp3" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
name

-- | Converts stereosignal to mono with function mean.
toMono :: (Sig, Sig) -> Sig
toMono :: (Sig, Sig) -> Sig
toMono (Sig
a, Sig
b) = Sig
0.5 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
a Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
0.5 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
b

-- | Length in seconds of the sound file.
lengthSnd :: String -> D
lengthSnd :: [Char] -> D
lengthSnd [Char]
fileName
    | [Char] -> Bool
isMp3 [Char]
fileName    = Str -> D
mp3len (Str -> D) -> Str -> D
forall a b. (a -> b) -> a -> b
$ [Char] -> Str
text [Char]
fileName
    | Bool
otherwise         = Str -> D
filelen (Str -> D) -> Str -> D
forall a b. (a -> b) -> a -> b
$ [Char] -> Str
text [Char]
fileName

-- | Produces repeating segments with the given time in seconds.
segments :: Sig -> Evt (Sco Unit)
segments :: Sig -> Evt (Sco Unit)
segments Sig
dt = Sig -> Evt Unit -> Evt (Sco Unit)
forall a. Sig -> Evt a -> Evt (Sco a)
withDur Sig
dt (Evt Unit -> Evt (Sco Unit)) -> Evt Unit -> Evt (Sco Unit)
forall a b. (a -> b) -> a -> b
$ Sig -> Evt Unit
metro (Sig -> Sig
forall a. Fractional a => a -> a
recip Sig
dt)

-- Stereo

-- | Reads stereo signal from the sound-file (wav or mp3 or aiff).
readSnd :: String -> (Sig, Sig)
readSnd :: [Char] -> (Sig, Sig)
readSnd [Char]
fileName
    | [Char] -> Bool
isMp3 [Char]
fileName = Str -> (Sig, Sig)
mp3in ([Char] -> Str
text [Char]
fileName)
    | Bool
otherwise      = Str -> (Sig, Sig)
forall a. Tuple a => Str -> a
diskin2 ([Char] -> Str
text [Char]
fileName)

-- | Reads stereo signal from the sound-file (wav or mp3 or aiff)
-- and loops it with the given period (in seconds).
loopSndBy :: Sig -> String -> (Sig, Sig)
loopSndBy :: Sig -> [Char] -> (Sig, Sig)
loopSndBy Sig
dt [Char]
fileName = Sig -> (Sig, Sig) -> (Sig, Sig)
forall a. Sigs a => Sig -> a -> a
repeatSnd Sig
dt ((Sig, Sig) -> (Sig, Sig)) -> (Sig, Sig) -> (Sig, Sig)
forall a b. (a -> b) -> a -> b
$ [Char] -> (Sig, Sig)
readSnd [Char]
fileName

-- | Reads stereo signal from the sound-file (wav or mp3 or aiff)
-- and loops it with the file length.
loopSnd :: String -> (Sig, Sig)
loopSnd :: [Char] -> (Sig, Sig)
loopSnd [Char]
fileName = Sig -> [Char] -> (Sig, Sig)
loopSndBy (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ [Char] -> D
lengthSnd [Char]
fileName) [Char]
fileName

-- | Reads the wav file with the given speed (if speed is 1 it's a norma playback).
-- We can use negative speed to read file in reverse.
readWav :: Sig -> String -> (Sig, Sig)
readWav :: Sig -> [Char] -> (Sig, Sig)
readWav Sig
speed [Char]
fileName = Str -> (Sig, Sig)
forall a. Tuple a => Str -> a
diskin2 ([Char] -> Str
text [Char]
fileName) (Sig, Sig) -> Sig -> (Sig, Sig)
forall a. Tuple a => a -> Sig -> a
`withSig` Sig
speed

-- | Reads th wav file and loops over it.
loopWav :: Sig -> String -> (Sig, Sig)
loopWav :: Sig -> [Char] -> (Sig, Sig)
loopWav Sig
speed [Char]
fileName = ((Sig, Sig) -> [D] -> (Sig, Sig))
-> [D] -> (Sig, Sig) -> (Sig, Sig)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Sig, Sig) -> [D] -> (Sig, Sig)
forall a. Tuple a => a -> [D] -> a
withDs [D
0, D
1] ((Sig, Sig) -> (Sig, Sig)) -> (Sig, Sig) -> (Sig, Sig)
forall a b. (a -> b) -> a -> b
$ (Sig, Sig) -> (Sig, Sig)
ar2 ((Sig, Sig) -> (Sig, Sig)) -> (Sig, Sig) -> (Sig, Sig)
forall a b. (a -> b) -> a -> b
$ Str -> (Sig, Sig)
forall a. Tuple a => Str -> a
diskin2 ([Char] -> Str
text [Char]
fileName) (Sig, Sig) -> Sig -> (Sig, Sig)
forall a. Tuple a => a -> Sig -> a
`withSig` Sig
speed

-- | Reads a segment from wav file.
readSegWav :: D -> D -> Sig -> String -> (Sig, Sig)
readSegWav :: D -> D -> Sig -> [Char] -> (Sig, Sig)
readSegWav D
start D
end Sig
speed [Char]
fileName = Sig -> (Sig, Sig) -> (Sig, Sig)
forall a. Sigs a => Sig -> a -> a
takeSnd (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ D
end D -> D -> D
forall a. Num a => a -> a -> a
- D
start) ((Sig, Sig) -> (Sig, Sig)) -> (Sig, Sig) -> (Sig, Sig)
forall a b. (a -> b) -> a -> b
$ (Str -> (Sig, Sig)
forall a. Tuple a => Str -> a
diskin2 ([Char] -> Str
text [Char]
fileName) (Sig, Sig) -> Sig -> (Sig, Sig)
forall a. Tuple a => a -> Sig -> a
`withSig` Sig
speed) (Sig, Sig) -> [D] -> (Sig, Sig)
forall a. Tuple a => a -> [D] -> a
`withDs` [D
start, D
1]

-- | Reads the wav file with the given speed (if speed is 1 it's a norma playback).
-- We can use negative speed to read file in reverse. Scales the tempo with first argument.
tempoReadWav :: Sig -> String -> (Sig, Sig)
tempoReadWav :: Sig -> [Char] -> (Sig, Sig)
tempoReadWav Sig
speed [Char]
fileName = (Sig -> Sig) -> (Sig, Sig) -> (Sig, Sig)
forall a. SigSpace a => (Sig -> Sig) -> a -> a
mapSig (Sig -> Sig -> Sig
scaleSpec (Sig
1 Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig -> Sig
forall a. Num a => a -> a
abs Sig
speed)) ((Sig, Sig) -> (Sig, Sig)) -> (Sig, Sig) -> (Sig, Sig)
forall a b. (a -> b) -> a -> b
$ Str -> (Sig, Sig)
forall a. Tuple a => Str -> a
diskin2 ([Char] -> Str
text [Char]
fileName) (Sig, Sig) -> Sig -> (Sig, Sig)
forall a. Tuple a => a -> Sig -> a
`withSig` Sig
speed

-- | Reads th wav file and loops over it. Scales the tempo with first argument.
tempoLoopWav :: Sig -> String -> (Sig, Sig)
tempoLoopWav :: Sig -> [Char] -> (Sig, Sig)
tempoLoopWav Sig
speed [Char]
fileName = (Sig -> Sig) -> (Sig, Sig) -> (Sig, Sig)
forall a. SigSpace a => (Sig -> Sig) -> a -> a
mapSig (Sig -> Sig -> Sig
scaleSpec (Sig
1 Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig -> Sig
forall a. Num a => a -> a
abs Sig
speed)) ((Sig, Sig) -> (Sig, Sig)) -> (Sig, Sig) -> (Sig, Sig)
forall a b. (a -> b) -> a -> b
$ ((Sig, Sig) -> [D] -> (Sig, Sig))
-> [D] -> (Sig, Sig) -> (Sig, Sig)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Sig, Sig) -> [D] -> (Sig, Sig)
forall a. Tuple a => a -> [D] -> a
withDs [D
0, D
1] ((Sig, Sig) -> (Sig, Sig)) -> (Sig, Sig) -> (Sig, Sig)
forall a b. (a -> b) -> a -> b
$ (Sig, Sig) -> (Sig, Sig)
ar2 ((Sig, Sig) -> (Sig, Sig)) -> (Sig, Sig) -> (Sig, Sig)
forall a b. (a -> b) -> a -> b
$ Str -> (Sig, Sig)
forall a. Tuple a => Str -> a
diskin2 ([Char] -> Str
text [Char]
fileName) (Sig, Sig) -> Sig -> (Sig, Sig)
forall a. Tuple a => a -> Sig -> a
`withSig` Sig
speed

-- Mono

-- | The mono variant of the function @readSnd@.
readSnd1 :: String -> Sig
readSnd1 :: [Char] -> Sig
readSnd1 [Char]
fileName
    | [Char] -> Bool
isMp3 [Char]
fileName = (Sig, Sig) -> Sig
toMono ((Sig, Sig) -> Sig) -> (Sig, Sig) -> Sig
forall a b. (a -> b) -> a -> b
$ [Char] -> (Sig, Sig)
readSnd [Char]
fileName
    | Bool
otherwise      = Str -> Sig
forall a. Tuple a => Str -> a
diskin2 ([Char] -> Str
text [Char]
fileName)

-- | The mono variant of the function @loopSndBy@.
loopSndBy1 :: Sig -> String -> Sig
loopSndBy1 :: Sig -> [Char] -> Sig
loopSndBy1 Sig
dt [Char]
fileName = Sig -> Sig -> Sig
forall a. Sigs a => Sig -> a -> a
repeatSnd Sig
dt (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ [Char] -> Sig
readSnd1 [Char]
fileName

-- | The mono variant of the function @loopSnd@.
loopSnd1 :: String -> Sig
loopSnd1 :: [Char] -> Sig
loopSnd1 [Char]
fileName = Sig -> [Char] -> Sig
loopSndBy1 (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ [Char] -> D
lengthSnd [Char]
fileName) [Char]
fileName

-- | The mono variant of the function @readWav@.
readWav1 :: Sig -> String -> Sig
readWav1 :: Sig -> [Char] -> Sig
readWav1 Sig
speed [Char]
fileName = Str -> Sig
forall a. Tuple a => Str -> a
diskin2 ([Char] -> Str
text [Char]
fileName) Sig -> Sig -> Sig
forall a. Tuple a => a -> Sig -> a
`withSig` Sig
speed

-- | The mono variant of the function @loopWav@.
loopWav1 :: Sig -> String -> Sig
loopWav1 :: Sig -> [Char] -> Sig
loopWav1 Sig
speed [Char]
fileName = (Sig -> [D] -> Sig) -> [D] -> Sig -> Sig
forall a b c. (a -> b -> c) -> b -> a -> c
flip Sig -> [D] -> Sig
forall a. Tuple a => a -> [D] -> a
withDs [D
0, D
1] (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Str -> Sig
forall a. Tuple a => Str -> a
diskin2 ([Char] -> Str
text [Char]
fileName) Sig -> Sig -> Sig
forall a. Tuple a => a -> Sig -> a
`withSig` Sig
speed

-- | Reads a segment from wav file.
readSegWav1 :: D -> D -> Sig -> String -> Sig
readSegWav1 :: D -> D -> Sig -> [Char] -> Sig
readSegWav1 D
start D
end Sig
speed [Char]
fileName = Sig -> Sig -> Sig
forall a. Sigs a => Sig -> a -> a
takeSnd (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ D
end D -> D -> D
forall a. Num a => a -> a -> a
- D
start) (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Str -> Sig
forall a. Tuple a => Str -> a
diskin2 ([Char] -> Str
text [Char]
fileName) Sig -> Sig -> Sig
forall a. Tuple a => a -> Sig -> a
`withSig` Sig
speed Sig -> [D] -> Sig
forall a. Tuple a => a -> [D] -> a
`withDs` [D
start, D
1]

-- | Reads the mono wav file with the given speed (if speed is 1 it's a norma playback).
-- We can use negative speed to read file in reverse. Scales the tempo with first argument.
tempoReadWav1 :: Sig -> String -> Sig
tempoReadWav1 :: Sig -> [Char] -> Sig
tempoReadWav1 Sig
speed [Char]
fileName = Sig -> Sig -> Sig
scaleSpec (Sig
1 Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig -> Sig
forall a. Num a => a -> a
abs Sig
speed) (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Sig -> [Char] -> Sig
readWav1 Sig
speed [Char]
fileName

-- | Reads th mono wav file and loops over it. Scales the tempo with first argument.
tempoLoopWav1 :: Sig -> String -> Sig
tempoLoopWav1 :: Sig -> [Char] -> Sig
tempoLoopWav1 Sig
speed [Char]
fileName = Sig -> Sig -> Sig
scaleSpec (Sig
1 Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig -> Sig
forall a. Num a => a -> a
abs Sig
speed) (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ Sig -> [Char] -> Sig
loopWav1 Sig
speed [Char]
fileName

--------------------------------------------------------------------------
-- With RAM

data LoopMode = Once | Loop | Bounce
    deriving (Int -> LoopMode -> ShowS
[LoopMode] -> ShowS
LoopMode -> [Char]
(Int -> LoopMode -> ShowS)
-> (LoopMode -> [Char]) -> ([LoopMode] -> ShowS) -> Show LoopMode
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LoopMode -> ShowS
showsPrec :: Int -> LoopMode -> ShowS
$cshow :: LoopMode -> [Char]
show :: LoopMode -> [Char]
$cshowList :: [LoopMode] -> ShowS
showList :: [LoopMode] -> ShowS
Show, LoopMode -> LoopMode -> Bool
(LoopMode -> LoopMode -> Bool)
-> (LoopMode -> LoopMode -> Bool) -> Eq LoopMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LoopMode -> LoopMode -> Bool
== :: LoopMode -> LoopMode -> Bool
$c/= :: LoopMode -> LoopMode -> Bool
/= :: LoopMode -> LoopMode -> Bool
Eq, Int -> LoopMode
LoopMode -> Int
LoopMode -> [LoopMode]
LoopMode -> LoopMode
LoopMode -> LoopMode -> [LoopMode]
LoopMode -> LoopMode -> LoopMode -> [LoopMode]
(LoopMode -> LoopMode)
-> (LoopMode -> LoopMode)
-> (Int -> LoopMode)
-> (LoopMode -> Int)
-> (LoopMode -> [LoopMode])
-> (LoopMode -> LoopMode -> [LoopMode])
-> (LoopMode -> LoopMode -> [LoopMode])
-> (LoopMode -> LoopMode -> LoopMode -> [LoopMode])
-> Enum LoopMode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: LoopMode -> LoopMode
succ :: LoopMode -> LoopMode
$cpred :: LoopMode -> LoopMode
pred :: LoopMode -> LoopMode
$ctoEnum :: Int -> LoopMode
toEnum :: Int -> LoopMode
$cfromEnum :: LoopMode -> Int
fromEnum :: LoopMode -> Int
$cenumFrom :: LoopMode -> [LoopMode]
enumFrom :: LoopMode -> [LoopMode]
$cenumFromThen :: LoopMode -> LoopMode -> [LoopMode]
enumFromThen :: LoopMode -> LoopMode -> [LoopMode]
$cenumFromTo :: LoopMode -> LoopMode -> [LoopMode]
enumFromTo :: LoopMode -> LoopMode -> [LoopMode]
$cenumFromThenTo :: LoopMode -> LoopMode -> LoopMode -> [LoopMode]
enumFromThenTo :: LoopMode -> LoopMode -> LoopMode -> [LoopMode]
Enum)

-- | Loads the sample in the table. The sample should be short. The size of the table is limited.
-- It's up to 3 minutes for 44100 sample rate (sr), 2.9 minutes for 48000 sr, 1.4 minutes for 96000 sr.
ramSnd :: LoopMode -> Sig -> String -> Sig2
ramSnd :: LoopMode -> Sig -> [Char] -> (Sig, Sig)
ramSnd LoopMode
loopMode Sig
speed [Char]
file = Sig -> Sig -> Tab -> (Sig, Sig)
forall a. Tuple a => Sig -> Sig -> Tab -> a
loscil3 Sig
1 Sig
speed Tab
t (Sig, Sig) -> [D] -> (Sig, Sig)
forall a. Tuple a => a -> [D] -> a
`withDs` [D
1, Int -> D
int (Int -> D) -> Int -> D
forall a b. (a -> b) -> a -> b
$ LoopMode -> Int
forall a. Enum a => a -> Int
fromEnum LoopMode
loopMode]
    where t :: Tab
t
            | [Char] -> Bool
isMp3 [Char]
file = [Char] -> Double -> Mp3Chn -> Tab
mp3s [Char]
file Double
0 Mp3Chn
forall a. Default a => a
def
            | Bool
otherwise  = [Char] -> Double -> WavChn -> Tab
wavs [Char]
file Double
0 WavChn
forall a. Default a => a
def

-- | Loads the sample in the table. The sample should be short. The size of the table is limited.
-- It's up to 6 minutes for 44100 sample rate (sr), 5.9 minutes for 48000 sr, 2.8 minutes for 96000 sr.
ramSnd1 :: LoopMode -> Sig -> String -> Sig
ramSnd1 :: LoopMode -> Sig -> [Char] -> Sig
ramSnd1 LoopMode
loopMode Sig
speed [Char]
file
    | [Char] -> Bool
isMp3 [Char]
file = (\(Sig
aleft, Sig
aright) -> Sig
0.5 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* (Sig
aleft Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
aright)) ((Sig, Sig) -> Sig) -> (Sig, Sig) -> Sig
forall a b. (a -> b) -> a -> b
$ Sig -> Sig -> Tab -> (Sig, Sig)
forall a. Tuple a => Sig -> Sig -> Tab -> a
loscil3 Sig
1 Sig
speed ([Char] -> Double -> Mp3Chn -> Tab
mp3s [Char]
file Double
0 Mp3Chn
forall a. Default a => a
def) (Sig, Sig) -> [D] -> (Sig, Sig)
forall a. Tuple a => a -> [D] -> a
`withDs` [D
1, Int -> D
int (Int -> D) -> Int -> D
forall a b. (a -> b) -> a -> b
$ LoopMode -> Int
forall a. Enum a => a -> Int
fromEnum LoopMode
loopMode]
    | Bool
otherwise  = Sig -> Sig -> Tab -> Sig
forall a. Tuple a => Sig -> Sig -> Tab -> a
loscil3 Sig
1 Sig
speed ([Char] -> Double -> WavChn -> Tab
wavs [Char]
file Double
0 WavChn
WavLeft) Sig -> [D] -> Sig
forall a. Tuple a => a -> [D] -> a
`withDs` [D
1, Int -> D
int (Int -> D) -> Int -> D
forall a b. (a -> b) -> a -> b
$ LoopMode -> Int
forall a. Enum a => a -> Int
fromEnum LoopMode
loopMode]

--------------------------------------------------------------------------
-- writing sound files

-- | The sample format.
data SampleFormat
    = NoHeaderFloat32       -- ^ 32-bit floating point samples without header
    | NoHeaderInt16         -- ^ 16-bit integers without header
    | HeaderInt16           -- ^ 16-bit integers with a header. The header type depends on the render (-o) format
    | UlawSamples           -- ^  u-law samples with a header
    | Int16                 -- ^ 16-bit integers with a header
    | Int32                 -- ^ 32-bit integers with a header
    | Float32               -- ^ 32-bit floats with a header
    | Uint8                 -- ^ 8-bit unsigned integers with a header
    | Int24                 -- ^ 24-bit integers with a header
    | Float64               -- ^ 64-bit floats with a header
    deriving (SampleFormat -> SampleFormat -> Bool
(SampleFormat -> SampleFormat -> Bool)
-> (SampleFormat -> SampleFormat -> Bool) -> Eq SampleFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SampleFormat -> SampleFormat -> Bool
== :: SampleFormat -> SampleFormat -> Bool
$c/= :: SampleFormat -> SampleFormat -> Bool
/= :: SampleFormat -> SampleFormat -> Bool
Eq, Eq SampleFormat
Eq SampleFormat =>
(SampleFormat -> SampleFormat -> Ordering)
-> (SampleFormat -> SampleFormat -> Bool)
-> (SampleFormat -> SampleFormat -> Bool)
-> (SampleFormat -> SampleFormat -> Bool)
-> (SampleFormat -> SampleFormat -> Bool)
-> (SampleFormat -> SampleFormat -> SampleFormat)
-> (SampleFormat -> SampleFormat -> SampleFormat)
-> Ord SampleFormat
SampleFormat -> SampleFormat -> Bool
SampleFormat -> SampleFormat -> Ordering
SampleFormat -> SampleFormat -> SampleFormat
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SampleFormat -> SampleFormat -> Ordering
compare :: SampleFormat -> SampleFormat -> Ordering
$c< :: SampleFormat -> SampleFormat -> Bool
< :: SampleFormat -> SampleFormat -> Bool
$c<= :: SampleFormat -> SampleFormat -> Bool
<= :: SampleFormat -> SampleFormat -> Bool
$c> :: SampleFormat -> SampleFormat -> Bool
> :: SampleFormat -> SampleFormat -> Bool
$c>= :: SampleFormat -> SampleFormat -> Bool
>= :: SampleFormat -> SampleFormat -> Bool
$cmax :: SampleFormat -> SampleFormat -> SampleFormat
max :: SampleFormat -> SampleFormat -> SampleFormat
$cmin :: SampleFormat -> SampleFormat -> SampleFormat
min :: SampleFormat -> SampleFormat -> SampleFormat
Ord, Int -> SampleFormat
SampleFormat -> Int
SampleFormat -> [SampleFormat]
SampleFormat -> SampleFormat
SampleFormat -> SampleFormat -> [SampleFormat]
SampleFormat -> SampleFormat -> SampleFormat -> [SampleFormat]
(SampleFormat -> SampleFormat)
-> (SampleFormat -> SampleFormat)
-> (Int -> SampleFormat)
-> (SampleFormat -> Int)
-> (SampleFormat -> [SampleFormat])
-> (SampleFormat -> SampleFormat -> [SampleFormat])
-> (SampleFormat -> SampleFormat -> [SampleFormat])
-> (SampleFormat -> SampleFormat -> SampleFormat -> [SampleFormat])
-> Enum SampleFormat
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: SampleFormat -> SampleFormat
succ :: SampleFormat -> SampleFormat
$cpred :: SampleFormat -> SampleFormat
pred :: SampleFormat -> SampleFormat
$ctoEnum :: Int -> SampleFormat
toEnum :: Int -> SampleFormat
$cfromEnum :: SampleFormat -> Int
fromEnum :: SampleFormat -> Int
$cenumFrom :: SampleFormat -> [SampleFormat]
enumFrom :: SampleFormat -> [SampleFormat]
$cenumFromThen :: SampleFormat -> SampleFormat -> [SampleFormat]
enumFromThen :: SampleFormat -> SampleFormat -> [SampleFormat]
$cenumFromTo :: SampleFormat -> SampleFormat -> [SampleFormat]
enumFromTo :: SampleFormat -> SampleFormat -> [SampleFormat]
$cenumFromThenTo :: SampleFormat -> SampleFormat -> SampleFormat -> [SampleFormat]
enumFromThenTo :: SampleFormat -> SampleFormat -> SampleFormat -> [SampleFormat]
Enum)

-- | Writes a sound signal to the file with the given format.
-- It supports only four formats: Wav, Aiff, Raw and Ircam.
writeSigs :: FormatType -> SampleFormat -> String -> [Sig] -> SE ()
writeSigs :: FormatType -> SampleFormat -> [Char] -> [Sig] -> SE ()
writeSigs FormatType
fmt SampleFormat
sample [Char]
file = Str -> D -> [Sig] -> SE ()
fout ([Char] -> Str
text [Char]
file) D
formatToInt
    where
        formatToInt :: D
formatToInt = Int -> D
int (Int -> D) -> Int -> D
forall a b. (a -> b) -> a -> b
$ FormatType -> Int
formatTypeToInt FormatType
fmt Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SampleFormat -> Int
forall a. Enum a => a -> Int
fromEnum SampleFormat
sample

        formatTypeToInt :: FormatType -> Int
        formatTypeToInt :: FormatType -> Int
formatTypeToInt FormatType
x = case FormatType
x of
            FormatType
Wav   -> Int
1
            FormatType
Aiff  -> Int
2
            FormatType
Raw   -> Int
3
            FormatType
Ircam -> Int
4
            FormatType
_     -> [Char] -> Int
forall a. HasCallStack => [Char] -> a
error ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ [Char]
"Format " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (FormatType -> [Char]
forall a. Show a => a -> [Char]
show FormatType
x) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" is not supported in the writeSnd."

-- | Writes wav files.
writeWav :: String -> (Sig, Sig) -> SE ()
writeWav :: [Char] -> (Sig, Sig) -> SE ()
writeWav [Char]
file = FormatType -> SampleFormat -> [Char] -> [Sig] -> SE ()
writeSigs FormatType
Wav SampleFormat
Int16 [Char]
file ([Sig] -> SE ()) -> ((Sig, Sig) -> [Sig]) -> (Sig, Sig) -> SE ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \(Sig
a, Sig
b) -> [Sig
a, Sig
b]

-- | Dumps signals to file and sends the audio through. Useful to monitor the signals.
dumpWav :: String -> (Sig, Sig) -> SE (Sig, Sig)
dumpWav :: [Char] -> (Sig, Sig) -> SE (Sig, Sig)
dumpWav [Char]
file (Sig, Sig)
asig = [Char] -> (Sig, Sig) -> SE ()
writeWav [Char]
file (Sig, Sig)
asig SE () -> SE (Sig, Sig) -> SE (Sig, Sig)
forall a b. SE a -> SE b -> SE b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Sig, Sig) -> SE (Sig, Sig)
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig, Sig)
asig

-- | Dumps mono signal to file and sends the audio through. Useful to monitor the signals.
dumpWav1 :: String -> Sig -> SE Sig
dumpWav1 :: [Char] -> Sig -> SE Sig
dumpWav1 [Char]
file Sig
asig = [Char] -> (Sig, Sig) -> SE ()
writeWav [Char]
file (Sig
asig, Sig
asig) SE () -> SE Sig -> SE Sig
forall a b. SE a -> SE b -> SE b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sig -> SE Sig
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return Sig
asig

-- | Writes aiff files.
writeAiff :: String -> (Sig, Sig) -> SE ()
writeAiff :: [Char] -> (Sig, Sig) -> SE ()
writeAiff [Char]
file = FormatType -> SampleFormat -> [Char] -> [Sig] -> SE ()
writeSigs FormatType
Aiff SampleFormat
Int16 [Char]
file ([Sig] -> SE ()) -> ((Sig, Sig) -> [Sig]) -> (Sig, Sig) -> SE ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \(Sig
a, Sig
b) -> [Sig
a, Sig
b]

-- | Writes mono signals to wav files.
writeWav1 :: String -> Sig -> SE ()
writeWav1 :: [Char] -> Sig -> SE ()
writeWav1 [Char]
file = [Char] -> (Sig, Sig) -> SE ()
writeWav [Char]
file ((Sig, Sig) -> SE ()) -> (Sig -> (Sig, Sig)) -> Sig -> SE ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \Sig
x -> (Sig
x, Sig
x)

-- | Writes mono signals to aiff files.
writeAiff1 :: String -> Sig -> SE ()
writeAiff1 :: [Char] -> Sig -> SE ()
writeAiff1 [Char]
file = [Char] -> (Sig, Sig) -> SE ()
writeAiff [Char]
file ((Sig, Sig) -> SE ()) -> (Sig -> (Sig, Sig)) -> Sig -> SE ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \Sig
x -> (Sig
x, Sig
x)

-------------------------------------------------------------------------------------
-------------------------------------------------------------------------------------
-- mincer

-- | Mincer. We can playback a table and scale by tempo and pitch.
--
-- > mincer fidelity table pointer pitch
--
-- fidelity is the parameter that specifies the size of the window (for FFT transform).
-- The size equals to formula (fidelity + 11) ^ 2. If you don't know what to choose
-- choose 0 for pitched sounds and -2 for drums. The table contains the sample to playback.
-- The pointer loops over the table. The pitch specifies a scaling factor for pitch.
-- So we can raise tone an octave up by setting the pitch to 2.
ramTab :: Fidelity -> Tab -> Sig -> Sig -> Sig
ramTab :: D -> Tab -> Sig -> Sig -> Sig
ramTab D
winSizePowerOfTwo Tab
tab Sig
aptr Sig
pitch = Sig -> Sig -> Sig -> Tab -> Sig -> Sig
mincer Sig
aptr Sig
1 Sig
pitch Tab
tab Sig
1 Sig -> D -> Sig
forall a. Tuple a => a -> D -> a
`withD` (D
2 D -> D -> D
forall a. Floating a => a -> a -> a
** (D
winSizePowerOfTwo D -> D -> D
forall a. Num a => a -> a -> a
+ D
11))


-- > let x n = mincer2 (Phsr "/home/anton/fox.wav" 0 (stepSeq [0.2, 1, 0.1, 0.5] 0.5) (lpshold [1, 0.8, -1, 0.2] 0.25)) n
-- > dac $ mul 3 $ at (lp18 0.7 800 0.1) $ cfd (slide 0.5 $ usqr 0.2) (x 1) (sum [x $ 6/5, x $ 2])

-- | Creates a pointer signal for reading audio from the table in loops.
--
-- > lphase length start end speed
--
-- Arguments are:
--
-- * length of the table  in seconds
--
-- * start and end points of the reading interval
--
-- * playback speed
lphase :: D -> Sig -> Sig -> Sig -> Sig
lphase :: D -> Sig -> Sig -> Sig -> Sig
lphase D
irefdur Sig
kloopstart Sig
kloopend Sig
kspeed  = Sig
atimpt Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* D -> Sig
sig D
irefdur
    where
        kfqrel :: Sig
kfqrel = Sig
kspeed Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ (Sig
kloopend Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
kloopstart)
        andxrel :: Sig
andxrel = Sig -> Sig
phasor Sig
kfqrel
        atimpt :: Sig
atimpt = Sig
andxrel Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* (Sig
kloopendSig -> Sig -> Sig
forall a. Num a => a -> a -> a
-Sig
kloopstart) Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
kloopstart

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

-- | Looping phasor. It creates a looping pointer to the file.
-- It's used in the function ram.
--
-- Ther arguments are: file name, start and end of the looping segment (in seconds),
-- and the playback speed.
data Phsr = Phsr
    { Phsr -> [Char]
phsrFile  :: String
    , Phsr -> Sig
phsrStart :: Sig
    , Phsr -> Sig
phsrEnd   :: Sig
    , Phsr -> Sig
phsrSpeed :: Sig
    }

-- | Forces phasor to play only once.
phsrOnce :: Phsr -> Phsr
phsrOnce :: Phsr -> Phsr
phsrOnce Phsr
a = Phsr
a { phsrSpeed = phsrSpeed a * linseg [1, dt, 1, 0.01, 0] }
    where dt :: D
dt = Sig -> D
ir (Sig -> D) -> Sig -> D
forall a b. (a -> b) -> a -> b
$ Sig -> Sig
forall a. Num a => a -> a
abs (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ (Phsr -> Sig
phsrEnd Phsr
a Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Phsr -> Sig
phsrStart Phsr
a) Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Phsr -> Sig
phsrSpeed Phsr
a

-- | Reads the file forth and back.
phsrBounce :: Phsr -> Phsr
phsrBounce :: Phsr -> Phsr
phsrBounce Phsr
a = Phsr
a { phsrSpeed = phsrSpeed a * sqr (1 / dt) }
    where dt :: Sig
dt = Sig -> Sig
forall a. Num a => a -> a
abs (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ (Phsr -> Sig
phsrEnd Phsr
a Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Phsr -> Sig
phsrStart Phsr
a) Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Phsr -> Sig
phsrSpeed Phsr
a

-- | Creates a phasor if segments are relative to the total length.
-- It can be useful for drum loops. If we don't know the complete length
-- but we know that loop contains four distinct parts.
relPhsr :: String -> Sig -> Sig -> Sig -> Phsr
relPhsr :: [Char] -> Sig -> Sig -> Sig -> Phsr
relPhsr [Char]
file Sig
start Sig
end Sig
speed = Phsr
    { phsrFile :: [Char]
phsrFile  = [Char]
file
    , phsrStart :: Sig
phsrStart = Sig
start Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* D -> Sig
sig D
len
    , phsrEnd :: Sig
phsrEnd   = Sig
end   Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* D -> Sig
sig D
len
    , phsrSpeed :: Sig
phsrSpeed = Sig
speed }
    where
        len :: D
len = (Str -> D
filelen (Str -> D) -> Str -> D
forall a b. (a -> b) -> a -> b
$ [Char] -> Str
text [Char]
file) D -> D -> D
forall a. Fractional a => a -> a -> a
/ D
srFactor
        srFactor :: D
srFactor = D
getSampleRate D -> D -> D
forall a. Fractional a => a -> a -> a
/ Str -> D
filesr ([Char] -> Str
text [Char]
file)

-- | Creates a phasor for reading the whole audio file  in loops
-- with given speed.
sndPhsr :: String -> Sig -> Phsr
sndPhsr :: [Char] -> Sig -> Phsr
sndPhsr [Char]
file Sig
speed = [Char] -> Sig -> Sig -> Sig -> Phsr
relPhsr [Char]
file Sig
0 Sig
1 Sig
speed

ram1 :: Fidelity -> Phsr -> Sig -> Sig
ram1 :: D -> Phsr -> Sig -> Sig
ram1 = Bool -> Int -> D -> Phsr -> Sig -> Sig
ramChn Bool
True Int
1

-- | Reads audio files in loops. The file is loaded in RAM.
-- The size of the file is limited. It should be not more than 6 minutes
-- for sample rate of 44100. 5.9 minutes for 48000.
--
-- What makes this function so cool is
-- that we can scale the sound by tempo
-- without affecting pitch, and we can scale the sound by pitch
-- without affecting the tempo. Let's study the arguments.
--
-- > ram fidelity phasor pitch
--
-- fidelity corresponds to the size of the FFT-window.
-- The function performs the FFT transform and it has to know the size.
-- It's not the value for the size it's an integer value
-- that proportional to the size. The higher the value the higher the size
-- the lower the value the lower the size. The default value is 0.
-- Zero is best for most of the cases. For drums we can lower it to (-2).
--
-- The phasor is a quadruple of values
--
-- > (Phsr fileName startTime endTime playbackSpeed)
--
-- we can read the file from startTime to endTime (in seconds)
-- and we can set the speed for playback. If speed is negative
-- file is played in reverse. The playback is looped.
-- So to scale the tempo or play in reverse we can change the playbackSpeed.
--
-- The last argument is pitch factor. We can rise by octave with factor 2.
-- It's good place to use the function semitone. It produces factors for a number in semitones.
--
-- Note that all parameters (except window size) are signals.
-- It makes this function very flexible. We can change the speed of playback
-- and start and end of the reading segment as we wish.
--
-- > ram 0 (Phsr "file.wav" 0 1 1.2) 1
--
-- PS: here is the formula for window size: 2 ** (fidelity + 11)
ram :: Fidelity -> Phsr -> Sig -> Sig2
ram :: D -> Phsr -> Sig -> (Sig, Sig)
ram D
winSize Phsr
phsr Sig
pitch = (Bool -> Int -> D -> Phsr -> Sig -> Sig
ramChn Bool
False Int
1 D
winSize Phsr
phsr Sig
pitch, Bool -> Int -> D -> Phsr -> Sig -> Sig
ramChn Bool
False Int
2 D
winSize Phsr
phsr Sig
pitch)

ramChn :: Bool -> Int -> Fidelity -> Phsr -> Sig -> Sig
ramChn :: Bool -> Int -> D -> Phsr -> Sig -> Sig
ramChn Bool
isMono Int
n D
winSize (Phsr [Char]
file Sig
start Sig
end Sig
speed) Sig
pitch =
    BoolSig -> Sig -> Sig -> Sig
forall bool. (bool ~ BooleanOf Sig) => bool -> Sig -> Sig -> Sig
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB (Sig -> Sig
forall a. Num a => a -> a
abs Sig
speed Sig -> Sig -> BooleanOf Sig
forall a. OrdB a => a -> a -> BooleanOf a
`lessThan` Sig
0.001) Sig
0 (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$
        D -> Tab -> Sig -> Sig -> Sig
ramTab D
winSize (Bool -> Int -> [Char] -> Tab
mkTab Bool
isMono Int
n [Char]
file ) (D -> Sig -> Sig -> Sig -> Sig
lphase (Str -> D
filelen (Str -> D) -> Str -> D
forall a b. (a -> b) -> a -> b
$ [Char] -> Str
text [Char]
file) Sig
start Sig
end (Sig
speed Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
srFactor)) (Sig
pitch Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
srFactor)
    where srFactor :: Sig
srFactor = D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ (Str -> D
filesr (Str -> D) -> Str -> D
forall a b. (a -> b) -> a -> b
$ [Char] -> Str
text [Char]
file) D -> D -> D
forall a. Fractional a => a -> a -> a
/ D
getSampleRate

mkTab :: Bool -> Int ->  String -> Tab
mkTab :: Bool -> Int -> [Char] -> Tab
mkTab Bool
isMono Int
chn [Char]
file
    | Bool
mp3 Bool -> Bool -> Bool
&& Bool
isMono    = [Char] -> Double -> Mp3Chn -> Tab
mp3s [Char]
file Double
0 Mp3Chn
Mp3Mono
    | Bool
mp3 Bool -> Bool -> Bool
&& Bool
isStereo  = [Char] -> Double -> Mp3Chn -> Tab
mp3s [Char]
file Double
0 (if Int
chn Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Mp3Chn
Mp3Left else Mp3Chn
Mp3Right)
    | Bool
otherwise        = [Char] -> Double -> WavChn -> Tab
wavs [Char]
file Double
0 (if Int
chn Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then WavChn
WavLeft else WavChn
WavRight)
    where
        mp3 :: Bool
mp3 = [Char] -> Bool
isMp3 [Char]
file
        isStereo :: Bool
isStereo = Bool -> Bool
not Bool
isMono

----------------------------------------
-- std funs

-- | Fidelity corresponds to the size of the FFT-window that is used by functions of RAM-family.
-- The function performs the FFT transform and it has to know the size.
-- It's not the value for the size it's an integer value
-- that proportional to the size. The higher the value the higher the size
-- the lower the value the lower the size. The default value is 0.
-- Zero is best for most of the cases. For drums we can lower it to (-2).
--
-- PS: here is the formula for window size: 2 ** (fidelity + 11).
-- So the fidelity is actually the degree for power of two.
-- The FFT-algorithm requires the window size to be a power of two.
--
-- The lower fidelity is the less power is consumed by the function.
type Fidelity = D

-- | Scaling factor for tempo. The 1 is inherent tempo.
type TempoSig = Sig

-- | Scaling factor for pitch. The 1 is inherent pitch.
type PitchSig = Sig

-- | Reads file once and scales it by tempo and pitch.
readRam :: Fidelity -> TempoSig-> PitchSig -> String -> Sig2
readRam :: D -> Sig -> Sig -> [Char] -> (Sig, Sig)
readRam D
winSize Sig
tempo Sig
pitch [Char]
file = D -> Phsr -> Sig -> (Sig, Sig)
ram D
winSize (Phsr -> Phsr
phsrOnce (Phsr -> Phsr) -> Phsr -> Phsr
forall a b. (a -> b) -> a -> b
$ [Char] -> Sig -> Phsr
sndPhsr [Char]
file Sig
tempo) Sig
pitch

-- | Loop over file and scales it by tempo and pitch (it's based on mincer opcode).
loopRam :: Fidelity -> TempoSig-> PitchSig -> String -> Sig2
loopRam :: D -> Sig -> Sig -> [Char] -> (Sig, Sig)
loopRam D
winSize Sig
tempo Sig
pitch [Char]
file = D -> Phsr -> Sig -> (Sig, Sig)
ram D
winSize ([Char] -> Sig -> Phsr
sndPhsr [Char]
file Sig
tempo) Sig
pitch

-- | Reads a segment from file once and scales it by tempo and pitch.
-- Segment is defined in seconds.
readSeg :: Fidelity -> (Sig, Sig) -> TempoSig-> PitchSig -> String -> Sig2
readSeg :: D -> (Sig, Sig) -> Sig -> Sig -> [Char] -> (Sig, Sig)
readSeg D
winSize (Sig
kmin, Sig
kmax) Sig
tempo Sig
pitch [Char]
file = D -> Phsr -> Sig -> (Sig, Sig)
ram D
winSize (Phsr -> Phsr
phsrOnce (Phsr -> Phsr) -> Phsr -> Phsr
forall a b. (a -> b) -> a -> b
$ [Char] -> Sig -> Sig -> Sig -> Phsr
Phsr [Char]
file Sig
kmin Sig
kmax Sig
tempo) Sig
pitch

-- | Loops over a segment of file and scales it by tempo and pitch.
-- Segment is defined in seconds.
loopSeg :: Fidelity -> (Sig, Sig) -> TempoSig-> PitchSig -> String -> Sig2
loopSeg :: D -> (Sig, Sig) -> Sig -> Sig -> [Char] -> (Sig, Sig)
loopSeg D
winSize (Sig
kmin, Sig
kmax) Sig
tempo Sig
pitch [Char]
file = D -> Phsr -> Sig -> (Sig, Sig)
ram D
winSize ([Char] -> Sig -> Sig -> Sig -> Phsr
Phsr [Char]
file Sig
kmin Sig
kmax Sig
tempo) Sig
pitch

-- | Reads a relative segment from file once and scales it by tempo and pitch.
-- Segment is defined in seconds. The end ponits for the segment are relative to the
-- total length of the file.
readRel :: Fidelity -> (Sig, Sig) -> TempoSig-> PitchSig -> String -> Sig2
readRel :: D -> (Sig, Sig) -> Sig -> Sig -> [Char] -> (Sig, Sig)
readRel D
winSize (Sig
kmin, Sig
kmax) Sig
tempo Sig
pitch [Char]
file = D -> Phsr -> Sig -> (Sig, Sig)
ram D
winSize (Phsr -> Phsr
phsrOnce (Phsr -> Phsr) -> Phsr -> Phsr
forall a b. (a -> b) -> a -> b
$ [Char] -> Sig -> Sig -> Sig -> Phsr
relPhsr [Char]
file Sig
kmin Sig
kmax Sig
tempo) Sig
pitch

-- | Loops over a relative segment of file and scales it by tempo and pitch.
-- Segment is defined in seconds. The end ponits for the segment are relative to the
-- total length of the file.
loopRel :: Fidelity -> (Sig, Sig) -> TempoSig-> PitchSig -> String -> Sig2
loopRel :: D -> (Sig, Sig) -> Sig -> Sig -> [Char] -> (Sig, Sig)
loopRel D
winSize (Sig
kmin, Sig
kmax) Sig
tempo Sig
pitch [Char]
file = D -> Phsr -> Sig -> (Sig, Sig)
ram D
winSize ([Char] -> Sig -> Sig -> Sig -> Phsr
relPhsr [Char]
file Sig
kmin Sig
kmax Sig
tempo) Sig
pitch

-- | The mono version of readRam.
readRam1 :: Fidelity -> TempoSig-> PitchSig -> String -> Sig
readRam1 :: D -> Sig -> Sig -> [Char] -> Sig
readRam1 D
winSize Sig
tempo Sig
pitch [Char]
file = D -> Phsr -> Sig -> Sig
ram1 D
winSize (Phsr -> Phsr
phsrOnce (Phsr -> Phsr) -> Phsr -> Phsr
forall a b. (a -> b) -> a -> b
$ [Char] -> Sig -> Phsr
sndPhsr [Char]
file Sig
tempo) Sig
pitch

-- | The mono version of loopRam.
loopRam1 :: Fidelity -> TempoSig-> PitchSig -> String -> Sig
loopRam1 :: D -> Sig -> Sig -> [Char] -> Sig
loopRam1 D
winSize Sig
tempo Sig
pitch [Char]
file = D -> Phsr -> Sig -> Sig
ram1 D
winSize ([Char] -> Sig -> Phsr
sndPhsr [Char]
file Sig
tempo) Sig
pitch

-- | The mono version of readSeg.
readSeg1 :: Fidelity -> (Sig, Sig) -> TempoSig-> PitchSig -> String -> Sig
readSeg1 :: D -> (Sig, Sig) -> Sig -> Sig -> [Char] -> Sig
readSeg1 D
winSize (Sig
kmin, Sig
kmax) Sig
tempo Sig
pitch [Char]
file = D -> Phsr -> Sig -> Sig
ram1 D
winSize (Phsr -> Phsr
phsrOnce (Phsr -> Phsr) -> Phsr -> Phsr
forall a b. (a -> b) -> a -> b
$ [Char] -> Sig -> Sig -> Sig -> Phsr
Phsr [Char]
file Sig
kmin Sig
kmax Sig
tempo) Sig
pitch

-- | The mono version of loopSeg.
loopSeg1 :: Fidelity -> (Sig, Sig) -> TempoSig-> PitchSig -> String -> Sig
loopSeg1 :: D -> (Sig, Sig) -> Sig -> Sig -> [Char] -> Sig
loopSeg1 D
winSize (Sig
kmin, Sig
kmax) Sig
tempo Sig
pitch [Char]
file = D -> Phsr -> Sig -> Sig
ram1 D
winSize ([Char] -> Sig -> Sig -> Sig -> Phsr
Phsr [Char]
file Sig
kmin Sig
kmax Sig
tempo) Sig
pitch

-- |  The mono version of readRel.
readRel1 :: Fidelity -> (Sig, Sig) -> TempoSig-> PitchSig -> String -> Sig
readRel1 :: D -> (Sig, Sig) -> Sig -> Sig -> [Char] -> Sig
readRel1 D
winSize (Sig
kmin, Sig
kmax) Sig
tempo Sig
pitch [Char]
file = D -> Phsr -> Sig -> Sig
ram1 D
winSize (Phsr -> Phsr
phsrOnce (Phsr -> Phsr) -> Phsr -> Phsr
forall a b. (a -> b) -> a -> b
$ [Char] -> Sig -> Sig -> Sig -> Phsr
relPhsr [Char]
file Sig
kmin Sig
kmax Sig
tempo) Sig
pitch

-- |  The mono version of loopRel.
loopRel1 :: Fidelity -> (Sig, Sig) -> TempoSig-> PitchSig -> String -> Sig
loopRel1 :: D -> (Sig, Sig) -> Sig -> Sig -> [Char] -> Sig
loopRel1 D
winSize (Sig
kmin, Sig
kmax) Sig
tempo Sig
pitch [Char]
file = D -> Phsr -> Sig -> Sig
ram1 D
winSize ([Char] -> Sig -> Sig -> Sig -> Phsr
relPhsr [Char]
file Sig
kmin Sig
kmax Sig
tempo) Sig
pitch

------------------------------------
-- scaling tempo/pitch based on temposcale

-- | ScaleWav function with fidelity set for drum-loops.
scaleDrum :: TempoSig -> PitchSig -> String -> Sig2
scaleDrum :: Sig -> Sig -> [Char] -> (Sig, Sig)
scaleDrum = D -> Sig -> Sig -> [Char] -> (Sig, Sig)
scaleWav (-D
2)

-- | ScaleWav function with fidelity set for hormonical-loops.
scaleHarm :: TempoSig -> PitchSig -> String -> Sig2
scaleHarm :: Sig -> Sig -> [Char] -> (Sig, Sig)
scaleHarm = D -> Sig -> Sig -> [Char] -> (Sig, Sig)
scaleWav D
0

-- | ScaleWav1 function with fidelity set for drum-loops.
scaleDrum1 :: TempoSig -> PitchSig -> String -> Sig
scaleDrum1 :: Sig -> Sig -> [Char] -> Sig
scaleDrum1 = D -> Sig -> Sig -> [Char] -> Sig
scaleWav1 (-D
2)

-- | ScaleWav1 function with fidelity set for hormonical-loops.
scaleHarm1 :: TempoSig -> PitchSig -> String -> Sig
scaleHarm1 :: Sig -> Sig -> [Char] -> Sig
scaleHarm1 = D -> Sig -> Sig -> [Char] -> Sig
scaleWav1 D
0

-- | Scaling mono audio files (accepts both midi and wav). It's based on temposcal Csound opcode.
scaleWav1 :: Fidelity -> TempoSig -> PitchSig -> String -> Sig
scaleWav1 :: D -> Sig -> Sig -> [Char] -> Sig
scaleWav1 D
winSizePowerOfTwo Sig
tempo Sig
pitch [Char]
filename = Tab -> Sig
go (Tab -> Sig) -> Tab -> Sig
forall a b. (a -> b) -> a -> b
$ if Bool
mp3 then [Char] -> Tab
mp3Left [Char]
filename else [Char] -> Tab
wavLeft [Char]
filename
    where
        go :: Tab -> Sig
go = D -> Sig -> Sig -> Tab -> Sig
simpleTempoScale D
winSizePowerOfTwo Sig
tempo Sig
pitch
        mp3 :: Bool
mp3 = [Char] -> Bool
isMp3 [Char]
filename


-- | Scaling stereo audio files (accepts both midi and wav). It's based on temposcal Csound opcode.
scaleWav :: Fidelity -> TempoSig -> PitchSig -> String -> Sig2
scaleWav :: D -> Sig -> Sig -> [Char] -> (Sig, Sig)
scaleWav D
winSizePowerOfTwo Sig
tempo Sig
pitch [Char]
filename = (Tab -> Sig
go (Tab -> Sig) -> Tab -> Sig
forall a b. (a -> b) -> a -> b
$ Bool -> Int -> [Char] -> Tab
mkTab Bool
False Int
0 [Char]
filename, Tab -> Sig
go (Tab -> Sig) -> Tab -> Sig
forall a b. (a -> b) -> a -> b
$ Bool -> Int -> [Char] -> Tab
mkTab Bool
False Int
1 [Char]
filename)
    where go :: Tab -> Sig
go = D -> Sig -> Sig -> Tab -> Sig
simpleTempoScale D
winSizePowerOfTwo Sig
tempo Sig
pitch

simpleTempoScale :: D -> Sig -> Sig -> Tab -> Sig
simpleTempoScale :: D -> Sig -> Sig -> Tab -> Sig
simpleTempoScale D
winSizePowerOfTwo Sig
tempo Sig
pitch Tab
t = Sig -> Sig -> Sig -> Tab -> Sig -> Sig
temposcal Sig
tempo Sig
1 Sig
pitch Tab
t Sig
1 Sig -> D -> Sig
forall a. Tuple a => a -> D -> a
`withD` (D
2 D -> D -> D
forall a. Floating a => a -> a -> a
** (D
winSizePowerOfTwo D -> D -> D
forall a. Num a => a -> a -> a
+ D
11))