summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAntonKholomiov <>2018-04-25 11:01:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-04-25 11:01:00 (GMT)
commit1428357ad46fc4ce77be99677f0ff05c609424ff (patch)
tree51f2a115d347fe78777199dbb350e9c9caa89337
parent697d009d9585654d3254c21a5da21b867708840d (diff)
version 0.0.9.0HEAD0.0.9.0master
-rw-r--r--csound-sampler.cabal4
-rw-r--r--src/Csound/Sam.hs217
-rw-r--r--src/Csound/Sam/Core.hs32
-rw-r--r--src/Csound/Sam/Trig.hs25
-rw-r--r--src/Csound/Sam/Ui.hs44
5 files changed, 168 insertions, 154 deletions
diff --git a/csound-sampler.cabal b/csound-sampler.cabal
index c351ffb..5ed11a6 100644
--- a/csound-sampler.cabal
+++ b/csound-sampler.cabal
@@ -1,5 +1,5 @@
name: csound-sampler
-version: 0.0.8.1
+version: 0.0.9.0
license: BSD3
license-file: LICENSE
author: Anton Kholomiov
@@ -25,7 +25,7 @@ Source-repository head
library
Ghc-Options: -Wall
Hs-Source-Dirs: src/
- build-depends: base >= 4, base < 5, transformers >= 0.3, csound-expression >= 5.2.2
+ build-depends: base >= 4, base < 5, transformers >= 0.3, csound-expression >= 5.3.2
exposed-modules:
Csound.Sam
Csound.Sam.Core
diff --git a/src/Csound/Sam.hs b/src/Csound/Sam.hs
index 0e9309a..3adb885 100644
--- a/src/Csound/Sam.hs
+++ b/src/Csound/Sam.hs
@@ -1,7 +1,7 @@
-- | The sampler
{-# Language TypeFamilies, DeriveFunctor, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses #-}
module Csound.Sam (
- Sample, Sam, Bpm, runSam,
+ Sample, Sam, Bpm, runSam,
-- * Lifters
mapBpm, bindSam, bindBpm, liftSam, mapBpm2, bindBpm2, withBpm,
-- * Constructors
@@ -9,11 +9,11 @@ module Csound.Sam (
-- ** Stereo
wav, wavr, seg, segr, rndWav, rndWavr, rndSeg, rndSegr, ramWav,
-- ** Mono
- wav1, wavr1, seg1, segr1, rndWav1, rndWavr1, rndSeg1, rndSegr1, ramWav1,
+ wav1, wavr1, seg1, segr1, rndWav1, rndWavr1, rndSeg1, rndSegr1, ramWav1,
-- * Reading from RAM
-- ** Stereo
ramLoop, ramRead, segLoop, segRead, relLoop, relRead,
- -- ** Mono
+ -- ** Mono
ramLoop1, ramRead1, segLoop1, segRead1, relLoop1, relRead1,
-- ** Tempo/pitch scaling based on temposcal
@@ -21,8 +21,8 @@ module Csound.Sam (
-- * Envelopes
linEnv, expEnv, hatEnv, decEnv, riseEnv, edecEnv, eriseEnv,
-- * Arrange
- wide, flow, pick, pickBy,
- atPan, atPch, atCps, atPanRnd, atVolRnd, atVolGauss,
+ wide, flow, pick, pickBy,
+ atPan, atPch, atCps, atPanRnd, atVolRnd, atVolGauss,
-- * Loops
rep1, rep, pat1, pat, pat', rndPat, rndPat',
-- * Arpeggio
@@ -51,7 +51,7 @@ import Csound.Sam.Core
import Csound.Sam.Ui
import Csound.Sam.Trig
-type instance DurOf Sam = D
+type instance DurOf Sam = Sig
instance Melody Sam where
mel = flow
@@ -64,7 +64,7 @@ instance Compose Sam where
instance Delay Sam where
del dt = tfmS phi
where phi bpm x = x { samSig = asig, samDur = dur }
- where
+ where
absDt = toSec bpm dt
asig = delaySnd absDt $ samSig x
dur = addDur absDt $ samDur x
@@ -73,8 +73,8 @@ instance Stretch Sam where
str k (Sam a) = Sam $ withReaderT ( * k) a
instance Limit Sam where
- lim d = tfmS $ \bpm x ->
- let absD = toSec bpm d
+ lim d = tfmS $ \bpm x ->
+ let absD = toSec bpm d
in x { samSig = takeSnd absD $ samSig x
, samDur = Dur absD }
@@ -99,15 +99,15 @@ instance At Sig (SE Sig) Sam where
instance At Sig Sig2 Sam where
type AtOut Sig Sig2 Sam = Sam
at f x = at phi x
- where
+ where
phi (a, b) = 0.5 * (f a + f b)
instance At Sig (SE Sig2) Sam where
type AtOut Sig (SE Sig2) Sam = Sam
at f x = at phi x
- where
+ where
phi (a, b) = do
- a' <- f a
+ a' <- f a
b' <- f b
return $ 0.5 * (a' + b')
@@ -135,40 +135,40 @@ infSig2 :: Sig2 -> Sam
infSig2 = pure
-- | Constructs sample from limited mono signal (duration is in seconds)
-sig1 :: D -> Sig -> Sam
+sig1 :: Sig -> Sig -> Sam
sig1 dt a = Sam $ reader $ \_ -> S (a, a) (Dur dt)
-- | Constructs sample from limited stereo signal (duration is in seconds)
-sig2 :: D -> Sig2 -> Sam
+sig2 :: Sig -> Sig2 -> Sam
sig2 dt a = Sam $ reader $ \_ -> S a (Dur dt)
-- | Constructs sample from limited mono signal (duration is in BPMs)
-fromSig1 :: D -> Sig -> Sam
+fromSig1 :: Sig -> Sig -> Sam
fromSig1 dt = lim dt . infSig1
-- | Constructs sample from limited stereo signal (duration is in BPMs)
-fromSig2 :: D -> Sig2 -> Sam
+fromSig2 :: Sig -> Sig2 -> Sam
fromSig2 dt = lim dt . infSig2
-- | Constructs sample from wav or aiff files.
wav :: String -> Sam
-wav fileName = Sam $ return $ S (readSnd fileName) (Dur $ lengthSnd fileName)
+wav fileName = Sam $ return $ S (readSnd fileName) (Dur $ sig $ lengthSnd fileName)
-- | Constructs sample from wav that is played in reverse.
wavr :: String -> Sam
-wavr fileName = Sam $ return $ S (takeSnd len $ loopWav (-1) fileName) (Dur len)
+wavr fileName = Sam $ return $ S (takeSnd (sig len) $ loopWav (-1) fileName) (Dur $ sig len)
where len = lengthSnd fileName
-- | Constructs sample from the segment of a wav file. The start and end times are measured in seconds.
--
-- > seg begin end fileName
seg :: D -> D -> String -> Sam
-seg start end fileName = Sam $ return $ S (readSegWav start end 1 fileName) (Dur len)
+seg start end fileName = Sam $ return $ S (readSegWav start end 1 fileName) (Dur $ sig len)
where len = end - start
--- | Constructs reversed sample from segment of an audio file.
segr :: D -> D -> String -> Sam
-segr start end fileName = Sam $ return $ S (readSegWav start end (-1) fileName) (Dur len)
+segr start end fileName = Sam $ return $ S (readSegWav start end (-1) fileName) (Dur $ sig len)
where len = end - start
-- | Picks segments from the wav file at random. The first argument is the length of the segment.
@@ -192,40 +192,40 @@ genRndSeg speed len start end fileName = Sam $ lift $ do
x <- random 0 1
let a = start + dl * x
let b = a + len
- return $ S (readSegWav a b speed fileName) (Dur len)
+ return $ S (readSegWav a b speed fileName) (Dur $ sig len)
where dl = end - len
-- | Reads a sample from the file in RAM.
--
-- > ramWav loopMode speed fileName
ramWav :: LoopMode -> Sig -> String -> Sam
-ramWav loopMode speed fileName = Sam $ return $ S (ramSnd loopMode speed fileName) (Dur $ lengthSnd fileName)
+ramWav loopMode speed fileName = Sam $ return $ S (ramSnd loopMode speed fileName) (Dur $ sig $ lengthSnd fileName)
-- | Reads a sample from the mono file in RAM.
--
-- > ramWav1 loopMode speed fileName
ramWav1 :: LoopMode -> Sig -> String -> Sam
-ramWav1 loopMode speed fileName = Sam $ return $ S (let x = ramSnd1 loopMode speed fileName in (x, x)) (Dur $ lengthSnd fileName)
+ramWav1 loopMode speed fileName = Sam $ return $ S (let x = ramSnd1 loopMode speed fileName in (x, x)) (Dur $ sig $ lengthSnd fileName)
-- | Constructs sample from mono wav or aiff files.
wav1 :: String -> Sam
-wav1 fileName = Sam $ return $ S (let x = readSnd1 fileName in (x, x)) (Dur $ lengthSnd fileName)
+wav1 fileName = Sam $ return $ S (let x = readSnd1 fileName in (x, x)) (Dur $ sig $ lengthSnd fileName)
-- | Constructs sample from mono wav that is played in reverse.
wavr1 :: String -> Sam
-wavr1 fileName = Sam $ return $ S (let x = takeSnd len $ loopWav1 (-1) fileName in (x, x)) (Dur len)
+wavr1 fileName = Sam $ return $ S (let x = takeSnd (sig len) $ loopWav1 (-1) fileName in (x, x)) (Dur $ sig len)
where len = lengthSnd fileName
-- | Constructs sample from the segment of a mono wav file. The start and end times are measured in seconds.
--
-- > seg begin end fileName
seg1 :: D -> D -> String -> Sam
-seg1 start end fileName = Sam $ return $ S (let x = readSegWav1 start end 1 fileName in (x, x)) (Dur len)
+seg1 start end fileName = Sam $ return $ S (let x = readSegWav1 start end 1 fileName in (x, x)) (Dur $ sig len)
where len = end - start
--- | Constructs reversed sample from segment of a mono audio file.
segr1 :: D -> D -> String -> Sam
-segr1 start end fileName = Sam $ return $ S (let x = readSegWav1 start end (-1) fileName in (x, x)) (Dur len)
+segr1 start end fileName = Sam $ return $ S (let x = readSegWav1 start end (-1) fileName in (x, x)) (Dur $ sig len)
where len = end - start
-- | Picks segments from the mono wav file at random. The first argument is the length of the segment.
@@ -249,17 +249,17 @@ genRndSeg1 speed len start end fileName = Sam $ lift $ do
x <- random 0 1
let a = start + dl * x
let b = a + len
- return $ S (let y = readSegWav1 a b speed fileName in (y, y)) (Dur len)
+ return $ S (let y = readSegWav1 a b speed fileName in (y, y)) (Dur $ sig len)
where dl = end - len
-toSec :: Bpm -> D -> D
+toSec :: Bpm -> Sig -> Sig
toSec bpm a = a * 60 / bpm
-toSecSig :: Bpm -> Sig -> Sig
-toSecSig bpm a = a * 60 / sig bpm
+toSecD :: Bpm -> D -> D
+toSecD bpm a = a * 60 / (ir bpm)
-addDur :: D -> Dur -> Dur
+addDur :: Sig -> Dur -> Dur
addDur d x = case x of
Dur a -> Dur $ d + a
InfDur -> InfDur
@@ -283,7 +283,7 @@ tfmS :: (Bpm -> S Sig2 -> S Sig2) -> Sam -> Sam
tfmS f ra = Sam $ do
bpm <- ask
a <- unSam ra
- return $ f bpm a
+ return $ f bpm a
setInfDur :: Sam -> Sam
setInfDur = Sam . fmap (\a -> a { samDur = InfDur }) . unSam
@@ -291,13 +291,13 @@ setInfDur = Sam . fmap (\a -> a { samDur = InfDur }) . unSam
-- | Makes the sampler broader. It's reciprocal of str
--
-- > wide k = str (1 / k)
-wide :: D -> Sam -> Sam
+wide :: Sig -> Sam -> Sam
wide = str . recip
-- | Plays a list of samples one after another.
flow :: [Sam] -> Sam
flow [] = 0
-flow as = foldr1 flow2 as
+flow as = foldr1 flow2 as
flow2 :: Sam -> Sam -> Sam
flow2 (Sam ra) (Sam rb) = Sam $ do
@@ -316,10 +316,11 @@ genPick :: PickFun -> Sig -> [Sam] -> Sam
genPick pickFun dt as = Sam $ do
bpm <- ask
xs <- sequence $ fmap unSam as
- let ds = fmap (getDur . samDur) xs
+ let ds = fmap (ir . getDur . samDur) xs
let sigs = fmap samSig xs
- return $ S (sched (\n -> return $ atTuple sigs $ sig n) $ fmap (\(dt, a) -> str dt $ temp a) $ pickFun (zip ds (fmap int [0..])) $ metroS bpm dt) InfDur
- where getDur x = case x of
+ return $ S (sched (\n -> return $ atTuple sigs $ sig n) $ fmap (\(dt, a) -> str (sig dt) $ temp a) $ pickFun (zip ds (fmap int [0..])) $ metroS bpm dt) InfDur
+ where
+ getDur x = case x of
InfDur -> -1
Dur d -> d
@@ -338,9 +339,9 @@ type EnvFun = (Dur -> D -> D -> Sig)
genEnv :: EnvFun -> D -> D -> Sam -> Sam
genEnv env start end = tfmS f
where f bpm a = a { samSig = mul (env (samDur a) absStart absEnd) $ samSig a }
- where
- absStart = toSec bpm start
- absEnd = toSec bpm end
+ where
+ absStart = toSecD bpm start
+ absEnd = toSecD bpm end
-- | A linear rise-decay envelope. Times a given in BPMs.
--
@@ -349,25 +350,25 @@ linEnv :: D -> D -> Sam -> Sam
linEnv = genEnv f
where f dur start end = case dur of
InfDur -> linseg [0, start, 1]
- Dur d -> linseg [0, start, 1, maxB 0 (d - start - end), 1, end , 0]
+ Dur d -> linseg [0, start, 1, maxB 0 (ir d - start - end), 1, end , 0]
-- | An exponential rise-decay envelope. Times a given in BPMs.
--
-- > expEnv rise dec sample
expEnv :: D -> D -> Sam -> Sam
expEnv = genEnv f
- where
+ where
f dur start end = case dur of
InfDur -> expseg [zero, start, 1]
- Dur d -> expseg [zero, start, 1, maxB 0 (d - start - end), 1, end , zero]
+ Dur d -> expseg [zero, start, 1, maxB 0 (ir d - start - end), 1, end , zero]
zero = 0.00001
genEnv1 :: (D -> Sig) -> Sam -> Sam
genEnv1 envFun = tfmBy f
- where
+ where
f a = flip mul (samSig a) $ case samDur a of
InfDur -> 1
- Dur d -> envFun d
+ Dur d -> envFun (ir d)
-- | Parabolic envelope that starts and ends at zero and reaches maximum at the center.
@@ -390,11 +391,11 @@ eriseEnv = genEnv1 $ \d -> expseg [0.0001, d, 1]
edecEnv :: Sam -> Sam
edecEnv = genEnv1 $ \d -> expseg [1, d, 0.0001]
-type LoopFun = D -> D -> Sig2 -> Sig2
+type LoopFun = Sig -> Sig -> Sig2 -> Sig2
-genLoop :: LoopFun -> Sam -> Sam
+genLoop :: LoopFun -> Sam -> Sam
genLoop g = setInfDur . tfmS f
- where
+ where
f bpm a = a { samSig = case samDur a of
InfDur -> samSig a
Dur d -> g bpm d (samSig a)
@@ -402,59 +403,59 @@ genLoop g = setInfDur . tfmS f
-- | Plays the sample at the given period (in BPMs). The samples don't overlap.
-rep1 :: D -> Sam -> Sam
+rep1 :: Sig -> Sam -> Sam
rep1 = rep . return
-- | Plays the sample at the given period (in BPMs). The overlapped samples are mixed together.
-pat1 :: D -> Sam -> Sam
+pat1 :: Sig -> Sam -> Sam
pat1 = pat . return
-- | Plays the sample at the given pattern of periods (in BPMs). The samples don't overlap.
-rep :: [D] -> Sam -> Sam
-rep dts = genLoop $ \bpm d asig -> sched (const $ return asig) $ fmap (const $ notes bpm d) $ metroS bpm (sig $ sum dts)
- where notes bpm _ = har $ zipWith (\t dt-> singleEvent (toSec bpm t) (toSec bpm dt) unit) (patDurs dts) dts
-
+rep :: [Sig] -> Sam -> Sam
+rep dts = genLoop $ \bpm d asig -> sched (const $ return asig) $ fmap (const $ notes bpm) $ metroS bpm (sum dts)
+ where notes bpm = har $ zipWith (\t dt-> singleEvent (toSec bpm t) (toSec bpm dt) unit) (patDurs dts) dts
+
-- | Plays the sample at the given pattern of periods (in BPMs). The overlapped samples are mixed together.
-pat :: [D] -> Sam -> Sam
-pat dts = genLoop $ \bpm d asig -> sched (const $ return asig) $ fmap (const $ notes bpm d) $ metroS bpm (sig $ sum dts)
- where notes bpm d = har $ fmap (\t -> fromEvent $ Event (toSec bpm t) d unit) $ patDurs dts
+pat :: [Sig] -> Sam -> Sam
+pat dts = genLoop $ \bpm d asig -> sched (const $ return asig) $ fmap (const $ notes bpm d) $ metroS bpm (sum dts)
+ where notes bpm d = har $ fmap (\t -> fromEvent $ Event (toSec bpm t) d unit) $ patDurs dts
-- | Plays the sample at the given pattern of periods (in BPMs) and sometimes skips the samples from playback. The overlapped samples are mixed together.
-- The first argument is the probability of inclusion.
-rndPat :: Sig -> [D] -> Sam -> Sam
-rndPat prob dts = genLoop $ \bpm d asig -> sched (const $ rndSkipInstr prob asig) $ fmap (const $ notes bpm d) $ metroS bpm (sig $ sum dts)
- where
- notes bpm d = har $ fmap (\t -> fromEvent $ Event (toSec bpm t) d unit) $ patDurs dts
+rndPat :: Sig -> [Sig] -> Sam -> Sam
+rndPat prob dts = genLoop $ \bpm d asig -> sched (const $ rndSkipInstr prob asig) $ fmap (const $ notes bpm d) $ metroS bpm (sum dts)
+ where
+ notes bpm d = har $ fmap (\t -> fromEvent $ Event (toSec bpm t) d unit) $ patDurs dts
-- | Plays the sample at the given pattern of volumes and periods (in BPMs). The overlapped samples are mixed together.
--
-- > pat' volumes periods
-pat' :: [D] -> [D] -> Sam -> Sam
-pat' vols dts = genLoop $ \bpm d asig -> sched (instr asig) $ fmap (const $ notes bpm d) $ metroS bpm (sig $ sum dts')
- where
- notes bpm d = har $ zipWith (\v t -> singleEvent (toSec bpm t) d v) vols' $ patDurs dts'
+pat' :: [D] -> [Sig] -> Sam -> Sam
+pat' vols dts = genLoop $ \bpm d asig -> sched (instr asig) $ fmap (const $ notes bpm d) $ metroS bpm (sum dts')
+ where
+ notes bpm d = har $ zipWith (\v t -> singleEvent (toSec bpm t) d v) vols' $ patDurs dts'
instr asig v = return $ mul (sig v) asig
(vols', dts') = unzip $ lcmList vols dts
rndSkipInstr probSig asig = do
let prob = ir probSig
- ref <- newRef 0
+ ref <- newRef 0
p <- random 0 (1 :: D)
- whenD1 (p `lessThan` prob) $
+ whenD1 (p `lessThan` prob) $
writeRef ref asig
whenD1 (p `greaterThanEquals` prob) $
writeRef ref 0
- readRef ref
+ readRef ref
-- | Plays the sample at the given pattern of volumes and periods (in BPMs) and sometimes skips the samples from playback. The overlapped samples are mixed together.
-- The first argument is the probability of inclusion.
--
-- > rndPat' probability volumes periods
-rndPat' :: Sig -> [D] -> [D] -> Sam -> Sam
-rndPat' prob vols dts = genLoop $ \bpm d asig -> sched (instr asig) $ fmap (const $ notes bpm d) $ metroS bpm (sig $ sum dts')
- where
- notes bpm d = har $ zipWith (\v t -> singleEvent (toSec bpm t) d v) vols' $ patDurs dts'
- instr asig v = mul (sig v) $ rndSkipInstr prob asig
+rndPat' :: Sig -> [D] -> [Sig] -> Sam -> Sam
+rndPat' prob vols dts = genLoop $ \bpm d asig -> sched (instr asig) $ fmap (const $ notes bpm d) $ metroS bpm (sum dts')
+ where
+ notes bpm d = har $ zipWith (\v t -> singleEvent (toSec bpm t) d v) vols' $ patDurs dts'
+ instr asig v = mul (sig v) $ rndSkipInstr prob asig
(vols', dts') = unzip $ lcmList vols dts
@@ -466,9 +467,9 @@ lcmList as bs = take n $ zip (cycle as) (cycle bs)
-- The segment length is given in BPMs.
--
-- > wall segLength
-wall :: D -> Sam -> Sam
+wall :: Sig -> Sam -> Sam
wall dt a = mean [b, del hdt b]
- where
+ where
hdt = 0.5 * dt
f = pat1 hdt . hatEnv . lim dt
b = f a
@@ -479,13 +480,13 @@ type Chord = [D]
type Arp1Fun = Evt Unit -> Evt D
arpInstr :: Sig2 -> D -> SE Sig2
-arpInstr asig k = return $ mapSig (scalePitch (sig k)) asig
+arpInstr asig k = return $ mapSig (scalePitch (sig k)) asig
-patDurs :: [D] -> [D]
+patDurs :: [Sig] -> [Sig]
patDurs dts = reverse $ snd $ foldl (\(counter, res) a -> (a + counter, counter:res)) (0, []) dts
genArp1 :: Arp1Fun -> Sig -> Sam -> Sam
-genArp1 arpFun dt = genLoop $ \bpm d asig ->
+genArp1 arpFun dt = genLoop $ \bpm d asig ->
sched (arpInstr asig) $ withDur d $ arpFun $ metroS bpm dt
-- | Plays ascending arpeggio of samples.
@@ -505,69 +506,67 @@ arpOneOf1 = genArp1 . oneOf
arpFreqOf1 :: [Sig] -> Chord -> Sig -> Sam -> Sam
arpFreqOf1 freqs ch = genArp1 (freqOf (zip freqs ch))
-genArp :: Arp1Fun -> [D] -> Sam -> Sam
-genArp arpFun dts = genLoop $ \bpm d asig -> sched (arpInstr asig) $ fmap (notes bpm d) $ arpFun $ metroS bpm (sig $ sum dts)
- where notes bpm d pchScale = har $ fmap (\t -> singleEvent (toSec bpm t) d pchScale) $ patDurs dts
+genArp :: Arp1Fun -> [Sig] -> Sam -> Sam
+genArp arpFun dts = genLoop $ \bpm d asig -> sched (arpInstr asig) $ fmap (notes bpm d) $ arpFun $ metroS bpm (sum dts)
+ where notes bpm d pchScale = har $ fmap (\t -> singleEvent (toSec bpm t) d pchScale) $ patDurs dts
-- | Plays ascending arpeggio of samples.
-arpUp :: Chord -> [D] -> Sam -> Sam
+arpUp :: Chord -> [Sig] -> Sam -> Sam
arpUp = genArp . cycleE
-- | Plays descending arpeggio of samples.
-arpDown :: Chord -> [D] -> Sam -> Sam
+arpDown :: Chord -> [Sig] -> Sam -> Sam
arpDown ch = arpUp (reverse ch)
-- | Plays arpeggio of samles with random notes from the chord.
-arpOneOf :: Chord -> [D] -> Sam -> Sam
+arpOneOf :: Chord -> [Sig] -> Sam -> Sam
arpOneOf = genArp . oneOf
-- | Plays arpeggio of samles with random notes from the chord.
-- We can assign the frequencies of the notes.
-arpFreqOf :: [Sig] -> Chord -> [D] -> Sam -> Sam
+arpFreqOf :: [Sig] -> Chord -> [Sig] -> Sam -> Sam
arpFreqOf freqs ch = genArp (freqOf $ zip freqs ch)
metroS :: Bpm -> Sig -> Evt Unit
-metroS bpm dt = metroE (recip $ toSecSig bpm dt)
+metroS bpm dt = metroE (recip $ toSec bpm dt)
-- | The pattern is influenced by the Brian Eno's work "Music fo Airports".
-- The argument is list of tripples:
--
-- > (delayTime, repeatPeriod, pitch)
---
+--
-- It takes a Sample and plays it in the loop with given initial delay time.
-- The third cell in the tuple pitch is a value for scaling of the pitch in tones.
-forAirports :: [(D, D, D)] -> Sam -> Sam
-forAirports xs sample = mean $ flip fmap xs $
- \(delTime, loopTime, note) -> del delTime $ pat [loopTime] (atPch (sig note) sample)
+forAirports :: [(Sig, Sig, Sig)] -> Sam -> Sam
+forAirports xs sample = mean $ flip fmap xs $
+ \(delTime, loopTime, note) -> del delTime $ pat [loopTime] (atPch note sample)
-- | The pattern is influenced by the Brian Eno's work "Music fo Airports".
-- It's more generic than pattern @forAirport@
-- The argument is list of tripples:
--
-- > (delayTime, repeatPeriod, Sample)
---
+--
-- It takes a list of Samples and plays them in the loop with given initial delay time and repeat period.
-genForAirports :: [(D, D, Sam)] -> Sam
+genForAirports :: [(Sig, Sig, Sam)] -> Sam
genForAirports xs = mean $ fmap (\(delTime, loopTime, sample) -> del delTime $ pat [loopTime] sample) xs
+arp1 :: (SigSpace a, Sigs a) => (D -> SE a) -> Sig -> Sig -> Int -> [D] -> a
+arp1 instr bpm dt n ch = sched (\(amp, cps) -> fmap (mul (sig amp)) $ instr cps) $
+ withDur (toSec bpm dt) $ cycleE (lcmList (1 : replicate (n - 1) 0.7) ch) $ metroS bpm dt
-
-arp1 :: (SigSpace a, Sigs a) => (D -> SE a) -> D -> D -> Int -> [D] -> a
-arp1 instr bpm dt n ch = sched (\(amp, cps) -> fmap (mul (sig amp)) $ instr cps) $
- withDur (toSec bpm dt) $ cycleE (lcmList (1 : replicate (n - 1) 0.7) ch) $ metroS bpm (sig dt)
-
--- | The arpeggiator for the sequence of chords.
+-- | The arpeggiator for the sequence of chords.
--
--- > arpy instrument chordPeriod speedOfTheNote accentNumber chords
+-- > arpy instrument chordPeriod speedOfTheNote accentNumber chords
--
-- The first argument is an instrument that takes in a frequency of
-- the note in Hz. The second argument is the period of
--- chord change (in beats). The next argument is the speed
+-- chord change (in beats). The next argument is the speed
-- of the single note (in beats). The integer argument
-- is number of notes in the group. Every n'th note is louder.
-- The last argument is the sequence of chords. The chord is
-- the list of frequencies.
-arpy :: (D -> SE Sig2) -> D -> D -> Int -> [[D]] -> Sam
+arpy :: (D -> SE Sig2) -> Sig -> Sig -> Int -> [[D]] -> Sam
arpy instr chordPeriod speed accentNum chords = Sam $ do
bpm <- ask
res <- unSam $ loop $ flow $ map (linEnv 0.05 0.05 . fromSig2 chordPeriod . arp1 instr bpm speed accentNum) chords
@@ -588,7 +587,7 @@ atVolRnd k = bindSam (rndVol k)
class ToSam a where
toSam :: a -> Sam
-limSam :: ToSam a => D -> a -> Sam
+limSam :: ToSam a => Sig -> a -> Sam
limSam dt = lim dt . toSam
instance ToSam Sig where
@@ -616,7 +615,7 @@ ramLoop winSize tempo pitch file = toSam $ loopRam winSize tempo pitch file
-- | It's the same as readRam but wrapped in Sam (see "Csound.Air.Wav").
ramRead :: Fidelity -> TempoSig -> PitchSig -> String -> Sam
-ramRead winSize tempo pitch file = sig2 (lengthSnd file / ir tempo) $ readRam winSize tempo pitch file
+ramRead winSize tempo pitch file = sig2 (sig (lengthSnd file) / tempo) $ readRam winSize tempo pitch file
-- | It's the same as loopSeg but wrapped in Sam (see "Csound.Air.Wav").
segLoop :: Fidelity -> (Sig, Sig) -> TempoSig -> PitchSig -> String -> Sam
@@ -624,7 +623,7 @@ segLoop winSize ds tempo pitch file = toSam $ loopSeg winSize ds tempo pitch fil
-- | It's the same as readSeg but wrapped in Sam (see "Csound.Air.Wav").
segRead :: Fidelity -> (Sig, Sig) -> TempoSig -> PitchSig -> String -> Sam
-segRead winSize ds@(kmin, kmax) tempo pitch file = sig2 (ir $ (kmax - kmin) / tempo) $ readSeg winSize ds tempo pitch file
+segRead winSize ds@(kmin, kmax) tempo pitch file = sig2 ((kmax - kmin) / tempo) $ readSeg winSize ds tempo pitch file
-- | It's the same as loopRel but wrapped in Sam (see "Csound.Air.Wav").
relLoop :: Fidelity -> (Sig, Sig) -> TempoSig -> PitchSig -> String -> Sam
@@ -632,7 +631,7 @@ relLoop winSize ds tempo pitch file = toSam $ loopRel winSize ds tempo pitch fil
-- | It's the same as readRel but wrapped in Sam (see "Csound.Air.Wav").
relRead :: Fidelity -> (Sig, Sig) -> TempoSig -> PitchSig -> String -> Sam
-relRead winSize ds@(kmin, kmax) tempo pitch file = sig2 (ir $ (kmax - kmin) / tempo) $ readRel winSize ds tempo pitch file
+relRead winSize ds@(kmin, kmax) tempo pitch file = sig2 ((kmax - kmin) / tempo) $ readRel winSize ds tempo pitch file
-- | It's the same as loopRam1 but wrapped in Sam (see "Csound.Air.Wav").
ramLoop1 :: Fidelity -> TempoSig -> PitchSig -> String -> Sam
@@ -640,7 +639,7 @@ ramLoop1 winSize tempo pitch file = toSam $ loopRam1 winSize tempo pitch file
-- | It's the same as readRam1 but wrapped in Sam (see "Csound.Air.Wav").
ramRead1 :: Fidelity -> TempoSig -> PitchSig -> String -> Sam
-ramRead1 winSize tempo pitch file = sig1 (lengthSnd file / ir tempo) $ readRam1 winSize tempo pitch file
+ramRead1 winSize tempo pitch file = sig1 (sig (lengthSnd file) / tempo) $ readRam1 winSize tempo pitch file
-- | It's the same as loopSeg1 but wrapped in Sam (see "Csound.Air.Wav").
segLoop1 :: Fidelity -> (Sig, Sig) -> TempoSig -> PitchSig -> String -> Sam
@@ -648,7 +647,7 @@ segLoop1 winSize ds tempo pitch file = toSam $ loopSeg1 winSize ds tempo pitch f
-- | It's the same as readSeg1 but wrapped in Sam (see "Csound.Air.Wav").
segRead1 :: Fidelity -> (Sig, Sig) -> TempoSig -> PitchSig -> String -> Sam
-segRead1 winSize ds@(kmin, kmax) tempo pitch file = sig1 (ir $ (kmax - kmin) / tempo) $ readSeg1 winSize ds tempo pitch file
+segRead1 winSize ds@(kmin, kmax) tempo pitch file = sig1 ((kmax - kmin) / tempo) $ readSeg1 winSize ds tempo pitch file
-- | It's the same as loopRel1 but wrapped in Sam (see "Csound.Air.Wav").
relLoop1 :: Fidelity -> (Sig, Sig) -> TempoSig -> PitchSig -> String -> Sam
@@ -656,7 +655,7 @@ relLoop1 winSize ds tempo pitch file = toSam $ loopRel1 winSize ds tempo pitch f
-- | It's the same as readRel1 but wrapped in Sam (see "Csound.Air.Wav").
relRead1 :: Fidelity -> (Sig, Sig) -> TempoSig -> PitchSig -> String -> Sam
-relRead1 winSize ds@(kmin, kmax) tempo pitch file = sig1 (ir $ (kmax - kmin) / tempo) $ readRel1 winSize ds tempo pitch file
+relRead1 winSize ds@(kmin, kmax) tempo pitch file = sig1 ((kmax - kmin) / tempo) $ readRel1 winSize ds tempo pitch file
-----------------------
-- temposcale
diff --git a/src/Csound/Sam/Core.hs b/src/Csound/Sam/Core.hs
index 1256f8b..527212c 100644
--- a/src/Csound/Sam/Core.hs
+++ b/src/Csound/Sam/Core.hs
@@ -15,21 +15,29 @@ import Csound.Base
type Sam = Sample Sig2
instance RenderCsd Sam where
- renderCsdBy opt sample = renderCsdBy opt (runSam (120 * 4) sample)
+ renderCsdBy opt sample = renderCsdBy opt (runSam (getBpm * 4) sample)
instance RenderCsd (Source Sam) where
- renderCsdBy opt sample = renderCsdBy opt (lift1 (runSam (120 * 4)) sample)
+ renderCsdBy opt sample = renderCsdBy opt (lift1 (runSam (getBpm * 4)) sample)
+
+instance RenderCsd (SE Sam) where
+ renderCsdBy opt sample = renderCsdBy opt (runSam (getBpm * 4) =<< sample)
+
+instance RenderCsd (SE (Source Sam)) where
+ renderCsdBy opt sample = renderCsdBy opt $ do
+ sample' <- sample
+ lift1 (runSam (getBpm * 4)) sample'
runSam :: Bpm -> Sam -> SE Sig2
runSam bpm x = fmap samSig $ runReaderT (unSam x) bpm
-data Dur = Dur D | InfDur
+data Dur = Dur Sig | InfDur
-- | The Beats Per Minute measure (BPM). Almost all values are measured in BPMs.
-type Bpm = D
+type Bpm = Sig
-- | The generic type for samples.
-newtype Sample a = Sam { unSam :: ReaderT Bpm SE (S a)
+newtype Sample a = Sam { unSam :: ReaderT Bpm SE (S a)
} deriving (Functor)
instance Applicative Sample where
@@ -38,7 +46,7 @@ instance Applicative Sample where
data S a = S
{ samSig :: a
- , samDur :: Dur
+ , samDur :: Dur
} deriving (Functor)
instance Applicative S where
@@ -63,6 +71,12 @@ instance Fractional a => Fractional (Sample a) where
instance SigSpace a => SigSpace (Sample a) where
mapSig f = fmap (mapSig f)
+instance SigSpace2 a => SigSpace2 (Sample a) where
+ mapSig2 f = fmap (mapSig2 f)
+
+instance BindSig2 a => BindSig2 (Sample a) where
+ bindSig2 f = return . bindSam (bindSig2 f)
+
-- Lifters
-- | Hides the effects inside sample.
@@ -74,14 +88,14 @@ liftSam (Sam ra) = Sam $ do
-- | Transforms the sample with BPM.
mapBpm :: (Bpm -> a -> b) -> Sample a -> Sample b
mapBpm f a = Sam $ do
- bpm <- ask
+ bpm <- ask
unSam $ fmap (f bpm) a
-- | Transforms the sample with BPM.
mapBpm2 :: (Bpm -> a -> b -> c) -> Sample a -> Sample b -> Sample c
mapBpm2 f a b = Sam $ do
- bpm <- ask
- unSam $ liftA2 (f bpm) a b
+ bpm <- ask
+ unSam $ liftA2 (f bpm) a b
-- | Lifts bind on stereo signals to samples.
bindSam :: (a -> SE b) -> Sample a -> Sample b
diff --git a/src/Csound/Sam/Trig.hs b/src/Csound/Sam/Trig.hs
index 0bb01f5..dc773e2 100644
--- a/src/Csound/Sam/Trig.hs
+++ b/src/Csound/Sam/Trig.hs
@@ -43,7 +43,7 @@ samCharToggle initVal ch x = case initVal of
-- | Char trigger with fixed note limiting by length in second.
-- It's useful optimization. It's good to use for drum notes and short sounds.
-samCharTap :: D -> String -> Sam -> Sam
+samCharTap :: Sig -> String -> Sam -> Sam
samCharTap stop starts = fmap (charTap stop starts)
-- | Plays one of the sample from the list when corresponding char is pressed.
@@ -54,7 +54,7 @@ samCharGroup initVal as stop = case initVal of
Just v0 -> liftA2 (\v xs -> charGroup (Just v) (zip starts xs) stop) v0 (sequenceA sams)
where (starts, sams) = unzip as
--- | Plays samples in sequence when key is pressed. The last string is
+-- | Plays samples in sequence when key is pressed. The last string is
-- for stopping the sequence.
samCharCycle :: Maybe Sam -> Char -> String -> [Sam] -> Sam
samCharCycle initVal start stop as = case initVal of
@@ -65,26 +65,27 @@ samCharCycle initVal start stop as = case initVal of
------------------------------------------------------
-- synchronised
-syncBeats bpm beats = sig $ bpm / beats
+syncBeats :: Sig -> Sig -> Sig
+syncBeats bpm beats = bpm / beats
-- | Triggers the sample with any char from the first string
-- and stops the sample with any char from the second string.
-- The first argument is the number of beats for syncronization.
-samSyncCharTrig :: D -> Maybe Sam -> String -> String -> Sam -> Sam
+samSyncCharTrig :: Sig -> Maybe Sam -> String -> String -> Sam -> Sam
samSyncCharTrig beats initVal starts stops x = case initVal of
Nothing -> mapBpm (\bpm a -> syncCharTrig (syncBeats bpm beats) Nothing starts stops a) x
Just v0 -> mapBpm2 (\bpm v sigs -> syncCharTrig (syncBeats bpm beats) (Just v) starts stops sigs) v0 x
-- | Plays a sample while the key is pressed.
-- The first argument is the number of beats for syncronization.
-samSyncCharPush :: D -> Maybe Sam -> Char -> Sam -> Sam
+samSyncCharPush :: Sig -> Maybe Sam -> Char -> Sam -> Sam
samSyncCharPush beats initVal ch x = case initVal of
Nothing -> mapBpm (\bpm a -> syncCharPush (syncBeats bpm beats) Nothing ch a) x
Just v0 -> mapBpm2 (\bpm v sigs -> syncCharPush (syncBeats bpm beats) (Just v) ch sigs) v0 x
-- | Toggles the sample when the key is pressed.
-- The first argument is the number of beats for syncronization.
-samSyncCharToggle :: D -> Maybe Sam -> Char -> Sam -> Sam
+samSyncCharToggle :: Sig -> Maybe Sam -> Char -> Sam -> Sam
samSyncCharToggle beats initVal ch x = case initVal of
Nothing -> mapBpm (\bpm a -> syncCharToggle (syncBeats bpm beats) Nothing ch a) x
Just v0 -> mapBpm2 (\bpm v sigs -> syncCharToggle (syncBeats bpm beats) (Just v) ch sigs) v0 x
@@ -92,21 +93,21 @@ samSyncCharToggle beats initVal ch x = case initVal of
-- | Char trigger with fixed note limiting by length in second.
-- It's useful optimization. It's good to use for drum notes and short sounds.
-- The first argument is the number of beats for syncronization.
-samSyncCharTap :: D -> D -> String -> Sam -> Sam
+samSyncCharTap :: Sig -> Sig -> String -> Sam -> Sam
samSyncCharTap beats stop starts = mapBpm (\bpm x -> syncCharTap (syncBeats bpm beats) stop starts x)
-- | Plays one of the sample from the list when corresponding char is pressed.
-- The last string is for stopping the samples.
-samSyncCharGroup :: D -> Maybe Sam -> [(Char, Sam)] -> String -> Sam
+samSyncCharGroup :: Sig -> Maybe Sam -> [(Char, Sam)] -> String -> Sam
samSyncCharGroup beats initVal as stop = case initVal of
Nothing -> mapBpm (\bpm xs -> syncCharGroup (syncBeats bpm beats) Nothing (zip starts xs) stop) (sequenceA sams)
Just v0 -> mapBpm2 (\bpm v xs -> syncCharGroup (syncBeats bpm beats) (Just v) (zip starts xs) stop) v0 (sequenceA sams)
where (starts, sams) = unzip as
--- | Plays samples in sequence when key is pressed. The last string is
+-- | Plays samples in sequence when key is pressed. The last string is
-- for stopping the sequence.
-- The first argument is the number of beats for syncronization.
-samSyncCharCycle :: D -> Maybe Sam -> Char -> String -> [Sam] -> Sam
+samSyncCharCycle :: Sig -> Maybe Sam -> Char -> String -> [Sam] -> Sam
samSyncCharCycle beats initVal start stop as = case initVal of
Nothing -> mapBpm (\bpm -> syncCharCycle (syncBeats bpm beats) Nothing start stop) (sequenceA as)
Just v0 -> mapBpm2 (\bpm v xs -> syncCharCycle (syncBeats bpm beats) (Just v) start stop xs) v0 (sequenceA as)
@@ -121,7 +122,7 @@ samMidiTrig = samMidiTrigBy midiAmpInstr
-- | Midi trigger with fixed note limiting by length in second.
-- It's useful optimization. It's good to use for drum notes and short sounds.
-- The key is an integer midi code. The C1 is 60 and the A1 is 69.
-samMidiTap :: MidiChn -> D -> Int -> Sam -> Sam
+samMidiTap :: MidiChn -> Sig -> Int -> Sam -> Sam
samMidiTap = samMidiTapBy midiAmpInstr
samMidiPush :: MidiChn -> Int -> Sam -> Sam
@@ -147,7 +148,7 @@ samMidiTrigBy midiFun midiChn key = bindSam (midiTrigBy midiFun midiChn key)
-- | Generic samMidiTap. We can specify the midi triggering function.
-- The midi function takes in a signal and a volume of the pressed key (it ranges from 0 to 1).
-- It produces some output. The default is scaling the signal with the amplitude.
-samMidiTapBy :: MidiTrigFun Sig2 -> MidiChn -> D -> Int -> Sam -> Sam
+samMidiTapBy :: MidiTrigFun Sig2 -> MidiChn -> Sig -> Int -> Sam -> Sam
samMidiTapBy midiFun midiChn dt key = bindSam (midiTapBy midiFun midiChn dt key)
-- | Generic samMidiPush. We can specify the midi triggering function.
diff --git a/src/Csound/Sam/Ui.hs b/src/Csound/Sam/Ui.hs
index b62dd93..d8e69f1 100644
--- a/src/Csound/Sam/Ui.hs
+++ b/src/Csound/Sam/Ui.hs
@@ -46,7 +46,7 @@ genFreeSim gcat as = genFreeSimInits gcat $ fmap (\(a, b) -> (a, b, False)) as
genFreeSimInits :: ([Gui] -> Gui) -> [(String, Sam, Bool)] -> Source Sam
genFreeSimInits gcat as = source $ do
- (guis, ts) <- fmap unzip $ zipWithM (\a b -> unSource $ toggle a b) names initVals
+ (guis, ts) <- fmap unzip $ zipWithM (\a b -> toggle a b) names initVals
let res = groupToggles mean sams ts
return (gcat guis, res)
where
@@ -63,7 +63,7 @@ hfreeTog = genFreeTog hor
genFreeTog :: ([Gui] -> Gui) -> [(String, Sam)] -> Source Sam
genFreeTog gcat as = source $ do
- (guis, writes, reads) <- fmap unzip3 $ mapM (unSinkSource . flip setToggleSig False) names
+ (guis, writes, reads) <- fmap unzip3 $ mapM (flip setToggleSig False) names
curRef <- newGlobalRef (0 :: Sig)
current <- readRef curRef
zipWithM_ (\w i -> w $ ifB (current ==* i) 1 0) writes ids
@@ -86,11 +86,11 @@ genSim gcat numBeats as = genSimInits gcat numBeats $ fmap (\(a, b) -> (a, b, Fa
genSimInits :: ([Gui] -> Gui) -> Int -> [(String, Sam, Bool)] -> Source Sam
genSimInits gcat numBeats as = source $ do
- (guis, writes, reads) <- fmap unzip3 $ zipWithM (\a b -> unSinkSource $ setToggleSig a b) names initVals
+ (guis, writes, reads) <- fmap unzip3 $ zipWithM (\a b -> setToggleSig a b) names initVals
curRefs <- mapM (const $ newGlobalRef (0 :: Sig)) ids
currents <- mapM readRef curRefs
zipWithM_ (\w val -> w val) writes currents
- let mkReaders bpm = zipWithM_ (\r ref -> runEvt (syncBpm (sig $ bpm / int numBeats) $ snaps r) $ \x -> do
+ let mkReaders bpm = zipWithM_ (\r ref -> runEvt (syncBpm (bpm / sig (int numBeats)) $ snaps r) $ \x -> do
writeRef ref (sig x)
) reads curRefs
let res = bindBpm (\bpm x -> mkReaders bpm >> return x) $ groupToggles mean sams $ fmap snaps currents
@@ -128,15 +128,15 @@ hsimWith = genSimInits hor
genTog :: ([Gui] -> Gui) -> Int -> [(String, Sam)] -> Source Sam
-genTog gcat numBeats as = Source $ fmap (\(g, x) -> (g, fst x)) $ unSource $ genTogWithRef gcat numBeats as
+genTog gcat numBeats as = fmap (\(g, x) -> (g, fst x)) $ genTogWithRef gcat numBeats as
genTogWithRef :: ([Gui] -> Gui) -> Int -> [(String, Sam)] -> Source (Sam, Ref Sig)
genTogWithRef gcat numBeats as = source $ do
- (guis, writes, reads) <- fmap unzip3 $ mapM (unSinkSource . flip setToggleSig False) names
+ (guis, writes, reads) <- fmap unzip3 $ mapM (flip setToggleSig False) names
curRef <- newGlobalRef (0 :: Sig)
current <- readRef curRef
zipWithM_ (\w i -> w $ ifB (current ==* i) 1 0) writes ids
- let mkReaders bpm = zipWithM_ (\r i -> runEvt (syncBpm (sig $ bpm / int numBeats) $ snaps r) $ \x -> do
+ let mkReaders bpm = zipWithM_ (\r i -> runEvt (syncBpm (bpm / (sig $ int numBeats)) $ snaps r) $ \x -> do
when1 (sig x ==* 0 &&* current ==* i) $ do
writeRef curRef 0
when1 (sig x ==* 1) $ do
@@ -174,10 +174,10 @@ htog = genTog hor
-- in row-wise fashion.
live :: Int -> [String] -> [Sam] -> Source Sam
live numBeats names sams = source $ do
- (gVols, vols) <- fmap unzip $ mapM (unSource . defSlider) $ replicate n "vol"
- (gs, xs) <- fmap unzip $ zipWithM (\a b -> unSource $ mkLiveRow numBeats a b) (zip names gVols) rows
+ (gVols, vols) <- fmap unzip $ mapM defSlider $ replicate n "vol"
+ (gs, xs) <- fmap unzip $ zipWithM (\a b -> mkLiveRow numBeats a b) (zip names gVols) rows
let (sigs, refs) = unzip xs
- (gMaster, masterVol) <- unSource $ defSlider "master"
+ (gMaster, masterVol) <- defSlider "master"
(g, proc) <- mkLiveSceneRow numBeats gMaster ids refs
return $ (hor $ g : gs, bindBpm (\bpm asig -> proc bpm >> return asig) $ mul masterVol $ mean $ zipWith mul vols sigs)
where
@@ -188,13 +188,13 @@ live numBeats names sams = source $ do
mkLiveRow :: Int -> (String, Gui) -> [Sam] -> Source (Sam, Ref Sig)
mkLiveRow numBeats (name, gVol) xs = genTogWithRef (\xs -> ver $ xs ++ [gVol]) numBeats (zip (name : repeat "") xs)
-mkLiveSceneRow :: Int -> Gui -> [Sig] -> [Ref Sig] -> SE (Gui, D -> SE ())
+mkLiveSceneRow :: Int -> Gui -> [Sig] -> [Ref Sig] -> SE (Gui, Sig -> SE ())
mkLiveSceneRow numBeats gMaster ids refs = do
- (guis, writes, reads) <- fmap unzip3 $ mapM (unSinkSource . flip setToggleSig False) names
+ (guis, writes, reads) <- fmap unzip3 $ mapM (flip setToggleSig False) names
curRef <- newGlobalRef (0 :: Sig)
current <- readRef curRef
zipWithM_ (\w i -> w $ ifB (current ==* i) 1 0) writes ids
- let mkReaders bpm = zipWithM_ (\r i -> runEvt (syncBpm (sig $ bpm / int numBeats) $ snaps r) $ \x -> do
+ let mkReaders bpm = zipWithM_ (\r i -> runEvt (syncBpm (bpm / sig (int numBeats)) $ snaps r) $ \x -> do
when1 (sig x ==* 0 &&* current ==* i) $ do
writeRef curRef 0
mapM_ (flip writeRef 0) refs
@@ -221,14 +221,14 @@ defSlider tag = slider tag (linSpan 0 1) 0.5
-- between dry and wet signals.
liveEf :: Int -> [String] -> [Sam] -> (Double, Fx2) -> [(Double, Fx2)] -> Source Sam
liveEf numBeats names sams masterEff effs = source $ do
- (gVols, vols) <- fmap unzip $ mapM (unSource . defSlider) $ replicate n "vol"
+ (gVols, vols) <- fmap unzip $ mapM defSlider $ replicate n "vol"
(gEffs, effCtrls) <- fmap unzip $
- mapM (\(tag, initVal) -> unSource $ slider tag (linSpan 0 1) initVal) $ zip (replicate n "eff") (fmap fst effs)
+ mapM (\(tag, initVal) -> slider tag (linSpan 0 1) initVal) $ zip (replicate n "eff") (fmap fst effs)
let gCtrls = zipWith ctrlGui gEffs gVols
- (gs, xs) <- fmap unzip $ zipWithM (\a b -> unSource $ mkLiveRow numBeats a b) (zip names gCtrls) rows
+ (gs, xs) <- fmap unzip $ zipWithM (\a b -> mkLiveRow numBeats a b) (zip names gCtrls) rows
let (sigs, refs) = unzip xs
- (gMaster, masterVol) <- unSource $ defSlider "master"
- (gMasterEff, masterEffCtrl) <- unSource $slider "eff" (linSpan 0 1) (fst masterEff)
+ (gMaster, masterVol) <- defSlider "master"
+ (gMasterEff, masterEffCtrl) <- slider "eff" (linSpan 0 1) (fst masterEff)
(g, proc) <- mkLiveSceneRow numBeats (ctrlGui gMasterEff gMaster) ids refs
return $ (hor $ g : gs, bindBpm (\bpm asig -> proc bpm >> return asig) $
mul masterVol $ appEff (snd masterEff) masterEffCtrl $
@@ -250,18 +250,18 @@ mixSam name bpm sam = (name, runSam bpm sam)
-- | Creates fx-unit from sampler widget.
--
-- > uisam name isOn bpm samWidget
-uiSam :: String -> Bool -> D -> Source Sam -> Source Fx2
+uiSam :: String -> Bool -> Sig -> Source Sam -> Source Fx2
uiSam name onOff bpm sam = uiSig name onOff (joinSource $ mapSource (runSam bpm) sam)
where
joinSource :: Source (SE Sig2) -> Source Sig2
joinSource a = source $ do
- (g, mres) <- unSource a
+ (g, mres) <- a
res <- mres
return (g, res)
-- | Adds gain slider on top of the widget.
addGain :: SigSpace a => Source a -> Source a
addGain x = source $ do
- (g, asig) <- unSource x
- (gainGui, gain) <- unSource $ slider "gain" (linSpan 0 1) 0.5
+ (g, asig) <- x
+ (gainGui, gain) <- slider "gain" (linSpan 0 1) 0.5
return (ver [sca 0.15 gainGui, g], mul gain asig)