-- | UGen data structure representation and associated functions.
module Sound.SC3.UGen.UGen where

import qualified Data.Char {- base -}
import Data.Maybe {- base -}
import Data.List {- base -}

import qualified Data.List.Split as Split {- split -}

import qualified Sound.SC3.Common.Envelope as Envelope {- hsc3 -}
import qualified Sound.SC3.Common.Base as Base {- hsc3 -}
import qualified Sound.SC3.Common.Math.Operator as Operator {- hsc3 -}
import qualified Sound.SC3.Common.Rate as Rate {- hsc3 -}
import qualified Sound.SC3.Common.UId as UId {- hsc3 -}

import Sound.SC3.UGen.Type {- hsc3 -}

-- | 'UId' of 'resolveID'.
toUId :: UId.ID a => a -> UGenId
toUId :: a -> UGenId
toUId = UID_t -> UGenId
UId (UID_t -> UGenId) -> (a -> UID_t) -> a -> UGenId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> UID_t
forall a. ID a => a -> UID_t
UId.resolveID

-- | Lookup operator name for operator UGens, else UGen name.
ugen_user_name :: String -> Special -> String
ugen_user_name :: String -> Special -> String
ugen_user_name String
nm (Special UID_t
n) = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
nm (String -> UID_t -> Maybe String
Operator.ugen_operator_name String
nm UID_t
n)

-- * UGen graph functions

-- | Depth first traversal of graph at `u', stopping at `halt_f', else applying `map_f' to each node.
ugenTraverse :: (UGen -> Bool) -> (UGen -> UGen) -> UGen -> UGen
ugenTraverse :: (UGen -> Bool) -> (UGen -> UGen) -> UGen -> UGen
ugenTraverse UGen -> Bool
halt_f UGen -> UGen
map_f UGen
u =
  if UGen -> Bool
halt_f UGen
u
  then UGen
u
  else
    let recur :: UGen -> UGen
recur = (UGen -> Bool) -> (UGen -> UGen) -> UGen -> UGen
ugenTraverse UGen -> Bool
halt_f UGen -> UGen
map_f
    in case UGen
u of
         Primitive_U Primitive
p ->
             let i :: [UGen]
i = Primitive -> [UGen]
ugenInputs Primitive
p
             in UGen -> UGen
map_f (Primitive -> UGen
Primitive_U (Primitive
p {ugenInputs :: [UGen]
ugenInputs = (UGen -> UGen) -> [UGen] -> [UGen]
forall a b. (a -> b) -> [a] -> [b]
map UGen -> UGen
recur [UGen]
i}))
         Proxy_U Proxy
p ->
             let s :: UGen
s = Primitive -> UGen
Primitive_U (Proxy -> Primitive
proxySource Proxy
p)
             in case UGen -> UGen
recur UGen
s of
                  Primitive_U Primitive
p' -> UGen -> UGen
map_f (Proxy -> UGen
Proxy_U (Proxy
p {proxySource :: Primitive
proxySource = Primitive
p'}))
                  UGen
_ -> String -> UGen
forall a. HasCallStack => String -> a
error String
"ugenTraverse"
         MCE_U MCE UGen
m -> UGen -> UGen
map_f ([UGen] -> UGen
mce ((UGen -> UGen) -> [UGen] -> [UGen]
forall a b. (a -> b) -> [a] -> [b]
map UGen -> UGen
recur (MCE UGen -> [UGen]
mceProxies MCE UGen
m)))
         MRG_U (MRG UGen
l UGen
r) -> UGen -> UGen
map_f (MRG -> UGen
MRG_U (UGen -> UGen -> MRG
MRG (UGen -> UGen
recur UGen
l) (UGen -> UGen
recur UGen
r)))
         UGen
_ -> UGen -> UGen
map_f UGen
u

{- | Right fold of UGen graph.

> ugenFoldr (:) [] (pan2 (sinOsc AR 440 0) 0.25 0.1)
-}
ugenFoldr :: (UGen -> a -> a) -> a -> UGen -> a
ugenFoldr :: (UGen -> a -> a) -> a -> UGen -> a
ugenFoldr UGen -> a -> a
f a
st UGen
u =
    let recur :: UGen -> a -> a
recur = (a -> UGen -> a) -> UGen -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((UGen -> a -> a) -> a -> UGen -> a
forall a. (UGen -> a -> a) -> a -> UGen -> a
ugenFoldr UGen -> a -> a
f)
    in case UGen
u of
         Primitive_U Primitive
p -> UGen -> a -> a
f UGen
u ((UGen -> a -> a) -> a -> [UGen] -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr UGen -> a -> a
recur a
st (Primitive -> [UGen]
ugenInputs Primitive
p))
         Proxy_U Proxy
p -> UGen -> a -> a
f UGen
u ((UGen -> a -> a) -> a -> UGen -> a
forall a. (UGen -> a -> a) -> a -> UGen -> a
ugenFoldr UGen -> a -> a
f a
st (Primitive -> UGen
Primitive_U (Proxy -> Primitive
proxySource Proxy
p)))
         MCE_U MCE UGen
m -> UGen -> a -> a
f UGen
u ((UGen -> a -> a) -> a -> [UGen] -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr UGen -> a -> a
recur a
st (MCE UGen -> [UGen]
mceProxies MCE UGen
m))
         MRG_U (MRG UGen
l UGen
r) -> UGen -> a -> a
f UGen
u (UGen -> a -> a
f UGen
l (UGen -> a -> a
f UGen
r a
st))
         UGen
_ -> UGen -> a -> a
f UGen
u a
st

-- * Unit generator node constructors

-- | Control input node constructor.
control_f64 :: Rate.Rate -> Maybe Int -> String -> Sample -> UGen
control_f64 :: Rate -> Maybe UID_t -> String -> Sample -> UGen
control_f64 Rate
r Maybe UID_t
ix String
nm Sample
d = Control -> UGen
Control_U (Rate
-> Maybe UID_t
-> String
-> Sample
-> Bool
-> Maybe (Control_Meta Sample)
-> Control
Control Rate
r Maybe UID_t
ix String
nm Sample
d Bool
False Maybe (Control_Meta Sample)
forall a. Maybe a
Nothing)

-- | Control input node constructor.
--
-- Note that if the name begins with a t_ prefix the control is /not/
-- converted to a triggered control.  Please see 'tr_control'.
control :: Rate.Rate -> String -> Double -> UGen
control :: Rate -> String -> Sample -> UGen
control Rate
r = Rate -> Maybe UID_t -> String -> Sample -> UGen
control_f64 Rate
r Maybe UID_t
forall a. Maybe a
Nothing

-- | Variant of 'control' with meta data.
control_m :: Rate.Rate -> String -> Double -> Control_Meta_T3 Double -> UGen
control_m :: Rate -> String -> Sample -> Control_Meta_T3 Sample -> UGen
control_m Rate
rt String
nm Sample
df Control_Meta_T3 Sample
meta =
    let m :: Control_Meta Sample
m = (Sample -> Sample) -> Control_Meta_T3 Sample -> Control_Meta Sample
forall m n.
Num m =>
(n -> m) -> Control_Meta_T3 n -> Control_Meta m
control_meta_t3 Sample -> Sample
forall a. a -> a
id Control_Meta_T3 Sample
meta
    in Control -> UGen
Control_U (Rate
-> Maybe UID_t
-> String
-> Sample
-> Bool
-> Maybe (Control_Meta Sample)
-> Control
Control Rate
rt Maybe UID_t
forall a. Maybe a
Nothing String
nm Sample
df Bool
False (Control_Meta Sample -> Maybe (Control_Meta Sample)
forall a. a -> Maybe a
Just Control_Meta Sample
m))

-- | Generate group of two controls.  Names are generated according to 'control_group_suffixes'
control_pair :: Control_Group -> Rate.Rate -> String -> (Double,Double) -> Control_Meta_T3 Double -> (UGen,UGen)
control_pair :: Control_Group
-> Rate
-> String
-> (Sample, Sample)
-> Control_Meta_T3 Sample
-> (UGen, UGen)
control_pair Control_Group
grp Rate
rt String
nm (Sample
df1,Sample
df2) Control_Meta_T3 Sample
meta =
    let m :: Control_Meta Sample
m = ((Sample -> Sample) -> Control_Meta_T3 Sample -> Control_Meta Sample
forall m n.
Num m =>
(n -> m) -> Control_Meta_T3 n -> Control_Meta m
control_meta_t3 Sample -> Sample
forall a. a -> a
id Control_Meta_T3 Sample
meta) {controlGroup :: Maybe Control_Group
controlGroup = Control_Group -> Maybe Control_Group
forall a. a -> Maybe a
Just Control_Group
grp}
    in case Control_Group -> [String]
control_group_suffixes Control_Group
grp of
         [String
lhs,String
rhs] ->
           (Control -> UGen
Control_U (Rate
-> Maybe UID_t
-> String
-> Sample
-> Bool
-> Maybe (Control_Meta Sample)
-> Control
Control Rate
rt Maybe UID_t
forall a. Maybe a
Nothing (String
nm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
lhs) Sample
df1 Bool
False (Control_Meta Sample -> Maybe (Control_Meta Sample)
forall a. a -> Maybe a
Just Control_Meta Sample
m))
           ,Control -> UGen
Control_U (Rate
-> Maybe UID_t
-> String
-> Sample
-> Bool
-> Maybe (Control_Meta Sample)
-> Control
Control Rate
rt Maybe UID_t
forall a. Maybe a
Nothing (String
nm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
rhs) Sample
df2 Bool
False (Control_Meta Sample -> Maybe (Control_Meta Sample)
forall a. a -> Maybe a
Just Control_Meta Sample
m)))
         [String]
_ -> String -> (UGen, UGen)
forall a. HasCallStack => String -> a
error String
"control_pair"

-- | Generate range controls.  Names are generated according to 'control_group_suffixes'
control_rng :: Rate.Rate -> String -> (Double,Double) -> Control_Meta_T3 Double -> (UGen,UGen)
control_rng :: Rate
-> String
-> (Sample, Sample)
-> Control_Meta_T3 Sample
-> (UGen, UGen)
control_rng = Control_Group
-> Rate
-> String
-> (Sample, Sample)
-> Control_Meta_T3 Sample
-> (UGen, UGen)
control_pair Control_Group
Control_Range

-- | Triggered (kr) control input node constructor.
tr_control_f64 :: Maybe Int -> String -> Sample -> UGen
tr_control_f64 :: Maybe UID_t -> String -> Sample -> UGen
tr_control_f64 Maybe UID_t
ix String
nm Sample
d = Control -> UGen
Control_U (Rate
-> Maybe UID_t
-> String
-> Sample
-> Bool
-> Maybe (Control_Meta Sample)
-> Control
Control Rate
Rate.KR Maybe UID_t
ix String
nm Sample
d Bool
True Maybe (Control_Meta Sample)
forall a. Maybe a
Nothing)

-- | Triggered (kr) control input node constructor.
tr_control :: String -> Double -> UGen
tr_control :: String -> Sample -> UGen
tr_control = Maybe UID_t -> String -> Sample -> UGen
tr_control_f64 Maybe UID_t
forall a. Maybe a
Nothing

-- | Set indices at a list of controls.
control_set :: [UGen] -> [UGen]
control_set :: [UGen] -> [UGen]
control_set =
    let f :: UID_t -> UGen -> UGen
f UID_t
ix UGen
u = case UGen
u of
                   Control_U Control
c -> Control -> UGen
Control_U (Control
c {controlIndex :: Maybe UID_t
controlIndex = UID_t -> Maybe UID_t
forall a. a -> Maybe a
Just UID_t
ix})
                   UGen
_ -> String -> UGen
forall a. HasCallStack => String -> a
error String
"control_set: non control input?"
    in (UID_t -> UGen -> UGen) -> [UID_t] -> [UGen] -> [UGen]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith UID_t -> UGen -> UGen
f [UID_t
0..]

-- | Multiple root graph node constructor (left input is output)
mrg2 :: UGen -> UGen -> UGen
mrg2 :: UGen -> UGen -> UGen
mrg2 UGen
u = MRG -> UGen
MRG_U (MRG -> UGen) -> (UGen -> MRG) -> UGen -> UGen
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UGen -> UGen -> MRG
MRG UGen
u

-- * Multiple channel expansion

-- | Multiple channel expansion for two inputs.
mce2 :: UGen -> UGen -> UGen
mce2 :: UGen -> UGen -> UGen
mce2 UGen
x UGen
y = [UGen] -> UGen
mce [UGen
x,UGen
y]

-- | Extract two channels from possible MCE, if there is only one channel it is duplicated.
mce2c :: UGen -> (UGen,UGen)
mce2c :: UGen -> (UGen, UGen)
mce2c UGen
u =
    case UGen -> [UGen]
mceChannels UGen
u of
      [] -> String -> (UGen, UGen)
forall a. HasCallStack => String -> a
error String
"mce2c"
      [UGen
p] -> (UGen
p,UGen
p)
      UGen
p:UGen
q:[UGen]
_ -> (UGen
p,UGen
q)

-- | Variant of 'mce2c' that requires input to have two channels.
unmce2 :: UGen -> (UGen, UGen)
unmce2 :: UGen -> (UGen, UGen)
unmce2 = [UGen] -> (UGen, UGen)
forall t. [t] -> T2 t
Base.t2_from_list ([UGen] -> (UGen, UGen))
-> (UGen -> [UGen]) -> UGen -> (UGen, UGen)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UGen -> [UGen]
mceChannels

-- | Multiple channel expansion for two inputs.
mce3 :: UGen -> UGen -> UGen -> UGen
mce3 :: UGen -> UGen -> UGen -> UGen
mce3 UGen
x UGen
y UGen
z = [UGen] -> UGen
mce [UGen
x,UGen
y,UGen
z]

-- | Variant of 'mce2c' that requires input to have two channels.
unmce3 :: UGen -> (UGen, UGen, UGen)
unmce3 :: UGen -> (UGen, UGen, UGen)
unmce3 = [UGen] -> (UGen, UGen, UGen)
forall t. [t] -> (t, t, t)
Base.t3_from_list ([UGen] -> (UGen, UGen, UGen))
-> (UGen -> [UGen]) -> UGen -> (UGen, UGen, UGen)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UGen -> [UGen]
mceChannels

-- | Apply a function to each channel at a unit generator.
mceMap :: (UGen -> UGen) -> UGen -> UGen
mceMap :: (UGen -> UGen) -> UGen -> UGen
mceMap UGen -> UGen
f UGen
u = [UGen] -> UGen
mce ((UGen -> UGen) -> [UGen] -> [UGen]
forall a b. (a -> b) -> [a] -> [b]
map UGen -> UGen
f (UGen -> [UGen]
mceChannels UGen
u))

-- | Map with element index.
map_ix :: ((Int,a) -> b) -> [a] -> [b]
map_ix :: ((UID_t, a) -> b) -> [a] -> [b]
map_ix (UID_t, a) -> b
f = (UID_t -> a -> b) -> [UID_t] -> [a] -> [b]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (((UID_t, a) -> b) -> UID_t -> a -> b
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (UID_t, a) -> b
f) [UID_t
0..]

-- | Variant of 'mceMap' with element index.
mce_map_ix :: ((Int,UGen) -> UGen) -> UGen -> UGen
mce_map_ix :: ((UID_t, UGen) -> UGen) -> UGen -> UGen
mce_map_ix (UID_t, UGen) -> UGen
f UGen
u = [UGen] -> UGen
mce (((UID_t, UGen) -> UGen) -> [UGen] -> [UGen]
forall a b. ((UID_t, a) -> b) -> [a] -> [b]
map_ix (UID_t, UGen) -> UGen
f (UGen -> [UGen]
mceChannels UGen
u))

-- | Apply UGen list operation on MCE contents.
mceEdit :: ([UGen] -> [UGen]) -> UGen -> UGen
mceEdit :: ([UGen] -> [UGen]) -> UGen -> UGen
mceEdit [UGen] -> [UGen]
f UGen
u =
    case UGen
u of
      MCE_U MCE UGen
m -> [UGen] -> UGen
mce ([UGen] -> [UGen]
f (MCE UGen -> [UGen]
mceProxies MCE UGen
m))
      UGen
_ -> String -> UGen
forall a. HasCallStack => String -> a
error String
"mceEdit: non MCE value"

-- | Reverse order of channels at MCE.
mceReverse :: UGen -> UGen
mceReverse :: UGen -> UGen
mceReverse = ([UGen] -> [UGen]) -> UGen -> UGen
mceEdit [UGen] -> [UGen]
forall a. [a] -> [a]
reverse

-- | Obtain indexed channel at MCE.
mceChannel :: Int -> UGen -> UGen
mceChannel :: UID_t -> UGen -> UGen
mceChannel UID_t
n UGen
u =
    case UGen
u of
      MCE_U MCE UGen
m -> MCE UGen -> [UGen]
mceProxies MCE UGen
m [UGen] -> UID_t -> UGen
forall a. [a] -> UID_t -> a
!! UID_t
n
      UGen
_ -> if UID_t
n UID_t -> UID_t -> Bool
forall a. Eq a => a -> a -> Bool
== UID_t
0 then UGen
u else String -> UGen
forall a. HasCallStack => String -> a
error String
"mceChannel: non MCE value, non ZERO index"

-- | Transpose rows and columns, ie. {{a,b},{c,d}} to {{a,c},{b,d}}.
mceTranspose :: UGen -> UGen
mceTranspose :: UGen -> UGen
mceTranspose = [UGen] -> UGen
mce ([UGen] -> UGen) -> (UGen -> [UGen]) -> UGen -> UGen
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([UGen] -> UGen) -> [[UGen]] -> [UGen]
forall a b. (a -> b) -> [a] -> [b]
map [UGen] -> UGen
mce ([[UGen]] -> [UGen]) -> (UGen -> [[UGen]]) -> UGen -> [UGen]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[UGen]] -> [[UGen]]
forall a. [[a]] -> [[a]]
transpose ([[UGen]] -> [[UGen]]) -> (UGen -> [[UGen]]) -> UGen -> [[UGen]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UGen -> [UGen]) -> [UGen] -> [[UGen]]
forall a b. (a -> b) -> [a] -> [b]
map UGen -> [UGen]
mceChannels ([UGen] -> [[UGen]]) -> (UGen -> [UGen]) -> UGen -> [[UGen]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UGen -> [UGen]
mceChannels

-- | Rotate mce /k/ places to the right, ie. {a,b,c,d} to {d,a,b,c}
--
-- > mceRotate 1 (mce [1,2,3,4]) == mce [4,1,2,3]
mceRotate :: Int -> UGen -> UGen
mceRotate :: UID_t -> UGen -> UGen
mceRotate UID_t
k =
  let rotateRight :: UID_t -> [a] -> [a]
rotateRight UID_t
n [a]
p = let ([a]
b,[a]
a) = UID_t -> [a] -> ([a], [a])
forall a. UID_t -> [a] -> ([a], [a])
splitAt ([a] -> UID_t
forall (t :: * -> *) a. Foldable t => t a -> UID_t
length [a]
p UID_t -> UID_t -> UID_t
forall a. Num a => a -> a -> a
- UID_t
n) [a]
p in [a]
a [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
b
  in [UGen] -> UGen
mce ([UGen] -> UGen) -> (UGen -> [UGen]) -> UGen -> UGen
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UID_t -> [UGen] -> [UGen]
forall a. UID_t -> [a] -> [a]
rotateRight UID_t
k ([UGen] -> [UGen]) -> (UGen -> [UGen]) -> UGen -> [UGen]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UGen -> [UGen]
mceChannels

-- | 'concat' at mce channels of each input, ie. {{a,b},{c,d}} to {a,b,c,d}.
--
-- > mceConcat (map mce [[1,2],[3,4]]) == mce [1..4]
mceConcat :: [UGen] -> UGen
mceConcat :: [UGen] -> UGen
mceConcat = [UGen] -> UGen
mce ([UGen] -> UGen) -> ([UGen] -> [UGen]) -> [UGen] -> UGen
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[UGen]] -> [UGen]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[UGen]] -> [UGen]) -> ([UGen] -> [[UGen]]) -> [UGen] -> [UGen]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UGen -> [UGen]) -> [UGen] -> [[UGen]]
forall a b. (a -> b) -> [a] -> [b]
map UGen -> [UGen]
mceChannels

-- | Collect subarrays of mce.
--
-- > mceClump 2 (mce [1,2,3,4]) == mce2 (mce2 1 2) (mce2 3 4)
mceClump :: Int -> UGen -> UGen
mceClump :: UID_t -> UGen -> UGen
mceClump UID_t
k = [UGen] -> UGen
mce ([UGen] -> UGen) -> (UGen -> [UGen]) -> UGen -> UGen
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([UGen] -> UGen) -> [[UGen]] -> [UGen]
forall a b. (a -> b) -> [a] -> [b]
map [UGen] -> UGen
mce ([[UGen]] -> [UGen]) -> (UGen -> [[UGen]]) -> UGen -> [UGen]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UID_t -> [UGen] -> [[UGen]]
forall e. UID_t -> [e] -> [[e]]
Split.chunksOf UID_t
k ([UGen] -> [[UGen]]) -> (UGen -> [UGen]) -> UGen -> [[UGen]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UGen -> [UGen]
mceChannels

-- * Transform

-- | Given /unmce/ function make halt mce transform.
halt_mce_transform_f :: (a -> [a]) -> [a] -> [a]
halt_mce_transform_f :: (a -> [a]) -> [a] -> [a]
halt_mce_transform_f a -> [a]
f [a]
l =
    let ([a]
l',a
e) = ([a], a) -> Maybe ([a], a) -> ([a], a)
forall a. a -> Maybe a -> a
fromMaybe (String -> ([a], a)
forall a. HasCallStack => String -> a
error String
"halt_mce_transform: null?") ([a] -> Maybe ([a], a)
forall t. [t] -> Maybe ([t], t)
Base.sep_last [a]
l)
    in [a]
l' [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ a -> [a]
f a
e

-- | The halt MCE transform, ie. lift channels of last input into list.
--   This is not used by hsc3, but it is used by hsc3-forth and stsc3.
--
-- > halt_mce_transform [1,2,mce2 3 4] == [1,2,3,4]
halt_mce_transform :: [UGen] -> [UGen]
halt_mce_transform :: [UGen] -> [UGen]
halt_mce_transform = (UGen -> [UGen]) -> [UGen] -> [UGen]
forall a. (a -> [a]) -> [a] -> [a]
halt_mce_transform_f UGen -> [UGen]
mceChannels

-- | If the root node of a UGen graph is /mce/, transform to /mrg/.
prepare_root :: UGen -> UGen
prepare_root :: UGen -> UGen
prepare_root UGen
u =
    case UGen
u of
      MCE_U MCE UGen
m -> [UGen] -> UGen
mrg (MCE UGen -> [UGen]
mceProxies MCE UGen
m)
      MRG_U MRG
m -> UGen -> UGen -> UGen
mrg2 (UGen -> UGen
prepare_root (MRG -> UGen
mrgLeft MRG
m)) (UGen -> UGen
prepare_root (MRG -> UGen
mrgRight MRG
m))
      UGen
_ -> UGen
u

-- * Multiple root graphs

-- * Labels

-- | Lift a 'String' to a UGen label (ie. for 'poll').
label :: String -> UGen
label :: String -> UGen
label = Label -> UGen
Label_U (Label -> UGen) -> (String -> Label) -> String -> UGen
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Label
Label

{- | Unpack a label to a length prefixed list of 'Constant's.  There
is a special case for mce nodes, but it requires labels to be equal
length.  Properly, 'poll' would not unpack the label, it would be
done by the synthdef builder.

> unpackLabel False (label "/tmp")

-}
unpackLabel :: Bool -> UGen -> [UGen]
unpackLabel :: Bool -> UGen -> [UGen]
unpackLabel Bool
length_prefix UGen
u =
    case UGen
u of
      Label_U (Label String
s) ->
          let q :: UID_t
q = Char -> UID_t
forall a. Enum a => a -> UID_t
fromEnum Char
'?'
              f :: Char -> UID_t
f Char
c = if Char -> Bool
Data.Char.isAscii Char
c then Char -> UID_t
forall a. Enum a => a -> UID_t
fromEnum Char
c else UID_t
q
              s' :: [UGen]
s' = (Char -> UGen) -> String -> [UGen]
forall a b. (a -> b) -> [a] -> [b]
map (UID_t -> UGen
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UID_t -> UGen) -> (Char -> UID_t) -> Char -> UGen
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> UID_t
f) String
s
          in if Bool
length_prefix then UID_t -> UGen
forall a b. (Integral a, Num b) => a -> b
fromIntegral (String -> UID_t
forall (t :: * -> *) a. Foldable t => t a -> UID_t
length String
s) UGen -> [UGen] -> [UGen]
forall a. a -> [a] -> [a]
: [UGen]
s' else [UGen]
s'
      MCE_U MCE UGen
m ->
          let x :: [[UGen]]
x = (UGen -> [UGen]) -> [UGen] -> [[UGen]]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> UGen -> [UGen]
unpackLabel Bool
length_prefix) (MCE UGen -> [UGen]
mceProxies MCE UGen
m)
          in if [[UGen]] -> Bool
forall a. [[a]] -> Bool
Base.equal_length_p [[UGen]]
x
             then ([UGen] -> UGen) -> [[UGen]] -> [UGen]
forall a b. (a -> b) -> [a] -> [b]
map [UGen] -> UGen
mce ([[UGen]] -> [[UGen]]
forall a. [[a]] -> [[a]]
transpose [[UGen]]
x)
             else String -> [UGen]
forall a. HasCallStack => String -> a
error ((String, [[UGen]]) -> String
forall a. Show a => a -> String
show (String
"unpackLabel: mce length /=",[[UGen]]
x))
      UGen
_ -> String -> [UGen]
forall a. HasCallStack => String -> a
error ((String, UGen) -> String
forall a. Show a => a -> String
show (String
"unpackLabel: non-label",UGen
u))

-- * Envelope

-- | 'mce' of 'Envelope.envelope_sc3_array'.
envelope_to_ugen :: Envelope.Envelope UGen -> UGen
envelope_to_ugen :: Envelope UGen -> UGen
envelope_to_ugen =
    let err :: a
err = String -> a
forall a. HasCallStack => String -> a
error String
"envGen: bad Envelope"
    in [UGen] -> UGen
mce ([UGen] -> UGen)
-> (Envelope UGen -> [UGen]) -> Envelope UGen -> UGen
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [UGen] -> Maybe [UGen] -> [UGen]
forall a. a -> Maybe a -> a
fromMaybe [UGen]
forall a. a
err (Maybe [UGen] -> [UGen])
-> (Envelope UGen -> Maybe [UGen]) -> Envelope UGen -> [UGen]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Envelope UGen -> Maybe [UGen]
forall a. Num a => Envelope a -> Maybe [a]
Envelope.envelope_sc3_array

-- | 'mce' of 'Envelope.envelope_sc3_ienvgen_array'.
envelope_to_ienvgen_ugen :: Envelope.Envelope UGen -> UGen
envelope_to_ienvgen_ugen :: Envelope UGen -> UGen
envelope_to_ienvgen_ugen =
    let err :: a
err = String -> a
forall a. HasCallStack => String -> a
error String
"envGen: bad Envelope"
    in [UGen] -> UGen
mce ([UGen] -> UGen)
-> (Envelope UGen -> [UGen]) -> Envelope UGen -> UGen
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [UGen] -> Maybe [UGen] -> [UGen]
forall a. a -> Maybe a -> a
fromMaybe [UGen]
forall a. a
err (Maybe [UGen] -> [UGen])
-> (Envelope UGen -> Maybe [UGen]) -> Envelope UGen -> [UGen]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Envelope UGen -> Maybe [UGen]
forall a. Num a => Envelope a -> Maybe [a]
Envelope.envelope_sc3_ienvgen_array

-- * Bitwise

-- | 'Operator.BitAnd'
bitAnd :: UGen -> UGen -> UGen
bitAnd :: UGen -> UGen -> UGen
bitAnd = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
Operator.BitAnd Sample -> Sample -> Sample
forall a. HasCallStack => a
undefined

-- | 'Operator.BitOr'
bitOr :: UGen -> UGen -> UGen
bitOr :: UGen -> UGen -> UGen
bitOr = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
Operator.BitOr Sample -> Sample -> Sample
forall a. HasCallStack => a
undefined

-- | 'Operator.BitXor'
bitXOr :: UGen -> UGen -> UGen
bitXOr :: UGen -> UGen -> UGen
bitXOr = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
Operator.BitXor Sample -> Sample -> Sample
forall a. HasCallStack => a
undefined

-- | 'Operator.BitNot'
bitNot :: UGen -> UGen
bitNot :: UGen -> UGen
bitNot = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
Operator.BitNot Sample -> Sample
forall a. HasCallStack => a
undefined

-- | 'Operator.ShiftLeft'
shiftLeft :: UGen -> UGen -> UGen
shiftLeft :: UGen -> UGen -> UGen
shiftLeft = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
Operator.ShiftLeft Sample -> Sample -> Sample
forall a. HasCallStack => a
undefined

-- | 'Operator.ShiftRight'
shiftRight :: UGen -> UGen -> UGen
shiftRight :: UGen -> UGen -> UGen
shiftRight = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
Operator.ShiftRight Sample -> Sample -> Sample
forall a. HasCallStack => a
undefined

-- | 'Operator.UnsignedShift'
unsignedShift :: UGen -> UGen -> UGen
unsignedShift :: UGen -> UGen -> UGen
unsignedShift = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
Operator.UnsignedShift Sample -> Sample -> Sample
forall a. HasCallStack => a
undefined

-- | 'shiftLeft' operator.
(.<<.) :: UGen -> UGen -> UGen
.<<. :: UGen -> UGen -> UGen
(.<<.) = UGen -> UGen -> UGen
shiftLeft

-- | 'shiftRight' operator.
(.>>.) :: UGen -> UGen -> UGen
.>>. :: UGen -> UGen -> UGen
(.>>.) = UGen -> UGen -> UGen
shiftRight

-- * Rate Flow

-- | Traverse graph rewriting audio rate nodes as control rate.
rewriteUGenRates :: (Rate.Rate -> Bool) -> Rate.Rate -> UGen -> UGen
rewriteUGenRates :: (Rate -> Bool) -> Rate -> UGen -> UGen
rewriteUGenRates Rate -> Bool
sel_f Rate
set_rt =
  let f :: UGen -> UGen
f UGen
u = case UGen
u of
              Primitive_U Primitive
p -> let Primitive Rate
rt String
nm [UGen]
i [Rate]
o Special
s UGenId
z = Primitive
p
                               in Primitive -> UGen
Primitive_U (if Rate -> Bool
sel_f Rate
rt then Rate
-> String -> [UGen] -> [Rate] -> Special -> UGenId -> Primitive
Primitive Rate
set_rt String
nm [UGen]
i [Rate]
o Special
s UGenId
z else Primitive
p)
              UGen
_ -> UGen
u
  in (UGen -> Bool) -> (UGen -> UGen) -> UGen -> UGen
ugenTraverse (Bool -> UGen -> Bool
forall a b. a -> b -> a
const Bool
False) UGen -> UGen
f -- requires endRewrite node (see rsc3-arf)

-- | Traverse graph rewriting audio rate nodes as control rate.
rewriteToControlRate :: UGen -> UGen
rewriteToControlRate :: UGen -> UGen
rewriteToControlRate = (Rate -> Bool) -> Rate -> UGen -> UGen
rewriteUGenRates (Rate -> Rate -> Bool
forall a. Eq a => a -> a -> Bool
== Rate
Rate.AR) Rate
Rate.KR

-- | Traverse graph rewriting all nodes as demand rate.
rewriteToDemandRate :: UGen -> UGen
rewriteToDemandRate :: UGen -> UGen
rewriteToDemandRate = (Rate -> Bool) -> Rate -> UGen -> UGen
rewriteUGenRates (Bool -> Rate -> Bool
forall a b. a -> b -> a
const Bool
True) Rate
Rate.DR

-- | Traverse graph rewriting audio and control nodes as initialisation rate.
rewriteToInitialisationRate :: UGen -> UGen
rewriteToInitialisationRate :: UGen -> UGen
rewriteToInitialisationRate = (Rate -> Bool) -> Rate -> UGen -> UGen
rewriteUGenRates (Rate -> [Rate] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Rate
Rate.KR,Rate
Rate.AR]) Rate
Rate.IR

-- | Select rewriting function given 'Rate.Rate'.
rewriteToRate :: Rate.Rate -> UGen -> UGen
rewriteToRate :: Rate -> UGen -> UGen
rewriteToRate Rate
rt =
  case Rate
rt of
    Rate
Rate.KR -> UGen -> UGen
rewriteToControlRate
    Rate
Rate.DR -> UGen -> UGen
rewriteToDemandRate
    Rate
Rate.IR -> UGen -> UGen
rewriteToInitialisationRate
    Rate
Rate.AR -> String -> UGen -> UGen
forall a. HasCallStack => String -> a
error String
"rewriteToRate: AR?"