module Sound.SC3.UGen.Envelope where
import Data.List
import Data.Maybe
import Sound.SC3.UGen.Enum
import Sound.SC3.UGen.Type
data Envelope a =
Envelope {env_levels :: [a]
,env_times :: [a]
,env_curves :: [Envelope_Curve a]
,env_release_node :: Maybe Int
,env_loop_node :: Maybe Int
}
deriving (Eq,Show)
envelope :: [a] -> [a] -> [Envelope_Curve a] -> Envelope a
envelope l t c = Envelope l t c Nothing Nothing
envelope_duration :: Num n => Envelope n -> n
envelope_duration = sum . env_times
envelope_n_segments :: (Num n,Integral i) => Envelope n -> i
envelope_n_segments = genericLength . env_times
envelope_segment_ix :: (Ord a, Num a) => Envelope a -> a -> Maybe Int
envelope_segment_ix e t =
let d = dx_d (env_times e)
in findIndex (>= t) d
type Envelope_Segment t = (t,t,t,t,Envelope_Curve t)
envelope_segment :: Num t => Envelope t -> Int -> Envelope_Segment t
envelope_segment e i =
let l = env_levels e
t = env_times e
x0 = l !! i
x1 = l !! (i + 1)
t0 = (0 : dx_d t) !! i
t1 = t0 + t !! i
c = envelope_curves e !! i
in (t0,x0,t1,x1,c)
envelope_segments :: Num t => Envelope t -> [Envelope_Segment t]
envelope_segments e =
let n = envelope_n_segments e
in map (envelope_segment e) [0 .. n 1]
pack_envelope_segments :: Num t => [Envelope_Segment t] -> ([t],[t],[Envelope_Curve t])
pack_envelope_segments s =
case s of
[] -> error ""
[(t0,l0,t1,l1,c)] -> ([l0,l1],[t1 t0],[c])
(_,l0,_,_,_) : _ ->
let t (t0,_,t1,_,_) = t1 t0
c (_,_,_,_,x) = x
l (_,_,_,x,_) = x
in (l0 : map l s,map t s,map c s)
envelope_is_normal :: (Eq n,Num n) => Envelope n -> Bool
envelope_is_normal = null . filter (== 0) . env_times
envelope_normalise :: (Num a, Ord a) => Envelope a -> Envelope a
envelope_normalise e =
let s = envelope_segments e
f (t0,_,t1,_,_) = t1 <= t0
s' = filter (not . f) s
(l,t,c) = pack_envelope_segments s'
in case e of
Envelope _ _ _ Nothing Nothing -> Envelope l t c Nothing Nothing
_ -> error "envelope_normalise: has release or loop node..."
envelope_at :: (Ord t, Floating t) => Envelope t -> t -> t
envelope_at e t =
case envelope_segment_ix e t of
Just n -> let (t0,x0,t1,x1,c) = envelope_segment e n
d = t1 t0
t' = (t t0) / d
f = env_curve_interpolation_f c
in if d <= 0
then x1
else f x0 x1 t'
Nothing -> 0
envelope_render :: (Ord t, Floating t, Enum t) => t -> Envelope t -> [(t,t)]
envelope_render n e =
let d = envelope_duration e
k = d / (n 1)
t = [0,k .. d]
in zip t (map (envelope_at e) t)
envelope_table :: (Ord t, Floating t, Enum t) => t -> Envelope t -> [t]
envelope_table n = map snd . envelope_render n
envelope_curves :: Num a => Envelope a -> [Envelope_Curve a]
envelope_curves e =
let c = env_curves e
n = envelope_n_segments e
in if null c
then replicate n EnvLin
else take n (cycle c)
envelope_sc3_array :: Num a => Envelope a -> Maybe [a]
envelope_sc3_array e =
let Envelope l t _ rn ln = e
n = length t
n' = fromIntegral n
rn' = fromIntegral (fromMaybe (99) rn)
ln' = fromIntegral (fromMaybe (99) ln)
c = envelope_curves e
f i j k = [i,j,env_curve_shape k,env_curve_value k]
in case l of
l0:l' -> Just (l0 : n' : rn' : ln' : concat (zipWith3 f l' t c))
_ -> Nothing
envelope_sc3_ienvgen_array :: Num a => Envelope a -> Maybe [a]
envelope_sc3_ienvgen_array e =
let Envelope l t _ _ _ = e
n = length t
n' = fromIntegral n
c = envelope_curves e
f i j k = [j,env_curve_shape k,env_curve_value k,i]
in case l of
l0:l' -> Just (0 : l0 : n' : sum t : concat (zipWith3 f l' t c))
_ -> Nothing
env_is_sustained :: Envelope a -> Bool
env_is_sustained = isJust . env_release_node
env_delay :: Envelope a -> a -> Envelope a
env_delay (Envelope l t c rn ln) d =
let (l0:_) = l
l' = l0 : l
t' = d : t
c' = EnvLin : c
rn' = fmap (+ 1) rn
ln' = fmap (+ 1) ln
in Envelope l' t' c' rn' ln'
env_circle :: (Num a,Fractional a) => Envelope a -> a -> Envelope_Curve a -> Envelope a
env_circle (Envelope l t c rn _) tc cc =
let z = 1
n = length t
in case rn of
Nothing -> let l' = 0 : l ++ [0]
t' = z * tc : t ++ [9e8]
c' = cc : take n (cycle c) ++ [EnvLin]
rn' = Just (n + 1)
in Envelope l' t' c' rn' (Just 0)
Just i -> let l' = 0 : l
t' = z * tc : t
c' = cc : take n (cycle c)
rn' = Just (i + 1)
in Envelope l' t' c' rn' (Just 0)
envelope_to_ugen :: Envelope UGen -> UGen
envelope_to_ugen =
let err = error "envGen: bad Envelope"
in mce . fromMaybe err . envelope_sc3_array
d_dx :: (Num a) => [a] -> [a]
d_dx l = zipWith () l (0:l)
dx_d :: Num n => [n] -> [n]
dx_d = scanl1 (+)
d_dx' :: Num n => [n] -> [n]
d_dx' l = zipWith () (tail l) l
dx_d' :: Num n => [n] -> [n]
dx_d' = (0 :) . scanl1 (+)