packages feed

csound-expression 4.0.0 → 4.1.0

raw patch · 12 files changed

+461/−196 lines, 12 filesdep ~csound-expression-opcodesdep ~csound-expression-typed

Dependency ranges changed: csound-expression-opcodes, csound-expression-typed

Files

csound-expression.cabal view
@@ -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
src/Csound/Air.hs view
@@ -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
src/Csound/Control.hs view
@@ -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
+ src/Csound/Control/Channel.hs view
@@ -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+
src/Csound/Control/Evt.hs view
@@ -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. --
src/Csound/Control/Instr.hs view
@@ -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-
+ src/Csound/Control/Midi.hs view
@@ -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+
+ src/Csound/Control/Osc.hs view
@@ -0,0 +1,7 @@+-- | Open Sound Control.+module Csound.Control.Osc(+    initOsc, listenOsc, sendOsc+) where++import Csound.Typed+
+ src/Csound/Control/Sf.hs view
@@ -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)+
src/Csound/SigSpace.hs view
@@ -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-
src/Csound/Tab.hs view
@@ -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,
src/Csound/Types.hs view
@@ -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)