packages feed

hdf 0.14 → 0.15

raw patch · 34 files changed

+698/−273 lines, 34 filesdep +fgl-visualizedep −sc3-rdudep ~hoscdep ~hsc3PVP ok

version bump matches the API change (PVP)

Dependencies added: fgl-visualize

Dependencies removed: sc3-rdu

Dependency ranges changed: hosc, hsc3

API changes (from Hackage documentation)

- Sound.DF.Uniform.Faust: audition :: [Message] -> BD -> IO ()
- Sound.DF.Uniform.GADT.Audition: audition :: [Message] -> DF () -> IO ()
- Sound.DF.Uniform.GADT.DF: M :: DF a -> DF () -> DF a
- Sound.DF.Uniform.GADT.DF: instance K' a => Typeable (DF a)
- Sound.DF.Uniform.GADT.UGen: hpf_c :: Floating t => t -> t -> T5 t
- Sound.DF.Uniform.LL.Audition: audition :: [Message] -> Instructions -> IO ()
- Sound.DF.Uniform.LL.K: instance Typeable1 Vec
- Sound.DF.Uniform.UDF: UDF_M :: UDF -> UDF -> UDF
+ Sound.DF.Uniform.Faust: audition_rju :: [Message] -> BD -> IO ()
+ Sound.DF.Uniform.GADT.Audition: audition_rju :: [Message] -> DF () -> IO ()
+ Sound.DF.Uniform.GADT.Audition: df_instructions :: DF () -> Instructions
+ Sound.DF.Uniform.GADT.DF: MCE :: [DF a] -> DF a
+ Sound.DF.Uniform.GADT.DF: MRG :: DF a -> DF () -> DF a
+ Sound.DF.Uniform.GADT.DF: instance Typeable DF
+ Sound.DF.Uniform.GADT.DF: is_mce :: DF t -> Bool
+ Sound.DF.Uniform.GADT.DF: lift_mce :: (DF a -> DF b) -> DF a -> DF b
+ Sound.DF.Uniform.GADT.DF: lift_mce2 :: (DF a -> DF b -> DF c) -> DF a -> DF b -> DF c
+ Sound.DF.Uniform.GADT.DF: lift_mce3 :: (DF a -> DF b -> DF c -> DF d) -> DF a -> DF b -> DF c -> DF d
+ Sound.DF.Uniform.GADT.DF: mce2 :: DF a -> DF a -> DF a
+ Sound.DF.Uniform.GADT.DF: mce_degree :: DF t -> Int
+ Sound.DF.Uniform.GADT.DF: mce_extend :: Int -> DF t -> [DF t]
+ Sound.DF.Uniform.GADT.DF: mce_extend3 :: DF a -> DF b -> DF c -> ([DF a], [DF b], [DF c])
+ Sound.DF.Uniform.GADT.DF: mk_p1 :: (K' a, K' b) => String -> TypeRep -> DF a -> DF b
+ Sound.DF.Uniform.GADT.DF: mk_p2 :: (K' a, K' b, K' c) => String -> TypeRep -> DF a -> DF b -> DF c
+ Sound.DF.Uniform.GADT.DF: mk_p3 :: (K' a, K' b, K' c, K' d) => String -> TypeRep -> DF a -> DF b -> DF c -> DF d
+ Sound.DF.Uniform.GADT.DF: out :: DF Float -> DF ()
+ Sound.DF.Uniform.GADT.DF: unmce :: DF t -> [DF t]
+ Sound.DF.Uniform.GADT.DF: unmce2 :: Show t => DF t -> (DF t, DF t)
+ Sound.DF.Uniform.GADT.UGen: a_tbl :: Int -> [Float] -> DF (Vec Float)
+ Sound.DF.Uniform.GADT.UGen: allpass_n' :: V_Id -> Float -> DF Float -> DF Float -> DF Float -> DF Float
+ Sound.DF.Uniform.GADT.UGen: comb_n' :: V_Id -> Float -> DF Float -> DF Float -> DF Float -> DF Float
+ Sound.DF.Uniform.GADT.UGen: counter_reset :: K_Num a => a -> DF a -> DF Bool -> DF a
+ Sound.DF.Uniform.GADT.UGen: delay_n :: Int -> DF Float -> Float -> DF Float -> DF Float
+ Sound.DF.Uniform.GADT.UGen: dust :: Int32 -> DF Float -> DF Float
+ Sound.DF.Uniform.GADT.UGen: hpz1 :: DF Float -> DF Float
+ Sound.DF.Uniform.GADT.UGen: hpz2 :: DF Float -> DF Float
+ Sound.DF.Uniform.GADT.UGen: k_sample_dur :: Fractional n => n
+ Sound.DF.Uniform.GADT.UGen: lf_noise1 :: Int32 -> DF Float -> DF Float
+ Sound.DF.Uniform.GADT.UGen: line :: DF Float -> DF Float -> DF Float -> DF Float
+ Sound.DF.Uniform.GADT.UGen: lpf :: DF Float -> DF Float -> DF Float
+ Sound.DF.Uniform.GADT.UGen: lpf_or_hpf_c :: Floating t => Bool -> t -> t -> T5 t
+ Sound.DF.Uniform.GADT.UGen: phasor' :: K_Num a => DF a -> a -> DF a -> DF a
+ Sound.DF.Uniform.GADT.UGen: ramp :: DF Float -> DF Float -> DF Float
+ Sound.DF.Uniform.GADT.UGen: rand :: Int32 -> DF Float -> DF Float -> DF Float
+ Sound.DF.Uniform.GADT.UGen: resonz' :: DF Float -> DF Float -> DF Float -> DF Float
+ Sound.DF.Uniform.GADT.UGen: rlpf' :: DF Float -> DF Float -> DF Float -> DF Float
+ Sound.DF.Uniform.GADT.UGen: silent :: DF Float
+ Sound.DF.Uniform.GADT.UGen: unit_line :: DF Float -> DF Float
+ Sound.DF.Uniform.GADT.UGen: unit_trigger :: DF Bool
+ Sound.DF.Uniform.GADT.UGen: w_sample_dur :: DF Float
+ Sound.DF.Uniform.LL.Audition: audition_rju :: [Message] -> Instructions -> IO ()
+ Sound.DF.Uniform.LL.Audition: rdl :: Int -> UGen -> UGen
+ Sound.DF.Uniform.LL.CGen: Var_B :: Bool -> Var_Fld
+ Sound.DF.Uniform.LL.CGen: Var_F :: Float -> Var_Fld
+ Sound.DF.Uniform.LL.CGen: Var_I :: Int32 -> Var_Fld
+ Sound.DF.Uniform.LL.CGen: Var_V :: [Float] -> Var_Fld
+ Sound.DF.Uniform.LL.CGen: data Var_Fld
+ Sound.DF.Uniform.LL.CGen: host_compiler_cmd_str :: (Host, FilePath) -> String
+ Sound.DF.Uniform.LL.CGen: var_fld_initialiser :: Var_Fld -> String
+ Sound.DF.Uniform.LL.K: instance Typeable Vec
+ Sound.DF.Uniform.UDF: UDF_MRG :: UDF -> UDF -> UDF
+ Sound.DF.Uniform.UDF: from_r_id :: R_Id -> Id
- Sound.DF.Uniform.GADT.UGen: comb_n :: V_Id -> Float -> DF Float -> DF Float -> DF Float -> DF Float
+ Sound.DF.Uniform.GADT.UGen: comb_n :: [Int] -> Float -> DF Float -> DF Float -> DF Float -> DF Float
- Sound.DF.Uniform.GADT.UGen: delay1 :: K_Num a => DF a -> DF a
+ Sound.DF.Uniform.GADT.UGen: delay1 :: DF Float -> DF Float
- Sound.DF.Uniform.GADT.UGen: delay2 :: K_Num a => DF a -> DF a
+ Sound.DF.Uniform.GADT.UGen: delay2 :: DF Float -> DF Float
- Sound.DF.Uniform.LL.CGen: c_init_atom :: Show a => C_QName -> a -> String
+ Sound.DF.Uniform.LL.CGen: c_init_atom :: C_QName -> Var_Fld -> String
- Sound.DF.Uniform.LL.CGen: c_init_var :: (Eq n, Show n) => C_QName -> Either n [n] -> [String]
+ Sound.DF.Uniform.LL.CGen: c_init_var :: C_QName -> Var_Fld -> [String]
- Sound.DF.Uniform.LL.CGen: type Var = (Var_Ty, TypeRep, Id, Maybe (Either Float [Float]))
+ Sound.DF.Uniform.LL.CGen: type Var = (Var_Ty, TypeRep, Id, Maybe Var_Fld)

Files

Help/hdf.lhs view
@@ -1,3 +1,5 @@+# hdf+ > import Sound.DF.Uniform.GADT  A counter is a first order `iir` at `+` with a unit delay.
README view
@@ -1,20 +1,66 @@ hdf - haskell data flow ----------------------- -[haskell][hs] library for audio processing+[Haskell][hs] library for uniform rate audio signal processing. -requires either `RDL` from [sc3-rdu][sc3-rdu] or `jack-dl` from [rju][rju].+It generates [C][c] code that requires either+`RDL` (from [sc3-rdu][sc3-rdu]) or `jack-dl` (from [rju][rju]). -implements `text-dl` for testing.+The [SC2][sc2] [analog bubbles][ab] graph can be written: -there is a small set of [graphs][ix].+~~~~+  let o = lf_saw (mce2 8.0 7.23) 0.0 * 3.0 + 80.0+      m = lf_saw 0.4 0.0 * 24.0 + o+      s = sin_osc (midi_cps m) 0.0 * 0.04+      c = comb_n [0,1] 0.4 s 0.2 4.0+  in out c+~~~~ +The data flow graph this generates is:++![](sw/hdf/svg/analog-bubbles.svg)++The generated C-code (for `jack-dl`) is [c/gen/analog-bubbles.c](sw/hdf/c/gen/analog-bubbles.c).++Slightly more elaborate, the [berlin 1977][b7] graph can be written:++~~~~+    let clock_rate = 9+        clock_time = 1 / clock_rate+        clock = impulse clock_rate 0 -- sequencer trigger+        tr = trigger clock+        note = sequ 0 [55,60,63,62,60,67,63,58] tr -- midi note pattern sequencer+        tr_16 = pulse_divider tr 16 0 -- divide tr by 16+        note' = sequ 1 [-12,-7,-5,0,2,5] tr_16 + note -- transpose+        freq = midi_cps note' -- convert midi note to cycles per second+        env = decay2 clock (0.05 * clock_time) (2 * clock_time)+        amp = env * 0.1 + 0.02 -- amplitude envelope+        filt = env * (sin_osc 0.17 0 * 800) + 1400 -- filter frequency+        pw = sin_osc (mce2 0.08 0.09) 0 * 0.45 + 0.5 -- pulse width LFO(s)+        s = lf_pulse freq 0 pw * amp -- not bandlimited+    in out (comb_n [0,1] 0.2 (rlpf s filt 0.15) (mce2 0.2 0.17) 1.5)+~~~~++The data flow graph this generates is:++![](sw/hdf/svg/berlin-1977.svg)++The generated C-code (for `jack-dl`) is [c/gen/berlin-1977.c](sw/hdf/c/gen/berlin-1977.c).++<!-- These are from the small set of example [graphs][ix]. -->++hdf implements `text-dl` for testing.+ [hs]: http://haskell.org/+[c]: http://c2.com/cgi/wiki?CeeLanguage [sc3-rdu]: http://rd.slavepianos.org/?t=sc3-rdu [rju]: http://rd.slavepianos.org/?t=rju-[ix]: http://rd.slavepianos.org/?t=hdf&m=md/ix.md+[ab]: sw/hsc3-graphs/gr/analog-bubbles.scd+[b7]: sw/hsc3-graphs/gr/berlin-1977.scd+[sc2]: http://audiosynth.com/+[ix]: http://rd.slavepianos.org/?t=hdf&e=md/ix.md -© [rohan drape][rd], 2006-2013, [gpl]+© [rohan drape][rd], 2006-2014, [gpl]  [rd]: http://rd.slavepianos.org/ [gpl]: http://gnu.org/copyleft/
Sound/DF/Uniform/Faust.hs view
@@ -2,6 +2,7 @@ module Sound.DF.Uniform.Faust where  import qualified Data.Graph.Inductive as G {- fgl -}+import qualified Data.Graph.Inductive.Dot as G {- fgl-visualize -} import Data.Maybe {- base -} import Data.List {- base -} import qualified Data.List.Split as S {- split -}@@ -452,7 +453,7 @@  -- | Make @dot@ rendering of graph at 'Node'. gr_dot :: BD -> String-gr_dot = G.graphviz' . gr+gr_dot = G.showDot . G.fglToDot . gr  -- | 'draw_dot' of 'gr_dot'. gr_draw :: BD -> IO ()@@ -732,7 +733,7 @@             Left k' -> Just (Std_Var,ty,k',Nothing)             Right (k',k'') ->                 if k' == k''-                then Just (Rec_Var,ty,k',Just (Left 0))+                then Just (Rec_Var,ty,k',Just (Var_F 0.0)) -- float?                 else Just (Std_Var,ty,k',Nothing)       N_Prim _ _ _ Nothing -> Nothing @@ -779,8 +780,8 @@ -- * Audition  -- | Audition graph after sending initialisation messages.-audition :: [Message] -> BD -> IO ()-audition is bd = L.audition is (bd_instructions bd)+audition_rju :: [Message] -> BD -> IO ()+audition_rju is bd = L.audition_rju is (bd_instructions bd)  -- * Figures from /Quick Reference/ 
Sound/DF/Uniform/GADT/Audition.hs view
@@ -4,16 +4,22 @@ import Sound.OSC {- hosc -}  import Sound.DF.Uniform.GADT.DF-import Sound.DF.Uniform.UDF as U+import qualified Sound.DF.Uniform.LL.Audition as L+import qualified Sound.DF.Uniform.LL.CGen as L+import qualified Sound.DF.Uniform.UDF as U +-- | Transform 'DF' to 'L.Instructions'.+df_instructions :: DF () -> L.Instructions+df_instructions = U.udf_instructions . df_erase+ -- | Audition graph at @jack-dl@ after sending initialisation messages.-audition :: [Message] -> DF () -> IO ()-audition is n = U.audition is (df_erase n)+audition_rju :: [Message] -> DF () -> IO ()+audition_rju is = L.audition_rju is . df_instructions  -- | Audition graph at @SC3@ after sending initialisation messages. audition_sc3 :: [Message] -> DF () -> IO ()-audition_sc3 is n = U.audition_sc3 is (df_erase n)+audition_sc3 is = L.audition_sc3 is . df_instructions  -- | Audition graph at @text-dl@. audition_text :: Int -> DF () -> IO ()-audition_text nf n = U.audition_text nf (df_erase n)+audition_text nf = L.audition_text nf . df_instructions
Sound/DF/Uniform/GADT/DF.hs view
@@ -12,6 +12,7 @@ -- * DF  -- | Data flow node.+-- K = constant, A = array, R = recursion, P = primitive, MRG = mrg. data DF a where     K :: K' a => a -> DF a     A :: Vec Float -> DF (Vec Float)@@ -19,16 +20,16 @@     P0 :: K' a => String -> TypeRep -> DF a     P1 :: (K' a,K' b) => String -> TypeRep -> DF a -> DF b     P2 :: (K' a,K' b,K' c) => String -> TypeRep -> DF a -> DF b -> DF c-    P3 :: (K' a,K' b,K' c,K' d) =>-          String -> TypeRep -> DF a -> DF b -> DF c -> DF d-    M :: K' a => DF a -> DF () -> DF a+    P3 :: (K' a,K' b,K' c,K' d) => String -> TypeRep -> DF a -> DF b -> DF c -> DF d+    MCE :: [DF a] -> DF a+    MRG :: K' a => DF a -> DF () -> DF a  deriving instance Show a => Show (DF a)  -- | Typeable instance for 'DF'. ----- > df_typeOf (C (undefined::Int32)) == int32_t--- > df_typeOf (C (undefined::Float)) == float_t+-- > df_typeOf (K (undefined::Int32)) == int32_t+-- > df_typeOf (K (undefined::Float)) == float_t -- > df_typeOf (A undefined) == vec_float_t -- > df_typeOf (0::DF Int32) == int32_t -- > df_typeOf (0.0::DF Float) == float_t@@ -42,9 +43,12 @@       P1 _ t _ -> t       P2 _ t _ _ -> t       P3 _ t _ _ _ -> t-      M n _ -> df_typeOf n+      MCE l -> case l of+                 [] -> error "df_typeOf: MCE []"+                 n:_ -> df_typeOf n+      MRG n _ -> df_typeOf n -instance K' a => Typeable (DF a) where typeOf = df_typeOf+deriving instance Typeable DF  -- | Name of primitive if 'DF' is 'P0' or 'P1' etc. df_primitive :: DF a -> Maybe String@@ -60,7 +64,7 @@  -- | Multiple root graph (alias for M). mrg :: K' a => DF a -> DF () -> DF a-mrg = M+mrg = MRG  -- * DF Vec @@ -110,19 +114,102 @@ -- | Binary function. type Binary_Fn i o = i -> i -> o +-- * MCE++-- | MCE predicate, sees into MRG.+is_mce :: DF t -> Bool+is_mce n =+    case n of+      MCE _ -> True+      MRG l _ -> is_mce l+      _ -> False++-- | MCE degree, sees into MRG.+mce_degree :: DF t -> Int+mce_degree n =+    case n of+      MCE l -> length l+      MRG l _ -> mce_degree l+      _ -> 1++-- | MCE extension, sees into MRG, will not reduce.+mce_extend :: Int -> DF t -> [DF t]+mce_extend k n =+    if k < mce_degree n+    then error "mce_extend: REDUCE?"+    else case n of+                MCE l -> take k (cycle l)+                MRG _ _ -> error "mce_extend: MRG"+                _ -> replicate k n++mce2 :: DF a -> DF a -> DF a+mce2 p q = MCE [p,q]++unmce :: DF t -> [DF t]+unmce n =+    case n of+      MCE l -> l+      MRG l r -> case unmce l of+                   [] -> error "unmce: MRG?"+                   h:t -> MRG h r : t+      _ -> [n]++unmce2 :: Show t => DF t -> (DF t, DF t)+unmce2 n =+    case unmce n of+      [p,q] -> (p,q)+      _ -> error ("unmce2: " ++ show n)++lift_mce :: (DF a -> DF b) -> DF a -> DF b+lift_mce f p =+    case p of+      MCE l -> MCE (map f l)+      _ -> f p++lift_mce2 :: (DF a -> DF b -> DF c) -> DF a -> DF b -> DF c+lift_mce2 f p q =+    if is_mce p || is_mce q+    then let k = max (mce_degree p) (mce_degree q)+         in MCE (zipWith f (mce_extend k p) (mce_extend k q))+       else f p q++mce_extend3 :: DF a -> DF b -> DF c -> ([DF a],[DF b],[DF c])+mce_extend3 p q r =+    let k = max (mce_degree p) (max (mce_degree q) (mce_degree r))+    in (mce_extend k p,mce_extend k q,mce_extend k r)++lift_mce3 :: (DF a -> DF b -> DF c -> DF d) -> DF a -> DF b -> DF c -> DF d+lift_mce3 f p q r =+    if is_mce p || is_mce q || is_mce r+    then let (p',q',r') = mce_extend3 p q r+         in MCE (zipWith3 f p' q' r')+    else f p q r+ -- * Primitive constructors +-- | 'lift_mce' of 'P1'.+mk_p1 :: (K' a, K' b) => String -> TypeRep -> DF a -> DF b+mk_p1 nm ty = lift_mce (P1 nm ty)+ -- | Unary operator. mk_uop :: (K' a) => String -> Unary_Op (DF a)-mk_uop nm p = P1 nm (df_typeOf p) p+mk_uop nm p = mk_p1 nm (df_typeOf p) p +-- | 'lift_mce2' of 'P2'.+mk_p2 :: (K' a, K' b, K' c) => String -> TypeRep -> DF a -> DF b -> DF c+mk_p2 nm ty = lift_mce2 (P2 nm ty)+ -- | Binary operator. mk_binop :: K' a => String -> Binary_Op (DF a)-mk_binop nm p q = P2 nm (df_typeOf p) p q+mk_binop nm p q = mk_p2 nm (df_typeOf p) p q +-- | 'lift_mce3' of 'P3'.+mk_p3 :: (K' a, K' b, K' c, K' d) => String -> TypeRep -> DF a -> DF b -> DF c -> DF d+mk_p3 nm ty = lift_mce3 (P3 nm ty)+ -- | Binary operator. mk_ternaryop :: K' a => String -> Ternary_Op (DF a)-mk_ternaryop nm p q r = P3 nm (df_typeOf p) p q r+mk_ternaryop nm p q r = mk_p3 nm (df_typeOf p) p q r  -- | 'DF' multiply and add. df_mul_add :: K_Num a => DF a -> DF a -> DF a -> DF a@@ -136,8 +223,8 @@ df_add_optimise :: K_Num a => DF a -> DF a -> DF a df_add_optimise p q =     case (p,q) of-      (P2 "df_mul" t l r,_) -> P3 "df_mul_add" t l r q-      (_,P2 "df_mul" t l r) -> P3 "df_mul_add" t l r p+      (P2 "df_mul" t l r,_) -> mk_p3 "df_mul_add" t l r q+      (_,P2 "df_mul" t l r) -> mk_p3 "df_mul_add" t l r p       _ -> mk_binop "df_add" p q  instance K_Num a => Num (DF a) where@@ -150,20 +237,20 @@     fromInteger = K . fromInteger  instance Fractional (DF Float) where-    (/) = P2 "df_div" float_t-    recip = P1 "df_recip" float_t+    (/) = mk_p2 "df_div" float_t+    recip = mk_p1 "df_recip" float_t     fromRational = K . fromRational  instance Floating (DF Float) where   pi = K pi-  exp = P1 "df_exp" float_t-  sqrt = P1 "df_sqrt" float_t-  log = P1 "df_log" float_t-  (**) = P2 "df_pow" float_t+  exp = mk_p1 "df_exp" float_t+  sqrt = mk_p1 "df_sqrt" float_t+  log = mk_p1 "df_log" float_t+  (**) = mk_p2 "df_pow" float_t   logBase = undefined-  sin = P1 "df_sin" float_t-  tan = P1 "df_tan" float_t-  cos = P1 "df_cos" float_t+  sin = mk_p1 "df_sin" float_t+  tan = mk_p1 "df_tan" float_t+  cos = mk_p1 "df_cos" float_t   asin = undefined   atan = undefined   acos = undefined@@ -178,37 +265,37 @@  -- | "Data.Bits" @.&.@. df_bw_and :: DF Int32 -> DF Int32 -> DF Int32-df_bw_and = P2 "df_bw_and" int32_t+df_bw_and = mk_p2 "df_bw_and" int32_t  -- | "Data.Bits" @.|.@. df_bw_or :: DF Int32 -> DF Int32 -> DF Int32-df_bw_or = P2 "df_bw_or" int32_t+df_bw_or = mk_p2 "df_bw_or" int32_t  -- | "Data.Bits" @complement@. df_bw_not :: DF Int32 -> DF Int32-df_bw_not = P1 "df_bw_not" int32_t+df_bw_not = mk_p1 "df_bw_not" int32_t  -- * Ord  -- | '==', equal to. df_eq :: K_Ord a => DF a -> DF a -> DF Bool-df_eq = P2 "df_eq" bool_t+df_eq = mk_p2 "df_eq" bool_t  -- | '<', less than. df_lt :: K_Ord a => DF a -> DF a -> DF Bool-df_lt = P2 "df_lt" bool_t+df_lt = mk_p2 "df_lt" bool_t  -- | '>=', greater than or equal to. df_gte :: K_Ord a => DF a -> DF a -> DF Bool-df_gte = P2 "df_gte" bool_t+df_gte = mk_p2 "df_gte" bool_t  -- | '>', greater than. df_gt :: K_Ord a => DF a -> DF a -> DF Bool-df_gt = P2 "df_gt" bool_t+df_gt = mk_p2 "df_gt" bool_t  -- | '<=', less than or equal to. df_lte :: K_Ord a => DF a -> DF a -> DF Bool-df_lte = P2 "df_lte" bool_t+df_lte = mk_p2 "df_lte" bool_t  -- | 'max', select maximum. df_max :: K_Ord a => DF a -> DF a -> DF a@@ -222,11 +309,11 @@  -- | Cast floating point to integer. df_float_to_int32 :: DF Float -> DF Int32-df_float_to_int32 = P1 "df_float_to_int32" int32_t+df_float_to_int32 = mk_p1 "df_float_to_int32" int32_t  -- | Cast integer to floating point. df_int32_to_float :: DF Int32 -> DF Float-df_int32_to_float = P1 "df_int32_to_float" float_t+df_int32_to_float = mk_p1 "df_int32_to_float" float_t  -- | Scale 'Int32' to (-1,1) normalised 'Float'. --@@ -238,29 +325,29 @@  -- | Integral modulo, ie. 'mod'. df_mod :: Binary_Op (DF Int32)-df_mod = P2 "df_mod" int32_t+df_mod = mk_p2 "df_mod" int32_t  -- | Floating point modulo, ie. "Foreign.C.Math" /fmodf/. df_fmodf :: Binary_Op (DF Float)-df_fmodf = P2 "df_fmodf" float_t+df_fmodf = mk_p2 "df_fmodf" float_t  -- * RealFrac  -- | ceilf(3) df_ceilf :: DF Float -> DF Float-df_ceilf = P1 "df_ceilf" float_t+df_ceilf = mk_p1 "df_ceilf" float_t  -- | floorf(3) df_floorf :: DF Float -> DF Float-df_floorf = P1 "df_floorf" float_t+df_floorf = mk_p1 "df_floorf" float_t --- | lrintf(3)+-- | lrintf(3), ie. round to nearest integer. df_lrintf :: DF Float -> DF Int32-df_lrintf = P1 "df_lrintf" int32_t+df_lrintf = mk_p1 "df_lrintf" int32_t  -- | roundf(3) df_roundf :: DF Float -> DF Float-df_roundf = P1 "df_roundf" float_t+df_roundf = mk_p1 "df_roundf" float_t  -- * Backward arcs @@ -269,13 +356,15 @@ -- The function receives the previous output as input, initially @y0@, -- and returns a /(feed-forward,feed-backward)/ pair. ----- > rec_r (R_Id 0) (0::Int) ((\i->(i,i)) . (+) 1)+-- > rec_r (R_Id 0) (0::Int32) ((\i->(i,i)) . (+) 1) -- > rec_r (R_Id 0) (0.0::Float) ((\i->(i,i)) . (+) 1.0) rec_r :: K' a => R_Id -> a -> (DF a -> (DF b,DF a)) -> DF b rec_r n y0 f =     let t = typeOf y0         i = R n t (Left y0)-    in R n t (Right (f i))+    in case f i of+         (MCE _,MCE _) -> error "rec_h: MCE"+         r -> R n t (Right r)  -- | Monadic variant of 'rec_r'. rec_m :: (K' a,UId m) => a -> (DF a -> (DF b,DF a)) -> m (DF b)@@ -306,36 +395,46 @@  -- | Single channel output (channel 0). out1 :: DF Float -> DF ()-out1 = P1 "df_out1" nil_t+out1 = mk_p1 "df_out1" nil_t  -- | Two channel output (channels 1 & 2). out2 :: DF Float -> DF Float -> DF ()-out2 = P2 "df_out2" nil_t+out2 = mk_p2 "df_out2" nil_t  -- | Three channel output. out3 :: DF Float -> DF Float -> DF Float -> DF ()-out3 = P3 "df_out3" nil_t+out3 = mk_p3 "df_out3" nil_t +-- | MCE collapsing output.+out :: DF Float -> DF ()+out n =+    case n of+      MCE [p] -> out1 p+      MCE [p,q] -> out2 p q+      MCE [p,q,r] -> out3 p q r+      MCE _ -> error "out: MCE"+      _ -> out1 n+ -- | Single control input. ctl1 :: DF Int32 -> DF Float-ctl1 = P1 "df_ctl1" float_t+ctl1 = mk_p1 "df_ctl1" float_t  -- | Logical '&&'. df_and :: DF Bool -> DF Bool -> DF Bool-df_and = P2 "df_and" bool_t+df_and = mk_p2 "df_and" bool_t  -- | Logical '||'. df_or :: DF Bool -> DF Bool -> DF Bool-df_or = P2 "df_or" bool_t+df_or = mk_p2 "df_or" bool_t  -- | Logical 'not'. df_not :: DF Bool -> DF Bool-df_not = P1 "df_not" bool_t+df_not = mk_p1 "df_not" bool_t  -- | If /p/ then /q/ else /r/.  /p/ must have type bool, and /q/ -- and /r/ must have equal types. select2 :: K' a => DF Bool -> DF a -> DF a -> DF a-select2 p q = P3 "df_select2" (df_typeOf q) p q+select2 p q = mk_p3 "df_select2" (df_typeOf q) p q  -- | Operating sample rate. w_sample_rate :: DF Float@@ -351,19 +450,19 @@  -- | Buffer read, read from buffer /p/ at index /q/. b_read :: DF Int32 -> DF Int32 -> DF Float-b_read = P2 "df_b_read" float_t+b_read = mk_p2 "df_b_read" float_t  -- | Buffer write, write to buffer /p/ at index /q/ value /r/. b_write :: DF Int32 -> DF Int32 -> DF Float -> DF ()-b_write = P3 "df_b_write" nil_t+b_write = mk_p3 "df_b_write" nil_t  -- | Array read. a_read :: DF (Vec Float)-> DF Int32 -> DF Float-a_read = P2 "df_a_read" float_t+a_read = mk_p2 "df_a_read" float_t --- | Array writ.+-- | Array write. a_write :: DF (Vec Float) -> DF Int32 -> DF Float -> DF ()-a_write = P3 "df_a_write" nil_t+a_write = mk_p3 "df_a_write" nil_t  -- * Untyped @@ -379,4 +478,5 @@       P1 nm t i -> UDF_P nm t [df_erase i]       P2 nm t i j -> UDF_P nm t [df_erase i,df_erase j]       P3 nm t i j k -> UDF_P nm t [df_erase i,df_erase j,df_erase k]-      M i j -> UDF_M (df_erase i) (df_erase j)+      MCE _ -> error "df_erase: MCE"+      MRG i j -> UDF_MRG (df_erase i) (df_erase j)
Sound/DF/Uniform/GADT/UGen.hs view
@@ -2,6 +2,7 @@ module Sound.DF.Uniform.GADT.UGen where  import Data.Int {- base -}+import Data.List {- base -} import Data.Maybe {- base -}  import Sound.DF.Uniform.GADT.DF@@ -52,9 +53,11 @@ -- -- > 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))}+-- > import Sound.DF.Uniform.GADT {- hdf -}+--+-- > let {s = lf_saw 1.0 0.0+-- >     ;o = sin_osc (lin_lin s (-1.0) 1.0 220.0 440.0) 0.0}+-- > in audition_rju [] (out1 (o * 0.1)) 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)@@ -65,9 +68,9 @@ -- -- > 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))}+-- > let {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}+-- > in audition_rju [] (out1 (o * 0.1)) 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@@ -101,10 +104,10 @@ -- -- > map (lin_pan2 1) [-1,0,1] == [(1,0),(0.5,0.5),(0,1)] ----- > do {o <- sin_osc 440.0 0.0--- >    ;l <- sin_osc 0.5 0.0--- >    ;let (p,q) = lin_pan2 (o * 0.1) l--- >     in audition [] (out2 p q)}+-- > let {o = sin_osc 440.0 0.0+-- >     ;l = sin_osc 0.5 0.0+-- >     ;(p,q) = lin_pan2 (o * 0.1) l}+-- > in audition_rju [] (out2 p q) lin_pan2 :: Fractional t => t -> t -> (t, t) lin_pan2 p q =     let q' = (q / 2) + 0.5@@ -116,6 +119,14 @@ k_sample_rate :: Fractional n => n k_sample_rate = 48000 +-- | Compile time sample duration (in seconds) constant.+k_sample_dur :: Fractional n => n+k_sample_dur = recip k_sample_rate++-- | Environment value, 'recip' of 'w_sample_rate'.+w_sample_dur :: DF Float+w_sample_dur = recip w_sample_rate+ -- | Environment value, equal to @'two_pi' / 'w_sample_rate'@. w_radians_per_sample :: DF Float w_radians_per_sample = two_pi / w_sample_rate@@ -147,8 +158,8 @@  -- | 'clip2' variant. ----- > do {o <- sin_osc 440 0--- >    ;audition [] (out1 (df_clip2 (o * 2) 0.1))}+-- > let o = sin_osc 440 0+-- > in audition_rju [] (out1 (df_clip2 (o * 2) 0.1)) df_clip2 :: K_Num a => DF a -> DF a -> DF a df_clip2 p q =     let nq = negate q@@ -170,8 +181,15 @@ -- -- > draw (phasor 9.0 (4.5::Float) 0.5) -- > draw (phasor 9 (0::Int32) 1)+-- > audition_text 10 (out1 (phasor' 5.0 0.0 1.0))+phasor' :: K_Num a => DF a -> a -> DF a -> DF a+phasor' r ip = unit_delay ip . iir1 ip (\x -> clipr r . (+ x))++-- | 'lift_mce2' of 'phasor''. phasor :: K_Num a => DF a -> a -> DF a -> DF a-phasor r ip = iir1 ip (\x y1 -> clipr r (x + y1))+phasor r ip x =+    let f r' x' = phasor' r' ip x'+    in lift_mce2 f r x  -- * Array @@ -187,7 +205,7 @@   let ri = clipr n (wi + 1)   in mrg (a_read a ri) (a_write a wi s) --- | Array delay.+-- | Array delay.  a = array, s = signal, n = number of frames. -- -- > do {a <- df_vec_m [0,1,2] -- >    ;draw (a_delay a 0.0 0)}@@ -196,16 +214,22 @@ -- >     ;o = sin_osc (f * 200.0 + 600.0) 0.0 -- >     ;a = df_vec (V_Id 0) (replicate 48000 0) -- >     ;d = a_delay a o 24000}--- > in audition [] (out2 (o * 0.1) (d * 0.05))+-- > in audition_rju [] (out2 (o * 0.1) (d * 0.05)) a_delay :: DF (Vec Float) -> DF Float -> DF Int32 -> DF Float a_delay a s n = a_delay_ph a s n (phasor n 0 1) +-- | SC3 UGen.+delay_n :: Int -> DF Float -> Float -> DF Float -> DF Float+delay_n k s mx dt =+    let a = a_alloc_sec (V_Id k) mx+    in a_delay a s (df_lrintf (dt * w_sample_rate))+ -- | Array fill function (sin). ----- > do {i <- phasor 64 0 1--- >    ;a = a_tbl_sin (V_Id 0) 64--- >    ;let s = a_read a i--- >     in audition [] (out1 (s * 0.2))}+-- > let {i = phasor 64 0 1+-- >     ;a = a_tbl_sin (V_Id 0) 64+-- >     ;s = a_read a i}+-- > in audition_rju [] (out1 (s * 0.2)) a_tbl_sin :: V_Id -> Int -> DF (Vec Float) a_tbl_sin k = df_vec k . tbl_sin @@ -214,7 +238,7 @@ -- > let {i = phasor 64.0 0 (hz_to_incr k_sample_rate 64.0 330.0) -- >     ;a = a_tbl_sin (V_Id 0) 64 -- >     ;s = a_lerp a i}--- > in audition [] (out1 (s * 0.2))+-- > in audition_rju [] (out1 (s * 0.2)) a_lerp :: DF (Vec Float) -> DF Float -> DF Float a_lerp a i =     let i_f = df_floorf i@@ -224,6 +248,9 @@         q = a_read a (df_lrintf i_c)     in (p * (1.0 - z)) + (q * z) +a_tbl :: Int -> [Float] -> DF (Vec Float)+a_tbl k = df_vec (V_Id k)+ -- * Osc  -- | 'phasor' for table of /z/ places. /ip/ is in (0,1).@@ -242,14 +269,14 @@ -- > let {a = a_tbl_sin (V_Id 0) 256 -- >     ;f = a_osc a 4.0 0.0 -- >     ;o = a_osc a (f * 200.0 + 400.0) 0.0}--- > in audition [] (out1 (o * 0.1))+-- > in audition_rju [] (out1 (o * 0.1)) -- -- Cancellation: -- -- > let {a = a_tbl_sin (V_Id 0) 256 -- >     ;o1 = a_osc a 440.0 0.0 -- >     ;o2 = a_osc a 440.0 0.5}--- > in audition [] (out1 (o1 + o2))+-- > in audition_rju [] (out1 (o1 + o2)) a_osc :: DF (Vec Float) -> DF Float -> Float -> DF Float a_osc a f ip =     let z = fromMaybe 0 (df_tbl_size a)@@ -269,6 +296,12 @@ unit_delay :: K' a => a -> DF a -> DF a unit_delay y0 s = rec_h y0 (\i -> (i,s)) +-- | Signal that is initially 'True' then always 'False'.+--+-- > audition_text 5 (out1 (latch (white_noise 812875317) unit_trigger))+unit_trigger :: DF Bool+unit_trigger = unit_delay True (K False)+ -- | Two place infinite impulse response filter.  Inputs are: /f/= -- function @(\x0 y1 y2 -> y0)@, /i/ = input signal. --@@ -276,7 +309,7 @@ -- >     ;o1 = sin_osc (c1 + 220.0) 0 -- >     ;c2 = iir2 (\x _ y2 -> x + y2) 0.001 -- >     ;o2 = sin_osc (c2 + 220.0) 0}--- > in audition [] (out2 (o1 * 0.1) (o2 * 0.1))+-- > in audition_rju [] (out2 (o1 * 0.1) (o2 * 0.1)) iir2 :: K_Num a => (Ternary_Op (DF a)) -> DF a -> DF a iir2 f i =     rec_h@@ -307,15 +340,48 @@  -- * Counter --- | Counter from indicated initial value.+-- | Counter from indicated initial value by indicated step. -- -- > draw (counter (0::Int32) 1) -- > draw (counter (0.0::Float) 1.0) -- -- > audition_text 10 (out1 (counter 0.0 1.0))+-- > audition_text 10 (out1 (counter 0.0 (white_noise 165876521 * 0.25))) counter :: K_Num a => a -> DF a -> DF a counter y0 n = unit_delay y0 (iir1 y0 (+) n) +-- | 'counter' that resets to the initial phase at trigger.+--+-- > let tr = trigger (impulse (k_sample_rate / 3) 0.0)+-- > in audition_text 10 (out1 (counter_reset 0.0 1.0 tr))+counter_reset :: K_Num a => a -> DF a -> DF Bool -> DF a+counter_reset y0 n tr =+    let f lhs rhs = select2 tr (K y0) (lhs + rhs)+    in iir1 y0 f n++-- | Counter from 0 to 1 over duration (in seconds).  Holds end value.+unit_line :: DF Float -> DF Float+unit_line d = let c = counter 0 (w_sample_dur / d) in select2 (c `df_gt` 1) 1 c++-- | 'lin_lin' of 'unit_line'.+--+-- > audition_rju [] (out1 (sin_osc (line 110 440 100) 0 * 0.1))+line :: DF Float -> DF Float -> DF Float -> DF Float+line s e d = lin_lin (unit_line d) 0 1 s e++-- | SC3 UGen.+--+-- > audition_text 20 (out1 (counter 30 10))+-- > audition_text 20 (out1 (ramp (counter 30 10) (3 / k_sample_rate)))+ramp :: DF Float -> DF Float -> DF Float+ramp s d =+    let im = impulse (1 / d) 0+        tr = trigger im+        s_l = latch s tr+        d_l = latch d tr+        n = latch ((s_l - unit_delay 0.0 s_l) / (d_l * w_sample_rate)) tr+    in counter 0 n+ -- * Buffer  -- | Buffer delay.@@ -346,7 +412,7 @@ -- >     ;dt = let f x = lin_exp (x + 2.0) 1.0 2.0 0.0001 0.01 -- >           in f (lf_saw 0.1 0.0) -- >     ;c = buf_comb_n 0 (n * 0.1) dt 0.2}--- > in audition [S.b_alloc 0 48000 1] (out1 c)+-- > in audition_rju [S.b_alloc 0 48000 1] (out1 c) -- -- Comb used as an echo. --@@ -354,7 +420,7 @@ -- >     ;n = white_noise 0 -- >     ;e = decay (i * 0.5) 0.2 -- >     ;c = buf_comb_n 0 (e * n) 0.2 3.0}--- > in audition [S.b_alloc 0 48000 1] (out1 c)+-- > in audition_rju [S.b_alloc 0 48000 1] (out1 c) buf_comb_n :: DF Int32 -> DF Float -> DF Float -> DF Float -> DF Float buf_comb_n b s dlt dct = do   let n = df_lrintf (dlt * w_sample_rate)@@ -365,28 +431,52 @@  -- * Comb --- | Array variant of 'buf_comb_n'.  Max delay time is in seconds.------ > let {n = white_noise 0--- >     ;dt = let f x = lin_exp (x + 2.0) 1.0 2.0 0.0001 0.01--- >           in f (lf_saw 0.1 0.0)--- >     ;c = comb_n (V_Id 0) 0.1 (n * 0.1) dt 0.2}--- > in audition [] (out1 c)------ > let {i = impulse 0.5 0.0--- >     ;n = white_noise 0--- >     ;e = decay (i * 0.5) 0.2--- >     ;c = comb_n (V_Id 0) 0.2 (e * n) 0.2 3.0}--- > in audition [] (out1 c)-comb_n :: V_Id -> Float -> DF Float -> DF Float -> DF Float -> DF Float-comb_n k z s dlt dct =+{- | Array variant of 'buf_comb_n'.  Max delay time is in seconds.++> let {n = white_noise 0+>     ;dt = let f x = lin_exp (x + 2.0) 1.0 2.0 0.0001 0.01+>           in f (lf_saw 0.1 0.0)+>     ;c = comb_n [0] 0.1 (n * 0.1) dt 0.2}+> in audition_rju [] (out c)++> let {i = impulse 0.5 0.0+>     ;n = white_noise 0+>     ;e = decay (i * 0.5) 0.2+>     ;c = comb_n [0] 0.2 (e * n) 0.2 3.0}+> in audition_rju [] (out c)++-}+comb_n' :: V_Id -> Float -> DF Float -> DF Float -> DF Float -> DF Float+comb_n' k z s dlt dct =   let a = a_alloc_sec k z       n = df_lrintf (dlt * w_sample_rate)       fb = calc_fb dlt dct       c i = let x = a_delay a i n-            in split (s + (fb * x))+            in (x,s + (fb * x))   in rec_h 0.0 c +-- | Allow MCE.+comb_n :: [Int] -> Float -> DF Float -> DF Float -> DF Float -> DF Float+comb_n k z s dlt dct =+    let (s',dlt',dct') = mce_extend3 s dlt dct+        f k' = comb_n' (V_Id k') z+    in MCE (zipWith4 f k s' dlt' dct')++allpass_n' :: V_Id -> Float -> DF Float -> DF Float -> DF Float -> DF Float+allpass_n' k z s dlt dct =+  let a = a_alloc_sec k z+      n = df_lrintf (dlt * w_sample_rate)+      fb = calc_fb dlt dct+      c i = let t = a_delay a i n+                u = s + (fb * t)+                o = t - (fb * u)+            in (o,u)+  in rec_h 0.0 c++-- > audition_rju [] (out1 silent)+silent :: DF Float+silent = 0.0+ -- * Noise  -- | 'Int32' linear congruential generator, hence signed modulo of@@ -423,10 +513,17 @@ -- -- > let {n = white_noise 0 * 0.1 -- >     ;m = white_noise 5 * 0.1}--- > in audition [] (out1 (n - m))+-- > in audition_rju [] (out1 (n - m)) white_noise :: Int32 -> DF Float white_noise = i32_to_normal_f32 . lcg_glibc +-- | SC3 UGen.+--+-- > let freq = lin_lin (lf_noise1 0 1) (-1) 1 220 440+-- > in audition_rju [] (out1 (sin_osc freq 0 * 0.1))+lf_noise1 :: Int32 -> DF Float -> DF Float+lf_noise1 k d = ramp (white_noise k) (1 / d)+ -- | 'iir1' brown noise function. brown_noise_f :: Binary_Op (DF Float) brown_noise_f x y1 =@@ -438,58 +535,81 @@ -- power by 6 dB per octave. -- -- > let n = brown_noise 0--- > in audition [] (out1 (n * 0.1))+-- > in audition_rju [] (out1 (n * 0.1)) -- -- > let {n = brown_noise 0 -- >     ;f = lin_exp n (-1.0) 1.0 64.0 9600.0 -- >     ;o = sin_osc f 0}--- > in audition [] (out1 (o * 0.1))+-- > in audition_rju [] (out1 (o * 0.1)) brown_noise :: Int32 -> DF Float brown_noise k =     let w = white_noise k         w8 = w / 8.0     in iir1 0.0 brown_noise_f w8 +-- | SC3 UGen.+--+-- > audition_rju [] (out1 (dust 0 200 * 0.25))+-- > audition_rju [] (out1 (dust 0 (sin_osc 0.1 0 * 500 + 550) * 0.25))+dust :: Int32 -> DF Float -> DF Float+dust k density =+    let threshold = density * w_sample_dur+        scale = select2 (threshold `df_gt` 0.0) (1.0 / threshold) 0.0+        z = randf k+    in select2 (z `df_lt` threshold) (z * scale) 0.0++-- | SC3 UGen.+--+-- > audition_rju [] (out1 (sin_osc (rand 6987612487 220.0 600.0) 0.0 * 0.1))+rand :: Int32 -> DF Float -> DF Float -> DF Float+rand k =+    let n = randf k+        z = unit_delay True (K False)+    in lin_lin (latch n z) 0 1+ -- * Osc  -- | Sine oscillator.  Inputs are: /f/ = frequency (in hz), /ip/ = -- initial phase. -- -- > let o = sin_osc 440.0 0.0--- > in audition [] (out1 (o * 0.1))+-- > in audition_rju [] (out1 (o * 0.1)) -- -- Used as both Oscillator and LFO. -- -- > let {f = sin_osc 4.0 0.0 -- >     ;o = sin_osc (f * 200.0 + 400.0) 0.0}--- > in audition [] (out1 (o * 0.1))+-- > in audition_rju [] (out1 (o * 0.1)) -- -- Cancellation. -- -- > let {o1 = sin_osc 440.0 0.0 -- >     ;o2 = sin_osc 440.0 pi}--- > in audition [] (out1 (o1 + o2))+-- > in audition_rju [] (out1 (o1 + o2)) sin_osc :: DF Float -> Float -> DF Float sin_osc f ip =     let p = phasor two_pi ip (hz_to_incr w_sample_rate two_pi f)     in sin p --- | Impulse oscillator (non band limited).--- Outputs non band limited single sample impulses.--- Inputs are: /f/ = frequency (in hertz), /ip/ = phase offset (0..1)------ > let o = impulse 800.0 0.0--- > in audition [] (out1 (o * 0.1))------ > let {f = sin_osc 0.25 0.0 * 2500.0 + 2505.0--- >     ;o = impulse f 0.0}--- > in audition [] (out1 (o * 0.1))+{- | Impulse oscillator (non band limited).+Outputs non band limited single sample impulses.+Inputs are: /f/ = frequency (in hertz), /ip/ = phase offset (0..1)++> let o = impulse 800.0 0.0+> in audition_rju [] (out1 (o * 0.1))++> let {f = sin_osc 0.25 0.0 * 2500.0 + 2505.0+>     ;o = impulse f 0.0}+> in audition_rju [] (out1 (o * 0.1))++> audition_text 10 (out1 (impulse (w_sample_rate / 5.0) 0.0))+> audition_text 10 (out1 (impulse (k_sample_rate / 5.0) 0.0))+-} impulse :: DF Float -> Float -> DF Float impulse f ip =     let i = hz_to_incr w_sample_rate 1.0 f         p = phasor 1.0 ip i-        x1 = unit_delay 0.0 p-        s = (x1 `df_lt` 0.5) `df_and` (p `df_gte` 0.5)+        s = unit_delay (if ip > 0.0 then 0.0 else 1.0) p `df_gt` p     in select2 s 1.0 0.0  -- * LF Osc.@@ -498,13 +618,13 @@ -- Inputs are: /f/ = frequency (in hertz), /ip/ = initial phase (0,2). -- -- > let o = lf_saw 500.0 1.0--- > in audition [] (out1 (o * 0.1))+-- > in audition_rju [] (out1 (o * 0.1)) -- -- Used as both Oscillator and LFO. -- -- > let {f = lf_saw 4.0 0.0 -- >     ;o = lf_saw (f * 400.0 + 400.0) 0.0}--- > in audition [] (out1 (o * 0.1))+-- > in audition_rju [] (out1 (o * 0.1)) lf_saw :: DF Float -> Float -> DF Float lf_saw f ip =     let p = phasor 2.0 ip (hz_to_incr w_sample_rate 2.0 f)@@ -516,7 +636,7 @@ -- -- > let {o1 = lf_pulse 3.0 0.0 0.3 * 200.0 + 200.0 -- >     ;o2 = lf_pulse o1 0.0 0.2 * 0.1}--- > in audition [] (out1 o2)+-- > in audition_rju [] (out1 o2) lf_pulse :: DF Float -> Float -> DF Float -> DF Float lf_pulse f ip w =     let p = phasor 1.0 ip (hz_to_incr w_sample_rate 1.0 f)@@ -532,6 +652,14 @@ brz2 :: DF Float -> DF Float brz2 = fir2 (\x _ x2 -> (x + x2) * 0.5) +-- | Two point difference filter+hpz1 :: DF Float -> DF Float+hpz1 = fir1 0 (\x x1 -> 0.5 * (x - x1))++-- | Two zero fixed highpass filter+hpz2 :: DF Float -> DF Float+hpz2 = fir2 (\x x1 x2 -> 0.25 * (x - (2 * x1) + x2))+ -- | Two point average filter lpz1 :: DF Float -> DF Float lpz1 = fir1 0 (\x x1 -> (x + x1) * 0.5)@@ -548,7 +676,7 @@ -- -- > let {n = white_noise 0 -- >     ;f = one_pole (n * 0.5) 0.95}--- > in audition [] (out1 f)+-- > in audition_rju [] (out1 f) one_pole :: DF Float -> DF Float -> DF Float one_pole i cf = iir1 0.0 (one_pole_f cf) i @@ -560,13 +688,13 @@ -- -- > let {n = white_noise 0 -- >     ;f = one_zero (n * 0.5) 0.5}--- > in audition [] (out1 f)+-- > in audition_rju [] (out1 f) one_zero :: DF Float -> DF Float -> DF Float one_zero i cf = fir1 0 (one_zero_f cf) i  -- | Given coefficients construct 'biquad' 'sos' function. sos_f :: Num a => a -> a -> a -> a -> a -> Quinary_Op a-sos_f a0 a1 a2 b1 b2 x x1 x2 y1 y2 = a0*x + a1*x1 + a2*x2 + b1*y1 + b2*y2+sos_f a0 a1 a2 b1 b2 x x1 x2 y1 y2 = a0*x + a1*x1 + a2*x2 - b1*y1 - b2*y2  -- | Second order filter section. sos :: DF Float -> DF Float -> DF Float -> DF Float -> DF Float -> DF Float -> DF Float@@ -587,6 +715,9 @@         y0 = x + b1 * y1 + b2 * y2     in a0 * (y0 - y2) +resonz' :: DF Float -> DF Float -> DF Float -> DF Float+resonz' i f rq = iir2 (resonz_f f rq) i+ -- | 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.@@ -599,16 +730,16 @@ -- -- > let {n = white_noise 0 -- >     ;r = resonz (n * 0.5) 440.0 0.1}--- > in audition [] (out1 r)+-- > in audition_rju [] (out1 r) -- -- Modulate frequency -- -- > let {n = white_noise 0 -- >     ;f = lf_saw 0.1 0.0 * 3500.0 + 4500.0 -- >     ;r = resonz (n * 0.5) f 0.05}--- > in audition [] (out1 r)+-- > in audition_rju [] (out1 r) resonz :: DF Float -> DF Float -> DF Float -> DF Float-resonz i f rq = iir2 (resonz_f f rq) i+resonz = lift_mce3 resonz'  -- | Given /f/ and /r/ construct 'iir2' 'rlpf' function. rlpf_f :: DF Float -> DF Float -> Ternary_Op (DF Float)@@ -628,9 +759,13 @@ -- > let {n = white_noise 0 -- >     ;f = sin_osc 0.5 0.0  * 40.0 + 220.0 -- >     ;r = rlpf n f 0.1}--- > in audition [] (out1 r)+-- > in audition_rju [] (out1 r)+rlpf' :: DF Float -> DF Float -> DF Float -> DF Float+rlpf' i f r = iir2 (rlpf_f f r) i++-- | Allow MCE. rlpf :: DF Float -> DF Float -> DF Float -> DF Float-rlpf i f r = iir2 (rlpf_f f r) i+rlpf = lift_mce3 rlpf'  -- | 5-tuple type T5 t = (t,t,t,t,t)@@ -638,25 +773,33 @@ -- | 2nd order Butterworth high-pass filter coefficients. -- -- > hpf_c 48000.0 (440.0 :: DF Float)-hpf_c :: Floating t => t -> t -> T5 t-hpf_c sr f =-    let c = tan ((pi * f) / sr)-        c2 = c ** 2.0-        s2 = sqrt 2.0-        a0 = (1.0 + (s2 * c) + c2) ** (-1.0)-        a1 = -2.0 * a0+lpf_or_hpf_c :: Floating t => Bool -> t -> t -> T5 t+lpf_or_hpf_c is_hpf sr f =+    let f' = f * pi / sr+        c = if is_hpf then tan f' else 1.0 / tan f'+        c2 = c * c+        s2c = sqrt 2.0 * c+        a0 = 1.0 / (1.0 + s2c + c2)+        a1 = if is_hpf then -2.0 * a0 else 2.0 * a0         a2 = a0-        b1 = 2 * (c2 - 1.0) * a0-        b2 = (1.0 - (s2 * c) + c2) * a0+        b1 = if is_hpf then 2.0 * (c2 - 1.0) * a0 else 2.0 * (1.0 - c2) * a0+        b2 = (1.0 - s2c + c2) * a0     in (a0,a1,a2,b1,b2) --- | 'sos' of 'hpf_c'.+-- | High pass filter. hpf :: DF Float -> DF Float -> DF Float hpf i f =     let sr = w_sample_rate-        (a0,a1,a2,b1,b2) = hpf_c sr f+        (a0,a1,a2,b1,b2) = lpf_or_hpf_c True sr f     in sos i a0 a1 a2 b1 b2 +-- | Low pass filter.+lpf :: DF Float -> DF Float -> DF Float+lpf i f =+    let sr = w_sample_rate+        (a0,a1,a2,b1,b2) = lpf_or_hpf_c False sr f+    in sos i a0 a1 a2 b1 b2+ -- * Triggers  -- | `df_gt` @0@.@@ -697,14 +840,16 @@     let f x = select2 x 1 0     in f . pulse_divider (trigger tr) n --- | Sample and hold. Holds input signal value when triggered.  Inputs--- are: /i/ = input signal, /t/ = trigger.------ > let {n = white_noise 0--- >     ;i = impulse 9.0 0.0--- >     ;l = latch n (trigger i)--- >     ;o = sin_osc (l * 400.0 + 500.0) 0.0}--- > in audition [] (out1 (o * 0.2))+{- | Sample and hold. Holds input signal value when triggered.  Inputs+are: /i/ = input signal, /t/ = trigger.++> let {n = white_noise 0+>     ;i = impulse 9.0 0.0+>     ;l = latch n (trigger i)+>     ;o = sin_osc (l * 400.0 + 500.0) 0.0}+> in audition_rju [] (out1 (o * 0.2))++-} latch :: K_Num a => DF a -> DF Bool -> DF a latch i t = iir1 0 (select2 t) i @@ -729,7 +874,7 @@ -- >     ;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}--- > in audition [] (out1 (e * n))+-- > in audition_rju [] (out1 (e * n)) decay :: DF Float -> DF Float -> DF Float decay i dt = iir1 0.0 (decay_f dt) i @@ -740,12 +885,14 @@ -- * Delays  -- | Single sample delay.-delay1 :: K_Num a => DF a -> DF a-delay1 = iir1 0 (\_ y1 -> y1)+delay1 :: DF Float -> DF Float+delay1 = unit_delay 0.0  -- | Two sample delay.-delay2 :: K_Num a => DF a -> DF a-delay2 = iir2 (\_ _ y2 -> y2)+--+-- > audition_text 10 (out1 (delay2 (counter 0 1)))+delay2 :: DF Float -> DF Float+delay2 = fir2 (\_ _ x -> x)  -- * Lags @@ -763,7 +910,7 @@ -- >     ;o = sin_osc f 0.0 -- >     ;f' = lag f 1.0 -- >     ;o' = sin_osc f' 0.0}--- > in audition [] (out2 (o * 0.2) (o' * 0.2))+-- > in audition_rju [] (out2 (o * 0.2) (o' * 0.2)) lag :: DF Float -> DF Float -> DF Float lag i t = iir1 0 (lag_f t) i 
Sound/DF/Uniform/LL/Audition.hs view
@@ -1,9 +1,10 @@ -- | Interaction with @jack-dl@, @scsynth@ and @text-dl@.+-- See <http://rd.slavepianos.org/?t=rju>. module Sound.DF.Uniform.LL.Audition where  import Sound.OSC {- hosc -} import qualified Sound.SC3 as S {- hsc3 -}-import Sound.SC3.UGen.External.RDU {- sc3-rdu -}+import qualified Sound.SC3.UGen.Bindings.HW.Construct as S {- hsc3 -} import System.Directory {- directory -} import System.FilePath {- filepath -} import System.Process {- process -}@@ -12,15 +13,21 @@ import Sound.DF.Uniform.LL.Command import Sound.DF.Uniform.LL.UId --- * jack-dl+-- import Sound.SC3.UGen.External.RDU {- sc3-rdu -} +-- | Local definition of RDL UGen, to avoid dependency on sc3-rdu.+rdl :: Int -> S.UGen -> S.UGen+rdl nc i = S.mkOscMCE S.AR "RDL" [] i nc++-- * jack-dl (rju)+ -- | Run action with @UDP@ link to @jack-dl@. with_jack_dl :: Connection UDP a -> IO a with_jack_dl = withTransport (openUDP "127.0.0.1" 57190)  -- | Audition graph after sending initialisation messages.-audition :: [Message] -> Instructions -> IO ()-audition is ins = do+audition_rju :: [Message] -> Instructions -> IO ()+audition_rju is ins = do   t <- getTemporaryDirectory   k <- generateId   let fn = t </> ("audition" ++ show k)
Sound/DF/Uniform/LL/CGen.hs view
@@ -2,10 +2,12 @@ -- | C code generator module Sound.DF.Uniform.LL.CGen where +import Data.Char {- base -}+import Data.Int {- base -} import Data.List {- base -} import Data.Maybe {- base -} import Data.Typeable {- base -}-import System.Cmd {- process -}+import System.Process {- process -} import System.FilePath {- filepath -}  import Sound.DF.Uniform.LL.K@@ -39,11 +41,19 @@ -- | Qualified name, (structure,access,member). type C_QName = (String,String,String) +var_fld_initialiser :: Var_Fld -> String+var_fld_initialiser v =+    case v of+      Var_B b -> map toLower (show b)+      Var_I i -> show i+      Var_F f -> show f+      Var_V _ -> error "var_fld_initialiser: vector"+ -- | Initialise 'C_QName' to value. -- -- > c_init_atom ("s",".","r") 5 == "s.m = 5;"-c_init_atom :: Show a => C_QName -> a -> String-c_init_atom (s,a,p) q = concat [s,a,p," = ",show q,";"]+c_init_atom :: C_QName -> Var_Fld -> String+c_init_atom (s,a,p) q = concat [s,a,p," = ",var_fld_initialiser q,";"]  -- | Initialise 'C_QName' to array.  Generates loop code for sequences -- of equal initial values.@@ -72,12 +82,14 @@ -- > let {qn = ("s","->","r") -- >     ;r = ["for(int i=0;i < 2;i++) {s->r[i] = 0;}","s->r[2] = 1;"]} -- > in c_init_var qn (Right [0,0,1]) == r-c_init_var :: (Eq n,Show n) => C_QName -> Either n [n] -> [String]+c_init_var :: C_QName -> Var_Fld -> [String] c_init_var qn e =     case e of-      Left i -> [c_init_atom qn i]-      Right [] -> error "c_init_var: Right []"-      Right l -> c_init_vec qn l+      Var_B _ -> [c_init_atom qn e]+      Var_I _ -> [c_init_atom qn e]+      Var_F _ -> [c_init_atom qn e]+      Var_V [] -> error "c_init_var: Right []"+      Var_V l -> c_init_vec qn l  -- | Qualify name if required.  The /rf/ flag indicates if array is a -- reference or an allocation.@@ -119,8 +131,10 @@       Std_Var -> 'n'       Buf_Var _ -> 'n' +data Var_Fld = Var_F Float | Var_V [Float] | Var_B Bool | Var_I Int32+ -- | (Type,Array,Label,Initialised)-type Var = (Var_Ty,TypeRep,Id,Maybe (Either Float [Float]))+type Var = (Var_Ty,TypeRep,Id,Maybe Var_Fld)  -- | 'Var' name. var_nm :: Var -> String@@ -139,14 +153,14 @@ k_var k vt n =     case n of       N _ -> error "k_var: ()"-      B _ -> error "k_var: bool"-      I i -> (vt,int32_t,k,Just (Left (fromIntegral i)))-      F i -> (vt,float_t,k,Just (Left i))+      B b -> (vt,bool_t,k,Just (Var_B b)) -- error ("k_var: bool: " ++ show b)+      I i -> (vt,int32_t,k,Just (Var_F (fromIntegral i)))+      F f -> (vt,float_t,k,Just (Var_F f))       V _ -> error "k_var: vec"  -- | Generate 'Buf_Var' from 'Vec'. buffer_var :: Id -> Vec Float -> Var-buffer_var k (Vec _ n l) = (Buf_Var n,float_t,k,Just (Right l))+buffer_var k (Vec _ n l) = (Buf_Var n,float_t,k,Just (Var_V l))  -- | 'c_init_var' of 'Var'. var_init :: String -> String -> Var -> [String]@@ -194,9 +208,9 @@ c_const :: (Id,K) -> [String] c_const (k,v) =     case v of-      B x -> c_init_var ("m",".",std_clabel k) (Left x)-      F x -> c_init_var ("m",".",std_clabel k) (Left x)-      I x -> c_init_var ("m",".",std_clabel k) (Left x)+      B x -> c_init_var ("m",".",std_clabel k) (Var_B x)+      F x -> c_init_var ("m",".",std_clabel k) (Var_F x)+      I x -> c_init_var ("m",".",std_clabel k) (Var_I x)       _ -> error "c_const: k"  -- * Code generators@@ -309,22 +323,26 @@  -- | Generate compiler command for 'Host' given @include@ directory -- prefix.------ > host_compiler_cmd (JACK,"/home/rohan/opt")--- > host_compiler_cmd (SC3,"/home/rohan/opt")--- > host_compiler_cmd (Text,"/home/rohan/opt") host_compiler_cmd :: (Host,FilePath) -> (String,[String]) host_compiler_cmd (h,d) =     case h of       SC3 ->            ("g++"-           ,["-Wall","-g","-O2","-shared"+           ,["-Wall","-g","-O2","-shared","-fPIC"             ,"-I",d </> "include/SuperCollider/plugin_interface"             ,"-I",d </> "include/SuperCollider/common"])       _ ->           ("gcc"-          ,["-Wall","-g","--std=c99","-O2","-shared"+          ,["-Wall","-g","--std=c99","-O2","-shared","-fPIC"            ,"-I",d </> "include"])++-- | Format 'host_compiler_cmd' as 'String'.+--+-- > host_compiler_cmd_str (JACK,"/home/rohan/opt")+-- > host_compiler_cmd_str (SC3,"/home/rohan/opt")+-- > host_compiler_cmd_str (Text,"/home/rohan/opt")+host_compiler_cmd_str :: (Host, FilePath) -> String+host_compiler_cmd_str = let f (cmd,arg) = unwords (cmd : arg) in f . host_compiler_cmd  -- * IO 
Sound/DF/Uniform/LL/K.hs view
@@ -1,4 +1,4 @@-{-# Language DeriveDataTypeable,FlexibleInstances #-}+{-# Language DeriveDataTypeable,FlexibleInstances,StandaloneDeriving #-} -- | Data flow wire values. module Sound.DF.Uniform.LL.K where @@ -28,6 +28,7 @@ -- * K  -- | Sum type for wire values.+-- N = nil, B = boolean, I = integer, F = floating point, V = vector (array). data K = N ()        | B Bool        | I Int32@@ -47,7 +48,7 @@       F _ -> float_t       V _ -> vec_float_t -instance Typeable K where typeOf = k_typeOf+deriving instance Typeable K -- where typeRep = k_typeOf  -- | Concise pretty printer and 'Show' instance for 'K'. k_concise :: K -> String
Sound/DF/Uniform/PhT/Node.hs view
@@ -2,9 +2,9 @@ -- | Data flow nodes. module Sound.DF.Uniform.PhT.Node where -import Data.Bits-import Data.Int-import Data.Typeable+import Data.Bits {- base -}+import Data.Int {- base -}+import Data.Typeable {- base -}  import Sound.DF.Uniform.LL import Sound.DF.Uniform.UDF@@ -48,7 +48,7 @@  -- | Multiple root graph. mrg :: DF a -> DF () -> DF a-mrg p q = DF (UDF_M (df_udf p) (df_udf q))+mrg p q = DF (UDF_MRG (df_udf p) (df_udf q))  -- * Querying data type on ports @@ -132,6 +132,9 @@ instance Eq a => Bits (DF a) where     (.&.) = binary_operator "df_and"     (.|.) = binary_operator "df_or"+    shift = undefined+    rotate = undefined+    bitSizeMaybe = undefined     xor = undefined     complement = undefined     bit = undefined
Sound/DF/Uniform/UDF.hs view
@@ -2,6 +2,7 @@ module Sound.DF.Uniform.UDF where  import qualified Data.Graph.Inductive as G {- fgl -}+import qualified Data.Graph.Inductive.Dot as G {- fgl-visualize -} import Data.Maybe {- base -} import Data.List {- base -} import Data.Typeable {- base -}@@ -21,12 +22,16 @@ -- | Recursion identifier. data R_Id = R_Id Id deriving (Eq,Show) +from_r_id :: R_Id -> Id+from_r_id (R_Id n) = n+ -- | Un-typed data-flow node.+-- K = constant, A = array, R = recursion, P = primitive, MRG = multiple root graph. data UDF = UDF_K {udf_k :: K}          | UDF_A {udf_a :: Vec Float}          | UDF_R R_Id (Either K (UDF,UDF))          | UDF_P String TypeRep [UDF]-         | UDF_M UDF UDF+         | UDF_MRG UDF UDF            deriving(Eq,Show)  -- | Concise pretty printer for 'UDF'.@@ -38,7 +43,7 @@       UDF_R _ (Left i) -> printf "recRd:%s" (k_concise i)       UDF_R _ (Right _) -> "recWr"       UDF_P nm ty _ -> printf "%s:%s" nm (show ty)-      UDF_M l r -> printf "m(%s,%s)" (show l) (show r)+      UDF_MRG l r -> printf "mrg(%s,%s)" (show l) (show r)  -- | Maybe variant of 'udf_k'. udf_k' :: UDF -> Maybe K@@ -56,7 +61,7 @@       UDF_P _ _ i -> n : concatMap udf_elem i       UDF_R _ (Left _) -> [n]       UDF_R _ (Right (l,r)) -> n : (udf_elem l ++ udf_elem r)-      UDF_M l r -> n : (udf_elem l ++ udf_elem r)+      UDF_MRG l r -> n : (udf_elem l ++ udf_elem r)  -- | Output type of 'UDF'. udf_typeOf :: UDF -> TypeRep@@ -67,7 +72,7 @@       UDF_P _ t _ -> t       UDF_R _ (Left k) -> k_typeOf k       UDF_R _ (Right (n,_)) -> udf_typeOf n-      UDF_M n _ -> udf_typeOf n+      UDF_MRG n _ -> udf_typeOf n  -- | Traversal with state, signature as 'mapAccumL'. udf_traverse :: (st -> UDF -> (st,UDF)) -> st -> UDF -> (st,UDF)@@ -83,10 +88,10 @@           let (st',p') = f st p               (st'',q') = f st' q           in f st'' (UDF_R r (Right (p',q')))-      UDF_M p q ->+      UDF_MRG p q ->           let (st',p') = f st p               (st'',q') = f st' q-          in f st'' (UDF_M p' q')+          in f st'' (UDF_MRG p' q')  -- * Graph @@ -137,7 +142,7 @@     let r = find ((== n) . node_udf) ns     in maybe (error ("label: " ++ show n)) node_id r --- | Transform node to source, see through 'UDF_R' (rec) and 'UDF_M' (mrg).+-- | Transform node to source, see through 'UDF_R' (rec) and 'UDF_MRG' (mrg). source :: [Node] -> UDF -> Id source ns n =     case n of@@ -146,7 +151,7 @@       UDF_P _ _ _ -> label ns n       UDF_R _ (Left _) -> label ns n       UDF_R _ (Right (n',_)) -> source ns n'-      UDF_M l _ -> source ns l+      UDF_MRG l _ -> source ns l  -- | Type of /out/ edge of 'UDF'. udf_edge_ty :: UDF -> Edge_Ty@@ -259,16 +264,18 @@         e' = mapMaybe (implicit_edge' e) e     in (n',e') --- | Label nodes and list incoming edges.  Multiple-root nodes are--- erased.+-- | Label nodes and list incoming edges.  Multiple-root and+-- multiple-channel nodes are erased. -- -- > analyse (udf_elem c) analyse :: [UDF] -> Analysis analyse ns =     let l_ns = zip [1..] ns         w_es (k,n) = ((k,n),edges l_ns n)-        rem_m ((_,UDF_M _ _),_) = False-        rem_m _ = True+        rem_m ((_,n),_) =+            case n of+              UDF_MRG _ _ -> False+              _ -> True     in filter rem_m (map w_es l_ns)  -- | Generate graph (node list and edge list).@@ -332,7 +339,7 @@           if ty == nil_t           then []           else [(Std_Var,ty,k,Nothing)]-      UDF_M _ _ -> error "node_vars_n: mrg"+      UDF_MRG _ _ -> error "node_vars_n: MRG"  -- | Possible c-call code statement. node_c_call :: (Node,[Edge]) -> Maybe C_Call@@ -392,7 +399,7 @@       UDF_P nm ty i -> dot_rec' k nm (dot_ar i) ty       UDF_R _ (Left c) -> dot_rec' k (udf_concise u) [Right c] (k_typeOf c)       UDF_R _ (Right (u',_)) -> dot_rec' k (udf_concise u) (dot_ar [u']) (udf_typeOf u')-      UDF_M _ _ -> error "dot_node: UDF_M"+      UDF_MRG _ _ -> error "dot_node: MRG"  -- | Edges are coloured according to their type. edge_ty_colour :: Edge_Ty -> String@@ -440,11 +447,11 @@  -- | Make @dot@ rendering of graph at 'Node', via 'vgraph_direct'. gr_dot :: UDF -> String-gr_dot = G.graphviz' . udf_gr' . vgraph_direct . vgraph_impl . graph+gr_dot = G.showDot . G.fglToDot . udf_gr' . vgraph_direct . vgraph_impl . graph  -- | Make @dot@ rendering of graph at 'Node', via 'vgraph_impl'. gr_dot' :: UDF -> String-gr_dot' = G.graphviz' . udf_gr' . vgraph_impl . graph+gr_dot' = G.showDot . G.fglToDot . udf_gr' . vgraph_impl . graph  -- | Draw graph, via 'gr_dot'. gr_draw :: UDF -> IO ()@@ -458,7 +465,7 @@  -- | Audition graph after sending initialisation messages. audition :: [Message] -> UDF -> IO ()-audition is n = L.audition is (udf_instructions n)+audition is n = L.audition_rju is (udf_instructions n)  -- | Audition graph after sending initialisation messages. audition_sc3 :: [Message] -> UDF -> IO ()
gr/analog-bubbles-buf-m.hs view
@@ -1,10 +1,10 @@ import Control.Monad import Sound.DF.Uniform.GADT {- hdf -} import Sound.OSC {- hosc -}-import qualified Sound.SC3.ID as S {- hsc3 -}+import qualified Sound.SC3 as S {- hsc3 -}  main :: IO ()-main = audition analog_bubbles_buf_msg =<< analog_bubbles_buf_m+main = audition_rju analog_bubbles_buf_msg =<< analog_bubbles_buf_m  analog_bubbles_buf_msg :: [Message] analog_bubbles_buf_msg = [S.b_alloc 0 44100 1,S.b_alloc 1 44100 1]
gr/analog-bubbles-buf.hs view
@@ -1,10 +1,10 @@-import Control.Monad+import Control.Monad {- base -} import Sound.DF.Uniform.GADT {- hdf -} import Sound.OSC {- hosc -}-import qualified Sound.SC3.ID as S {- hsc3 -}+import qualified Sound.SC3 as S {- hsc3 -}  main :: IO ()-main = audition analog_bubbles_buf_msg analog_bubbles_buf+main = audition_rju analog_bubbles_buf_msg analog_bubbles_buf  analog_bubbles_buf_msg :: [Message] analog_bubbles_buf_msg = [S.b_alloc 0 44100 1,S.b_alloc 1 44100 1]
gr/analog-bubbles-m.hs view
@@ -2,7 +2,7 @@ import Sound.DF.Uniform.GADT {- hdf -}  main :: IO ()-main = audition [] =<< analog_bubbles_m+main = audition_rju [] =<< analog_bubbles_m  -- > drawM analog_bubbles_m analog_bubbles_m :: (Functor m,UId m) => m (DF ())
+ gr/analog-bubbles-no-mce.hs view
@@ -0,0 +1,20 @@+import Sound.DF.Uniform.GADT {- hdf -}+import qualified Sound.DF.Uniform.LL as L {- hdf -}++-- > draw analog_bubbles+-- > let dir = "/home/rohan/opt" -- "/usr/local"+-- > L.dl_gen "/tmp/analog-bubbles" (L.SC3,dir) (df_instructions analog_bubbles)+analog_bubbles :: DF ()+analog_bubbles =+  let bimap f g (a,b) = (f a,g b)+      bimap1 f = bimap f f+      mk_o f = lf_saw f 0.0 * 3.0 + 80.0+      mk_f a = lf_saw 0.4 0.0 * 24.0 + a+      mk_s f = sin_osc (midi_cps f) 0.0 * 0.04+      mk_c k z s = comb_n' k z s 0.2 4.0+      mk_c' = bimap (\z -> mk_c (L.V_Id 0) 0.2 z) (\z -> mk_c (L.V_Id 1) 0.4 z)+      c = mk_c' (bimap1 (mk_s . mk_f . mk_o) (8.0,7.23))+  in uncurry out2 c++main :: IO ()+main = audition_rju [] analog_bubbles
gr/analog-bubbles.hs view
@@ -1,20 +1,19 @@-import Control.Monad import Sound.DF.Uniform.GADT {- hdf -}-import Sound.DF.Uniform.LL.K {- hdf -}  -- > draw analog_bubbles+-- > let dir = "/home/rohan/opt" -- "/usr/local"+-- > import qualified Sound.DF.Uniform.LL as L {- hdf -}+-- > L.dl_gen "/tmp/analog-bubbles" (L.SC3,dir) (df_instructions analog_bubbles) analog_bubbles :: DF () analog_bubbles =-  let dpl f a b = (f a,f b)-      mk_o f = lf_saw f 0.0 * 3.0 + 80.0-      mk_f a = lf_saw 0.4 0.0 * 24.0 + a-      mk_s f = sin_osc (midi_cps f) 0.0 * 0.04-      (o1,o2) = dpl mk_o 8.0 7.23-      (f1,f2) = dpl mk_f o1 o2-      (s1,s2) = dpl mk_s f1 f2-      c1 = comb_n (V_Id 0) 0.2 s1 0.2 4.0-      c2 = comb_n (V_Id 1) 0.4 s2 0.2 4.0-  in out2 c1 c2+  let o = lf_saw (mce2 8.0 7.23) 0.0 * 3.0 + 80.0+      m = lf_saw 0.4 0.0 * 24.0 + o+      s = sin_osc (midi_cps m) 0.0 * 0.04+      c = comb_n [0,1] 0.4 s 0.2 4.0+  in out c  main :: IO ()-main = audition [] analog_bubbles+main = audition_rju [] analog_bubbles++-- > draw (out (sin_osc (mce2 220 660) 0.0 * 0.1))+-- > audition_rju [] (out (sin_osc (mce2 440 442) 0.0 * 0.1))
+ gr/berlin-1977.hs view
@@ -0,0 +1,32 @@+-- berlin 1977 (jmcc) #4++import Data.List {- base -}+import Sound.DF.Uniform.GADT {- hdf -}++sequ :: Int -> [Float] -> DF Bool -> DF Float+sequ k l tr =+    let a = a_tbl k l+        n = genericLength l+        c = count_true tr `df_mod` n+    in a_read a c++-- > draw berlin_1977+berlin_1977 :: DF ()+berlin_1977 =+    let clock_rate = 9+        clock_time = 1 / clock_rate+        clock = impulse clock_rate 0 -- sequencer trigger+        tr = trigger clock+        note = sequ 0 [55,60,63,62,60,67,63,58] tr -- midi note pattern sequencer+        tr_16 = pulse_divider tr 16 0 -- divide tr by 16+        note' = sequ 1 [-12,-7,-5,0,2,5] tr_16 + note -- transpose+        freq = midi_cps note' -- convert midi note to cycles per second+        env = decay2 clock (0.05 * clock_time) (2 * clock_time)+        amp = env * 0.1 + 0.02 -- amplitude envelope+        filt = env * (sin_osc 0.17 0 * 800) + 1400 -- filter frequency+        pw = sin_osc (mce2 0.08 0.09) 0 * 0.45 + 0.5 -- pulse width LFO(s)+        s = lf_pulse freq 0 pw * amp -- not bandlimited+    in out (comb_n [0,1] 0.2 (rlpf s filt 0.15) (mce2 0.2 0.17) 1.5)++main :: IO ()+main = audition_rju [] berlin_1977
gr/ctl1.hs view
@@ -1,7 +1,6 @@-import Control.Monad import Sound.DF.Uniform.GADT {- hdf -} import Sound.OSC {- hosc -}-import qualified Sound.SC3.ID as S {- hsc3 -}+import qualified Sound.SC3 as S {- hsc3 -}  -- > import qualified Sound.DF.Uniform.LL as L {- hdf -} -- > L.with_jack_dl (mapM_ S.send ctl_osc_msg)@@ -17,10 +16,10 @@ -- > L.with_jack_dl (mapM_ S.send [S.c_set1 0 880,S.c_set1 1 0.1]) -- > L.with_jack_dl (mapM_ S.send [S.c_set1 0 220,S.c_set1 1 0.2]) main :: IO ()-main = audition ctl_osc_msg ctl_osc+main = audition_rju ctl_osc_msg ctl_osc  -- > drawM ctl_osc_m--- > ctl_osc_m >>= audition ctl_osc_msg+-- > ctl_osc_m >>= audition_rju ctl_osc_msg ctl_osc_m :: (Functor m,UId m) => m (DF ()) ctl_osc_m = do   o <- fmap (* (ctl1 1)) (sin_osc_m (ctl1 0) 0.0)
gr/drummer.hs view
@@ -14,4 +14,4 @@   in out1 ((snare + bass + hihat) * 0.4)  main :: IO ()-main = audition [] drummer+main = audition_rju [] drummer
gr/fig-3-6-m.hs view
@@ -19,4 +19,4 @@ fig_3_6_m' = fmap (out1 . (* 0.1) . i32_to_normal_f32) fig_3_6_m  main :: IO ()-main = audition [] =<< fig_3_6_m'+main = audition_rju [] =<< fig_3_6_m'
gr/fig-3-6.hs view
@@ -19,4 +19,4 @@ fig_3_6' = out1 (i32_to_normal_f32 fig_3_6 * 0.1)  main :: IO ()-main = audition [] fig_3_6'+main = audition_rju [] fig_3_6'
gr/lfo-modulation-buf-m.hs view
@@ -4,7 +4,7 @@ import qualified Sound.SC3 as S {- hsc3 -}  main :: IO ()-main = audition lfo_modulation_buf_msg =<< lfo_modulation_buf_m+main = audition_rju lfo_modulation_buf_msg =<< lfo_modulation_buf_m  lfo_modulation_buf_msg :: [Message] lfo_modulation_buf_msg = [S.b_alloc 0 44100 1, S.b_alloc 1 44100 1]
gr/lfo-modulation-buf.hs view
@@ -1,10 +1,9 @@-import Control.Monad import Sound.DF.Uniform.GADT {- hdf -} import Sound.OSC {- hosc -} import qualified Sound.SC3 as S {- hsc3 -}  main :: IO ()-main = audition lfo_modulation_buf_msg lfo_modulation_buf+main = audition_rju lfo_modulation_buf_msg lfo_modulation_buf  lfo_modulation_buf_msg :: [Message] lfo_modulation_buf_msg = [S.b_alloc 0 44100 1, S.b_alloc 1 44100 1]
gr/lfo-modulation-m.hs view
@@ -1,4 +1,4 @@-import Control.Monad+import Control.Monad {- base -} import Sound.DF.Uniform.GADT {- hdf -} import Sound.OSC {- hosc -} import qualified Sound.SC3 as S {- hsc3 -}@@ -17,7 +17,7 @@   return (out2 c1 c2)  main :: IO ()-main = audition [] =<< lfo_modulation_m+main = audition_rju [] =<< lfo_modulation_m  lfo_modulation_buf_msg :: [Message] lfo_modulation_buf_msg = [S.b_alloc 0 44100 1, S.b_alloc 1 44100 1]
+ gr/lfo-modulation-no-mce.hs view
@@ -0,0 +1,18 @@+import Sound.DF.Uniform.GADT {- hdf -}+import Sound.DF.Uniform.LL.K {- hdf -}++-- > draw lfo_modulation+lfo_modulation :: DF ()+lfo_modulation =+    let dpl f p q = (f p,f q)+        mk_p f = sin_osc f 0.0 * 3600.0 + 4000.0+        s = sin_osc 0.05 0.0 * 80.0 + 160.0+        (p1,p2) = dpl mk_p 0.6 0.7+        l = lf_pulse s 0 0.4 * 0.05+        (r1,r2) = dpl (\x -> rlpf l x 0.2) p1 p2+        c1 = comb_n' (V_Id 0) 0.2 r1 0.20 2.0+        c2 = comb_n' (V_Id 1) 0.25 r2 0.25 2.0+    in out2 c1 c2++main :: IO ()+main = audition_rju [] lfo_modulation
gr/lfo-modulation.hs view
@@ -1,19 +1,15 @@-import Control.Monad import Sound.DF.Uniform.GADT {- hdf -} import Sound.DF.Uniform.LL.K {- hdf -}  -- > draw lfo_modulation lfo_modulation :: DF () lfo_modulation =-    let dpl f p q = (f p,f q)-        mk_p f = sin_osc f 0.0 * 3600.0 + 4000.0+    let p = sin_osc (mce2 0.6 0.7) 0.0 * 3600.0 + 4000.0         s = sin_osc 0.05 0.0 * 80.0 + 160.0-        (p1,p2) = dpl mk_p 0.6 0.7         l = lf_pulse s 0 0.4 * 0.05-        (r1,r2) = dpl (\x -> rlpf l x 0.2) p1 p2-        c1 = comb_n (V_Id 0) 0.2 r1 0.20 2.0-        c2 = comb_n (V_Id 1) 0.25 r2 0.25 2.0-    in out2 c1 c2+        r = rlpf l p 0.2+        c = comb_n [0,1] 0.25 r (mce2 0.20 0.25) 2.0+    in out c  main :: IO ()-main = audition [] lfo_modulation+main = audition_rju [] lfo_modulation
gr/moto-rev-m.hs view
@@ -1,4 +1,4 @@-import Control.Monad+import Control.Monad {- base -} import Sound.DF.Uniform.GADT {- hdf -}  -- > drawM moto_rev_m@@ -14,4 +14,4 @@   return (out2 c1 c2)  main :: IO ()-main = audition [] =<< moto_rev_m+main = audition_rju [] =<< moto_rev_m
gr/moto-rev.hs view
@@ -1,8 +1,7 @@-import Control.Monad import Sound.DF.Uniform.GADT {- hdf -}  main :: IO ()-main = audition [] moto_rev+main = audition_rju [] moto_rev  -- > draw moto_rev moto_rev :: DF ()
gr/pass-through.hs view
@@ -5,4 +5,4 @@ pass_through = out1 in1  main :: IO ()-main = audition [] pass_through+main = audition_rju [] pass_through
gr/silence.hs view
@@ -6,4 +6,4 @@  -- > audition_text 12 silence main :: IO ()-main = audition [] silence+main = audition_rju [] silence
gr/sprinkler-m.hs view
@@ -11,5 +11,4 @@   return (out1 o)  main :: IO ()-main = sprinkler_m >>= audition []-+main = sprinkler_m >>= audition_rju []
gr/sprinkler.hs view
@@ -10,5 +10,5 @@     in out1 o  main :: IO ()-main = audition [] sprinkler+main = audition_rju [] sprinkler 
+ gr/why-supercollider.hs view
@@ -0,0 +1,25 @@+-- why supercollider (jmcc) #0++import Sound.DF.Uniform.GADT {- hdf -}++-- > draw why_supercollider+why_supercollider =+    let r = resonz (dust 16987362 0.2 * 50) (rand 216948736 200 3200) 0.003+        z = r -- delay_n 1629876327 r 0.048 0.048+        n = lf_noise1 169872631 (rand 790283276 0 0.01) * 0.04 + 0.05+        c = comb_n [0] 0.1 z n 15+    in out c++{-+    let r = resonz (dust 'α' AR 0.2 * 50) (rand 'β' 200 3200) 0.003+        s = mix (uclone 'γ' 10 r)+        z = delayN s 0.048 0.048+        c = combL z 0.1 (lfNoise1 'δ' KR (rand 'ε' 0 0.1) * 0.04 + 0.05) 15+        y = mix (uclone 'ζ' 7 c)+        f i = allpassN i 0.05 (randN 2 'η' 0 0.05) 1+        x = useq 'θ' 4 f y+    in out 0 (s + 0.2 * x)+-}++main :: IO ()+main = audition_rju [] why_supercollider
hdf.cabal view
@@ -1,20 +1,20 @@ Name:              hdf-Version:           0.14-Synopsis:          Haskell data flow library for audio processing+Version:           0.15+Synopsis:          HDF: Uniform Rate Audio Signal Processing in Haskell Description:       Haskell data flow library for audio processing.                    Requires either the @RDL@ UGen from @sc3-rdu@ or                    the @jack-dl@ host from @rju@.                    .-                   See <http://rd.slavepianos.org/?t=sc3-rdu>-                   or <http://rd.slavepianos.org/?t=rju>.+                   See <http://rd.slavepianos.org/t/sc3-rdu>+                   or <http://rd.slavepianos.org/t/rju>. License:           GPL Category:          Sound-Copyright:         (c) Rohan Drape, 2006-2013+Copyright:         (c) Rohan Drape, 2006-2014 Author:            Rohan Drape Maintainer:        rd@slavepianos.org Stability:         Experimental-Homepage:          http://rd.slavepianos.org/?t=hdf-Tested-With:       GHC == 7.6.1+Homepage:          http://rd.slavepianos.org/t/hdf+Tested-With:       GHC == 7.8.2 Build-Type:        Simple Cabal-Version:     >= 1.8 @@ -29,12 +29,13 @@   Build-Depends:   base == 4.*,                    directory,                    fgl,+                   fgl-visualize,                    filepath,-                   hosc == 0.14.*,-                   hsc3 == 0.14.*,+                   hosc == 0.15.*,+                   hsc3 == 0.15.*,                    murmur-hash,                    process,-                   sc3-rdu == 0.14.*,+                   -- sc3-rdu == 0.15.*,                    split,                    transformers   GHC-Options:     -Wall -fwarn-tabs