diff --git a/csound-expression.cabal b/csound-expression.cabal --- a/csound-expression.cabal +++ b/csound-expression.cabal @@ -1,5 +1,5 @@ Name: csound-expression -Version: 4.0.0 +Version: 4.1.0 Cabal-Version: >= 1.6 License: BSD3 License-file: LICENSE @@ -67,7 +67,7 @@ Ghc-Options: -Wall Build-Depends: base >= 4, base < 5, process, data-default, Boolean >= 0.1.0, - csound-expression-typed >= 0.0.5.3, csound-expression-opcodes + csound-expression-typed >= 0.0.5.4, csound-expression-opcodes >= 0.0.1 Hs-Source-Dirs: src/ Exposed-Modules: Csound.Base @@ -84,6 +84,11 @@ Csound.Control.Evt Csound.Control.Instr Csound.Control.SE + + Csound.Control.Midi + Csound.Control.Sf + Csound.Control.Osc + Csound.Control.Channel Csound.Control.Gui Csound.Control.Gui.Widget diff --git a/src/Csound/Air.hs b/src/Csound/Air.hs --- a/src/Csound/Air.hs +++ b/src/Csound/Air.hs @@ -40,15 +40,23 @@ mlp, -- * Sound files playback - + -- ** Stereo readSnd, loopSnd, loopSndBy, - readWav, loopWav, + readWav, loopWav, readSegWav, + tempoLoopWav, tempoReadWav, -- ** Mono readSnd1, loopSnd1, loopSndBy1, - readWav1, loopWav1, + 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, + -- * Writing sound files SampleFormat(..), writeSigs, writeWav, writeAiff, writeWav1, writeAiff1, @@ -108,7 +116,9 @@ import Csound.Control.Evt(metroE, eventList) import Csound.Control.Instr(withDur, sched) -import Csound.Tab(sine, sines4) +import Csound.Types(Sig2) +import Csound.Tab(sine, sines4, mp3s, wavs) +import Csound.SigSpace(mapSig) ------------------------------------------------------------------- -- waveforms @@ -453,6 +463,19 @@ loopWav :: Sig -> String -> (Sig, Sig) loopWav speed fileName = flip withDs [0, 1] $ ar2 $ diskin2 (text fileName) speed +-- | Reads a segment from wav file. +readSegWav :: D -> D -> Sig -> String -> (Sig, Sig) +readSegWav start end speed fileName = takeSnd (end - start) $ diskin2 (text fileName) speed `withDs` [start, 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 speed fileName = mapSig (scaleSpec (1 / abs speed)) $ diskin2 (text fileName) speed + +-- | Reads th wav file and loops over it. Scales the tempo with first argument. +tempoLoopWav :: Sig -> String -> (Sig, Sig) +tempoLoopWav speed fileName = mapSig (scaleSpec (1 / abs speed)) $ flip withDs [0, 1] $ ar2 $ diskin2 (text fileName) speed + -- Mono -- | The mono variant of the function @readSnd@. @@ -477,7 +500,39 @@ loopWav1 :: Sig -> String -> Sig loopWav1 speed fileName = flip withDs [0, 1] $ diskin2 (text fileName) speed +-- | Reads a segment from wav file. +readSegWav1 :: D -> D -> Sig -> String -> Sig +readSegWav1 start end speed fileName = takeSnd (end - start) $ diskin2 (text fileName) speed `withDs` [start, 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 speed fileName = scaleSpec (1 / abs speed) $ readWav1 speed fileName + +-- | Reads th mono wav file and loops over it. Scales the tempo with first argument. +tempoLoopWav1 :: Sig -> String -> Sig +tempoLoopWav1 speed fileName = scaleSpec (1 / abs speed) $ loopWav1 speed fileName + -------------------------------------------------------------------------- +-- With RAM + +data LoopMode = Once | Loop | Bounce + deriving (Show, Eq, Enum) + +-- | 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 +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 + | otherwise = wavs file 0 0 + +ramSnd1 :: LoopMode -> Sig -> String -> Sig +ramSnd1 loopMode speed file + | isMp3 file = (\(aleft, aright) -> 0.5 * (aleft + aright)) $ loscil3 1 speed (mp3s file 0) `withDs` [1, int $ fromEnum loopMode] + | otherwise = loscil3 1 speed (wavs file 0 1) `withDs` [1, int $ fromEnum loopMode] + +-------------------------------------------------------------------------- -- writing sound files -- | The sample format. @@ -790,8 +845,8 @@ -- | Mono reverb (based on reverbsc) -- -- > rever2 feedback asigLeft asigRight -rever2 :: Sig -> Sig -> Sig -> (Sig, Sig) -rever2 fbk a1 a2 = (a1 + wa1, a2 + wa2) +rever2 :: Sig -> Sig2 -> Sig2 +rever2 fbk (a1, a2) = (a1 + wa1, a2 + wa2) where (wa1, wa2) = reverbsc a1 a2 fbk 12000 -- | Mono reverb for small room. @@ -811,19 +866,19 @@ magicCave = rever1 0.99 -- | Stereo reverb for small room. -smallRoom2 :: Sig -> Sig -> (Sig, Sig) +smallRoom2 :: Sig2 -> Sig2 smallRoom2 = rever2 0.6 -- | Stereo reverb for small hall. -smallHall2 :: Sig -> Sig -> (Sig, Sig) +smallHall2 :: Sig2 -> Sig2 smallHall2 = rever2 0.8 -- | Stereo reverb for large hall. -largeHall2 :: Sig -> Sig -> (Sig, Sig) +largeHall2 :: Sig2 -> Sig2 largeHall2 = rever2 0.9 -- | The magic cave reverb (stereo). -magicCave2 :: Sig -> Sig -> (Sig, Sig) +magicCave2 :: Sig2 -> Sig2 magicCave2 = rever2 0.99 -- Delays diff --git a/src/Csound/Control.hs b/src/Csound/Control.hs --- a/src/Csound/Control.hs +++ b/src/Csound/Control.hs @@ -8,11 +8,22 @@ -- | Handy functions to arrange the event streams (periodic and random). module Csound.Control.Evt, -- * Instruments - -- | Invoking the instruments + -- | Invoking the instruments. module Csound.Control.Instr, -- * Gui - -- | Interactive controllers - module Csound.Control.Gui + -- | Interactive controllers. + module Csound.Control.Gui, + -- * Midi + -- | Interface with Midi. + module Csound.Control.Midi, + -- | Playing Sf2 samples. + module Csound.Control.Sf, + -- * Osc + -- | Interface with Osc. + module Csound.Control.Osc, + -- * Channels + -- | Interface with named channels. + module Csound.Control.Channel ) where import Csound.Control.SE @@ -20,4 +31,8 @@ import Csound.Control.Instr import Csound.Control.Gui +import Csound.Control.Midi +import Csound.Control.Sf +import Csound.Control.Osc +import Csound.Control.Channel diff --git a/src/Csound/Control/Channel.hs b/src/Csound/Control/Channel.hs new file mode 100644 --- /dev/null +++ b/src/Csound/Control/Channel.hs @@ -0,0 +1,20 @@ +-- | Named channels. +-- +-- With named channels we can read and +-- write values to the variables with dynamic names. +-- We can specify the variable with string (Str). +-- +-- Csound has an C api wich is ported to many languages. +-- With named channels we can interact with csound +-- that runns a program. We can read and write to named channels +-- from another program. +module Csound.Control.Channel( + -- * Getters + chnGetD, chnGetSig, chnGetCtrl, chnGetStr, + + -- * Setters + chnSetD, chnSetSig, chnSetCtrl, chnSetStr +) where + +import Csound.Typed + diff --git a/src/Csound/Control/Evt.hs b/src/Csound/Control/Evt.hs --- a/src/Csound/Control/Evt.hs +++ b/src/Csound/Control/Evt.hs @@ -16,7 +16,7 @@ cycleE, iterateE, repeatE, appendE, mappendE, partitionE, splitToggle, Rnds, oneOf, freqOf, freqAccum, - randDs, randInts, randSkip, randSkipBy, + randDs, randList, randInts, randSkip, randSkipBy, range, listAt, every, masked ) where @@ -28,6 +28,7 @@ import Csound.Typed import Csound.Typed.Opcode +import Csound.Types(atArg) -- | Constant event stream. It produces the same value (the first argument) -- all the time. @@ -99,9 +100,6 @@ within x = (x >=* 0) &&* (x <* len) len = int $ length vals -atArg :: (Tuple a, Arg a) => [a] -> D -> a -atArg as ind = guardedArg (zip (fmap (\x -> int x ==* ind) [0 .. ]) as) (head as) - -- | -- -- > range (xMin, xMax) === cycleE [xMin .. pred xMax] @@ -116,6 +114,12 @@ -- | An event stream of the random values in the interval @(0, 1)@. randDs :: Evt b -> Evt D randDs = accumSE (0 :: D) $ const $ \s -> fmap (, s) $ fmap readSnap $ random (0::D) 1 + +-- | An event stram of lists of random values in the interval @(0, 1)@. +-- The first argument is the length of the each list. +randList :: Int -> Evt b -> Evt [D] +randList n = accumSE (0 :: D) $ const $ \s -> fmap (, s) $ + sequence $ replicate n $ fmap readSnap $ random (0::D) 1 -- | Skips elements at random. -- diff --git a/src/Csound/Control/Instr.hs b/src/Csound/Control/Instr.hs --- a/src/Csound/Control/Instr.hs +++ b/src/Csound/Control/Instr.hs @@ -14,7 +14,7 @@ -- -- * Trigger an instrument with event stream (@Evt@-section). -- --- * By using midi-instruments (@Midi@-section). +-- * By using midi-instruments (see @Csound.Control.Midi@). -- -- Sometimes we don't want to produce any sound. Our instrument is just -- a procedure that makes something useful without being noisy about it. @@ -75,18 +75,7 @@ -- way down the Score-structure. CsdSco(..), Mix, sco, mix, eff, CsdEventList(..), CsdEvent, mixLoop, sco_, mix_, mixLoop_, mixBy, - - -- * Midi - Msg, Channel, midi, midin, pgmidi, ampCps, - midi_, midin_, pgmidi_, - -- ** Mono-midi synth - monoMsg, holdMsg, monoMsgn, holdMsgn, pgmonoMsg, pgholdMsg, - -- ** Reading midi note parameters - cpsmidi, ampmidi, initc7, ctrl7, midiCtrl7, midiCtrl, umidiCtrl, - -- * OSC - initOsc, listenOsc, sendOsc, - -- * Evt -- ** Singlular @@ -103,24 +92,15 @@ -- * Overload -- | Converters to make it easier a construction of the instruments. - Outs(..), onArg, MidiInstr(..), AmpInstr(..), CpsInstr(..) + Outs(..), onArg, AmpInstr(..), CpsInstr(..) ) where -import Data.Boolean - import Csound.Typed -import Csound.Typed.Opcode hiding (initc7, oscInit, oscListen, oscSend) +import Csound.Typed.Opcode hiding (initc7) import Csound.Control.Overload import Csound.Control.Evt(metroE, repeatE, splitToggle) --------------------------------------------------------------------------- --- midi - -ampCps :: Msg -> (D, D) -ampCps msg = (ampmidi msg 1, cpsmidi msg) - - -- | Mixes the scores and plays them in the loop. mixLoop :: (CsdSco f, Sigs a) => f (Mix a) -> a mixLoop a = sched instr $ withDur dur $ repeatE unit $ metroE $ sig $ 1 / dur @@ -235,129 +215,4 @@ -- | A closure to trigger an instrument inside the body of another instrument. schedHarpBy :: (Arg a, Sigs b, Arg c) => D -> (a -> SE b) -> (c -> Evt a) -> c -> b schedHarpBy dt f = fromPluralBy $ schedHarpsBy dt f - ------------------------------------------------------------------------ --- Midi addons - --- mono midi - --- | Produces midi amplitude and frequency as a signal. --- The signal fades out when nothing is pressed. --- It can be used in mono-synths. Arguments are portamento time --- and release time. A portamento time is time it takes for transition --- from one note to another. --- --- > monoMsg portamentoTime releaseTime -monoMsg :: D -> D -> SE (Sig, Sig) -monoMsg portTime relTime = do - (amp, cps, status) <- genAmpCpsSig midi - return (port amp portTime * port status relTime, port cps portTime) - --- | Produces midi amplitude and frequency as a signal and holds the --- last value till the next one is present. --- It can be used in mono-synths. Arguments are portamento time --- and release time. A portamento time is time it takes for transition --- from one note to another. --- --- > holdMsg portamentoTime -holdMsg :: D -> SE (Sig, Sig) -holdMsg portTime = do - (amp, cps) <- genHoldAmpCpsSig midi_ - return (port amp portTime, port cps portTime) - - --- | Produces midi amplitude and frequency as a signal. --- The signal fades out when nothing is pressed. We can specify a channel. --- It can be used in mono-synths. Arguments are portamento time --- and release time. A portamento time is time it takes for transition --- from one note to another. --- --- > monoMsgn chnNumber portamentoTime releaseTime -monoMsgn :: Channel -> D -> D -> SE (Sig, Sig) -monoMsgn n portTime relTime = do - (amp, cps, status) <- genAmpCpsSig (midin n) - return (port amp portTime * port status relTime, port cps portTime) - --- | Produces midi amplitude and frequency as a signal and holds the --- last value till the next one is present. We can specify a channel. --- It can be used in mono-synths. Arguments are portamento time --- and release time. A portamento time is time it takes for transition --- from one note to another. --- --- > holdMsgn chnNumber portamentoTime -holdMsgn :: Channel -> D -> SE (Sig, Sig) -holdMsgn n portTime = do - (amp, cps) <- genHoldAmpCpsSig (midin_ n) - return (port amp portTime, port cps portTime) - - --- | Produces midi amplitude and frequency as a signal. --- The signal fades out when nothing is pressed. We can specify a programm number and channel. --- It can be used in mono-synths. Arguments are portamento time --- and release time. A portamento time is time it takes for transition --- from one note to another. --- --- > pgmonoMsg chnNumber portamentoTime releaseTime -pgmonoMsg :: Maybe Int -> Channel -> D -> D -> SE (Sig, Sig) -pgmonoMsg pg n portTime relTime = do - (amp, cps, status) <- genAmpCpsSig (pgmidi pg n) - return (port amp portTime * port status relTime, port cps portTime) - --- | Produces midi amplitude and frequency as a signal and holds the --- last value till the next one is present. We can specify a programm number and channel. --- It can be used in mono-synths. Arguments are portamento time --- and release time. A portamento time is time it takes for transition --- from one note to another. --- --- > pgholdMsg portamentoTime -pgholdMsg :: Maybe Int -> Channel -> D -> SE (Sig, Sig) -pgholdMsg pg n portTime = do - (amp, cps) <- genHoldAmpCpsSig (pgmidi_ pg n) - return (port amp portTime, port cps portTime) - - -genAmpCpsSig :: ((Msg -> SE Sig) -> Sig) -> SE (Sig, Sig, Sig) -genAmpCpsSig midiFun = do - ref <- newGlobalSERef ((0, 0) :: (Sig, Sig)) - let status = midiFun (instr ref) - let resStatus = ifB (downsamp status ==* 0) 0 1 - (amp, cps) <- readSERef ref - return (downsamp amp, downsamp cps, resStatus) - where - instr :: SERef (Sig, Sig) -> Msg -> SE Sig - instr hNote msg = do - writeSERef hNote (sig $ ampmidi msg 1, sig $ cpsmidi msg) - return 1 - -genHoldAmpCpsSig :: ((Msg -> SE ()) -> SE ()) -> SE (Sig, Sig) -genHoldAmpCpsSig midiFun = do - ref <- newGlobalSERef ((0, 0) :: (Sig, Sig)) - midiFun (instr ref) - (amp, cps) <- readSERef ref - return (downsamp amp, downsamp cps) - where - instr :: SERef (Sig, Sig) -> Msg -> SE () - instr hNote msg = do - writeSERef hNote (sig $ ampmidi msg 1, sig $ cpsmidi msg) - --------------------------------------------------------------- - --- | Initialization of the midi control-messages. -initc7 :: D -> D -> D -> SE () -initc7 = initMidiCtrl - --- | Initializes midi control and get the value in the specified range. -midiCtrl7 :: D -> D -> D -> D -> D -> SE Sig -midiCtrl7 chno ctrlno ival imin imax = do - initc7 chno ctrlno ival - return $ ctrl7 chno ctrlno imin imax - --- | Initializes midi control and get the value in the range (-1) to 1. -midiCtrl :: D -> D -> D -> SE Sig -midiCtrl chno ctrlno ival = midiCtrl7 chno ctrlno ival (-1) 1 - --- | Unipolar midiCtrl. Initializes midi control and get the value in the range 0 to 1. -umidiCtrl :: D -> D -> D -> SE Sig -umidiCtrl chno ctrlno ival = midiCtrl7 chno ctrlno ival (-1) 1 - diff --git a/src/Csound/Control/Midi.hs b/src/Csound/Control/Midi.hs new file mode 100644 --- /dev/null +++ b/src/Csound/Control/Midi.hs @@ -0,0 +1,145 @@ +-- | Midi. +module Csound.Control.Midi( + Msg, Channel, midi, midin, pgmidi, ampCps, + midi_, midin_, pgmidi_, + -- * Mono-midi synth + monoMsg, holdMsg, monoMsgn, holdMsgn, pgmonoMsg, pgholdMsg, + -- * Reading midi note parameters + cpsmidi, ampmidi, initc7, ctrl7, midiCtrl7, midiCtrl, umidiCtrl, + -- * Overload + MidiInstr(..) +) where + +import Data.Boolean + +import Csound.Typed +import Csound.Typed.Opcode hiding (initc7) +import Csound.Control.Overload + +ampCps :: Msg -> (D, D) +ampCps msg = (ampmidi msg 1, cpsmidi msg) + +----------------------------------------------------------------------- +-- Midi addons + +-- mono midi + +-- | Produces midi amplitude and frequency as a signal. +-- The signal fades out when nothing is pressed. +-- It can be used in mono-synths. Arguments are portamento time +-- and release time. A portamento time is time it takes for transition +-- from one note to another. +-- +-- > monoMsg portamentoTime releaseTime +monoMsg :: D -> D -> SE (Sig, Sig) +monoMsg portTime relTime = do + (amp, cps, status) <- genAmpCpsSig midi + return (port amp portTime * port status relTime, port cps portTime) + +-- | Produces midi amplitude and frequency as a signal and holds the +-- last value till the next one is present. +-- It can be used in mono-synths. Arguments are portamento time +-- and release time. A portamento time is time it takes for transition +-- from one note to another. +-- +-- > holdMsg portamentoTime +holdMsg :: D -> SE (Sig, Sig) +holdMsg portTime = do + (amp, cps) <- genHoldAmpCpsSig midi_ + return (port amp portTime, port cps portTime) + + +-- | Produces midi amplitude and frequency as a signal. +-- The signal fades out when nothing is pressed. We can specify a channel. +-- It can be used in mono-synths. Arguments are portamento time +-- and release time. A portamento time is time it takes for transition +-- from one note to another. +-- +-- > monoMsgn chnNumber portamentoTime releaseTime +monoMsgn :: Channel -> D -> D -> SE (Sig, Sig) +monoMsgn n portTime relTime = do + (amp, cps, status) <- genAmpCpsSig (midin n) + return (port amp portTime * port status relTime, port cps portTime) + +-- | Produces midi amplitude and frequency as a signal and holds the +-- last value till the next one is present. We can specify a channel. +-- It can be used in mono-synths. Arguments are portamento time +-- and release time. A portamento time is time it takes for transition +-- from one note to another. +-- +-- > holdMsgn chnNumber portamentoTime +holdMsgn :: Channel -> D -> SE (Sig, Sig) +holdMsgn n portTime = do + (amp, cps) <- genHoldAmpCpsSig (midin_ n) + return (port amp portTime, port cps portTime) + + +-- | Produces midi amplitude and frequency as a signal. +-- The signal fades out when nothing is pressed. We can specify a programm number and channel. +-- It can be used in mono-synths. Arguments are portamento time +-- and release time. A portamento time is time it takes for transition +-- from one note to another. +-- +-- > pgmonoMsg chnNumber portamentoTime releaseTime +pgmonoMsg :: Maybe Int -> Channel -> D -> D -> SE (Sig, Sig) +pgmonoMsg pg n portTime relTime = do + (amp, cps, status) <- genAmpCpsSig (pgmidi pg n) + return (port amp portTime * port status relTime, port cps portTime) + +-- | Produces midi amplitude and frequency as a signal and holds the +-- last value till the next one is present. We can specify a programm number and channel. +-- It can be used in mono-synths. Arguments are portamento time +-- and release time. A portamento time is time it takes for transition +-- from one note to another. +-- +-- > pgholdMsg portamentoTime +pgholdMsg :: Maybe Int -> Channel -> D -> SE (Sig, Sig) +pgholdMsg pg n portTime = do + (amp, cps) <- genHoldAmpCpsSig (pgmidi_ pg n) + return (port amp portTime, port cps portTime) + + +genAmpCpsSig :: ((Msg -> SE Sig) -> Sig) -> SE (Sig, Sig, Sig) +genAmpCpsSig midiFun = do + ref <- newGlobalSERef ((0, 0) :: (Sig, Sig)) + let status = midiFun (instr ref) + let resStatus = ifB (downsamp status ==* 0) 0 1 + (amp, cps) <- readSERef ref + return (downsamp amp, downsamp cps, resStatus) + where + instr :: SERef (Sig, Sig) -> Msg -> SE Sig + instr hNote msg = do + writeSERef hNote (sig $ ampmidi msg 1, sig $ cpsmidi msg) + return 1 + +genHoldAmpCpsSig :: ((Msg -> SE ()) -> SE ()) -> SE (Sig, Sig) +genHoldAmpCpsSig midiFun = do + ref <- newGlobalSERef ((0, 0) :: (Sig, Sig)) + midiFun (instr ref) + (amp, cps) <- readSERef ref + return (downsamp amp, downsamp cps) + where + instr :: SERef (Sig, Sig) -> Msg -> SE () + instr hNote msg = do + writeSERef hNote (sig $ ampmidi msg 1, sig $ cpsmidi msg) + +-------------------------------------------------------------- + +-- | Initialization of the midi control-messages. +initc7 :: D -> D -> D -> SE () +initc7 = initMidiCtrl + +-- | Initializes midi control and get the value in the specified range. +midiCtrl7 :: D -> D -> D -> D -> D -> SE Sig +midiCtrl7 chno ctrlno ival imin imax = do + initc7 chno ctrlno ival + return $ ctrl7 chno ctrlno imin imax + +-- | Initializes midi control and get the value in the range (-1) to 1. +midiCtrl :: D -> D -> D -> SE Sig +midiCtrl chno ctrlno ival = midiCtrl7 chno ctrlno ival (-1) 1 + +-- | Unipolar midiCtrl. Initializes midi control and get the value in the range 0 to 1. +umidiCtrl :: D -> D -> D -> SE Sig +umidiCtrl chno ctrlno ival = midiCtrl7 chno ctrlno ival (-1) 1 + diff --git a/src/Csound/Control/Osc.hs b/src/Csound/Control/Osc.hs new file mode 100644 --- /dev/null +++ b/src/Csound/Control/Osc.hs @@ -0,0 +1,7 @@ +-- | Open Sound Control. +module Csound.Control.Osc( + initOsc, listenOsc, sendOsc +) where + +import Csound.Typed + diff --git a/src/Csound/Control/Sf.hs b/src/Csound/Control/Sf.hs new file mode 100644 --- /dev/null +++ b/src/Csound/Control/Sf.hs @@ -0,0 +1,152 @@ +-- | Sound fonts. Playing Sf2 samples. +-- +-- There are three groups of functions. +-- Functions that are defined for midi messages, midi notes (it's a pair of integers from 0-127) +-- and the frequencies (in Hz). +-- Each group contains four functions. They are destinguished by suffixes. +-- The function with no suffix play a sf2 file with linear interpolation +-- and take stereo output. +-- The function with suffix @3@ read samples with cubic interpolation. +-- The functions with suffix @m@ produce mono outputs. +-- The loopers play samples in loops. +module Csound.Control.Sf( + Sf(Sf), sf2, + -- * Midi message + sfMsg, sfMsg3, sfMsgm, sfMsg3m, sfMsgLooper, + -- * Midi note + sfKey, sfKey3, sfKeym, sfKey3m, sfKeyLooper, + -- * Frequency in Hz + sfCps, sfCps3, sfCpsm, sfCps3m, sfCpsLooper +) where + +import Csound.Typed +import Csound.Typed.Opcode +import Csound.SigSpace + +-- | Creates a midi instrument from sf2 sound font. +-- Midi listens on all channels. It's useful to quickly +-- test a sound font. The second argument is a sustain in seconds. +-- How long it takes for the sound to decay. +sf2 :: Sf -> D -> (Sig, Sig) +sf2 sf sust = midi $ sfMsg3 sf sust + +----------------------------------- + +-- | Creates a midi instrument from sf2 sound font file. +-- The second argument is sustain in seconds. +-- Reads samples with linear interpolation. +sfMsg :: Sf -> D -> Msg -> SE (Sig, Sig) +sfMsg = genSfMsg sfplay + +-- | Creates a midi instrument from sf2 sound font file. +-- The second argument is sustain in seconds. +-- Reads samples with cubic interpolation. +sfMsg3 :: Sf -> D -> Msg -> SE (Sig, Sig) +sfMsg3 = genSfMsg sfplay3 + +-- | Creates a midi instrument from sf2 sound font file. +-- The second argument is sustain in seconds. +-- Reads samples with linear interpolation. +-- Produces mono output. +sfMsgm :: Sf -> D -> Msg -> SE Sig +sfMsgm = genSfMsg sfplaym + +-- | Creates a midi instrument from sf2 sound font file. +-- The second argument is sustain in seconds. +-- Reads samples with cubic interpolation. +-- Produces mono output. +sfMsg3m :: Sf -> D -> Msg -> SE Sig +sfMsg3m = genSfMsg sfplay3m + +-- | Midi looper of the sf2 samples. +-- The first arguments are: start, end, crossfade of the loop. +sfMsgLooper :: Sig -> Sig -> Sig -> Sf -> D -> Msg -> SE (Sig, Sig) +sfMsgLooper start end crossfade = genSfMsg $ + \vel key amp cps sf -> sflooper vel key amp cps sf start end crossfade + +----------------------------------------- + +-- | Reads sf2 samples at given midi velocity and key (both are from 0 to 127). +-- The second argument is sustain. Interpolation is linear. +sfKey :: Sf -> D -> D -> D -> (Sig, Sig) +sfKey = genSfKey sfplay + +-- | Reads sf2 samples at given midi velocity and key (both are from 0 to 127). +-- The second argument is sustain. Interpolation is cubic. +sfKey3 :: Sf -> D -> D -> D -> (Sig, Sig) +sfKey3 = genSfKey sfplay3 + +-- | Reads sf2 samples at given midi velocity and key (both are from 0 to 127). +-- The second argument is sustain. Interpolation is linear. +-- The output is mono. +sfKeym :: Sf -> D -> D -> D -> Sig +sfKeym = genSfKey sfplaym + +-- | Reads sf2 samples at given midi velocity and key (both are from 0 to 127). +-- The second argument is sustain. Interpolation is cubic. +-- The output is mono. +sfKey3m :: Sf -> D -> D -> D -> Sig +sfKey3m = genSfKey sfplay3m + +-- | Looper of the sf2 samples. +-- The first arguments are: start, end, crossfade of the loop. +sfKeyLooper :: Sig -> Sig -> Sig -> Sf -> D -> D -> D -> (Sig, Sig) +sfKeyLooper start end crossfade = genSfKey $ + \vel key amp cps sf -> sflooper vel key amp cps sf start end crossfade + +----------------------------------------- + +-- | Reads sf2 samples with amplitude in (0, 1) and frequency in Hz. +-- The interpolation is linear. +sfCps :: Sf -> D -> D -> D -> (Sig, Sig) +sfCps = genSfCps sfplay + +-- | Reads sf2 samples with amplitude in (0, 1) and frequency in Hz. +-- The interpolation is cubic. +sfCps3 :: Sf -> D -> D -> D -> (Sig, Sig) +sfCps3 = genSfCps sfplay3 + +-- | Reads sf2 samples with amplitude in (0, 1) and frequency in Hz. +-- The interpolation is linear. +-- The output is mono. +sfCpsm :: Sf -> D -> D -> D -> Sig +sfCpsm = genSfCps sfplaym + +-- | Reads sf2 samples with amplitude in (0, 1) and frequency in Hz. +-- The interpolation is cubic. +-- The output is mono. +sfCps3m :: Sf -> D -> D -> D -> Sig +sfCps3m = genSfCps sfplay3m + +-- | Looper of the sf2 samples. +-- The first arguments are: start, end, crossfade of the loop. +sfCpsLooper :: Sig -> Sig -> Sig -> Sf -> D -> D -> D -> (Sig, Sig) +sfCpsLooper start end crossfade = genSfCps $ + \vel key amp cps sf -> sflooper vel key amp cps sf start end crossfade + +---------------------------------------------- + +type SfFun a = D -> D -> Sig -> Sig -> Sf -> a + +genSfMsg :: (SigSpace a, Sigs a) => SfFun a -> Sf -> D -> Msg -> SE a +genSfMsg play sf sustain msg = return $ mul env $ play (veloc msg) (notnum msg) 1 1 sf + where env = sfEnv sustain (veloc msg / 127) + +genSfKey :: SigSpace a => SfFun a -> Sf -> D -> D -> D -> a +genSfKey play sf sustain vel key = mul env $ play vel key 1 1 sf + where env = sfEnv sustain (vel / 127) + +genSfCps :: (Tuple a, SigSpace a) => SfFun a -> Sf -> D -> D -> D -> a +genSfCps play sf sustain amp cps = mul env $ play (127 * amp) (f2m cps) 1 (sig cps) sf `withD` 1 + where env = sfEnv sustain amp + +sfEnv :: D -> D -> Sig +sfEnv sustain amp = sig frac * env + where + frac = amp / 8000 + env = linsegr [0, 0.007, 1] sustain 0 + +-- | frequency to midi +f2m :: D -> D +f2m cps = round' (12 * (log (cps / 220) / log 2) + 57) + diff --git a/src/Csound/SigSpace.hs b/src/Csound/SigSpace.hs --- a/src/Csound/SigSpace.hs +++ b/src/Csound/SigSpace.hs @@ -1,7 +1,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-# Language FlexibleInstances #-} module Csound.SigSpace( - SigSpace(..), mul, + SigSpace(..), BindSig(..), mul, cfd, cfds, cfdSpec, cfdsSpec, wsum ) where @@ -14,6 +14,9 @@ -- | A class for easy way to process the outputs of the instruments. class Num a => SigSpace a where mapSig :: (Sig -> Sig) -> a -> a + +-- | A class for easy way to process the outputs of the instruments. +class SigSpace a => BindSig a where bindSig :: (Sig -> SE Sig) -> a -> SE a -- | Scaling the sound. @@ -52,37 +55,29 @@ wsum :: SigSpace a => [(Sig, a)] -> a wsum = sum . fmap (uncurry mul) -instance SigSpace Sig where - mapSig = id - bindSig = id +instance SigSpace Sig where mapSig = id +instance BindSig Sig where bindSig = id -instance SigSpace (Sig, Sig) where - mapSig f (a1, a2) = (f a1, f a2) - bindSig f (a1, a2) = (,) <$> f a1 <*> f a2 +instance SigSpace (Sig, Sig) where mapSig f (a1, a2) = (f a1, f a2) +instance BindSig (Sig, Sig) where bindSig f (a1, a2) = (,) <$> f a1 <*> f a2 -instance SigSpace (Sig, Sig, Sig) where - mapSig f (a1, a2, a3) = (f a1, f a2, f a3) - bindSig f (a1, a2, a3) = (,,) <$> f a1 <*> f a2 <*> f a3 +instance SigSpace (Sig, Sig, Sig) where mapSig f (a1, a2, a3) = (f a1, f a2, f a3) +instance BindSig (Sig, Sig, Sig) where bindSig f (a1, a2, a3) = (,,) <$> f a1 <*> f a2 <*> f a3 -instance SigSpace (Sig, Sig, Sig, Sig) where - mapSig f (a1, a2, a3, a4) = (f a1, f a2, f a3, f a4) - bindSig f (a1, a2, a3, a4) = (,,,) <$> f a1 <*> f a2 <*> f a3 <*> f a4 +instance SigSpace (Sig, Sig, Sig, Sig) where mapSig f (a1, a2, a3, a4) = (f a1, f a2, f a3, f a4) +instance BindSig (Sig, Sig, Sig, Sig) where bindSig f (a1, a2, a3, a4) = (,,,) <$> f a1 <*> f a2 <*> f a3 <*> f a4 -instance SigSpace (SE Sig) where - mapSig f = fmap (mapSig f) - bindSig f = fmap (bindSig f) +instance SigSpace (SE Sig) where mapSig f = fmap (mapSig f) +instance BindSig (SE Sig) where bindSig f = fmap (bindSig f) -instance SigSpace (SE (Sig, Sig)) where - mapSig f = fmap (mapSig f) - bindSig f = fmap (bindSig f) +instance SigSpace (SE (Sig, Sig)) where mapSig f = fmap (mapSig f) +instance BindSig (SE (Sig, Sig)) where bindSig f = fmap (bindSig f) -instance SigSpace (SE (Sig, Sig, Sig)) where - mapSig f = fmap (mapSig f) - bindSig f = fmap (bindSig f) +instance SigSpace (SE (Sig, Sig, Sig)) where mapSig f = fmap (mapSig f) +instance BindSig (SE (Sig, Sig, Sig)) where bindSig f = fmap (bindSig f) -instance SigSpace (SE (Sig, Sig, Sig, Sig)) where - mapSig f = fmap (mapSig f) - bindSig f = fmap (bindSig f) +instance SigSpace (SE (Sig, Sig, Sig, Sig)) where mapSig f = fmap (mapSig f) +instance BindSig (SE (Sig, Sig, Sig, Sig)) where bindSig f = fmap (bindSig f) ----------------------------------------------------- -- numeric instances @@ -286,5 +281,4 @@ instance Fractional (a -> (Sig, Sig, Sig, Sig)) where (/) = liftA2 (/) fromRational = return . fromRational - diff --git a/src/Csound/Tab.hs b/src/Csound/Tab.hs --- a/src/Csound/Tab.hs +++ b/src/Csound/Tab.hs @@ -6,6 +6,10 @@ -- table once but you don't need the guard point if you read the table in many cycles, then the guard point is the the first point of your table). Tab, + -- * Table querries + + nsamp, ftlen, ftsr, ftchnls, ftcps, + -- * Table granularity TabFi, fineFi, coarseFi, diff --git a/src/Csound/Types.hs b/src/Csound/Types.hs --- a/src/Csound/Types.hs +++ b/src/Csound/Types.hs @@ -55,7 +55,7 @@ ar1, ar2, ar4, ar6, ar8, -- * Tuples - Tuple(..), makeTupleMethods, Unit, unit, + Tuple(..), makeTupleMethods, Unit, unit, atTuple, -- *** Logic functions ifTuple, guardedTuple, caseTuple, @@ -67,18 +67,27 @@ -- > (Arg a, Out b) => a -> b -- ** Arguments - Arg, + Arg, atArg, -- *** Logic functions - ifArg, guardedArg, caseArg, + ifArg, guardedArg, caseArg, -- ** Outputs Sigs ) where +import Data.Boolean import Csound.Typed.Types type Sig2 = (Sig, Sig) type Sig4 = (Sig, Sig, Sig, Sig) type Sig6 = (Sig, Sig, Sig, Sig, Sig, Sig) type Sig8 = (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig) + +-- | Gets an init-rate value from the list by index. +atArg :: (Tuple a, Arg a) => [a] -> D -> a +atArg as ind = guardedArg (zip (fmap (\x -> int x ==* ind) [0 .. ]) as) (head as) + +-- | Gets an control/audio-rate value from the list by index. +atTuple :: (Tuple a) => [a] -> Sig -> a +atTuple as ind = guardedTuple (zip (fmap (\x -> sig (int x) ==* ind) [0 .. ]) as) (head as)