packages feed

hdf (empty) → 0.7

raw patch · 29 files changed

+1385/−0 lines, 29 filesdep +basedep +directorydep +fglsetup-changed

Dependencies added: base, directory, fgl, filepath, hosc, process

Files

+ Help/Graphs/analog-bubbles.lhs view
@@ -0,0 +1,20 @@+analog bubbles (jmcc)++> import Control.Monad+> import Sound.DF++> let { dpl f a b = liftM2 (,) (f a) (f b)+>     ; mk_o f = liftM (\o -> o * 3.0 + 80.0) (lf_saw f 0.0)+>     ; mk_f a = liftM (\o -> o * 24.0 + a) (lf_saw 0.4 0.0)+>     ; mk_s f = liftM (\o -> o * 0.04) (sin_osc (midi_cps f) 0.0) }+> in do { (o1, o2) <- dpl mk_o 8.0 7.23+>       ; (f1, f2) <- dpl mk_f o1 o2+>       ; (s1, s2) <- dpl mk_s f1 f2+>       ; c1 <- buf_comb_n 0 s1 0.2 4.0+>       ; c2 <- buf_comb_n 1 s2 0.2 4.0+>       ; audition [b_alloc 0 44100, b_alloc 1 44100] (out2 (c1, c2)) }++let { o = lfSaw kr (mce2 8 7.23) 0 * 3 + 80+    ; f = lfSaw kr 0.4 0 * 24 + o+    ; s = sinOsc ar (midiCPS f) 0 * 0.04 }+in audition (out 0 (combN s 0.2 0.2 4))
+ Help/Graphs/lfo-modulation.lhs view
@@ -0,0 +1,19 @@+lfo modulation (jmcc)++> import Control.Monad+> import Sound.DF++> let { dpl f p q = liftM2 (,) (f p) (f q)+>     ; mk_p f = liftM (\o -> o * 3600.0 + 4000.0) (sin_osc f 0.0) }+> in do { s <- liftM (\o -> o * 80.0 + 160.0) (sin_osc 0.05 0.0)+>       ; (p1, p2) <- dpl mk_p 0.6 0.7+>       ; l <- liftM (\o -> o * 0.05) (lf_pulse s 0 0.4)+>       ; (r1, r2) <- dpl (\x -> rlpf l x 0.2) p1 p2+>       ; c1 <- buf_comb_n 0 r1 0.20 2.0+>       ; c2 <- buf_comb_n 1 r2 0.25 2.0+>       ; audition [b_alloc 0 44100, b_alloc 1 44100] (out2 (c1, c2)) }++let { o = fSinOsc kr 0.05 0 * 80 + 160+    ; p = fSinOsc kr (mce2 0.6 0.7) 0 * 3600 + 4000+    ; s = rlpf (lfPulse ar o 0 0.4 * 0.05) p 0.2 }+in audition (out 0 (combL s 0.3 (mce2 0.2 0.25) 2))
+ Help/Graphs/moto-rev.lhs view
@@ -0,0 +1,16 @@+moto rev (jmcc)++> import Control.Monad+> import Sound.DF++> let { dpl f a b = (,) (f a) (f b)+>     ; dplm f a b = liftM2 (,) (f a) (f b) }+> in do { f <- liftM (\o -> o * 10.0 + 21.0) (sin_osc 0.2 0.0)+>       ; (s1, s2) <- dplm (\x -> lf_pulse f x 0.1) 0.0 0.1+>       ; (o1, o2) <- dplm (\x -> rlpf x 100.0 0.1) s1 s2+>       ; let (c1, c2) = dpl (\x -> clip2 x 0.4) o1 o2+>         in audition [] (out2 (c1, c2)) }++let { f = sinOsc kr 0.2 0 * 10 + 21+    ; s = lfPulse ar f (mce2 0 0.1) 0.1 }+in audition (out 0 (clip2 (rlpf s 100 0.1) 0.4))
+ Help/Graphs/sprinkler.lhs view
@@ -0,0 +1,14 @@+sprinkler (jmcc)++> import Sound.DF++> do { n <- white_noise_m+>    ; f <- fmap (\x -> x * 10.0 + 7.0) (lf_pulse 0.09 0.0 0.16)+>    ; t <- fmap (\x -> x * 0.1) (lf_pulse f 0.0 0.25)+>    ; o <- bpz2 (n * t)+>    ; audition [] (out1 o) }++do { n <- M.whiteNoise ar+   ; let { f = lfPulse kr 0.09 0 0.16 * 10 + 7+         ; t = lfPulse kr f 0 0.25 * 0.1 }+     in audition (out 0 (bpz2 (n * t))) }
+ Help/UGen/Filter/buf_comb_n.help.lhs view
@@ -0,0 +1,29 @@+buf_comb_n b i dl dc++   b - buffer index+   i - input signal+  dl - delay time+  dc - decay time++Comb delay line. CombN uses no interpolation, CombL uses linear+interpolation, CombC uses all pass interpolation.  All times are in+seconds.  The decay time is the time for the echoes to decay by 60+decibels. If this time is negative then the feedback coefficient+will be negative, thus emphasizing only odd harmonics at an octave+lower.++Comb used as a resonator. The resonant fundamental is equal to+reciprocal of the delay time.++> import Sound.DF++> do { n <- white_noise_m+>    ; dt <- fmap (\x -> lin_exp (x + 2.0) 1.0 2.0 0.0001 0.01) (lf_saw 0.1 0.0)+>    ; c <- buf_comb_n 0 (n * 0.1) dt 0.2+>    ; audition [b_alloc 0 44100] (out1 c) }++> do { i <- impulse 0.5 0.0+>    ; n <- white_noise_m+>    ; e <- decay (i * 0.5) 0.2+>    ; c <- buf_comb_n 0 (e * n) 0.2 3.0+>    ; audition [b_alloc 0 44100] (out1 c) }
+ Help/UGen/Filter/decay.help.lhs view
@@ -0,0 +1,18 @@+decay i t++   i - input signal+   t - decay time++Exponential decay.  This is essentially the same as Integrator+except that instead of supplying the coefficient directly, it is+caculated from a 60 dB decay time. This is the time required for+the integrator to lose 99.9 % of its value or -60dB. This is useful+for exponential decaying envelopes triggered by impulses.++Used as an envelope.++> do { n <- brown_noise_m+>    ; f <- lf_saw 0.1 0.0+>    ; i <- impulse (lin_lin f (-1.0) 1.0 2.0 5.0) 0.25+>    ; e <- decay i 0.2+>    ; audition [] (out1 (e * n)) }
+ Help/UGen/Filter/iir2.help.lhs view
@@ -0,0 +1,12 @@+iir2 f i++  f - function (\x0 y1 y2 -> y0)+  i - input signal++> import Sound.DF++> do { c1 <- iir2 (\x y1 _ -> x + y1) 0.001+>    ; o1 <- sin_osc (c1 + 220.0) 0+>    ; c2 <- iir2 (\x _ y2 -> x + y2) 0.001+>    ; o2 <- sin_osc (c2 + 220.0) 0+>    ; audition [] (out2 (o1 * 0.1, o2 * 0.1)) }
+ Help/UGen/Filter/lag.help.lhs view
@@ -0,0 +1,16 @@+lag i t++  i - input signal+  t - lag time++A simple averaging filter.++> import Sound.DF++> do { s <- sin_osc 0.05 0.0+>    ; let f = lin_lin s (-1.0) 1.0 220.0 440.0+>      in do { o <- sin_osc f 0.0+>            ; f' <- lag f 1.0+>            ; o' <- sin_osc f' 0.0+>            ; audition [] (out2 (o * 0.2, o' * 0.2)) } }+
+ Help/UGen/Filter/latch.help.lhs view
@@ -0,0 +1,14 @@+latch i t++Sample and hold. Holds input signal value when triggered.++   i - input signal.+   t - trigger (non-positive to positive)++> import Sound.DF++> do { n <- white_noise_m+>    ; i <- impulse 9.0 0.0+>    ; l <- latch n i+>    ; o <- sin_osc (l * 400.0 + 500.0) 0.0+>    ; audition [] (out1 (o * 0.2)) }
+ Help/UGen/Filter/lin_exp.help.lhs view
@@ -0,0 +1,7 @@+> import Sound.DF++> map (\i -> lin_exp i 1 2 1 3) [1, 1.1 .. 2]++> do { s <- lf_saw 0.25 0.0+>    ; o <- sin_osc (lin_exp (s + 1.0) 0.0 2.0 220.0 440.0) 0.0+>    ; audition [] (out1 (o * 0.1)) }
+ Help/UGen/Filter/lin_lin.help.lhs view
@@ -0,0 +1,7 @@+> import Sound.DF++> map (\i -> lin_lin i (-1) 1 0 1) [-1, -0.9 .. 1.0]++> do { s <- lf_saw 1.0 0.0+>    ; o <- sin_osc (lin_lin s (-1.0) 1.0 220.0 440.0) 0.0+>    ; audition [] (out1 (o * 0.1)) }
+ Help/UGen/Filter/resonz.help.lhs view
@@ -0,0 +1,25 @@+resonz i f rq++A two pole resonant filter with zeroes at z = +/- 1. Based on+K. Steiglitz, "A Note on Constant-Gain Digital Resonators,"+Computer Music Journal, vol 18, no. 4, pp. 8-10, Winter 1994.  The+reciprocal of Q is used rather than Q because it saves a divide+operation inside the unit generator.++     i - input signal+     f - resonant frequency (in hertz)+    rq - bandwidth ratio (reciprocal of Q). +         rq = bandwidth / centerFreq++> import Sound.DF++> do { n <- white_noise_m+>    ; r <- resonz (n * 0.5) 440.0 0.1+>    ; audition [] (out1 r) }++Modulate frequency++> do { n <- white_noise_m+>    ; f <- fmap (\x -> x * 3500.0 + 4500.0) (lf_saw 0.1 0.0)+>    ; r <- resonz (n * 0.5) f 0.05+>    ; audition [] (out1 r) }
+ Help/UGen/Filter/rlpf.help.lhs view
@@ -0,0 +1,14 @@+rlpf in freq rq++   i - input signal+   f - frequency (hertz)+  rq - reciprocal of Q++A resonant low pass filter.++> import Sound.DF++> do { n <- white_noise_m+>    ; f <- fmap (\x -> x * 40.0 + 220.0) (sin_osc 0.5 0.0)+>    ; r <- rlpf n f 0.1+>    ; audition [] (out1 r) }
+ Help/UGen/Noise/brown_noise.help.lhs view
@@ -0,0 +1,17 @@+brown_noise++Generates noise whose spectrum falls off in power by 6 dB per+octave.++> import Sound.DF++> do { n <- brown_noise_m+>    ; audition [] (out1 (n * 0.1)) }++> do { n <- white_noise_m+>    ; audition [] (out1 (n * 0.1)) }++> do { n <- brown_noise_m+>    ; let f = lin_exp n (-1) 1 64 9600+>      in do { o <- sin_osc f 0+>            ; audition [] (out1 (o * 0.1)) } }
+ Help/UGen/Noise/white_noise.help.lhs view
@@ -0,0 +1,8 @@+white_noise++Generates noise whose spectrum has equal power at all frequencies.++> import Sound.DF++> do { n <- white_noise_m+>    ; audition [] (out1 (n * 0.1)) }
+ Help/UGen/Oscillator/impulse.help.lhs view
@@ -0,0 +1,15 @@+impulse f ip++Impulse oscillator.  Outputs non band limited single sample impulses.++   f - frequency (in hertz)+  ip - phase offset (0..1)++> import Sound.DF++> do { o <- impulse 800.0 0.0+>    ; audition [] (out1 (o * 0.1)) }++> do { f <- fmap (\x -> x * 2500.0 + 2505.0) (sin_osc 0.25 0.0)+>    ; o <- impulse f 0.0+>    ; audition [] (out1 (o * 0.1)) }
+ Help/UGen/Oscillator/lf_pulse.help.lhs view
@@ -0,0 +1,14 @@+lf_pulse f ip w++A non-band-limited pulse oscillator. Outputs a high value of one+and a low value of zero.++   f - frequency (in hertz)+  ip - initial phase (0, 1)+   w - pulse width duty cycle (0, 1)++> import Sound.DF++> do { o1 <- fmap (\x -> x * 200.0 + 200.0) (lf_pulse 3.0 0.0 0.3)+>    ; o2 <- fmap (\x -> x * 0.1) (lf_pulse o1 0.0 0.2)+>    ; audition [] (out1 o2) }
+ Help/UGen/Oscillator/lf_saw.help.lhs view
@@ -0,0 +1,18 @@+lf_saw f ip++Sawtooth oscillator.  A non-band-limited sawtooth+oscillator. Output ranges from -1 to +1.++    f - frequency (in hertz)+   ip - initial phase (0,2)++> import Sound.DF++> do { o <- lf_saw 500.0 1.0+>    ; audition [] (out1 (o * 0.1)) }++Used as both Oscillator and LFO.++> do { f <- lf_saw 4.0 0.0+>    ; o <- lf_saw (f * 400.0 + 400.0) 0.0+>    ; audition [] (out1 (o * 0.1)) }
+ Help/UGen/Oscillator/sin_osc.help.lhs view
@@ -0,0 +1,21 @@+sin_osc f ip++   f - frequency +  ip - initial phase++> import Sound.DF++> do { o <- sin_osc 440.0 0.0+>    ; audition [] (out1 (o * 0.1)) }++Used as both Oscillator and LFO.++> do { f <- sin_osc 4.0 0.0+>    ; o <- sin_osc (f * 400.0 + 400.0) 0.0+>    ; audition [] (out1 (o * 0.1)) }++Cancellation.++> do { o1 <- sin_osc 440.0 0.0+>    ; o2 <- sin_osc 440.0 pi+>    ; audition [] (out1 (o1 + o2)) }
+ README view
@@ -0,0 +1,8 @@+hdf - haskell data flow library for audio processing++requires jack.dl from jack.*.++  http://slavepianos.org/rd/f/207983/++(c) rohan drape, 2006-2009+    gpl, http://gnu.org/copyleft/
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ Sound/DF.hs view
@@ -0,0 +1,13 @@+module Sound.DF ( module Sound.DF.Audition+                , module Sound.DF.CGen+                , module Sound.DF.Draw+                , module Sound.DF.Graph+                , module Sound.DF.Node+                , module Sound.DF.UGen ) where++import Sound.DF.Audition+import Sound.DF.CGen+import Sound.DF.Draw+import Sound.DF.Graph+import Sound.DF.Node+import Sound.DF.UGen
+ Sound/DF/Audition.hs view
@@ -0,0 +1,35 @@+module Sound.DF.Audition where++import Sound.DF.CGen+import Sound.DF.Node+import Sound.OpenSoundControl+import System.Directory+import System.FilePath++-- * Interaction with jack.dl server++-- | Allocate buffer.+b_alloc :: Int -> Int -> OSC+b_alloc b n = Message "/b_alloc" [Int b, Int n]++-- | Load graph.+g_load :: Int -> String -> OSC+g_load i s = Message "/g_load" [Int i, String s]++-- | Load graph.+g_unload :: Int -> OSC+g_unload i = Message "/g_unload" [Int i]++-- | Run action with UDP link to jack.dl.+with_jack_dl :: (UDP -> IO a) -> IO a+with_jack_dl = withTransport (openUDP "127.0.0.1" 57190)++-- | Audition graph 'n' after sending initialisation messages 'is'.+audition :: [OSC] -> Node -> IO ()+audition is n = +    do t <- getTemporaryDirectory+       k <- generateID+       let fn = t </> ("audition" ++ show k)+       dl_gen fn n+       with_jack_dl (\fd -> mapM (send fd) is)+       with_jack_dl (\fd -> send fd (g_load 0 (fn <.> "so")))
+ Sound/DF/CGen.hs view
@@ -0,0 +1,208 @@+module Sound.DF.CGen ( -- * C code generator+                       code_gen, dl_gen ) where++import Data.List+import Sound.DF.Node+import Sound.DF.Graph+import System.Cmd+import System.FilePath++-- | Generate C code for graph.+code_gen :: Node -> String+code_gen n = +    let as = analyse (tsort n)+        ns = map fst as+        hd = [ "#include <stdio.h>"+             , "#include <stdlib.h>"+             , "#include <stdbool.h>"+             , "#include <math.h>"+             , "#include <jack.dl.h>"]+        c = [hd, cdef, cstate ns, dsp_init ns, dsp_step as ns]+    in (unlines . concat) c++-- | Generate C code, write file disk and call GNU C compiler to build+--   shared library.+dl_gen :: FilePath -> Node -> IO ()+dl_gen fn n = +    do let c = fn <.> "c"+           so = fn <.> "so"+           gcc = "gcc -g --std=c99 -O2 -shared -I ~/include "+           cmd = gcc ++ c ++ " -o " ++ so+       writeFile c (code_gen n)+       system cmd+       return ()++-- | Construct an identifier.+clabel :: String -> (NodeID, PortID) -> String+clabel p (k, n) = concat [p, "_", show k, "_", show n]++-- | Construct a function/macro call.+ccall :: String -> [String] -> String+ccall s as = concat ([s, "("] ++ intersperse "," as ++ [");"])++-- | A ccall variant with trace output.+d_ccall :: String -> Node -> [String] -> [String]+d_ccall s n as = [ "/*" ++ show n ++ "*/"+                 , ccall s as ]++ctype :: Type -> String+ctype Real_Type = "float"+ctype Integer_Type = "long int"+ctype Boolean_Type = "bool"++type CVar = (String, String, Maybe Double, Bool)++cvar_from_constant :: NodeID -> String -> Constant -> Bool -> CVar+cvar_from_constant k c (Real_Constant i) st = +    (ctype Real_Type, clabel c (k, 0), Just i, st)+cvar_from_constant k c (Integer_Constant i) st = +    (ctype Integer_Type, clabel c (k, 0), Just (fromIntegral i), st)++-- | List of required variable declarations.+cvars_n :: (NodeID, Node) -> [CVar]+cvars_n (k, S i) = +    [cvar_from_constant k "n" i False]+cvars_n (k, R (R_ID j) (Left i)) =+    [cvar_from_constant j "r" i True+    ,cvar_from_constant k "n" i False]+cvars_n (k, R (R_ID _) (Right _)) =+    [("float", clabel "n" (k, 0), Nothing, False)]+cvars_n (k, (A _ _ o)) = +    let f (p, t) = let t' = port_data_type t+                   in (ctype t', clabel "n" (k, p), Nothing, False)+    in map f (zip [0 .. length o - 1] o)+cvars_n (_, (M _ _)) = undefined+cvars_n (_, (P _ _)) = undefined++cvars :: [(NodeID, Node)] -> [CVar]+cvars = concatMap cvars_n++is_stateful :: CVar -> Bool+is_stateful (_, _, _, st) = st++stateful_cvars :: [(NodeID, Node)] -> [CVar]+stateful_cvars = filter is_stateful . cvars++non_stateful_cvars :: [(NodeID, Node)] -> [CVar]+non_stateful_cvars = filter (not . is_stateful) . cvars++cstate :: [(NodeID, Node)] -> [String]+cstate ns = +    let f (t, n, _, _) = t ++ " " ++ n ++ ";"+    in "struct df_state {" : map f (stateful_cvars ns) ++ ["};"]++cstate_init :: String -> [(NodeID, Node)] -> [String]+cstate_init s ns =  +    let f (_, n, Just i, _) = s ++ "->" ++ n ++ " = " ++ show i ++ ";"+        f (_, _, Nothing, _) = error "cstate_init"+    in map f (stateful_cvars ns)++-- | Non-statefule variable declarations.  Unintialised, the node +--   writes the constant value.+non_state_decl :: [(NodeID, Node)] -> [String]+non_state_decl ns =  +    let f (ty, n, _, _) = ty ++ " " ++ n ++ ";"+    in map f (non_stateful_cvars ns)++-- | Generate dsp_init function.+dsp_init :: [(NodeID, Node)] -> [String]+dsp_init ns = +    let a = [ "void *dsp_init(struct world *w, int g)"+            , "{"+            , "struct df_state *s = malloc(sizeof(struct df_state));" ]+        b = [ "return (void*)s;"+            , "}"]+    in a ++ cstate_init "s" ns ++ b++-- | Generate dsp_step function.+dsp_step :: [((NodeID, Node), [Edge])] -> [(NodeID, Node)] -> [String]+dsp_step as ns = +    let s = "void dsp_step(struct world *w, int g, void *ptr, int nf)"+        f (t, n, _, _) = t ++ " " ++ n ++ " = s->" ++ n ++ ";"+        g (_, n, _, _) = "s->" ++ n ++ " = " ++ n ++ ";"+        ss = [ [ s+               , "{"+               , "struct df_state *s = (struct df_state *)ptr;"+               , "/* load state */" ]+             , map f (stateful_cvars ns)+             , [ "/* non-stateful variables */" ]+             , non_state_decl ns                   +             , [ "/* algorithm */" +               , "for(int i = 0; i < nf; i++) {" ]+             , concatMap cgen as+             , [ "}"+               , "/* store state */" ]+             , map g (stateful_cvars ns)+             , [ "}" ] ]+    in concat ss++-- | List of code statements.+cgen :: ((NodeID, Node), [Edge]) -> [String]+cgen ((k, n@(S (Real_Constant x))), []) = +    d_ccall "df_real_constant" n [clabel "n" (k, 0), show x]+cgen ((k, n@(S (Integer_Constant x))), []) = +    d_ccall "df_integer_constant" n [clabel "n" (k, 0), show x]+cgen ((k, n@(R (R_ID j) (Left _))), []) = +    d_ccall "df_rec_r" n [clabel "n" (k, 0), clabel "r" (j, 0)]+cgen ((_, n@(R (R_ID j) (Right _))), [(s, _)]) = +    d_ccall "df_rec_w" n [clabel "r" (j, 0), clabel "n" s]+cgen ((k, n@(A a _ o)), es) = +    let o_l = map (clabel "n") (zip (repeat k) [0 .. length o - 1])+        i_l = map (clabel "n". fst) es+    in d_ccall a n (o_l ++ i_l)+cgen ((_, (P _ _)), _) =+    []+cgen c = error ("cgen: " ++ show c)++-- | Macro definitions+cdef :: [String]+cdef = +    ["/* reader */"+    ,"#define df_integer_constant(o_0,i_0) { o_0 = i_0; }"+    ,"#define df_real_constant(o_0,i_0) { o_0 = i_0; }"+    ,"#define df_rec_r(o_0,i_0) { o_0 = i_0; }"+    ,"#define df_rec_w(o_0,i_0) { o_0 = i_0; }"+    ,"/* instance Num */"+    ,"#define df_add(o_0,i_0,i_1) { o_0 = (i_0) + (i_1); }"+    ,"#define df_mul(o_0,i_0,i_1) { o_0 = (i_0) * (i_1); }"+    ,"#define df_sub(o_0,i_0,i_1) { o_0 = (i_0) - (i_1); }"+    ,"#define df_negate(o_0,i_0) { o_0 = -(i_0); }"+    ,"#define df_fabs(o_0,i_0) { o_0 = fabsf(i_0); }"+    ,"#define df_iabs(o_0,i_0) { o_0 = labs(i_0); }"+    ,"#define df_signum(o_0,i_0) { o_0 = i_0 > 0 ? 1 (i_0 < 0 ? -1 : 0); } }"+    ,"/* instance Fractional */"+    ,"#define df_div(o_0,i_0,i_1) { o_0 = (i_0) / (i_1); }"+    ,"#define df_recip(o_0,i_0) { o_0 = 1.0 / i_0; }"+    ,"/* instance Floating */"+    ,"#define df_exp(o_0,i_0) { o_0 = expf(i_0); }"+    ,"#define df_sqrt(o_0,i_0) { o_0 = sqrtf(i_0); }"+    ,"#define df_log(o_0,i_0) { o_0 = logf(i_0); }"+    ,"#define df_pow(o_0,i_0,i_1) { o_0 = powf(i_0,i_1); }"+    ,"#define df_sin(o_0,i_0) { o_0 = sinf(i_0); }"+    ,"#define df_cos(o_0,i_0) { o_0 = cosf(i_0); }"+    ,"#define df_tan(o_0,i_0) { o_0 = tanf(i_0); }"+    ,"/* instance Ord */"+    ,"#define df_lt(o_0,i_0,i_1) { o_0 = i_0 < i_1 ? true : false; }"+    ,"#define df_lte(o_0,i_0,i_1) { o_0 = i_0 <= i_1 ? true : false; }"+    ,"#define df_gt(o_0,i_0,i_1) { o_0 = i_0 > i_1 ? true : false; }"+    ,"#define df_gte(o_0,i_0,i_1) { o_0 = i_0 >= i_1 ? true : false; }"+    ,"#define df_max(o_0,i_0,i_1) { o_0 = i_0 > i_1 ? i_0 : i_1; }"+    ,"#define df_min(o_0,i_0,i_1) { o_0 = i_0 < i_1 ? i_0 : i_1; }"+    ,"/* instance Eq */"+    ,"#define df_eq(o_0,i_0,i_1) { o_0 = i_0 == i_1 ? true : false; }"+    ,"/* instance RealFrac */"+    ,"#define df_floor(o_0,i_0) { o_0 = floorf(i_0); }"     +    ,"#define df_lrint(o_0,i_0) { o_0 = lrintf(i_0); }"     +    ,"/* Control */"+    ,"#define df_and(o_0,i_0,i_1) { o_0 = i_0 && i_1 ? true : false; }"+    ,"#define df_or(o_0,i_0,i_1) { o_0 = i_0 || i_1 ? true : false; }"+    ,"#define df_select2(o_0,i_0,i_1,i_2) { o_0 = i_0 ? i_1 : i_2; }"+    ,"/* World|Environment */"+    ,"#define df_sample_rate(o_0) { o_0 = w_sr(w); }"    +    ,"#define df_b_read(o_0,i_0,i_1) { o_0=w_b_read1(w,i_0,i_1); }"+    ,"#define df_b_write(i_0,i_1,i_2) { w_b_write1(w,i_0,i_1,i_2); }"+    ,"#define df_random(o_0,i_0) { o_0 = ((float)rand() / (float)RAND_MAX); }"+    ,"#define df_out1(i_0) { w_out1(w,i,i_0); }"+    ,"#define df_out2(i_0,i_1) { w_out2(w,i,i_0,i_1); }"+    ,"#define df_out3(i_0,i_1,i_2) { w_out3(w,i,i_0,i_1,i_2); }"+    ]
+ Sound/DF/Draw.hs view
@@ -0,0 +1,42 @@+module Sound.DF.Draw ( -- * Graph drawing+                       view ) where++import Sound.DF.Node+import Sound.DF.Graph++import Control.Monad+import qualified Data.Graph.Inductive as G+import qualified Data.Graph.Inductive.Graphviz as G+import Data.Maybe+import Data.List+import System.Cmd+import System.Directory+import System.FilePath++-- | Implicit edge from wR to rW.+r_edge :: [(NodeID, Node)] -> (NodeID, Node) -> Maybe Edge+r_edge ns (i, R (R_ID d) (Left _)) = +    let f x (_, (R (R_ID y) (Right _))) = x == y+        f _ _ = False+        (j, _) = fromMaybe (error "r_edge") (find (f d) ns)+    in Just ((j,0),(i,0))+r_edge _ _ = Nothing++-- | Transform the actual graph into the viewing graph.+vgraph :: G.Gr Node (PortID, PortID) -> G.Gr Node (PortID, PortID)+vgraph g = let ns = G.labNodes g+               es = G.labEdges g+               es' = map mod_e (catMaybes (map (r_edge ns) ns))+           in G.mkGraph ns (es ++ es')++draw :: Node -> String+draw = G.graphviz' . vgraph . graph++-- | Draw graph using graphviz.+view :: Node -> IO ()+view n = do t <- getTemporaryDirectory+            let s = draw n+                fn = t </> "df_view" <.> "dot"+            writeFile fn s+            rawSystem "dotty" [fn]+            return ()
+ Sound/DF/Graph.hs view
@@ -0,0 +1,71 @@+module Sound.DF.Graph where++import qualified Data.Graph.Inductive as G+import qualified Data.Graph.Inductive.Query.DFS as G+import Data.List+import Data.Maybe+import Sound.DF.Node++-- * Graph analysis++-- | List of nodes, in left biased order.+nodes :: Node -> [Node]+nodes n@(S _) = [n]+nodes n@(A _ i _) = n : concatMap nodes i+nodes n@(R _ (Left _)) = [n]+nodes n@(R _ (Right (l, r))) = n : (nodes l ++ nodes r)+nodes n@(P i _) = n : nodes i+nodes n@(M l r) = n : (nodes l ++ nodes r)++-- | Read label of node.+label :: [(NodeID, Node)] -> Node -> NodeID+label ns n = let r = find ((== n) . snd) ns+                  in maybe (error ("label: " ++ show n)) fst r++-- | Transform node to source, see through rec_r and proxy and mrg.+source :: [(NodeID, Node)] -> Node -> (NodeID, PortID)+source ns n@(S _) = (label ns n, 0)+source ns n@(A _ _ [_]) = (label ns n, 0)+source _ (A _ _ _) = error "non unary A"+source ns n@(R _ (Left _)) = (label ns n, 0)+source ns (R _ (Right (n, _))) = source ns n+source ns (P n i) = (label ns n, i)+source ns (M l _) = source ns l++-- | Edge between ports.+type Edge = ((NodeID, PortID), (NodeID, PortID))++-- | List incoming node edges, +edges :: [(NodeID, Node)] -> Node -> [Edge]+edges ns r@(A _ is _) = let f i k = (source ns i, (label ns r, k))+                        in zipWith f is [0..]+edges ns r@(R _ (Right (_, rr))) = [(source ns rr, (label ns r, 0))]+edges _ (P _ _) = []+edges _ _ = []++-- | Label nodes and list edges.  Proxy and multiple-root nodes are+--   erased.+analyse :: [Node] -> [((NodeID, Node), [Edge])]+analyse ns = let l_ns = zip [1..] ns+                 w_es (k, n) = ((k, n), edges l_ns n)+                 rem_p ((_, (P _ _)), _) = False+                 rem_p _ = True+                 rem_m ((_, (M _ _)), _) = False+                 rem_m _ = True+            in filter rem_m (filter rem_p (map w_es l_ns))++-- | Transform edge into form required by fgl.+mod_e :: Edge -> (NodeID, NodeID, (PortID, PortID))+mod_e ((l, lp), (r, rp)) = (l, r, (lp, rp))++-- | Generate graph.+graph :: Node -> G.Gr Node (PortID, PortID)+graph n = let a = analyse (nub (nodes n))+              ns = map fst a+              es = concatMap (map mod_e . snd) a+          in G.mkGraph ns es++-- | Topological sort of nodes (via graph).+tsort :: Node -> [Node]+tsort s = let g = graph s+          in map (fromMaybe (error "tsort") . G.lab g) (G.topsort g)
+ Sound/DF/Node.hs view
@@ -0,0 +1,301 @@+module Sound.DF.Node where++import Control.Monad+import Data.Unique++-- * The Node data type++-- | Recursion identifer.+data R_ID = R_ID Int+            deriving (Eq)++-- | Enumeration of types of data on ports.+data Type = Real_Type +          | Integer_Type+          | Boolean_Type+            deriving (Eq, Show)++-- | Constant values.+data Constant = Real_Constant Double+              | Integer_Constant Int+                deriving (Eq)++-- | How to display constants.+instance Show Constant where+    show (Real_Constant x) = show x+    show (Integer_Constant x) = show x++-- | Port meta data.+data Port = Port { port_data_type :: Type+                 , port_tokens :: Int }+            deriving (Eq)++-- | Data flow node.+data Node = S { constant :: Constant }+          | A { operator :: String+              , inputs :: [Node]+              , outputs :: [Port] }+          | R { identifier :: R_ID+              , input :: Either Constant (Node, Node) }+          | P { proxy :: Node+              , port :: Int }+          | M { mleft :: Node+              , mright :: Node }+            deriving (Eq)++-- | Node identifier.+type NodeID = Int++-- | Port identifier.+type PortID = Int++-- | Multiple root graph (alias for M).+mrg :: Node -> Node -> Node+mrg = M++-- | How to display nodes.+instance Show Node where+    show (S x) = show x+    show (A p _ _) = p+    show (R (R_ID d) (Left i)) = "rR_" ++ show d ++ ":" ++ show i+    show (R (R_ID d) (Right _)) = "wR_" ++ show d+    show (P _ p) = "proxy_" ++ show p+    show (M l r) = "m(" ++ show l ++ "," ++ show r ++ ")"++-- * Querying data type on ports++-- | Type of a constant value.+constant_type :: Constant -> Type+constant_type (Real_Constant _) = Real_Type+constant_type (Integer_Constant _) = Integer_Type++-- | Type of a node.+node_type :: Node -> Type+node_type (S c) = constant_type c+node_type (A _ _ [Port t _]) = t+node_type (A _ _ _) = error "node_type: A: non unary output"+node_type (R _ (Left c)) = constant_type c+node_type (R _ (Right (n, _))) = node_type n+node_type (P n i) = port_data_type (outputs n !! i)+node_type (M l _) = node_type l++-- * Numeric primitives for class instances++-- | Lift constant to node.+n_real_constant :: Double -> Node+n_real_constant = S . Real_Constant++-- | Lift constant to node.+n_integer_constant :: Int -> Node+n_integer_constant = S . Integer_Constant++-- | Unary operator over Real and Integer values.+numerical_unary_operator :: String -> Node -> Node+numerical_unary_operator s p = A s [p] [Port (node_type p) 1]++-- | Binary operator over Real and Integer values.+numerical_binary_operator :: String -> Node -> Node -> Node+numerical_binary_operator s p q =+    let pt = node_type p+        qt = node_type q+    in if pt /= qt+       then error (show ("binary operator", s, pt, qt, p, q))+       else A s [p, q] [Port pt 1]++-- | Unary operator over Real values.+real_unary_operator :: String -> Node -> Node+real_unary_operator s p =+    if node_type p == Real_Type+    then A s [p] [Port Real_Type 1]+    else error (show ("real unary operator", s, p))++-- | Binary operator over Real values.+real_binary_operator :: String -> Node -> Node -> Node+real_binary_operator s p q =+    if node_type p == Real_Type && node_type q == Real_Type+    then A s [p, q] [Port Real_Type 1]+    else error (show ("real binary operator", s, p, q))+    +-- | Addition.+n_add :: Node -> Node -> Node+n_add = numerical_binary_operator "df_add"++-- | Multiplication.+n_mul :: Node -> Node -> Node+n_mul = numerical_binary_operator "df_mul"++-- | Subtraction.+n_sub :: Node -> Node -> Node+n_sub = numerical_binary_operator "df_sub"++-- | Negation.+n_negate :: Node -> Node+n_negate = numerical_unary_operator "df_negate"++-- | Absolute value.+n_abs :: Node -> Node+n_abs p | node_type p == Real_Type = A "df_fabs" [p] [Port Real_Type 1]+        | node_type p == Integer_Type = A "df_iabs" [p] [Port Integer_Type 1]+        | otherwise = error "n_abs" {- quieten compiler -}++-- | Sign of.+n_signum :: Node -> Node+n_signum = numerical_unary_operator "df_signum"++instance Num Node where+  (+) = n_add+  (*) = n_mul+  (-) = n_sub+  negate = n_negate+  abs = n_abs+  signum = n_signum+  fromInteger = n_integer_constant . fromInteger++-- | Division.+n_div :: Node -> Node -> Node+n_div = real_binary_operator "df_div"++-- | Reciprocal.+n_recip :: Node -> Node+n_recip = real_unary_operator "df_recip"++instance Fractional Node where+  (/) = n_div+  recip = n_recip+  fromRational = n_real_constant . fromRational++-- | Natural exponential.+n_exp :: Node -> Node+n_exp = real_unary_operator "df_exp"++-- | Square root.+n_sqrt :: Node -> Node+n_sqrt = real_unary_operator "df_sqrt"++-- | Natural logarithm.+n_log :: Node -> Node+n_log = real_unary_operator "df_log"++-- | 'p' to the power of 'q'.+n_pow :: Node -> Node -> Node+n_pow = real_binary_operator "df_pow"++-- | Sine.+n_sin :: Node -> Node+n_sin = real_unary_operator "df_sin"++-- | Cosine.+n_cos :: Node -> Node+n_cos = real_unary_operator "df_cos"++-- | Tangent.+n_tan :: Node -> Node+n_tan = real_unary_operator "df_tan"++instance Floating Node where+  pi = n_real_constant pi+  exp = n_exp+  sqrt = n_sqrt+  log = n_log+  (**) = n_pow+  logBase = undefined+  sin = n_sin+  tan = n_tan+  cos = n_cos+  asin = undefined+  atan = undefined+  acos = undefined+  sinh = undefined+  tanh = undefined+  cosh = undefined+  asinh = undefined+  atanh = undefined+  acosh = undefined++-- | Operator from Real or Integer values to a Boolean value.+numerical_comparison_operator :: String -> Node -> Node -> Node+numerical_comparison_operator s p q =+    let pt = node_type p+        qt = node_type q+    in if pt == qt && (pt == Integer_Type || pt == Real_Type)+       then A s [p, q] [Port Boolean_Type 1]+       else error (show ("comparison operator", s, pt, qt, p, q))++-- | Less than.+n_lt :: Node -> Node -> Node+n_lt = numerical_comparison_operator "df_lt"++-- | Greater than or equal to.+n_gte :: Node -> Node -> Node+n_gte = numerical_comparison_operator "df_gte"++-- | Greater than.+n_gt :: Node -> Node -> Node+n_gt = numerical_comparison_operator "df_gt"++-- | Less than or equal to.+n_lte :: Node -> Node -> Node+n_lte = numerical_comparison_operator "df_lte"++-- | Maximum.+n_max :: Node -> Node -> Node+n_max = numerical_binary_operator "df_max"++-- | Minimum.+n_min :: Node -> Node -> Node+n_min = numerical_binary_operator "df_min"++instance Ord Node where+  compare = undefined+  (<) = undefined+  (>=) = undefined+  (>) = undefined+  (<=) = undefined+  max = n_max+  min = n_min++-- | Real valued floor. +n_floor :: Node -> Node+n_floor = real_unary_operator "df_floor"++-- | Integer valued floor.+n_lrint :: Node -> Node+n_lrint p +    | node_type p == Real_Type = A "df_lrint" [p] [Port Integer_Type 1]+    | otherwise = error "n_lrint"++{-+class (Real a, Fractional a) => RealFrac a where+  properFraction :: (Integral b) => a -> (b, a)+  truncate :: (Integral b) => a -> b+  round :: (Integral b) => a -> b+  ceiling :: (Integral b) => a -> b+  floor :: (Integral b) => a -> b+-}++-- * Class of monads generating identifers++class (Monad m) => ID m where+   generateID :: m Int++instance ID IO where+   generateID = liftM hashUnique newUnique++-- * Backward arcs++-- | Introduce backward arc with implicit unit delay.+rec_r :: R_ID -> Constant -> (Node -> (Node, Node)) -> Node+rec_r n i f = R n (Right (f (R n (Left i))))++-- | Monadic variant of rec_r.+rec :: ID m => Constant -> (Node -> (Node, Node)) -> m Node+rec i f = do n <- generateID+             return (rec_r (R_ID n) i f)++-- | Variant or rec with monadic action in backward arc.+recm :: ID m => Constant -> (Node -> m (Node, Node)) -> m Node+recm i f = +    do n <- generateID+       let r_r = R (R_ID n) (Left i)+       r <- f r_r+       return (R (R_ID n) (Right r))
+ Sound/DF/UGen.hs view
@@ -0,0 +1,346 @@+module Sound.DF.UGen where++import Control.Monad+import Sound.DF.Node++-- * Primitive unit generators++-- | Uniform input type operator.+uniform_operator :: Type -> Int -> String -> [Node] -> Node+uniform_operator t n s ps =+    if all (\p -> node_type p == t) ps+    then A s ps (replicate n (Port t 1)) +    else error (show ("output operator", ps))++-- | Single channel output.+out1 :: Node -> Node+out1 p = uniform_operator Real_Type 0 "df_out1" [p]++-- | Two channel output.+out2 :: (Node, Node) -> Node+out2 (p, q) = uniform_operator Real_Type 0 "df_out2" [p, q]++-- | Three channel output.+out3 :: (Node, Node, Node) -> Node+out3 (p, q, r) = uniform_operator Real_Type 0 "df_out3" [p, q, r]++-- | Operating sample rate.+sample_rate :: Node+sample_rate = A "df_sample_rate" [] [Port Real_Type 1]++-- | Equal to.+eq :: Node -> Node -> Node+eq = numerical_comparison_operator "df_eq"++-- | If 'p' then 'q' else 'r'.+select2 :: Node -> Node -> Node -> Node+select2 p q r = +    if node_type p == Boolean_Type && +       node_type q == node_type r+    then A "df_select2" [p, q, r] [Port (node_type q) 1]+    else error (show ("select2", p, q, r))++-- | Binary boolean valued operator.+logical_operator :: String -> Node -> Node -> Node+logical_operator s p q =+    if node_type p == Boolean_Type && node_type q == Boolean_Type+    then A s [p, q] [Port Boolean_Type 1]+    else error (show ("logical operator", s, p, q))+    +-- | Logical and.+n_and :: Node -> Node -> Node+n_and = logical_operator "df_and"++-- | Logical or.+n_or :: Node -> Node -> Node+n_or = logical_operator "df_or"++-- | Buffer read.+b_read :: Node -> Node -> Node+b_read p q =+    if node_type p == Integer_Type && node_type q == Integer_Type+    then A "df_b_read" [p, q] [Port Real_Type 1]+    else error (show ("b_read", p, q))++-- | Buffer write.+b_write :: Node -> Node -> Node -> Node+b_write p q r =+    if node_type p == Integer_Type && +       node_type q == Integer_Type && +       node_type r == Real_Type+    then A "df_b_write" [p, q, r] []+    else error (show ("b_write", p, q, r))+ +-- | White noise (0, 1).+white_noise_u :: Node -> Node+white_noise_u p = A "df_random" [p] [Port Real_Type 1]++-- * Ordinary unit generators++-- | Linear pan.+pan2 :: Node -> Node -> (Node, Node)+pan2 p q = (p * q, p * (q - 1.0))++-- | Reversed tuple constructor, (ie. @flip (,)@)+swap :: a -> b -> (b, a)+swap = flip (,)++-- | Duplicate a value into a tuple.+split :: a -> (a, a)+split p = (p, p)++-- | Single sample delay with indicated initial value.+unit_delay :: ID m => Constant -> Node -> m Node+unit_delay y0 = rec y0 . swap++-- | Single place infinte impulse response filter with indicated initial value.+iir1 :: ID m => Constant -> (Node -> Node -> Node) -> Node -> m Node+iir1 y0 f i = rec y0 (split . f i)++-- | Two place infinte impulse response filter.+iir2 :: ID m => (Node -> Node -> Node -> Node) -> Node -> m Node+iir2 f i = recm +             (Real_Constant 0)+             (liftM split . (\y1 -> do y2 <- unit_delay (Real_Constant 0) y1+                                       return (f i y1 y2)))++-- | Single place finte impulse response filter.+fir1 :: ID m => (Node -> Node -> Node) -> Node -> m Node+fir1 f i = do x1 <- unit_delay (Real_Constant 0) i+              return (f i x1)++-- | Two place finte impulse response filter.+fir2 :: ID m => (Node -> Node -> Node -> Node) -> Node -> m Node+fir2 f i = do x1 <- unit_delay (Real_Constant 0) i+              x2 <- unit_delay (Real_Constant 0) x1+              return (f i x1 x2)++-- | Ordinary biquad filter section.+biquad :: ID m => (Node -> Node -> Node -> Node -> Node -> Node) -> Node -> m Node+biquad f i = recm+               (Real_Constant 0)+               (liftM split . (\y1 -> do x1 <- unit_delay (Real_Constant 0) i+                                         x2 <- unit_delay (Real_Constant 0) x1+                                         y2 <- unit_delay (Real_Constant 0) y1+                                         return (f i x1 x2 y1 y2)))++-- | Counter from indicated initial value.+counter :: ID m => Constant -> Node -> m Node+counter y0 = iir1 y0 (+)++-- | Environment value, equal to @'two_pi' / 'sample_rate'@.+radians_per_sample :: Node+radians_per_sample = two_pi / sample_rate++-- | r = cycle (two-pi), hz = frequency, sr = sample rate+hz_to_incr :: Node -> Node -> Node -> Node+hz_to_incr r hz sr = (r / sr) * hz++-- | Two pi.+two_pi :: Floating a => a+two_pi = 2.0 * pi++-- | If 'q >= p' then 'q - p' else 'q'.+clipr :: Node -> Node -> Node+clipr p q = select2 (q `n_gte` p) (q - p) q++-- | r = right hand edge, ip = initial phase, x = increment+phasor :: ID m => Constant -> Node -> Node -> m Node+phasor ip r = iir1 ip (\x y1 -> clipr r (x + y1))++-- | Sine oscillator, f = frequency in hz.+sin_osc :: ID m => Node -> Double -> m Node+sin_osc f ip = +    do p <- phasor (Real_Constant ip) two_pi (hz_to_incr two_pi f sample_rate)+       return (sin p)++-- | Non-band limited sawtooth oscillator.+lf_saw :: ID m => Node -> Double -> m Node+lf_saw f ip = do p <- phasor (Real_Constant ip) 2.0 (hz_to_incr 2.0 f sample_rate)+                 return (p - 1.0)++-- | Non-band limited pulse oscillator, w = width (0,1).+lf_pulse :: ID m => Node -> Double -> Node -> m Node+lf_pulse f ip w = +    do p <- phasor (Real_Constant ip) 1.0 (hz_to_incr 1.0 f sample_rate)+       return (select2 (p `n_gte` w) 0.0 1.0)++-- | Midi note number to cycles per second.+midi_cps :: Floating a => a -> a+midi_cps a = 440.0 * (2.0 ** ((a - 69.0) * (1.0 / 12.0)))++-- | Multiply and add.+mul_add :: Num a => a -> a -> a -> a+mul_add i m a = (i * m) + a++calc_fb :: Floating a => a -> a -> a+calc_fb delayt decayt = exp ((log 0.001 * delayt) / decayt)++-- | Delay.+delay :: ID m => Node -> Node -> Node -> m Node+delay b s n =+    do wi <- phasor (Integer_Constant 0) n 1+       let ri = clipr n (wi + 1)+       return (mrg (b_read b ri) (b_write b wi s))++-- | Comb filter.+buf_comb_n :: ID m => Node -> Node -> Node -> Node -> m Node+buf_comb_n b s dlt dct =+    do let n = n_lrint (dlt * sample_rate)+           fb = calc_fb dlt dct+           c i = do x <- delay b i n+                    return (split (s + (fb * x)))+       recm (Real_Constant 0) c++-- | Resonant low pass filter, f = frequency, r = resonance.+rlpf :: ID m => Node -> Node -> Node -> m Node+rlpf i f r = +    let qr = max 0.001 r+        pf = f * radians_per_sample+        d = tan (pf * qr * 0.5)+        c = (1.0 - d) / (1.0 + d)+        b1 = (1.0 + c) * cos pf+        b2 = negate c+        a0 = (1.0 + c - b1) * 0.25+    in iir2 (\x y1 y2 -> a0 * x + b1 * y1 + b2 * y2) i++-- | Constrain p in (-q, q).+clip2 :: Node -> Node -> Node+clip2 p q =+    let nq = negate q +    in min q (max p nq)++-- | White noise (-1, 1).+white_noise :: Node -> Node+white_noise p = white_noise_u p * 2.0 - 1.0++-- | White noise (-1, 1).+white_noise_m :: ID m => m Node+white_noise_m = +    do i <- generateID+       return (white_noise (n_integer_constant i))++-- | Brown noise (-1, 1).+brown_noise_m :: ID m => m Node+brown_noise_m = +    do w <- white_noise_m+       let w8 = w / 8.0+       iir1 +         (Real_Constant 0) +         (\x y1 -> let z = x + y1 +                       r = select2 (z `n_lt` (-1.0)) ((-2.0) - z) z+                   in select2 (z `n_gt` 1.0) (2.0 - z) r)+         w8++-- | Two zero fixed midpass filter.+bpz2 :: ID m => Node -> m Node+bpz2 = fir2 (\x _ x2 -> (x - x2) * 0.5)++-- | Two zero fixed midcut filter.+brz2 :: ID m => Node -> m Node+brz2 = fir2 (\x _ x2 -> (x + x2) * 0.5)++-- | Two point average filter+lpz1 :: ID m => Node -> m Node+lpz1 = fir1 (\x x1 -> (x + x1) * 0.5)++-- | Two zero fixed lowpass filter+lpz2 :: ID m => Node -> m Node+lpz2 = fir2 (\x x1 x2 -> (x + (2.0 * x1) + x2) * 0.25)++-- | One pole filter.+one_pole :: ID m => Node -> Node -> m Node+one_pole i cf = iir1 +                  (Real_Constant 0) +                  (\x y1 -> ((1.0 - abs cf) * x) + (cf * y1)) +                  i++-- | One zero filter.+one_zero :: ID m => Node -> Node -> m Node+one_zero i cf = fir1 (\x x1 -> ((1.0 - abs cf) * x) + (cf * x1)) i++-- | Second order filter section.+sos :: ID m => Node -> Node -> Node -> Node -> Node -> Node -> m Node+sos i a0 a1 a2 b1 b2 = +    let f x x1 x2 y1 y2 = a0*x + a1*x1 + a2*x2 + b1*y1 + b2*y2+    in biquad f i++-- | Impulse oscillator (non band limited).+impulse :: ID m => Node -> Double -> m Node+impulse f ip =+    do let i = hz_to_incr 1.0 f sample_rate+       p <- phasor (Real_Constant ip) 1.0 i+       x1 <- unit_delay (Real_Constant 0) p+       let s = (x1 `n_lt` 0.5) `n_and` (p `n_gte` 0.5)+       return (select2 s 1.0 0.0)++-- | Two pole resonant filter.+resonz :: ID m => Node -> Node -> Node -> m Node+resonz i f rq = +    let ff = f * radians_per_sample+        b = ff * rq+        r = 1.0 - b * 0.5+        two_r = 2.0 * r+        r2 = r * r+        ct = (two_r * cos ff) / (1.0 + r2)+        b1 = two_r * ct+        b2 = negate r2+        a0 = (1.0 - r2) * 0.5+    in iir2 (\x y1 y2 -> let y0 = x + b1 * y1 + b2 * y2+                         in a0 * (y0 - y2)) i++-- | Sample and hold.+latch :: ID m => Node -> Node -> m Node+latch i t = iir1 +              (Real_Constant 0) +              (\x y1 -> select2 (t `n_gt` 0.0) x y1) +              i++-- | Linear range conversion.+lin_lin :: Fractional a => a -> a -> a -> a -> a -> a+lin_lin i in_l in_r out_l out_r =+    let s = (out_r - out_l) / (in_r - in_l)+        o = out_l - (s * in_l)+    in (i * s) + o++-- | Exponential range conversion.+lin_exp :: Floating a => a -> a -> a -> a -> a -> a+lin_exp i in_l in_r out_l out_r =+    let rt = out_r / out_l+        rn = 1.0 / (in_r - in_l)+        rr = rn * negate in_l+    in out_l * (rt ** (i * rn + rr))++-- | Exponential decay.+decay :: ID m => Node -> Node -> m Node+decay i dt =+    let b1 = exp (log 0.001 / (dt * sample_rate))+    in iir1 (Real_Constant 0) (\x y1 -> x + b1 * y1) i++-- | Exponential decay (equvalent to @decay dcy - decay atk@).+decay2 :: ID m => Node -> Node -> Node -> m Node+decay2 i atk dcy =  liftM2 (-) (decay i dcy) (decay i atk)++-- | Single sample delay.+delay1 :: ID m => Node -> m Node+delay1 = iir1 (Real_Constant 0) (\_ y1 -> y1)++-- | Two sample delay.+delay2 :: ID m => Node -> m Node+delay2 = iir2 (\_ _ y2 -> y2)++-- | Simple averaging filter.+lag :: ID m => Node -> Node -> m Node+lag i t = let b1 = exp (log (0.001 / (t * sample_rate)))+          in iir1 (Real_Constant 0) (\x y1 -> x + b1 * (y1 - x)) i++-- | Nested lag filter.+lag2 :: ID m => Node -> Node -> m Node+lag2 i t = do a <- lag i t+              lag a t++-- | Twice nested lag filter.+lag3 :: ID m => Node -> Node -> m Node+lag3 i t = do a <- lag i t+              b <- lag a t+              lag b t
+ hdf.cabal view
@@ -0,0 +1,54 @@+Name:              hdf+Version:           0.7+Synopsis:          Haskell data flow library for audio processing+Description:       Haskell data flow library for audio processing+License:           GPL+Category:          Sound+Copyright:         (c) Rohan Drape, 2006-2009+Author:            Rohan Drape+Maintainer:        rd@slavepianos.org+Stability:         Experimental+Homepage:          http://www.slavepianos.org/rd/f/740981/+Tested-With:       GHC == 6.8.2+Build-Type:        Simple+Cabal-Version:     >= 1.6++Data-files:        README+                   -- The below is appended by:+                   -- find Help -name "*.[l]hs" | sort | \+                   -- sed "s/^/                   /"+                   Help/Graphs/analog-bubbles.lhs+                   Help/Graphs/lfo-modulation.lhs+                   Help/Graphs/moto-rev.lhs+                   Help/Graphs/sprinkler.lhs+                   Help/UGen/Filter/buf_comb_n.help.lhs+                   Help/UGen/Filter/decay.help.lhs+                   Help/UGen/Filter/iir2.help.lhs+                   Help/UGen/Filter/lag.help.lhs+                   Help/UGen/Filter/latch.help.lhs+                   Help/UGen/Filter/lin_exp.help.lhs+                   Help/UGen/Filter/lin_lin.help.lhs+                   Help/UGen/Filter/resonz.help.lhs+                   Help/UGen/Filter/rlpf.help.lhs+                   Help/UGen/Noise/brown_noise.help.lhs+                   Help/UGen/Noise/white_noise.help.lhs+                   Help/UGen/Oscillator/impulse.help.lhs+                   Help/UGen/Oscillator/lf_pulse.help.lhs+                   Help/UGen/Oscillator/lf_saw.help.lhs+                   Help/UGen/Oscillator/sin_osc.help.lhs++Library+  Build-Depends:   base == 3.*,+                   directory,+                   fgl,+                   filepath,+                   hosc == 0.7,+                   process+  GHC-Options:     -Wall -fwarn-tabs+  Exposed-modules: Sound.DF+  Other-modules:   Sound.DF.Audition+                   Sound.DF.CGen+                   Sound.DF.Draw+                   Sound.DF.Graph+                   Sound.DF.Node+                   Sound.DF.UGen