Safe Haskell | None |
---|---|
Language | Haskell2010 |
Sound file playback
Synopsis
- readSnd :: String -> (Sig, Sig)
- loopSnd :: String -> (Sig, Sig)
- loopSndBy :: Sig -> String -> (Sig, Sig)
- readWav :: Sig -> String -> (Sig, Sig)
- loopWav :: Sig -> String -> (Sig, Sig)
- readSegWav :: D -> D -> Sig -> String -> (Sig, Sig)
- tempoLoopWav :: Sig -> String -> (Sig, Sig)
- tempoReadWav :: Sig -> String -> (Sig, Sig)
- readSnd1 :: String -> Sig
- loopSnd1 :: String -> Sig
- loopSndBy1 :: Sig -> String -> Sig
- readWav1 :: Sig -> String -> Sig
- loopWav1 :: Sig -> String -> Sig
- readSegWav1 :: D -> D -> Sig -> String -> Sig
- tempoLoopWav1 :: Sig -> String -> Sig
- tempoReadWav1 :: Sig -> String -> Sig
- data LoopMode
- ramSnd :: LoopMode -> Sig -> String -> Sig2
- ramSnd1 :: LoopMode -> Sig -> String -> Sig
- ramTab :: Fidelity -> Tab -> Sig -> Sig -> Sig
- mincer :: Sig -> Sig -> Sig -> Tab -> Sig -> Sig
- temposcal :: Sig -> Sig -> Sig -> Tab -> Sig -> Sig
- data Phsr = Phsr {}
- lphase :: D -> Sig -> Sig -> Sig -> Sig
- relPhsr :: String -> Sig -> Sig -> Sig -> Phsr
- sndPhsr :: String -> Sig -> Phsr
- phsrBounce :: Phsr -> Phsr
- phsrOnce :: Phsr -> Phsr
- ram :: Fidelity -> Phsr -> Sig -> Sig2
- ram1 :: Fidelity -> Phsr -> Sig -> Sig
- type Fidelity = D
- type TempoSig = Sig
- type PitchSig = Sig
- readRam :: Fidelity -> TempoSig -> PitchSig -> String -> Sig2
- loopRam :: Fidelity -> TempoSig -> PitchSig -> String -> Sig2
- readSeg :: Fidelity -> (Sig, Sig) -> TempoSig -> PitchSig -> String -> Sig2
- loopSeg :: Fidelity -> (Sig, Sig) -> TempoSig -> PitchSig -> String -> Sig2
- readRel :: Fidelity -> (Sig, Sig) -> TempoSig -> PitchSig -> String -> Sig2
- loopRel :: Fidelity -> (Sig, Sig) -> TempoSig -> PitchSig -> String -> Sig2
- readRam1 :: Fidelity -> TempoSig -> PitchSig -> String -> Sig
- loopRam1 :: Fidelity -> TempoSig -> PitchSig -> String -> Sig
- readSeg1 :: Fidelity -> (Sig, Sig) -> TempoSig -> PitchSig -> String -> Sig
- loopSeg1 :: Fidelity -> (Sig, Sig) -> TempoSig -> PitchSig -> String -> Sig
- readRel1 :: Fidelity -> (Sig, Sig) -> TempoSig -> PitchSig -> String -> Sig
- loopRel1 :: Fidelity -> (Sig, Sig) -> TempoSig -> PitchSig -> String -> Sig
- scaleDrum :: TempoSig -> PitchSig -> String -> Sig2
- scaleHarm :: TempoSig -> PitchSig -> String -> Sig2
- scaleDrum1 :: TempoSig -> PitchSig -> String -> Sig
- scaleHarm1 :: TempoSig -> PitchSig -> String -> Sig
- scaleWav1 :: Fidelity -> TempoSig -> PitchSig -> String -> Sig
- scaleWav :: Fidelity -> TempoSig -> PitchSig -> String -> Sig2
- data SampleFormat
- writeSigs :: FormatType -> SampleFormat -> String -> [Sig] -> SE ()
- writeWav :: String -> (Sig, Sig) -> SE ()
- writeAiff :: String -> (Sig, Sig) -> SE ()
- writeWav1 :: String -> Sig -> SE ()
- writeAiff1 :: String -> Sig -> SE ()
- dumpWav :: String -> (Sig, Sig) -> SE (Sig, Sig)
- dumpWav1 :: String -> Sig -> SE Sig
- lengthSnd :: String -> D
- segments :: Sig -> Evt (Sco Unit)
- takeSnd :: Sigs a => Sig -> a -> a
- delaySnd :: Sigs a => Sig -> a -> a
- afterSnd :: (Num b, Sigs b) => Sig -> b -> b -> b
- lineSnd :: (Num a, Sigs a) => Sig -> [a] -> a
- loopLineSnd :: (Num a, Sigs a) => Sig -> [a] -> a
- segmentSnd :: Sigs a => Sig -> Sig -> a -> a
- repeatSnd :: Sigs a => Sig -> a -> a
- toMono :: (Sig, Sig) -> Sig
Stereo
readSnd :: String -> (Sig, Sig) Source #
Reads stereo signal from the sound-file (wav or mp3 or aiff).
loopSnd :: String -> (Sig, Sig) Source #
Reads stereo signal from the sound-file (wav or mp3 or aiff) and loops it with the file length.
loopSndBy :: Sig -> String -> (Sig, Sig) Source #
Reads stereo signal from the sound-file (wav or mp3 or aiff) and loops it with the given period (in seconds).
readWav :: Sig -> String -> (Sig, Sig) Source #
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.
tempoLoopWav :: Sig -> String -> (Sig, Sig) Source #
Reads th wav file and loops over it. Scales the tempo with first argument.
tempoReadWav :: Sig -> String -> (Sig, Sig) Source #
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.
Mono
tempoLoopWav1 :: Sig -> String -> Sig Source #
Reads th mono wav file and loops over it. Scales the tempo with first argument.
tempoReadWav1 :: Sig -> String -> Sig Source #
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.
Read sound with RAM
Instances
Enum LoopMode Source # | |
Eq LoopMode Source # | |
Show LoopMode Source # | |
ramSnd :: LoopMode -> Sig -> String -> Sig2 Source #
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.
ramSnd1 :: LoopMode -> Sig -> String -> Sig Source #
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.
ramTab :: Fidelity -> Tab -> Sig -> Sig -> Sig Source #
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.
mincer :: Sig -> Sig -> Sig -> Tab -> Sig -> Sig #
Phase-locked vocoder processing.
mincer implements phase-locked vocoder processing using function tables containing sampled-sound sources, with GEN01, and mincer will accept deferred allocation tables.
asig mincer atimpt, kamp, kpitch, ktab, klock[,ifftsize,idecim]
csound doc: http://csound.com/docs/manual/mincer.html
temposcal :: Sig -> Sig -> Sig -> Tab -> Sig -> Sig #
Phase-locked vocoder processing with onset detection/processing, 'tempo-scaling'.
temposcal implements phase-locked vocoder processing using function tables containing sampled-sound sources, with GEN01, and temposcal will accept deferred allocation tables.
asig temposcal ktimescal, kamp, kpitch, ktab, klock [,ifftsize, idecim, ithresh]
csound doc: http://csound.com/docs/manual/temposcal.html
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.
lphase :: D -> Sig -> Sig -> Sig -> Sig Source #
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
relPhsr :: String -> Sig -> Sig -> Sig -> Phsr Source #
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.
sndPhsr :: String -> Sig -> Phsr Source #
Creates a phasor for reading the whole audio file in loops with given speed.
phsrBounce :: Phsr -> Phsr Source #
Reads the file forth and back.
ram :: Fidelity -> Phsr -> Sig -> Sig2 Source #
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)
Simple audio reading functions (Stereo)
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.
readRam :: Fidelity -> TempoSig -> PitchSig -> String -> Sig2 Source #
Reads file once and scales it by tempo and pitch.
loopRam :: Fidelity -> TempoSig -> PitchSig -> String -> Sig2 Source #
Loop over file and scales it by tempo and pitch (it's based on mincer opcode).
readSeg :: Fidelity -> (Sig, Sig) -> TempoSig -> PitchSig -> String -> Sig2 Source #
Reads a segment from file once and scales it by tempo and pitch. Segment is defined in seconds.
loopSeg :: Fidelity -> (Sig, Sig) -> TempoSig -> PitchSig -> String -> Sig2 Source #
Loops over a segment of file and scales it by tempo and pitch. Segment is defined in seconds.
readRel :: Fidelity -> (Sig, Sig) -> TempoSig -> PitchSig -> String -> Sig2 Source #
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.
loopRel :: Fidelity -> (Sig, Sig) -> TempoSig -> PitchSig -> String -> Sig2 Source #
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.
Simple audio reading functions (Mono)
readSeg1 :: Fidelity -> (Sig, Sig) -> TempoSig -> PitchSig -> String -> Sig Source #
The mono version of readSeg.
loopSeg1 :: Fidelity -> (Sig, Sig) -> TempoSig -> PitchSig -> String -> Sig Source #
The mono version of loopSeg.
readRel1 :: Fidelity -> (Sig, Sig) -> TempoSig -> PitchSig -> String -> Sig Source #
The mono version of readRel.
loopRel1 :: Fidelity -> (Sig, Sig) -> TempoSig -> PitchSig -> String -> Sig Source #
The mono version of loopRel.
Scaling audio files
scaleDrum :: TempoSig -> PitchSig -> String -> Sig2 Source #
ScaleWav function with fidelity set for drum-loops.
scaleHarm :: TempoSig -> PitchSig -> String -> Sig2 Source #
ScaleWav function with fidelity set for hormonical-loops.
scaleDrum1 :: TempoSig -> PitchSig -> String -> Sig Source #
ScaleWav1 function with fidelity set for drum-loops.
scaleHarm1 :: TempoSig -> PitchSig -> String -> Sig Source #
ScaleWav1 function with fidelity set for hormonical-loops.
scaleWav1 :: Fidelity -> TempoSig -> PitchSig -> String -> Sig Source #
Scaling mono audio files (accepts both midi and wav). It's based on temposcal Csound opcode.
scaleWav :: Fidelity -> TempoSig -> PitchSig -> String -> Sig2 Source #
Scaling stereo audio files (accepts both midi and wav). It's based on temposcal Csound opcode.
Writing sound files
data SampleFormat Source #
The sample format.
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 |
Instances
Enum SampleFormat Source # | |
Defined in Csound.Air.Wav succ :: SampleFormat -> SampleFormat # pred :: SampleFormat -> SampleFormat # toEnum :: Int -> SampleFormat # fromEnum :: SampleFormat -> Int # enumFrom :: SampleFormat -> [SampleFormat] # enumFromThen :: SampleFormat -> SampleFormat -> [SampleFormat] # enumFromTo :: SampleFormat -> SampleFormat -> [SampleFormat] # enumFromThenTo :: SampleFormat -> SampleFormat -> SampleFormat -> [SampleFormat] # | |
Eq SampleFormat Source # | |
Defined in Csound.Air.Wav (==) :: SampleFormat -> SampleFormat -> Bool # (/=) :: SampleFormat -> SampleFormat -> Bool # | |
Ord SampleFormat Source # | |
Defined in Csound.Air.Wav compare :: SampleFormat -> SampleFormat -> Ordering # (<) :: SampleFormat -> SampleFormat -> Bool # (<=) :: SampleFormat -> SampleFormat -> Bool # (>) :: SampleFormat -> SampleFormat -> Bool # (>=) :: SampleFormat -> SampleFormat -> Bool # max :: SampleFormat -> SampleFormat -> SampleFormat # min :: SampleFormat -> SampleFormat -> SampleFormat # |
writeSigs :: FormatType -> SampleFormat -> String -> [Sig] -> SE () Source #
Writes a sound signal to the file with the given format. It supports only four formats: Wav, Aiff, Raw and Ircam.
dumpWav :: String -> (Sig, Sig) -> SE (Sig, Sig) Source #
Dumps signals to file and sends the audio through. Useful to monitor the signals.
dumpWav1 :: String -> Sig -> SE Sig Source #
Dumps mono signal to file and sends the audio through. Useful to monitor the signals.
Utility
segments :: Sig -> Evt (Sco Unit) Source #
Produces repeating segments with the given time in seconds.
Signal manipulation
takeSnd :: Sigs a => Sig -> a -> a Source #
Takes only given amount (in seconds) from the signal (the rest is silence).
afterSnd :: (Num b, Sigs b) => Sig -> b -> b -> b Source #
Plays the first signal for some time (in seconds) and then switches to the next one.
afterSnd dur sig1 sig2
lineSnd :: (Num a, Sigs a) => Sig -> [a] -> a Source #
Creates a sequence of signals. Each segment lasts for fixed amount of time given in the first argument.
loopLineSnd :: (Num a, Sigs a) => Sig -> [a] -> a Source #
Creates a sequence of signals and loops over the sequence. Each segment lasts for fixed amount of time given in the first argument.