module Sound.SC3.UGen.UGen where
import Control.Monad
import Data.List
import Sound.SC3.UGen.Operator
import Sound.SC3.UGen.Rate
import Sound.SC3.UGen.UId
import System.Random
data UGen = Constant { constantValue :: Double }
| Control { controlOperatingRate :: Rate
, controlName :: String
, controlDefault :: Double }
| Primitive { ugenRate :: Rate
, ugenName :: String
, ugenInputs :: [UGen]
, ugenOutputs :: [Output]
, ugenSpecial :: Special
, ugenId :: Maybe UGenId }
| Proxy { proxySource :: UGen
, proxyIndex :: Int }
| MCE { mceProxies :: [UGen] }
| MRG { mrgLeft :: UGen
, mrgRight :: UGen }
deriving (Eq, Show)
type Output = Rate
newtype Special = Special Int
deriving (Eq, Show)
newtype UGenId = UGenId Int
deriving (Eq, Show)
uid :: Int -> UGenId
uid = UGenId
constant :: (Real a) => a -> UGen
constant = Constant . realToFrac
control :: Rate -> String -> Double -> UGen
control = Control
mce :: [UGen] -> UGen
mce [] = error "mce: empty list"
mce xs = MCE xs
mrg2 :: UGen -> UGen -> UGen
mrg2 = MRG
proxy :: UGen -> Int -> UGen
proxy = Proxy
isConstant :: UGen -> Bool
isConstant (Constant _) = True
isConstant _ = False
isControl :: UGen -> Bool
isControl (Control _ _ _) = True
isControl _ = False
isUGen :: UGen -> Bool
isUGen (Primitive _ _ _ _ _ _) = True
isUGen _ = False
isProxy :: UGen -> Bool
isProxy (Proxy _ _) = True
isProxy _ = False
isMCE :: UGen -> Bool
isMCE (MCE _) = True
isMCE _ = False
isMRG :: UGen -> Bool
isMRG (MRG _ _) = True
isMRG _ = False
mce2 :: UGen -> UGen -> UGen
mce2 x y = mce [x, y]
clone :: (UId m) => Int -> m UGen -> m UGen
clone n u = liftM mce (replicateM n u)
mceDegree :: UGen -> Int
mceDegree (MCE l) = length l
mceDegree (MRG u _) = mceDegree u
mceDegree _ = error "mceDegree: illegal ugen"
mceExtend :: Int -> UGen -> [UGen]
mceExtend n (MCE l) = take n (cycle l)
mceExtend n (MRG x y) = (MRG r y : rs) where (r:rs) = mceExtend n x
mceExtend n u = replicate n u
mceTransform :: UGen -> UGen
mceTransform (Primitive r n i o s d) = MCE (map f i')
where f j = Primitive r n j o s d
upr = maximum (map mceDegree (filter isMCE i))
i' = transpose (map (mceExtend upr) i)
mceTransform _ = error "mceTransform: illegal ugen"
mceExpand :: UGen -> UGen
mceExpand (MCE l) = MCE (map mceExpand l)
mceExpand (MRG x y) = MRG (mceExpand x) y
mceExpand u = if required u then mceExpand (mceTransform u) else u
where required (Primitive _ _ i _ _ _) = not (null (filter isMCE i))
required _ = False
mceEdit :: ([UGen] -> [UGen]) -> UGen -> UGen
mceEdit f (MCE l) = MCE (f l)
mceEdit _ _ = error "mceEdit: non MCE value"
mceReverse :: UGen -> UGen
mceReverse = mceEdit reverse
mceChannel :: Int -> UGen -> UGen
mceChannel n (MCE l) = l !! n
mceChannel _ _ = error "mceChannel: non MCE value"
mceChannels :: UGen -> [UGen]
mceChannels (MCE l) = l
mceChannels (MRG x y) = (MRG r y) : rs where (r:rs) = mceChannels x
mceChannels u = [u]
mceTranspose :: UGen -> UGen
mceTranspose u = mce (map mce (transpose (map mceChannels (mceChannels u))))
mrg :: [UGen] -> UGen
mrg [] = undefined
mrg [x] = x
mrg (x:xs) = MRG x (mrg xs)
proxify :: UGen -> UGen
proxify u
| isMCE u = mce (map proxify (mceProxies u))
| isMRG u = mrg [proxify (mrgLeft u), mrgRight u]
| isUGen u = let o = ugenOutputs u
in case o of
(_:_:_) -> mce (map (proxy u) [0..(length o 1)])
_ -> u
| otherwise = error "proxify: illegal ugen"
rateOf :: UGen -> Rate
rateOf u
| isConstant u = IR
| isControl u = controlOperatingRate u
| isUGen u = ugenRate u
| isProxy u = rateOf (proxySource u)
| isMCE u = maximum (map rateOf (mceProxies u))
| isMRG u = rateOf (mrgLeft u)
| otherwise = undefined
is_sink :: UGen -> Bool
is_sink u
| isUGen u = null (ugenOutputs u)
| isMCE u = all is_sink (mceProxies u)
| isMRG u = is_sink (mrgLeft u)
| otherwise = False
check_input :: UGen -> UGen
check_input u = if is_sink u
then error ("illegal input: " ++ show u)
else u
mkUGen :: Rate -> String -> [UGen] -> [Output] -> Special -> Maybe UGenId -> UGen
mkUGen r n i o s z = proxify (mceExpand u)
where u = Primitive r n (map check_input i) o s z
mkOperator :: String -> [UGen] -> Int -> UGen
mkOperator c i s = mkUGen r c i [r] (Special s) Nothing
where r = maximum (map rateOf i)
mkUnaryOperator :: Unary -> (Double -> Double) -> UGen -> UGen
mkUnaryOperator i f a
| isConstant a = constant (f (constantValue a))
| otherwise = mkOperator "UnaryOpUGen" [a] (fromEnum i)
mkBinaryOperator :: Binary -> (Double -> Double -> Double) -> UGen -> UGen -> UGen
mkBinaryOperator i f a b
| isConstant a && isConstant b = let a' = constantValue a
b' = constantValue b
in constant (f a' b')
| otherwise = mkOperator "BinaryOpUGen" [a, b] (fromEnum i)
mk_osc :: Maybe UGenId -> Rate -> String -> [UGen] -> Int -> UGen
mk_osc z r c i o = mkUGen r c i (replicate o r) (Special 0) z
mkOsc :: Rate -> String -> [UGen] -> Int -> UGen
mkOsc = mk_osc Nothing
mkOscId :: UGenId -> Rate -> String -> [UGen] -> Int -> UGen
mkOscId z = mk_osc (Just z)
mk_osc_mce :: Maybe UGenId -> Rate -> String -> [UGen] -> UGen -> Int -> UGen
mk_osc_mce z r c i j o = mk_osc z r c (i ++ mceChannels j) o
mkOscMCE :: Rate -> String -> [UGen] -> UGen -> Int -> UGen
mkOscMCE = mk_osc_mce Nothing
mkOscMCEId :: UGenId -> Rate -> String -> [UGen] -> UGen -> Int -> UGen
mkOscMCEId z = mk_osc_mce (Just z)
mk_filter :: Maybe UGenId -> String -> [UGen] -> Int -> UGen
mk_filter z c i o = mkUGen r c i o' (Special 0) z
where r = maximum (map rateOf i)
o'= replicate o r
mkFilter :: String -> [UGen] -> Int -> UGen
mkFilter = mk_filter Nothing
mkFilterId :: UGenId -> String -> [UGen] -> Int -> UGen
mkFilterId z = mk_filter (Just z)
mkFilterKeyed :: String -> Int -> [UGen] -> Int -> UGen
mkFilterKeyed c k i o = mkUGen r c i o' (Special 0) Nothing
where r = rateOf (i !! k)
o' = replicate o r
mk_filter_mce :: Maybe UGenId -> String -> [UGen] -> UGen -> Int -> UGen
mk_filter_mce z c i j o = mk_filter z c (i ++ mceChannels j) o
mkFilterMCE :: String -> [UGen] -> UGen -> Int -> UGen
mkFilterMCE = mk_filter_mce Nothing
mkFilterMCEId :: UGenId -> String -> [UGen] -> UGen -> Int -> UGen
mkFilterMCEId z = mk_filter_mce (Just z)
mkInfo :: String -> UGen
mkInfo name = mkOsc IR name [] 1
instance Num UGen where
negate = mkUnaryOperator Neg negate
(+) = mkBinaryOperator Add (+)
() = mkBinaryOperator Sub ()
(*) = mkBinaryOperator Mul (*)
abs = mkUnaryOperator Abs abs
signum = mkUnaryOperator Sign signum
fromInteger = Constant . fromInteger
instance Fractional UGen where
recip = mkUnaryOperator Recip recip
(/) = mkBinaryOperator FDiv (/)
fromRational = Constant . fromRational
instance Floating UGen where
pi = Constant pi
exp = mkUnaryOperator Exp exp
log = mkUnaryOperator Log log
sqrt = mkUnaryOperator Sqrt sqrt
(**) = mkBinaryOperator Pow (**)
logBase a b = log b / log a
sin = mkUnaryOperator Sin sin
cos = mkUnaryOperator Cos cos
tan = mkUnaryOperator Tan tan
asin = mkUnaryOperator ArcSin asin
acos = mkUnaryOperator ArcCos acos
atan = mkUnaryOperator ArcTan atan
sinh = mkUnaryOperator SinH sinh
cosh = mkUnaryOperator CosH cosh
tanh = mkUnaryOperator TanH tanh
asinh x = log (sqrt (x*x+1) + x)
acosh x = log (sqrt (x*x1) + x)
atanh x = (log (1+x) log (1x)) / 2
instance Real UGen where
toRational (Constant n) = toRational n
toRational _ = error "toRational at non-constant UGen"
instance Integral UGen where
quot = mkBinaryOperator IDiv undefined
rem = mkBinaryOperator Mod undefined
quotRem a b = (quot a b, rem a b)
div = mkBinaryOperator IDiv undefined
mod = mkBinaryOperator Mod undefined
toInteger (Constant n) = floor n
toInteger _ = error "toInteger at non-constant UGen"
instance Ord UGen where
(Constant a) < (Constant b) = a < b
_ < _ = error "< at UGen is partial, see <*"
(Constant a) <= (Constant b) = a <= b
_ <= _ = error "<= at UGen is partial, see <=*"
(Constant a) > (Constant b) = a < b
_ > _ = error "> at UGen is partial, see >*"
(Constant a) >= (Constant b) = a >= b
_ >= _ = error ">= at UGen is partial, see >=*"
min = mkBinaryOperator Min min
max = mkBinaryOperator Max max
instance Enum UGen where
succ u = u + 1
pred u = u 1
toEnum i = constant i
fromEnum (Constant n) = truncate n
fromEnum _ = error "cannot enumerate non-constant UGens"
enumFrom = iterate (+1)
enumFromThen n m = iterate (+(mn)) n
enumFromTo n m = takeWhile (<= m+1/2) (enumFrom n)
enumFromThenTo n n' m = takeWhile (p (m + (n'n)/2)) (enumFromThen n n')
where p = if n' >= n then (>=) else (<=)
instance Random UGen where
randomR (Constant l, Constant r) g = let (n, g') = randomR (l,r) g
in (Constant n, g')
randomR _ _ = error "randomR: non constant (l,r)"
random g = randomR (1.0, 1.0) g