-- | Utility function over Ugen data structure.
module Sound.Sc3.Ugen.Util where

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

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

import qualified Sound.Sc3.Common.Base as Base {- hsc3 -}
import qualified Sound.Sc3.Common.Envelope as Envelope {- hsc3 -}
import qualified Sound.Sc3.Common.Mce as Mce {- hsc3 -}
import qualified Sound.Sc3.Common.Rate as Rate {- hsc3 -}
import qualified Sound.Sc3.Common.Uid as Uid {- hsc3 -}

import Sound.Sc3.Ugen.Brackets {- hsc3 -}
import Sound.Sc3.Ugen.Control {- hsc3 -}
import Sound.Sc3.Ugen.Label {- hsc3 -}
import Sound.Sc3.Ugen.Mrg {- hsc3 -}
import Sound.Sc3.Ugen.Primitive {- hsc3 -}
import Sound.Sc3.Ugen.Proxy {- hsc3 -}
import Sound.Sc3.Ugen.Ugen {- hsc3 -}

-- | 'Uid' of 'resolveID'.
toUid :: Uid.ID a => a -> UgenId
toUid :: forall a. ID a => a -> UgenId
toUid = Int -> UgenId
Uid (Int -> UgenId) -> (a -> Int) -> a -> UgenId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. ID a => a -> Int
Uid.resolveID

-- * 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 Ugen
p ->
            let i :: [Ugen]
i = Primitive Ugen -> [Ugen]
forall t. Primitive t -> [t]
ugenInputs Primitive Ugen
p
            in Ugen -> Ugen
map_f (Primitive Ugen -> Ugen
Primitive_U (Primitive Ugen
p {ugenInputs = map recur i}))
          Proxy_U (Proxy Primitive Ugen
p Int
ix) ->
            let i :: [Ugen]
i = Primitive Ugen -> [Ugen]
forall t. Primitive t -> [t]
ugenInputs Primitive Ugen
p
            in Ugen -> Ugen
map_f (Proxy Ugen -> Ugen
Proxy_U (Primitive Ugen -> Int -> Proxy Ugen
forall t. Primitive t -> Int -> Proxy t
Proxy (Primitive Ugen
p {ugenInputs = map recur i}) Int
ix))
          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 -> Ugen
Mrg_U (Ugen -> Ugen -> Mrg Ugen
forall t. t -> t -> Mrg t
Mrg (Ugen -> Ugen
recur Ugen
l) (Ugen -> Ugen
recur Ugen
r)))
          Ugen
_ -> Ugen -> Ugen
map_f Ugen
u

{- | Right fold of Ugen graph.

> import qualified Sound.Sc3.Ugen.Pp as Pp
> let pp = Pp.ugen_concise_pp
> map pp (ugenFoldr (:) [] (sinOsc ar 440 0 * 0.1))
["*","SinOsc","440","0","0.1"]

> map pp (ugenFoldr (:) [] (pan2 (sinOsc ar 440 0) 0.25 0.1))
["[Pan2@0,Pan2@1]","Pan2@0","SinOsc","440","0","0.25","0.1","Pan2@1","SinOsc","440","0","0.25","0.1"]
-}
ugenFoldr :: (Ugen -> a -> a) -> a -> Ugen -> a
ugenFoldr :: forall a. (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 Ugen
p -> Ugen -> a -> a
f Ugen
u ((Ugen -> a -> a) -> a -> [Ugen] -> a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Ugen -> a -> a
recur a
st (Primitive Ugen -> [Ugen]
forall t. Primitive t -> [t]
ugenInputs Primitive Ugen
p))
      Proxy_U (Proxy Primitive Ugen
p Int
_) -> Ugen -> a -> a
f Ugen
u ((Ugen -> a -> a) -> a -> [Ugen] -> a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Ugen -> a -> a
recur a
st (Primitive Ugen -> [Ugen]
forall t. Primitive t -> [t]
ugenInputs Primitive Ugen
p)) -- ...
      Mce_U Mce Ugen
m -> Ugen -> a -> a
f Ugen
u ((Ugen -> a -> a) -> a -> [Ugen] -> a
forall a b. (a -> b -> b) -> b -> [a] -> b
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

-- | Fold over Ugen and collect all bracketing messages from all Primitive nodes.
ugenCollectBrackets :: Ugen -> Brackets
ugenCollectBrackets :: Ugen -> ([Message], [Message])
ugenCollectBrackets =
  [([Message], [Message])] -> ([Message], [Message])
concatBrackets
    ([([Message], [Message])] -> ([Message], [Message]))
-> (Ugen -> [([Message], [Message])])
-> Ugen
-> ([Message], [Message])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ugen -> ([Message], [Message]))
-> [Ugen] -> [([Message], [Message])]
forall a b. (a -> b) -> [a] -> [b]
map Ugen -> ([Message], [Message])
ugenBrackets
    ([Ugen] -> [([Message], [Message])])
-> (Ugen -> [Ugen]) -> Ugen -> [([Message], [Message])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ugen] -> [Ugen]
forall a. Eq a => [a] -> [a]
nub
    ([Ugen] -> [Ugen]) -> (Ugen -> [Ugen]) -> Ugen -> [Ugen]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ugen -> [Ugen] -> [Ugen]) -> [Ugen] -> Ugen -> [Ugen]
forall a. (Ugen -> a -> a) -> a -> Ugen -> a
ugenFoldr (:) []

-- | Are there any brackets at Ugen.
ugenHasAnyBrackets :: Ugen -> Bool
ugenHasAnyBrackets :: Ugen -> Bool
ugenHasAnyBrackets = (([Message], [Message]) -> ([Message], [Message]) -> Bool
forall a. Eq a => a -> a -> Bool
/= ([], [])) (([Message], [Message]) -> Bool)
-> (Ugen -> ([Message], [Message])) -> Ugen -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ugen -> ([Message], [Message])
ugenCollectBrackets

-- * Unit generator node constructors

-- | Control input node constructor.
control_f64 :: Rate.Rate -> Maybe Int -> String -> Sample -> Ugen
control_f64 :: Rate -> Maybe Int -> String -> Sample -> Ugen
control_f64 Rate
r Maybe Int
ix String
nm Sample
d = Control -> Ugen
Control_U (Rate
-> Maybe Int
-> String
-> Sample
-> Bool
-> Maybe (Control_Meta Sample)
-> ([Message], [Message])
-> Control
Control Rate
r Maybe Int
ix String
nm Sample
d Bool
False Maybe (Control_Meta Sample)
forall a. Maybe a
Nothing ([Message], [Message])
emptyBrackets)

{- | 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 'trigControl'.
-}
control :: Rate.Rate -> String -> Double -> Ugen
control :: Rate -> String -> Sample -> Ugen
control Rate
r = Rate -> Maybe Int -> String -> Sample -> Ugen
control_f64 Rate
r Maybe Int
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 Int
-> String
-> Sample
-> Bool
-> Maybe (Control_Meta Sample)
-> ([Message], [Message])
-> Control
Control Rate
rt Maybe Int
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) ([Message], [Message])
emptyBrackets)

-- | 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 = Just grp}
  in case Control_Group -> [String]
control_group_suffixes Control_Group
grp of
      [String
lhs, String
rhs] ->
        ( Control -> Ugen
Control_U (Rate
-> Maybe Int
-> String
-> Sample
-> Bool
-> Maybe (Control_Meta Sample)
-> ([Message], [Message])
-> Control
Control Rate
rt Maybe Int
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) ([Message], [Message])
emptyBrackets)
        , Control -> Ugen
Control_U (Rate
-> Maybe Int
-> String
-> Sample
-> Bool
-> Maybe (Control_Meta Sample)
-> ([Message], [Message])
-> Control
Control Rate
rt Maybe Int
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) ([Message], [Message])
emptyBrackets)
        )
      [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.
trigControl_f64 :: Maybe Int -> String -> Sample -> Ugen
trigControl_f64 :: Maybe Int -> String -> Sample -> Ugen
trigControl_f64 Maybe Int
ix String
nm Sample
d = Control -> Ugen
Control_U (Rate
-> Maybe Int
-> String
-> Sample
-> Bool
-> Maybe (Control_Meta Sample)
-> ([Message], [Message])
-> Control
Control Rate
Rate.ControlRate Maybe Int
ix String
nm Sample
d Bool
True Maybe (Control_Meta Sample)
forall a. Maybe a
Nothing ([Message], [Message])
emptyBrackets)

-- | Triggered (kr) control input node constructor.
trigControl :: String -> Double -> Ugen
trigControl :: String -> Sample -> Ugen
trigControl = Maybe Int -> String -> Sample -> Ugen
trigControl_f64 Maybe Int
forall a. Maybe a
Nothing

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

-- * Multiple channel expansion

mce1 :: Ugen -> Ugen
mce1 :: Ugen -> Ugen
mce1 = [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]
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | 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 :: forall a b. ((Int, a) -> b) -> [a] -> [b]
map_ix (Int, a) -> b
f = (Int -> a -> b) -> [Int] -> [a] -> [b]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (((Int, a) -> b) -> Int -> a -> b
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (Int, a) -> b
f) [Int
0 ..]

-- | Variant of 'mceMap' with element index.
mce_map_ix :: ((Int, Ugen) -> Ugen) -> Ugen -> Ugen
mce_map_ix :: ((Int, Ugen) -> Ugen) -> Ugen -> Ugen
mce_map_ix (Int, Ugen) -> Ugen
f Ugen
u = [Ugen] -> Ugen
mce (((Int, Ugen) -> Ugen) -> [Ugen] -> [Ugen]
forall a b. ((Int, a) -> b) -> [a] -> [b]
map_ix (Int, 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 :: Int -> Ugen -> Ugen
mceChannel Int
n Ugen
u =
  case Ugen
u of
    Mce_U Mce Ugen
m -> Mce Ugen -> [Ugen]
mceProxies Mce Ugen
m [Ugen] -> Int -> Ugen
forall a. HasCallStack => [a] -> Int -> a
!! Int
n
    Ugen
_ -> if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Ugen
u else String -> Ugen
forall a. HasCallStack => String -> a
error String
"mceChannel: non Mce value, non ZERO index"

{- | Obtain indexed channel at Mce, indices wrap around.

> map (\ix -> pp (mceChannelWrap ix (mce [1,2,3,4,5]))) [0 .. 9]
["1","2","3","4","5","1","2","3","4","5"]
-}
mceChannelWrap :: Int -> Ugen -> Ugen
mceChannelWrap :: Int -> Ugen -> Ugen
mceChannelWrap Int
n Ugen
u =
  case Ugen
u of
    Mce_U Mce Ugen
m -> Mce Ugen -> [Ugen]
mceProxies Mce Ugen
m [Ugen] -> Int -> Ugen
forall a. HasCallStack => [a] -> Int -> a
!! (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Mce Ugen -> Int
forall a. Mce a -> Int
Mce.mce_length Mce Ugen
m)
    Ugen
_ -> Ugen
u

-- | 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]
True
-}
mceRotate :: Int -> Ugen -> Ugen
mceRotate :: Int -> Ugen -> Ugen
mceRotate Int
k =
  let rotateRight :: Int -> [a] -> [a]
rotateRight Int
n [a]
p = let ([a]
b, [a]
a) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
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
. Int -> [Ugen] -> [Ugen]
forall {a}. Int -> [a] -> [a]
rotateRight Int
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]
True
-}
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]) -> [Ugen] -> [Ugen]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Ugen -> [Ugen]
mceChannels

{- | Collect subarrays of mce.

>>> mceClump 2 (mce [1,2,3,4]) == mce2 (mce2 1 2) (mce2 3 4)
True
-}
mceClump :: Int -> Ugen -> Ugen
mceClump :: Int -> Ugen -> Ugen
mceClump Int
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
. Int -> [Ugen] -> [[Ugen]]
forall e. Int -> [e] -> [[e]]
Split.chunksOf Int
k ([Ugen] -> [[Ugen]]) -> (Ugen -> [Ugen]) -> Ugen -> [[Ugen]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ugen -> [Ugen]
mceChannels

-- | Foldl1 at channels of mce.
mceReduce :: (Ugen -> Ugen -> Ugen) -> Ugen -> Ugen
mceReduce :: (Ugen -> Ugen -> Ugen) -> Ugen -> Ugen
mceReduce Ugen -> Ugen -> Ugen
f = (Ugen -> Ugen -> Ugen) -> [Ugen] -> Ugen
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Ugen -> Ugen -> Ugen
f ([Ugen] -> Ugen) -> (Ugen -> [Ugen]) -> Ugen -> Ugen
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ugen -> [Ugen]
mceChannels

-- | mceReduce of *.
mceProduct :: Ugen -> Ugen
mceProduct :: Ugen -> Ugen
mceProduct = (Ugen -> Ugen -> Ugen) -> Ugen -> Ugen
mceReduce Ugen -> Ugen -> Ugen
forall a. Num a => a -> a -> a
(*)

-- * Transform

-- | Given /unmce/ function make halt mce transform.
halt_mce_transform_f :: (a -> [a]) -> [a] -> [a]
halt_mce_transform_f :: forall a. (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]
True
-}
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 Ugen
m -> Ugen -> Ugen -> Ugen
mrg2 (Ugen -> Ugen
prepare_root (Mrg Ugen -> Ugen
forall t. Mrg t -> t
mrgLeft Mrg Ugen
m)) (Ugen -> Ugen
prepare_root (Mrg Ugen -> Ugen
forall t. Mrg t -> t
mrgRight Mrg Ugen
m))
    Ugen
_ -> Ugen
u

-- * Multiple root graphs

-- | Multiple root graph node constructor (left input is output)
mrg2 :: Ugen -> Ugen -> Ugen
mrg2 :: Ugen -> Ugen -> Ugen
mrg2 Ugen
u = Mrg Ugen -> Ugen
Mrg_U (Mrg Ugen -> Ugen) -> (Ugen -> Mrg Ugen) -> Ugen -> Ugen
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ugen -> Ugen -> Mrg Ugen
forall t. t -> t -> Mrg t
Mrg Ugen
u

-- * 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 :: Int
q = Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
'?'
          f :: Char -> Int
f Char
c = if Char -> Bool
Data.Char.isAscii Char
c then Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c else Int
q
          s' :: [Ugen]
s' = (Char -> Ugen) -> String -> [Ugen]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Ugen
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Ugen) -> (Char -> Int) -> Char -> Ugen
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
f) String
s
      in if Bool
length_prefix then Int -> Ugen
forall a b. (Integral a, Num b) => a -> b
fromIntegral (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
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

-- * 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 Rate
rt String
nm [Ugen]
i [Rate]
o Special
s UgenId
z ([Message], [Message])
b) -> Primitive Ugen -> Ugen
Primitive_U (Rate
-> String
-> [Ugen]
-> [Rate]
-> Special
-> UgenId
-> ([Message], [Message])
-> Primitive Ugen
forall t.
Rate
-> String
-> [t]
-> [Rate]
-> Special
-> UgenId
-> ([Message], [Message])
-> Primitive t
Primitive (if Rate -> Bool
sel_f Rate
rt then Rate
set_rt else Rate
rt) String
nm [Ugen]
i [Rate]
o Special
s UgenId
z ([Message], [Message])
b)
        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.AudioRate) Rate
Rate.ControlRate

-- | 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.DemandRate

-- | 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 a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Rate
Rate.ControlRate, Rate
Rate.AudioRate]) Rate
Rate.InitialisationRate

-- | Select rewriting function given 'Rate.Rate'.
rewriteToRate :: Rate.Rate -> Ugen -> Ugen
rewriteToRate :: Rate -> Ugen -> Ugen
rewriteToRate Rate
rt =
  case Rate
rt of
    Rate
Rate.ControlRate -> Ugen -> Ugen
rewriteToControlRate
    Rate
Rate.DemandRate -> Ugen -> Ugen
rewriteToDemandRate
    Rate
Rate.InitialisationRate -> Ugen -> Ugen
rewriteToInitialisationRate
    Rate
Rate.AudioRate -> String -> Ugen -> Ugen
forall a. HasCallStack => String -> a
error String
"rewriteToRate: AudioRate?"