module Sound.SC3.UGen.UGen where
import qualified Data.Char as C
import Data.Maybe
import Data.List
import qualified Sound.SC3.Common.Envelope as E
import qualified Sound.SC3.Common.Base as B
import qualified Sound.SC3.Common.UId as UId
import qualified Sound.SC3.UGen.Operator as O
import qualified Sound.SC3.UGen.Rate as R
import Sound.SC3.UGen.Type
toUId :: UId.ID a => a -> UGenId
toUId = UId . UId.resolveID
ugen_user_name :: String -> Special -> String
ugen_user_name nm (Special n) =
case nm of
"UnaryOpUGen" -> O.unaryName n
"BinaryOpUGen" -> O.binaryName n
_ -> nm
ugenTraverse :: (UGen -> UGen) -> UGen -> UGen
ugenTraverse f u =
let recur = ugenTraverse f
in case u of
Primitive_U p ->
let i = ugenInputs p
in f (Primitive_U (p {ugenInputs = map recur i}))
Proxy_U p ->
let s = Primitive_U (proxySource p)
in case recur s of
Primitive_U p' -> f (Proxy_U (p {proxySource = p'}))
_ -> error "ugenTraverse"
MCE_U m -> f (mce (map recur (mceProxies m)))
MRG_U (MRG l r) -> f (MRG_U (MRG (recur l) (recur r)))
_ -> f u
ugenFoldr :: (UGen -> a -> a) -> a -> UGen -> a
ugenFoldr f st u =
let recur = flip (ugenFoldr f)
in case u of
Primitive_U p ->
let i = ugenInputs p
in f u (foldr recur st i)
Proxy_U p ->
let s = proxySource p
in f u (f (Primitive_U s) st)
MCE_U m -> f u (foldr recur st (mceProxies m))
MRG_U (MRG l r) -> f u (f l (f r st))
_ -> f u st
control_f64 :: R.Rate -> Maybe Int -> String -> Sample -> UGen
control_f64 r ix nm d = Control_U (Control r ix nm d False Nothing)
control :: R.Rate -> String -> Double -> UGen
control r = control_f64 r Nothing
meta_control :: R.Rate -> String -> Double -> C_Meta_T5 Double -> UGen
meta_control rt nm df meta =
let m = c_meta_t5 id meta
in Control_U (Control rt Nothing nm df False (Just m))
tr_control_f64 :: Maybe Int -> String -> Sample -> UGen
tr_control_f64 ix nm d = Control_U (Control R.KR ix nm d True Nothing)
tr_control :: String -> Double -> UGen
tr_control = tr_control_f64 Nothing
control_set :: [UGen] -> [UGen]
control_set =
let f ix u = case u of
Control_U c -> Control_U (c {controlIndex = Just ix})
_ -> error "control_set: non control input?"
in zipWith f [0..]
mrg2 :: UGen -> UGen -> UGen
mrg2 u = MRG_U . MRG u
mce2 :: UGen -> UGen -> UGen
mce2 x y = mce [x,y]
mce2c :: UGen -> (UGen,UGen)
mce2c u =
case mceChannels u of
[] -> error "mce2c"
[p] -> (p,p)
p:q:_ -> (p,q)
unmce2 :: UGen -> (UGen, UGen)
unmce2 = B.t2_from_list . mceChannels
mce3 :: UGen -> UGen -> UGen -> UGen
mce3 x y z = mce [x,y,z]
mceMap :: (UGen -> UGen) -> UGen -> UGen
mceMap f u = mce (map f (mceChannels u))
map_ix :: ((Int,a) -> b) -> [a] -> [b]
map_ix f = map f . zip [0..]
mce_map_ix :: ((Int,UGen) -> UGen) -> UGen -> UGen
mce_map_ix f u = mce (map_ix f (mceChannels u))
mceEdit :: ([UGen] -> [UGen]) -> UGen -> UGen
mceEdit f u =
case u of
MCE_U m -> mce (f (mceProxies m))
_ -> error "mceEdit: non MCE value"
mceReverse :: UGen -> UGen
mceReverse = mceEdit reverse
mceChannel :: Int -> UGen -> UGen
mceChannel n u =
case u of
MCE_U m -> mceProxies m !! n
_ -> error "mceChannel: non MCE value"
mceTranspose :: UGen -> UGen
mceTranspose = mce . map mce . transpose . map mceChannels . mceChannels
mceSum :: UGen -> UGen
mceSum = sum . mceChannels
halt_mce_transform_f :: (a -> [a]) -> [a] -> [a]
halt_mce_transform_f f l =
let (l',e) = fromMaybe (error "halt_mce_transform: null?") (B.sep_last l)
in l' ++ f e
halt_mce_transform :: [UGen] -> [UGen]
halt_mce_transform = halt_mce_transform_f mceChannels
prepare_root :: UGen -> UGen
prepare_root u =
case u of
MCE_U m -> mrg (mceProxies m)
MRG_U m -> mrg2 (prepare_root (mrgLeft m)) (prepare_root (mrgRight m))
_ -> u
label :: String -> UGen
label = Label_U . Label
unpackLabel :: UGen -> [UGen]
unpackLabel u =
case u of
Label_U (Label s) ->
let q = fromEnum '?'
f c = if C.isAscii c then fromEnum c else q
s' = map (fromIntegral . f) s
n = fromIntegral (length s)
in n : s'
MCE_U m ->
let x = map unpackLabel (mceProxies m)
in if B.equal_length_p x
then map mce (transpose x)
else error (show ("unpackLabel: mce length /=",x))
_ -> error (show ("unpackLabel: non-label",u))
envelope_to_ugen :: E.Envelope UGen -> UGen
envelope_to_ugen =
let err = error "envGen: bad Envelope"
in mce . fromMaybe err . E.envelope_sc3_array
envelope_to_ienvgen_ugen :: E.Envelope UGen -> UGen
envelope_to_ienvgen_ugen =
let err = error "envGen: bad Envelope"
in mce . fromMaybe err . E.envelope_sc3_ienvgen_array
bitAnd :: UGen -> UGen -> UGen
bitAnd = mkBinaryOperator O.BitAnd undefined
bitOr :: UGen -> UGen -> UGen
bitOr = mkBinaryOperator O.BitOr undefined
bitXOr :: UGen -> UGen -> UGen
bitXOr = mkBinaryOperator O.BitXor undefined
bitNot :: UGen -> UGen
bitNot = mkUnaryOperator O.BitNot undefined
shiftLeft :: UGen -> UGen -> UGen
shiftLeft = mkBinaryOperator O.ShiftLeft undefined
shiftRight :: UGen -> UGen -> UGen
shiftRight = mkBinaryOperator O.ShiftRight undefined
unsignedShift :: UGen -> UGen -> UGen
unsignedShift = mkBinaryOperator O.UnsignedShift undefined
(.<<.) :: UGen -> UGen -> UGen
(.<<.) = shiftLeft
(.>>.) :: UGen -> UGen -> UGen
(.>>.) = shiftRight