-- | Unit Generator ('UGen') and associated types and instances.
module Sound.SC3.UGen.Type where

import Data.Bits {- base -}
import Data.Either {- base -}
import qualified Data.Fixed as F {- base -}
import Data.List {- base -}
import Data.Maybe {- base -}
import Text.Printf {- base -}

import qualified Safe {- safe -}
import qualified System.Random as Random {- random -}

import qualified Sound.SC3.Common.Math as Math
import Sound.SC3.Common.Math.Operator
import Sound.SC3.Common.Rate
import Sound.SC3.UGen.MCE

-- * Basic types

-- | Type of unique identifier.
type UID_t = Int

-- | Data type for the identifier at a 'Primitive' 'UGen'.
data UGenId = NoId | UId UID_t
              deriving (UGenId -> UGenId -> Bool
(UGenId -> UGenId -> Bool)
-> (UGenId -> UGenId -> Bool) -> Eq UGenId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UGenId -> UGenId -> Bool
$c/= :: UGenId -> UGenId -> Bool
== :: UGenId -> UGenId -> Bool
$c== :: UGenId -> UGenId -> Bool
Eq,ReadPrec [UGenId]
ReadPrec UGenId
Int -> ReadS UGenId
ReadS [UGenId]
(Int -> ReadS UGenId)
-> ReadS [UGenId]
-> ReadPrec UGenId
-> ReadPrec [UGenId]
-> Read UGenId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UGenId]
$creadListPrec :: ReadPrec [UGenId]
readPrec :: ReadPrec UGenId
$creadPrec :: ReadPrec UGenId
readList :: ReadS [UGenId]
$creadList :: ReadS [UGenId]
readsPrec :: Int -> ReadS UGenId
$creadsPrec :: Int -> ReadS UGenId
Read,Int -> UGenId -> ShowS
[UGenId] -> ShowS
UGenId -> String
(Int -> UGenId -> ShowS)
-> (UGenId -> String) -> ([UGenId] -> ShowS) -> Show UGenId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UGenId] -> ShowS
$cshowList :: [UGenId] -> ShowS
show :: UGenId -> String
$cshow :: UGenId -> String
showsPrec :: Int -> UGenId -> ShowS
$cshowsPrec :: Int -> UGenId -> ShowS
Show)

-- | Alias of 'NoId', the 'UGenId' used for deterministic UGens.
no_id :: UGenId
no_id :: UGenId
no_id = UGenId
NoId

-- | SC3 samples are 32-bit 'Float'.  hsc3 represents data as 64-bit
-- 'Double'.  If 'UGen' values are used more generally (ie. see
-- hsc3-forth) 'Float' may be too imprecise, ie. for representing time
-- stamps.
type Sample = Double

-- | Constants.
--
-- > Constant 3 == Constant 3
-- > (Constant 3 > Constant 1) == True
newtype Constant = Constant {Constant -> Sample
constantValue :: Sample} deriving (Constant -> Constant -> Bool
(Constant -> Constant -> Bool)
-> (Constant -> Constant -> Bool) -> Eq Constant
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Constant -> Constant -> Bool
$c/= :: Constant -> Constant -> Bool
== :: Constant -> Constant -> Bool
$c== :: Constant -> Constant -> Bool
Eq,Eq Constant
Eq Constant
-> (Constant -> Constant -> Ordering)
-> (Constant -> Constant -> Bool)
-> (Constant -> Constant -> Bool)
-> (Constant -> Constant -> Bool)
-> (Constant -> Constant -> Bool)
-> (Constant -> Constant -> Constant)
-> (Constant -> Constant -> Constant)
-> Ord Constant
Constant -> Constant -> Bool
Constant -> Constant -> Ordering
Constant -> Constant -> Constant
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Constant -> Constant -> Constant
$cmin :: Constant -> Constant -> Constant
max :: Constant -> Constant -> Constant
$cmax :: Constant -> Constant -> Constant
>= :: Constant -> Constant -> Bool
$c>= :: Constant -> Constant -> Bool
> :: Constant -> Constant -> Bool
$c> :: Constant -> Constant -> Bool
<= :: Constant -> Constant -> Bool
$c<= :: Constant -> Constant -> Bool
< :: Constant -> Constant -> Bool
$c< :: Constant -> Constant -> Bool
compare :: Constant -> Constant -> Ordering
$ccompare :: Constant -> Constant -> Ordering
$cp1Ord :: Eq Constant
Ord,ReadPrec [Constant]
ReadPrec Constant
Int -> ReadS Constant
ReadS [Constant]
(Int -> ReadS Constant)
-> ReadS [Constant]
-> ReadPrec Constant
-> ReadPrec [Constant]
-> Read Constant
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Constant]
$creadListPrec :: ReadPrec [Constant]
readPrec :: ReadPrec Constant
$creadPrec :: ReadPrec Constant
readList :: ReadS [Constant]
$creadList :: ReadS [Constant]
readsPrec :: Int -> ReadS Constant
$creadsPrec :: Int -> ReadS Constant
Read,Int -> Constant -> ShowS
[Constant] -> ShowS
Constant -> String
(Int -> Constant -> ShowS)
-> (Constant -> String) -> ([Constant] -> ShowS) -> Show Constant
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Constant] -> ShowS
$cshowList :: [Constant] -> ShowS
show :: Constant -> String
$cshow :: Constant -> String
showsPrec :: Int -> Constant -> ShowS
$cshowsPrec :: Int -> Constant -> ShowS
Show)

-- | Control meta-data.
data Control_Meta n =
    Control_Meta {Control_Meta n -> n
ctl_min :: n -- ^ Minimum
                 ,Control_Meta n -> n
ctl_max :: n -- ^ Maximum
                 ,Control_Meta n -> String
ctl_warp :: String -- ^ @(0,1)@ @(min,max)@ transfer function.
                 ,Control_Meta n -> n
ctl_step :: n -- ^ The step to increment & decrement by.
                 ,Control_Meta n -> String
ctl_units :: String -- ^ Unit of measure (ie hz, ms etc.).
                 ,Control_Meta n -> Maybe Control_Group
controlGroup :: Maybe Control_Group -- ^ Control group.
                 }
    deriving (Control_Meta n -> Control_Meta n -> Bool
(Control_Meta n -> Control_Meta n -> Bool)
-> (Control_Meta n -> Control_Meta n -> Bool)
-> Eq (Control_Meta n)
forall n. Eq n => Control_Meta n -> Control_Meta n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Control_Meta n -> Control_Meta n -> Bool
$c/= :: forall n. Eq n => Control_Meta n -> Control_Meta n -> Bool
== :: Control_Meta n -> Control_Meta n -> Bool
$c== :: forall n. Eq n => Control_Meta n -> Control_Meta n -> Bool
Eq,ReadPrec [Control_Meta n]
ReadPrec (Control_Meta n)
Int -> ReadS (Control_Meta n)
ReadS [Control_Meta n]
(Int -> ReadS (Control_Meta n))
-> ReadS [Control_Meta n]
-> ReadPrec (Control_Meta n)
-> ReadPrec [Control_Meta n]
-> Read (Control_Meta n)
forall n. Read n => ReadPrec [Control_Meta n]
forall n. Read n => ReadPrec (Control_Meta n)
forall n. Read n => Int -> ReadS (Control_Meta n)
forall n. Read n => ReadS [Control_Meta n]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Control_Meta n]
$creadListPrec :: forall n. Read n => ReadPrec [Control_Meta n]
readPrec :: ReadPrec (Control_Meta n)
$creadPrec :: forall n. Read n => ReadPrec (Control_Meta n)
readList :: ReadS [Control_Meta n]
$creadList :: forall n. Read n => ReadS [Control_Meta n]
readsPrec :: Int -> ReadS (Control_Meta n)
$creadsPrec :: forall n. Read n => Int -> ReadS (Control_Meta n)
Read,Int -> Control_Meta n -> ShowS
[Control_Meta n] -> ShowS
Control_Meta n -> String
(Int -> Control_Meta n -> ShowS)
-> (Control_Meta n -> String)
-> ([Control_Meta n] -> ShowS)
-> Show (Control_Meta n)
forall n. Show n => Int -> Control_Meta n -> ShowS
forall n. Show n => [Control_Meta n] -> ShowS
forall n. Show n => Control_Meta n -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Control_Meta n] -> ShowS
$cshowList :: forall n. Show n => [Control_Meta n] -> ShowS
show :: Control_Meta n -> String
$cshow :: forall n. Show n => Control_Meta n -> String
showsPrec :: Int -> Control_Meta n -> ShowS
$cshowsPrec :: forall n. Show n => Int -> Control_Meta n -> ShowS
Show)

-- | 3-tuple form of 'Control_Meta' data.
type Control_Meta_T3 n = (n,n,String)

-- | Lift 'Control_Meta_T3' to 'Control_Meta' allowing type coercion.
control_meta_t3 :: Num m => (n -> m) -> Control_Meta_T3 n -> Control_Meta m
control_meta_t3 :: (n -> m) -> Control_Meta_T3 n -> Control_Meta m
control_meta_t3 n -> m
f (n
l,n
r,String
w) = m
-> m
-> String
-> m
-> String
-> Maybe Control_Group
-> Control_Meta m
forall n.
n
-> n
-> String
-> n
-> String
-> Maybe Control_Group
-> Control_Meta n
Control_Meta (n -> m
f n
l) (n -> m
f n
r) String
w m
0 String
"" Maybe Control_Group
forall a. Maybe a
Nothing

-- | 5-tuple form of 'Control_Meta' data.
type Control_Meta_T5 n = (n,n,String,n,String)

-- | Lift 'Control_Meta_T5' to 'Control_Meta' allowing type coercion.
control_meta_t5 :: (n -> m) -> Control_Meta_T5 n -> Control_Meta m
control_meta_t5 :: (n -> m) -> Control_Meta_T5 n -> Control_Meta m
control_meta_t5 n -> m
f (n
l,n
r,String
w,n
stp,String
u) = m
-> m
-> String
-> m
-> String
-> Maybe Control_Group
-> Control_Meta m
forall n.
n
-> n
-> String
-> n
-> String
-> Maybe Control_Group
-> Control_Meta n
Control_Meta (n -> m
f n
l) (n -> m
f n
r) String
w (n -> m
f n
stp) String
u Maybe Control_Group
forall a. Maybe a
Nothing

{- | Controls may form part of a control group. -}
data Control_Group
  = Control_Range
  | Control_Array Int
  | Control_XY
  deriving (Control_Group -> Control_Group -> Bool
(Control_Group -> Control_Group -> Bool)
-> (Control_Group -> Control_Group -> Bool) -> Eq Control_Group
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Control_Group -> Control_Group -> Bool
$c/= :: Control_Group -> Control_Group -> Bool
== :: Control_Group -> Control_Group -> Bool
$c== :: Control_Group -> Control_Group -> Bool
Eq,ReadPrec [Control_Group]
ReadPrec Control_Group
Int -> ReadS Control_Group
ReadS [Control_Group]
(Int -> ReadS Control_Group)
-> ReadS [Control_Group]
-> ReadPrec Control_Group
-> ReadPrec [Control_Group]
-> Read Control_Group
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Control_Group]
$creadListPrec :: ReadPrec [Control_Group]
readPrec :: ReadPrec Control_Group
$creadPrec :: ReadPrec Control_Group
readList :: ReadS [Control_Group]
$creadList :: ReadS [Control_Group]
readsPrec :: Int -> ReadS Control_Group
$creadsPrec :: Int -> ReadS Control_Group
Read,Int -> Control_Group -> ShowS
[Control_Group] -> ShowS
Control_Group -> String
(Int -> Control_Group -> ShowS)
-> (Control_Group -> String)
-> ([Control_Group] -> ShowS)
-> Show Control_Group
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Control_Group] -> ShowS
$cshowList :: [Control_Group] -> ShowS
show :: Control_Group -> String
$cshow :: Control_Group -> String
showsPrec :: Int -> Control_Group -> ShowS
$cshowsPrec :: Int -> Control_Group -> ShowS
Show)

-- | The number of elements in a control group.
control_group_degree :: Control_Group -> Int
control_group_degree :: Control_Group -> Int
control_group_degree Control_Group
grp =
  case Control_Group
grp of
    Control_Group
Control_Range -> Int
2
    Control_Array Int
n -> Int
n
    Control_Group
Control_XY -> Int
2

{- | Grouped controls have names that have equal prefixes and identifying suffixes.
     Range controls have two elements, minima and maxima, suffixes are [ and ].
     Array controls have N elements and have IX suffixes.
     XY controls have two elements, X and Y coordinates, suffixes are X and Y.
-}
control_group_suffixes :: Control_Group -> [String]
control_group_suffixes :: Control_Group -> [String]
control_group_suffixes Control_Group
grp =
  case Control_Group
grp of
    Control_Group
Control_Range -> [String
"[",String
"]"]
    Control_Array Int
n -> (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%02d") [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
    Control_Group
Control_XY -> [String
"X",String
"Y"]

-- | Control inputs.  It is an invariant that controls with equal
-- names within a UGen graph must be equal in all other respects.
data Control = Control {Control -> Rate
controlOperatingRate :: Rate
                       ,Control -> Maybe Int
controlIndex :: Maybe Int
                       ,Control -> String
controlName :: String
                       ,Control -> Sample
controlDefault :: Sample
                       ,Control -> Bool
controlTriggered :: Bool
                       ,Control -> Maybe (Control_Meta Sample)
controlMeta :: Maybe (Control_Meta Sample)}
               deriving (Control -> Control -> Bool
(Control -> Control -> Bool)
-> (Control -> Control -> Bool) -> Eq Control
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Control -> Control -> Bool
$c/= :: Control -> Control -> Bool
== :: Control -> Control -> Bool
$c== :: Control -> Control -> Bool
Eq,ReadPrec [Control]
ReadPrec Control
Int -> ReadS Control
ReadS [Control]
(Int -> ReadS Control)
-> ReadS [Control]
-> ReadPrec Control
-> ReadPrec [Control]
-> Read Control
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Control]
$creadListPrec :: ReadPrec [Control]
readPrec :: ReadPrec Control
$creadPrec :: ReadPrec Control
readList :: ReadS [Control]
$creadList :: ReadS [Control]
readsPrec :: Int -> ReadS Control
$creadsPrec :: Int -> ReadS Control
Read,Int -> Control -> ShowS
[Control] -> ShowS
Control -> String
(Int -> Control -> ShowS)
-> (Control -> String) -> ([Control] -> ShowS) -> Show Control
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Control] -> ShowS
$cshowList :: [Control] -> ShowS
show :: Control -> String
$cshow :: Control -> String
showsPrec :: Int -> Control -> ShowS
$cshowsPrec :: Int -> Control -> ShowS
Show)

-- | Labels.
newtype Label = Label {Label -> String
ugenLabel :: String} deriving (Label -> Label -> Bool
(Label -> Label -> Bool) -> (Label -> Label -> Bool) -> Eq Label
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Label -> Label -> Bool
$c/= :: Label -> Label -> Bool
== :: Label -> Label -> Bool
$c== :: Label -> Label -> Bool
Eq,ReadPrec [Label]
ReadPrec Label
Int -> ReadS Label
ReadS [Label]
(Int -> ReadS Label)
-> ReadS [Label]
-> ReadPrec Label
-> ReadPrec [Label]
-> Read Label
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Label]
$creadListPrec :: ReadPrec [Label]
readPrec :: ReadPrec Label
$creadPrec :: ReadPrec Label
readList :: ReadS [Label]
$creadList :: ReadS [Label]
readsPrec :: Int -> ReadS Label
$creadsPrec :: Int -> ReadS Label
Read,Int -> Label -> ShowS
[Label] -> ShowS
Label -> String
(Int -> Label -> ShowS)
-> (Label -> String) -> ([Label] -> ShowS) -> Show Label
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Label] -> ShowS
$cshowList :: [Label] -> ShowS
show :: Label -> String
$cshow :: Label -> String
showsPrec :: Int -> Label -> ShowS
$cshowsPrec :: Int -> Label -> ShowS
Show)

-- | Unit generator output descriptor.
type Output = Rate

-- | Operating mode of unary and binary operators.
newtype Special = Special Int
    deriving (Special -> Special -> Bool
(Special -> Special -> Bool)
-> (Special -> Special -> Bool) -> Eq Special
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Special -> Special -> Bool
$c/= :: Special -> Special -> Bool
== :: Special -> Special -> Bool
$c== :: Special -> Special -> Bool
Eq,ReadPrec [Special]
ReadPrec Special
Int -> ReadS Special
ReadS [Special]
(Int -> ReadS Special)
-> ReadS [Special]
-> ReadPrec Special
-> ReadPrec [Special]
-> Read Special
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Special]
$creadListPrec :: ReadPrec [Special]
readPrec :: ReadPrec Special
$creadPrec :: ReadPrec Special
readList :: ReadS [Special]
$creadList :: ReadS [Special]
readsPrec :: Int -> ReadS Special
$creadsPrec :: Int -> ReadS Special
Read,Int -> Special -> ShowS
[Special] -> ShowS
Special -> String
(Int -> Special -> ShowS)
-> (Special -> String) -> ([Special] -> ShowS) -> Show Special
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Special] -> ShowS
$cshowList :: [Special] -> ShowS
show :: Special -> String
$cshow :: Special -> String
showsPrec :: Int -> Special -> ShowS
$cshowsPrec :: Int -> Special -> ShowS
Show)

-- | UGen primitives.
data Primitive = Primitive {Primitive -> Rate
ugenRate :: Rate
                           ,Primitive -> String
ugenName :: String
                           ,Primitive -> [UGen]
ugenInputs :: [UGen]
                           ,Primitive -> [Rate]
ugenOutputs :: [Output]
                           ,Primitive -> Special
ugenSpecial :: Special
                           ,Primitive -> UGenId
ugenId :: UGenId}
                 deriving (Primitive -> Primitive -> Bool
(Primitive -> Primitive -> Bool)
-> (Primitive -> Primitive -> Bool) -> Eq Primitive
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Primitive -> Primitive -> Bool
$c/= :: Primitive -> Primitive -> Bool
== :: Primitive -> Primitive -> Bool
$c== :: Primitive -> Primitive -> Bool
Eq,ReadPrec [Primitive]
ReadPrec Primitive
Int -> ReadS Primitive
ReadS [Primitive]
(Int -> ReadS Primitive)
-> ReadS [Primitive]
-> ReadPrec Primitive
-> ReadPrec [Primitive]
-> Read Primitive
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Primitive]
$creadListPrec :: ReadPrec [Primitive]
readPrec :: ReadPrec Primitive
$creadPrec :: ReadPrec Primitive
readList :: ReadS [Primitive]
$creadList :: ReadS [Primitive]
readsPrec :: Int -> ReadS Primitive
$creadsPrec :: Int -> ReadS Primitive
Read,Int -> Primitive -> ShowS
[Primitive] -> ShowS
Primitive -> String
(Int -> Primitive -> ShowS)
-> (Primitive -> String)
-> ([Primitive] -> ShowS)
-> Show Primitive
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Primitive] -> ShowS
$cshowList :: [Primitive] -> ShowS
show :: Primitive -> String
$cshow :: Primitive -> String
showsPrec :: Int -> Primitive -> ShowS
$cshowsPrec :: Int -> Primitive -> ShowS
Show)

-- | Proxy indicating an output port at a multi-channel primitive.
data Proxy = Proxy {Proxy -> Primitive
proxySource :: Primitive
                   ,Proxy -> Int
proxyIndex :: Int}
            deriving (Proxy -> Proxy -> Bool
(Proxy -> Proxy -> Bool) -> (Proxy -> Proxy -> Bool) -> Eq Proxy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Proxy -> Proxy -> Bool
$c/= :: Proxy -> Proxy -> Bool
== :: Proxy -> Proxy -> Bool
$c== :: Proxy -> Proxy -> Bool
Eq,ReadPrec [Proxy]
ReadPrec Proxy
Int -> ReadS Proxy
ReadS [Proxy]
(Int -> ReadS Proxy)
-> ReadS [Proxy]
-> ReadPrec Proxy
-> ReadPrec [Proxy]
-> Read Proxy
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Proxy]
$creadListPrec :: ReadPrec [Proxy]
readPrec :: ReadPrec Proxy
$creadPrec :: ReadPrec Proxy
readList :: ReadS [Proxy]
$creadList :: ReadS [Proxy]
readsPrec :: Int -> ReadS Proxy
$creadsPrec :: Int -> ReadS Proxy
Read,Int -> Proxy -> ShowS
[Proxy] -> ShowS
Proxy -> String
(Int -> Proxy -> ShowS)
-> (Proxy -> String) -> ([Proxy] -> ShowS) -> Show Proxy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Proxy] -> ShowS
$cshowList :: [Proxy] -> ShowS
show :: Proxy -> String
$cshow :: Proxy -> String
showsPrec :: Int -> Proxy -> ShowS
$cshowsPrec :: Int -> Proxy -> ShowS
Show)

-- | Multiple root graph.
data MRG = MRG {MRG -> UGen
mrgLeft :: UGen
               ,MRG -> UGen
mrgRight :: UGen}
           deriving (MRG -> MRG -> Bool
(MRG -> MRG -> Bool) -> (MRG -> MRG -> Bool) -> Eq MRG
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MRG -> MRG -> Bool
$c/= :: MRG -> MRG -> Bool
== :: MRG -> MRG -> Bool
$c== :: MRG -> MRG -> Bool
Eq,ReadPrec [MRG]
ReadPrec MRG
Int -> ReadS MRG
ReadS [MRG]
(Int -> ReadS MRG)
-> ReadS [MRG] -> ReadPrec MRG -> ReadPrec [MRG] -> Read MRG
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MRG]
$creadListPrec :: ReadPrec [MRG]
readPrec :: ReadPrec MRG
$creadPrec :: ReadPrec MRG
readList :: ReadS [MRG]
$creadList :: ReadS [MRG]
readsPrec :: Int -> ReadS MRG
$creadsPrec :: Int -> ReadS MRG
Read,Int -> MRG -> ShowS
[MRG] -> ShowS
MRG -> String
(Int -> MRG -> ShowS)
-> (MRG -> String) -> ([MRG] -> ShowS) -> Show MRG
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MRG] -> ShowS
$cshowList :: [MRG] -> ShowS
show :: MRG -> String
$cshow :: MRG -> String
showsPrec :: Int -> MRG -> ShowS
$cshowsPrec :: Int -> MRG -> ShowS
Show)

-- | Union type of Unit Generator forms.
data UGen = Constant_U Constant
          | Control_U Control
          | Label_U Label
          | Primitive_U Primitive
          | Proxy_U Proxy
          | MCE_U (MCE UGen)
          | MRG_U MRG
            deriving (UGen -> UGen -> Bool
(UGen -> UGen -> Bool) -> (UGen -> UGen -> Bool) -> Eq UGen
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UGen -> UGen -> Bool
$c/= :: UGen -> UGen -> Bool
== :: UGen -> UGen -> Bool
$c== :: UGen -> UGen -> Bool
Eq,ReadPrec [UGen]
ReadPrec UGen
Int -> ReadS UGen
ReadS [UGen]
(Int -> ReadS UGen)
-> ReadS [UGen] -> ReadPrec UGen -> ReadPrec [UGen] -> Read UGen
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UGen]
$creadListPrec :: ReadPrec [UGen]
readPrec :: ReadPrec UGen
$creadPrec :: ReadPrec UGen
readList :: ReadS [UGen]
$creadList :: ReadS [UGen]
readsPrec :: Int -> ReadS UGen
$creadsPrec :: Int -> ReadS UGen
Read,Int -> UGen -> ShowS
[UGen] -> ShowS
UGen -> String
(Int -> UGen -> ShowS)
-> (UGen -> String) -> ([UGen] -> ShowS) -> Show UGen
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UGen] -> ShowS
$cshowList :: [UGen] -> ShowS
show :: UGen -> String
$cshow :: UGen -> String
showsPrec :: Int -> UGen -> ShowS
$cshowsPrec :: Int -> UGen -> ShowS
Show)

instance EqE UGen where
    equal_to :: UGen -> UGen -> UGen
equal_to = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
EQ_ Sample -> Sample -> Sample
forall n. (Num n, Eq n) => n -> n -> n
Math.sc3_eq
    not_equal_to :: UGen -> UGen -> UGen
not_equal_to = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
NE Sample -> Sample -> Sample
forall n. (Num n, Eq n) => n -> n -> n
Math.sc3_neq

instance OrdE UGen where
    less_than :: UGen -> UGen -> UGen
less_than = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
LT_ Sample -> Sample -> Sample
forall n. (Num n, Ord n) => n -> n -> n
Math.sc3_lt
    less_than_or_equal_to :: UGen -> UGen -> UGen
less_than_or_equal_to = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
LE Sample -> Sample -> Sample
forall n. (Num n, Ord n) => n -> n -> n
Math.sc3_lte
    greater_than :: UGen -> UGen -> UGen
greater_than = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
GT_ Sample -> Sample -> Sample
forall n. (Num n, Ord n) => n -> n -> n
Math.sc3_gt
    greater_than_or_equal_to :: UGen -> UGen -> UGen
greater_than_or_equal_to = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
GE Sample -> Sample -> Sample
forall n. (Num n, Ord n) => n -> n -> n
Math.sc3_gte

-- | 'UGen' form or 'Math.sc3_round_to'.
roundTo :: UGen -> UGen -> UGen
roundTo :: UGen -> UGen -> UGen
roundTo = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
Round Sample -> Sample -> Sample
forall n. RealFrac n => n -> n -> n
Math.sc3_round_to

instance RealFracE UGen where
    properFractionE :: UGen -> (UGen, UGen)
properFractionE = String -> UGen -> (UGen, UGen)
forall a. HasCallStack => String -> a
error String
"UGen.properFractionE"
    truncateE :: UGen -> UGen
truncateE = String -> UGen -> UGen
forall a. HasCallStack => String -> a
error String
"UGen.truncateE"
    roundE :: UGen -> UGen
roundE UGen
i = UGen -> UGen -> UGen
roundTo UGen
i UGen
1
    ceilingE :: UGen -> UGen
ceilingE = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
Ceil Sample -> Sample
forall a. RealFracE a => a -> a
ceilingE
    floorE :: UGen -> UGen
floorE = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
Floor Sample -> Sample
forall a. RealFracE a => a -> a
floorE

instance UnaryOp UGen where
    ampDb :: UGen -> UGen
ampDb = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
AmpDb Sample -> Sample
forall a. UnaryOp a => a -> a
ampDb
    asFloat :: UGen -> UGen
asFloat = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
AsFloat Sample -> Sample
forall a. UnaryOp a => a -> a
asFloat
    asInt :: UGen -> UGen
asInt = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
AsInt Sample -> Sample
forall a. UnaryOp a => a -> a
asInt
    cpsMIDI :: UGen -> UGen
cpsMIDI = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
CPSMIDI Sample -> Sample
forall a. UnaryOp a => a -> a
cpsMIDI
    cpsOct :: UGen -> UGen
cpsOct = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
CPSOct Sample -> Sample
forall a. UnaryOp a => a -> a
cpsOct
    cubed :: UGen -> UGen
cubed = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
Cubed Sample -> Sample
forall a. UnaryOp a => a -> a
cubed
    dbAmp :: UGen -> UGen
dbAmp = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
DbAmp Sample -> Sample
forall a. UnaryOp a => a -> a
dbAmp
    distort :: UGen -> UGen
distort = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
Distort Sample -> Sample
forall a. UnaryOp a => a -> a
distort
    frac :: UGen -> UGen
frac = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
Frac Sample -> Sample
forall a. UnaryOp a => a -> a
frac
    isNil :: UGen -> UGen
isNil = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
IsNil Sample -> Sample
forall a. UnaryOp a => a -> a
isNil
    log10 :: UGen -> UGen
log10 = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
Log10 Sample -> Sample
forall a. UnaryOp a => a -> a
log10
    log2 :: UGen -> UGen
log2 = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
Log2 Sample -> Sample
forall a. UnaryOp a => a -> a
log2
    midiCPS :: UGen -> UGen
midiCPS = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
MIDICPS Sample -> Sample
forall a. UnaryOp a => a -> a
midiCPS
    midiRatio :: UGen -> UGen
midiRatio = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
MIDIRatio Sample -> Sample
forall a. UnaryOp a => a -> a
midiRatio
    notE :: UGen -> UGen
notE = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
Not Sample -> Sample
forall a. UnaryOp a => a -> a
notE
    notNil :: UGen -> UGen
notNil = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
NotNil Sample -> Sample
forall a. UnaryOp a => a -> a
notNil
    octCPS :: UGen -> UGen
octCPS = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
OctCPS Sample -> Sample
forall a. UnaryOp a => a -> a
octCPS
    ramp_ :: UGen -> UGen
ramp_ = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
Ramp_ Sample -> Sample
forall a. UnaryOp a => a -> a
ramp_
    ratioMIDI :: UGen -> UGen
ratioMIDI = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
RatioMIDI Sample -> Sample
forall a. UnaryOp a => a -> a
ratioMIDI
    softClip :: UGen -> UGen
softClip = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
SoftClip Sample -> Sample
forall a. UnaryOp a => a -> a
softClip
    squared :: UGen -> UGen
squared = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
Squared Sample -> Sample
forall a. UnaryOp a => a -> a
squared

instance BinaryOp UGen where
    iDiv :: UGen -> UGen -> UGen
iDiv = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
IDiv Sample -> Sample -> Sample
forall a. BinaryOp a => a -> a -> a
iDiv
    modE :: UGen -> UGen -> UGen
modE = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
Mod Sample -> Sample -> Sample
forall a. Real a => a -> a -> a
F.mod'
    lcmE :: UGen -> UGen -> UGen
lcmE = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
LCM Sample -> Sample -> Sample
forall a. BinaryOp a => a -> a -> a
lcmE
    gcdE :: UGen -> UGen -> UGen
gcdE = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
GCD Sample -> Sample -> Sample
forall a. BinaryOp a => a -> a -> a
gcdE
    roundUp :: UGen -> UGen -> UGen
roundUp = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
RoundUp Sample -> Sample -> Sample
forall a. BinaryOp a => a -> a -> a
roundUp
    trunc :: UGen -> UGen -> UGen
trunc = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
Trunc Sample -> Sample -> Sample
forall a. BinaryOp a => a -> a -> a
trunc
    atan2E :: UGen -> UGen -> UGen
atan2E = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
Atan2 Sample -> Sample -> Sample
forall a. BinaryOp a => a -> a -> a
atan2E
    hypot :: UGen -> UGen -> UGen
hypot = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
Hypot Sample -> Sample -> Sample
forall a. BinaryOp a => a -> a -> a
hypot
    hypotx :: UGen -> UGen -> UGen
hypotx = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
Hypotx Sample -> Sample -> Sample
forall a. BinaryOp a => a -> a -> a
hypotx
    fill :: UGen -> UGen -> UGen
fill = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
Fill Sample -> Sample -> Sample
forall a. BinaryOp a => a -> a -> a
fill
    ring1 :: UGen -> UGen -> UGen
ring1 = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
Ring1 Sample -> Sample -> Sample
forall a. BinaryOp a => a -> a -> a
ring1
    ring2 :: UGen -> UGen -> UGen
ring2 = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
Ring2 Sample -> Sample -> Sample
forall a. BinaryOp a => a -> a -> a
ring2
    ring3 :: UGen -> UGen -> UGen
ring3 = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
Ring3 Sample -> Sample -> Sample
forall a. BinaryOp a => a -> a -> a
ring3
    ring4 :: UGen -> UGen -> UGen
ring4 = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
Ring4 Sample -> Sample -> Sample
forall a. BinaryOp a => a -> a -> a
ring4
    difSqr :: UGen -> UGen -> UGen
difSqr = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
DifSqr Sample -> Sample -> Sample
forall a. BinaryOp a => a -> a -> a
difSqr
    sumSqr :: UGen -> UGen -> UGen
sumSqr = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
SumSqr Sample -> Sample -> Sample
forall a. BinaryOp a => a -> a -> a
sumSqr
    sqrSum :: UGen -> UGen -> UGen
sqrSum = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
SqrSum Sample -> Sample -> Sample
forall a. BinaryOp a => a -> a -> a
sqrSum
    sqrDif :: UGen -> UGen -> UGen
sqrDif = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
SqrDif Sample -> Sample -> Sample
forall a. BinaryOp a => a -> a -> a
sqrDif
    absDif :: UGen -> UGen -> UGen
absDif = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
AbsDif Sample -> Sample -> Sample
forall a. BinaryOp a => a -> a -> a
absDif
    thresh :: UGen -> UGen -> UGen
thresh = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
Thresh Sample -> Sample -> Sample
forall a. BinaryOp a => a -> a -> a
thresh
    amClip :: UGen -> UGen -> UGen
amClip = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
AMClip Sample -> Sample -> Sample
forall a. BinaryOp a => a -> a -> a
amClip
    scaleNeg :: UGen -> UGen -> UGen
scaleNeg = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
ScaleNeg Sample -> Sample -> Sample
forall a. BinaryOp a => a -> a -> a
scaleNeg
    clip2 :: UGen -> UGen -> UGen
clip2 = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
Clip2 Sample -> Sample -> Sample
forall a. BinaryOp a => a -> a -> a
clip2
    excess :: UGen -> UGen -> UGen
excess = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
Excess Sample -> Sample -> Sample
forall a. BinaryOp a => a -> a -> a
excess
    fold2 :: UGen -> UGen -> UGen
fold2 = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
Fold2 Sample -> Sample -> Sample
forall a. BinaryOp a => a -> a -> a
fold2
    wrap2 :: UGen -> UGen -> UGen
wrap2 = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
Wrap2 Sample -> Sample -> Sample
forall a. BinaryOp a => a -> a -> a
wrap2
    firstArg :: UGen -> UGen -> UGen
firstArg = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
FirstArg Sample -> Sample -> Sample
forall a. BinaryOp a => a -> a -> a
firstArg
    randRange :: UGen -> UGen -> UGen
randRange = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
RandRange Sample -> Sample -> Sample
forall a. BinaryOp a => a -> a -> a
randRange
    exprandRange :: UGen -> UGen -> UGen
exprandRange = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
ExpRandRange Sample -> Sample -> Sample
forall a. BinaryOp a => a -> a -> a
exprandRange

--instance MulAdd UGen where mul_add = mulAdd

-- * Parser

-- | 'constant' of 'parse_double'.
parse_constant :: String -> Maybe UGen
parse_constant :: String -> Maybe UGen
parse_constant = (Sample -> UGen) -> Maybe Sample -> Maybe UGen
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Sample -> UGen
forall n. Real n => n -> UGen
constant (Maybe Sample -> Maybe UGen)
-> (String -> Maybe Sample) -> String -> Maybe UGen
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Sample
Math.parse_double

-- * Accessors

-- | See into 'Constant_U'.
un_constant :: UGen -> Maybe Constant
un_constant :: UGen -> Maybe Constant
un_constant UGen
u =
    case UGen
u of
      Constant_U Constant
c -> Constant -> Maybe Constant
forall a. a -> Maybe a
Just Constant
c
      UGen
_ -> Maybe Constant
forall a. Maybe a
Nothing

-- | Value of 'Constant_U' 'Constant'.
u_constant :: UGen -> Maybe Sample
u_constant :: UGen -> Maybe Sample
u_constant = (Constant -> Sample) -> Maybe Constant -> Maybe Sample
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Constant -> Sample
constantValue (Maybe Constant -> Maybe Sample)
-> (UGen -> Maybe Constant) -> UGen -> Maybe Sample
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UGen -> Maybe Constant
un_constant

-- | Erroring variant.
u_constant_err :: UGen -> Sample
u_constant_err :: UGen -> Sample
u_constant_err = Sample -> Maybe Sample -> Sample
forall a. a -> Maybe a -> a
fromMaybe (String -> Sample
forall a. HasCallStack => String -> a
error String
"u_constant") (Maybe Sample -> Sample)
-> (UGen -> Maybe Sample) -> UGen -> Sample
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UGen -> Maybe Sample
u_constant

-- * MRG

-- | Multiple root graph constructor.
mrg :: [UGen] -> UGen
mrg :: [UGen] -> UGen
mrg [UGen]
u =
    case [UGen]
u of
      [] -> String -> UGen
forall a. HasCallStack => String -> a
error String
"mrg: []"
      [UGen
x] -> UGen
x
      (UGen
x:[UGen]
xs) -> MRG -> UGen
MRG_U (UGen -> UGen -> MRG
MRG UGen
x ([UGen] -> UGen
mrg [UGen]
xs))

-- | See into 'MRG_U', follows leftmost rule until arriving at non-MRG node.
mrg_leftmost :: UGen -> UGen
mrg_leftmost :: UGen -> UGen
mrg_leftmost UGen
u =
    case UGen
u of
      MRG_U MRG
m -> UGen -> UGen
mrg_leftmost (MRG -> UGen
mrgLeft MRG
m)
      UGen
_ -> UGen
u

-- * Predicates

-- | Constant node predicate.
isConstant :: UGen -> Bool
isConstant :: UGen -> Bool
isConstant = Maybe Constant -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Constant -> Bool)
-> (UGen -> Maybe Constant) -> UGen -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UGen -> Maybe Constant
un_constant

-- | True if input is a sink 'UGen', ie. has no outputs.  Sees into MRG.
isSink :: UGen -> Bool
isSink :: UGen -> Bool
isSink UGen
u =
    case UGen -> UGen
mrg_leftmost UGen
u of
      Primitive_U Primitive
p -> [Rate] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Primitive -> [Rate]
ugenOutputs Primitive
p)
      MCE_U MCE UGen
m -> (UGen -> Bool) -> [UGen] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all UGen -> Bool
isSink (MCE UGen -> [UGen]
forall t. MCE t -> [t]
mce_elem MCE UGen
m)
      UGen
_ -> Bool
False

-- | See into 'Proxy_U'.
un_proxy :: UGen -> Maybe Proxy
un_proxy :: UGen -> Maybe Proxy
un_proxy UGen
u =
    case UGen
u of
      Proxy_U Proxy
p -> Proxy -> Maybe Proxy
forall a. a -> Maybe a
Just Proxy
p
      UGen
_ -> Maybe Proxy
forall a. Maybe a
Nothing

-- | Is 'UGen' a 'Proxy'?
isProxy :: UGen -> Bool
isProxy :: UGen -> Bool
isProxy = Maybe Proxy -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Proxy -> Bool) -> (UGen -> Maybe Proxy) -> UGen -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UGen -> Maybe Proxy
un_proxy

-- * MCE

-- | Multiple channel expansion node constructor.
mce :: [UGen] -> UGen
mce :: [UGen] -> UGen
mce [UGen]
xs =
    case [UGen]
xs of
      [] -> String -> UGen
forall a. HasCallStack => String -> a
error String
"mce: []"
      [UGen
x] -> UGen
x
      [UGen]
_ -> MCE UGen -> UGen
MCE_U ([UGen] -> MCE UGen
forall n. [n] -> MCE n
MCE_Vector [UGen]
xs)

-- | Type specified 'mce_elem'.
mceProxies :: MCE UGen -> [UGen]
mceProxies :: MCE UGen -> [UGen]
mceProxies = MCE UGen -> [UGen]
forall t. MCE t -> [t]
mce_elem

-- | Multiple channel expansion node ('MCE_U') predicate.  Sees into MRG.
isMCE :: UGen -> Bool
isMCE :: UGen -> Bool
isMCE UGen
u =
    case UGen -> UGen
mrg_leftmost UGen
u of
      MCE_U MCE UGen
_ -> Bool
True
      UGen
_ -> Bool
False

-- | Output channels of UGen as a list.  If required, preserves the RHS of and MRG node in channel 0.
mceChannels :: UGen -> [UGen]
mceChannels :: UGen -> [UGen]
mceChannels UGen
u =
    case UGen
u of
      MCE_U MCE UGen
m -> MCE UGen -> [UGen]
forall t. MCE t -> [t]
mce_elem MCE UGen
m
      MRG_U (MRG UGen
x UGen
y) -> let UGen
r:[UGen]
rs = UGen -> [UGen]
mceChannels UGen
x in MRG -> UGen
MRG_U (UGen -> UGen -> MRG
MRG UGen
r UGen
y) UGen -> [UGen] -> [UGen]
forall a. a -> [a] -> [a]
: [UGen]
rs
      UGen
_ -> [UGen
u]

-- | Number of channels to expand to.  This function sees into MRG, and is defined only for MCE nodes.
mceDegree :: UGen -> Maybe Int
mceDegree :: UGen -> Maybe Int
mceDegree UGen
u =
    case UGen -> UGen
mrg_leftmost UGen
u of
      MCE_U MCE UGen
m -> Int -> Maybe Int
forall a. a -> Maybe a
Just ([UGen] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (MCE UGen -> [UGen]
mceProxies MCE UGen
m))
      UGen
_ -> Maybe Int
forall a. Maybe a
Nothing

-- | Erroring variant.
mceDegree_err :: UGen -> Int
mceDegree_err :: UGen -> Int
mceDegree_err = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (String -> Int
forall a. HasCallStack => String -> a
error String
"mceDegree: not mce") (Maybe Int -> Int) -> (UGen -> Maybe Int) -> UGen -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UGen -> Maybe Int
mceDegree

-- | Extend UGen to specified degree.  Follows "leftmost" rule for MRG nodes.
mceExtend :: Int -> UGen -> [UGen]
mceExtend :: Int -> UGen -> [UGen]
mceExtend Int
n UGen
u =
    case UGen
u of
      MCE_U MCE UGen
m -> MCE UGen -> [UGen]
mceProxies (Int -> MCE UGen -> MCE UGen
forall n. Int -> MCE n -> MCE n
mce_extend Int
n MCE UGen
m)
      MRG_U (MRG UGen
x UGen
y) -> let (UGen
r:[UGen]
rs) = Int -> UGen -> [UGen]
mceExtend Int
n UGen
x
                         in MRG -> UGen
MRG_U (UGen -> UGen -> MRG
MRG UGen
r UGen
y) UGen -> [UGen] -> [UGen]
forall a. a -> [a] -> [a]
: [UGen]
rs
      UGen
_ -> Int -> UGen -> [UGen]
forall a. Int -> a -> [a]
replicate Int
n UGen
u

-- | Is MCE required, ie. are any input values MCE?
mceRequired :: [UGen] -> Bool
mceRequired :: [UGen] -> Bool
mceRequired = (UGen -> Bool) -> [UGen] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any UGen -> Bool
isMCE

{- | Apply MCE transform to a list of inputs.
     The transform extends each input so all are of equal length, and then transposes the matrix.

> mceInputTransform [mce2 1 2,mce2 3 4] == Just [[1,3],[2,4]]
> mceInputTransform [mce2 1 2,mce2 3 4,mce3 5 6 7] == Just [[1,3,5],[2,4,6],[1,3,7]]
-}
mceInputTransform :: [UGen] -> Maybe [[UGen]]
mceInputTransform :: [UGen] -> Maybe [[UGen]]
mceInputTransform [UGen]
i =
    if [UGen] -> Bool
mceRequired [UGen]
i
    then let n :: Int
n = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((UGen -> Int) -> [UGen] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map UGen -> Int
mceDegree_err ((UGen -> Bool) -> [UGen] -> [UGen]
forall a. (a -> Bool) -> [a] -> [a]
filter UGen -> Bool
isMCE [UGen]
i))
         in [[UGen]] -> Maybe [[UGen]]
forall a. a -> Maybe a
Just ([[UGen]] -> [[UGen]]
forall a. [[a]] -> [[a]]
transpose ((UGen -> [UGen]) -> [UGen] -> [[UGen]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> UGen -> [UGen]
mceExtend Int
n) [UGen]
i))
    else Maybe [[UGen]]
forall a. Maybe a
Nothing

-- | Build a UGen after MCE transformation of inputs.
mceBuild :: ([UGen] -> UGen) -> [UGen] -> UGen
mceBuild :: ([UGen] -> UGen) -> [UGen] -> UGen
mceBuild [UGen] -> UGen
f [UGen]
i =
    case [UGen] -> Maybe [[UGen]]
mceInputTransform [UGen]
i of
      Maybe [[UGen]]
Nothing -> [UGen] -> UGen
f [UGen]
i
      Just [[UGen]]
i' -> MCE UGen -> UGen
MCE_U ([UGen] -> MCE UGen
forall n. [n] -> MCE n
MCE_Vector (([UGen] -> UGen) -> [[UGen]] -> [UGen]
forall a b. (a -> b) -> [a] -> [b]
map (([UGen] -> UGen) -> [UGen] -> UGen
mceBuild [UGen] -> UGen
f) [[UGen]]
i'))

-- | True if MCE is an immediate proxy for a multiple-out Primitive.
--   This is useful when disassembling graphs, ie. ugen_graph_forth_pp at hsc3-db.
mce_is_direct_proxy :: MCE UGen -> Bool
mce_is_direct_proxy :: MCE UGen -> Bool
mce_is_direct_proxy MCE UGen
m =
    case MCE UGen
m of
      MCE_Unit UGen
_ -> Bool
False
      MCE_Vector [UGen]
v ->
          let p :: [Maybe Proxy]
p = (UGen -> Maybe Proxy) -> [UGen] -> [Maybe Proxy]
forall a b. (a -> b) -> [a] -> [b]
map UGen -> Maybe Proxy
un_proxy [UGen]
v
              p' :: [Proxy]
p' = [Maybe Proxy] -> [Proxy]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Proxy]
p
          in (Maybe Proxy -> Bool) -> [Maybe Proxy] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Maybe Proxy -> Bool
forall a. Maybe a -> Bool
isJust [Maybe Proxy]
p Bool -> Bool -> Bool
&&
             [Primitive] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Primitive] -> [Primitive]
forall a. Eq a => [a] -> [a]
nub ((Proxy -> Primitive) -> [Proxy] -> [Primitive]
forall a b. (a -> b) -> [a] -> [b]
map Proxy -> Primitive
proxySource [Proxy]
p')) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&&
             (Proxy -> Int) -> [Proxy] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Proxy -> Int
proxyIndex [Proxy]
p' [Int] -> [Int] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Int
0..]

-- * Validators

-- | Ensure input 'UGen' is valid, ie. not a sink.
checkInput :: UGen -> UGen
checkInput :: UGen -> UGen
checkInput UGen
u =
    if UGen -> Bool
isSink UGen
u
    then String -> UGen
forall a. HasCallStack => String -> a
error (String
"checkInput: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ UGen -> String
forall a. Show a => a -> String
show UGen
u)
    else UGen
u

-- * Constructors

-- | Constant value node constructor.
constant :: Real n => n -> UGen
constant :: n -> UGen
constant = Constant -> UGen
Constant_U (Constant -> UGen) -> (n -> Constant) -> n -> UGen
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sample -> Constant
Constant (Sample -> Constant) -> (n -> Sample) -> n -> Constant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Sample
forall a b. (Real a, Fractional b) => a -> b
realToFrac

-- | Type specialised 'constant'.
int_to_ugen :: Int -> UGen
int_to_ugen :: Int -> UGen
int_to_ugen = Int -> UGen
forall n. Real n => n -> UGen
constant

-- | Type specialised 'constant'.
float_to_ugen :: Float -> UGen
float_to_ugen :: Float -> UGen
float_to_ugen = Float -> UGen
forall n. Real n => n -> UGen
constant

-- | Type specialised 'constant'.
double_to_ugen :: Double -> UGen
double_to_ugen :: Sample -> UGen
double_to_ugen = Sample -> UGen
forall n. Real n => n -> UGen
constant

-- | Unit generator proxy node constructor.
proxy :: UGen -> Int -> UGen
proxy :: UGen -> Int -> UGen
proxy UGen
u Int
n =
    case UGen
u of
      Primitive_U Primitive
p -> Proxy -> UGen
Proxy_U (Primitive -> Int -> Proxy
Proxy Primitive
p Int
n)
      UGen
_ -> String -> UGen
forall a. HasCallStack => String -> a
error String
"proxy: not primitive?"

-- | Determine the rate of a UGen.
rateOf :: UGen -> Rate
rateOf :: UGen -> Rate
rateOf UGen
u =
    case UGen
u of
      Constant_U Constant
_ -> Rate
IR
      Control_U Control
c -> Control -> Rate
controlOperatingRate Control
c
      Label_U Label
_ -> Rate
IR
      Primitive_U Primitive
p -> Primitive -> Rate
ugenRate Primitive
p
      Proxy_U Proxy
p -> Primitive -> Rate
ugenRate (Proxy -> Primitive
proxySource Proxy
p)
      MCE_U MCE UGen
_ -> [Rate] -> Rate
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((UGen -> Rate) -> [UGen] -> [Rate]
forall a b. (a -> b) -> [a] -> [b]
map UGen -> Rate
rateOf (UGen -> [UGen]
mceChannels UGen
u))
      MRG_U MRG
m -> UGen -> Rate
rateOf (MRG -> UGen
mrgLeft MRG
m)

-- | Apply proxy transformation if required.
proxify :: UGen -> UGen
proxify :: UGen -> UGen
proxify UGen
u =
    case UGen
u of
      MCE_U MCE UGen
m -> [UGen] -> UGen
mce ((UGen -> UGen) -> [UGen] -> [UGen]
forall a b. (a -> b) -> [a] -> [b]
map UGen -> UGen
proxify (MCE UGen -> [UGen]
forall t. MCE t -> [t]
mce_elem MCE UGen
m))
      MRG_U MRG
m -> [UGen] -> UGen
mrg [UGen -> UGen
proxify (MRG -> UGen
mrgLeft MRG
m), MRG -> UGen
mrgRight MRG
m]
      Primitive_U Primitive
p ->
          let o :: [Rate]
o = Primitive -> [Rate]
ugenOutputs Primitive
p
          in case [Rate]
o of
               Rate
_:Rate
_:[Rate]
_ -> [UGen] -> UGen
mce ((Int -> UGen) -> [Int] -> [UGen]
forall a b. (a -> b) -> [a] -> [b]
map (UGen -> Int -> UGen
proxy UGen
u) [Int
0 .. [Rate] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Rate]
o Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1])
               [Rate]
_ -> UGen
u
      Constant_U Constant
_ -> UGen
u
      UGen
_ -> String -> UGen
forall a. HasCallStack => String -> a
error String
"proxify: illegal ugen"

-- | Filters with DR inputs run at KR.  This is a little unfortunate,
-- it'd be nicer if the rate in this circumstance could be given.
mk_ugen_select_rate :: String -> [UGen] -> [Rate] -> Either Rate [Int] -> Rate
mk_ugen_select_rate :: String -> [UGen] -> [Rate] -> Either Rate [Int] -> Rate
mk_ugen_select_rate String
nm [UGen]
h [Rate]
rs Either Rate [Int]
r =
  let r' :: Rate
r' = (Rate -> Rate) -> ([Int] -> Rate) -> Either Rate [Int] -> Rate
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Rate -> Rate
forall a. a -> a
id ([Rate] -> Rate
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Rate] -> Rate) -> ([Int] -> [Rate]) -> [Int] -> Rate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Rate) -> [Int] -> [Rate]
forall a b. (a -> b) -> [a] -> [b]
map (UGen -> Rate
rateOf (UGen -> Rate) -> (Int -> UGen) -> Int -> Rate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [UGen] -> Int -> UGen
forall a. HasCallStack => String -> [a] -> Int -> a
Safe.atNote (String
"mkUGen: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
nm) [UGen]
h)) Either Rate [Int]
r
  in if Either Rate [Int] -> Bool
forall a b. Either a b -> Bool
isRight Either Rate [Int]
r Bool -> Bool -> Bool
&& Rate
r' Rate -> Rate -> Bool
forall a. Eq a => a -> a -> Bool
== Rate
DR Bool -> Bool -> Bool
&& Rate
DR Rate -> [Rate] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Rate]
rs
     then if Rate
KR Rate -> [Rate] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Rate]
rs then Rate
KR else String -> Rate
forall a. HasCallStack => String -> a
error String
"mkUGen: DR input to non-KR filter"
     else if Rate
r' Rate -> [Rate] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Rate]
rs Bool -> Bool -> Bool
|| Rate
r' Rate -> Rate -> Bool
forall a. Eq a => a -> a -> Bool
== Rate
DR
          then Rate
r'
          else String -> Rate
forall a. HasCallStack => String -> a
error (String
"mkUGen: rate restricted: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Either Rate [Int], Rate, [Rate], String) -> String
forall a. Show a => a -> String
show (Either Rate [Int]
r,Rate
r',[Rate]
rs,String
nm))

-- | Construct proxied and multiple channel expanded UGen.
--
-- cf = constant function, rs = rate set, r = rate, nm = name, i =
-- inputs, i_mce = list of MCE inputs, o = outputs.
mkUGen :: Maybe ([Sample] -> Sample) -> [Rate] -> Either Rate [Int] ->
          String -> [UGen] -> Maybe [UGen] -> Int -> Special -> UGenId -> UGen
mkUGen :: Maybe ([Sample] -> Sample)
-> [Rate]
-> Either Rate [Int]
-> String
-> [UGen]
-> Maybe [UGen]
-> Int
-> Special
-> UGenId
-> UGen
mkUGen Maybe ([Sample] -> Sample)
cf [Rate]
rs Either Rate [Int]
r String
nm [UGen]
i Maybe [UGen]
i_mce Int
o Special
s UGenId
z =
    let i' :: [UGen]
i' = [UGen] -> ([UGen] -> [UGen]) -> Maybe [UGen] -> [UGen]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [UGen]
i (([UGen]
i [UGen] -> [UGen] -> [UGen]
forall a. [a] -> [a] -> [a]
++) ([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) Maybe [UGen]
i_mce
        f :: [UGen] -> UGen
f [UGen]
h = let r' :: Rate
r' = String -> [UGen] -> [Rate] -> Either Rate [Int] -> Rate
mk_ugen_select_rate String
nm [UGen]
h [Rate]
rs Either Rate [Int]
r
                  o' :: [Rate]
o' = Int -> Rate -> [Rate]
forall a. Int -> a -> [a]
replicate Int
o Rate
r'
                  u :: UGen
u = Primitive -> UGen
Primitive_U (Rate
-> String -> [UGen] -> [Rate] -> Special -> UGenId -> Primitive
Primitive Rate
r' String
nm [UGen]
h [Rate]
o' Special
s UGenId
z)
              in case Maybe ([Sample] -> Sample)
cf of
                   Just [Sample] -> Sample
cf' ->
                     if (UGen -> Bool) -> [UGen] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all UGen -> Bool
isConstant [UGen]
h
                     then Sample -> UGen
forall n. Real n => n -> UGen
constant ([Sample] -> Sample
cf' ((UGen -> Maybe Sample) -> [UGen] -> [Sample]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe UGen -> Maybe Sample
u_constant [UGen]
h))
                     else UGen
u
                   Maybe ([Sample] -> Sample)
Nothing -> UGen
u
    in UGen -> UGen
proxify (([UGen] -> UGen) -> [UGen] -> UGen
mceBuild [UGen] -> UGen
f ((UGen -> UGen) -> [UGen] -> [UGen]
forall a b. (a -> b) -> [a] -> [b]
map UGen -> UGen
checkInput [UGen]
i'))

-- * Operators

-- | Operator UGen constructor.
mkOperator :: ([Sample] -> Sample) -> String -> [UGen] -> Int -> UGen
mkOperator :: ([Sample] -> Sample) -> String -> [UGen] -> Int -> UGen
mkOperator [Sample] -> Sample
f String
c [UGen]
i Int
s =
    let ix :: [Int]
ix = [Int
0 .. [UGen] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [UGen]
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
    in Maybe ([Sample] -> Sample)
-> [Rate]
-> Either Rate [Int]
-> String
-> [UGen]
-> Maybe [UGen]
-> Int
-> Special
-> UGenId
-> UGen
mkUGen (([Sample] -> Sample) -> Maybe ([Sample] -> Sample)
forall a. a -> Maybe a
Just [Sample] -> Sample
f) [Rate]
all_rates ([Int] -> Either Rate [Int]
forall a b. b -> Either a b
Right [Int]
ix) String
c [UGen]
i Maybe [UGen]
forall a. Maybe a
Nothing Int
1 (Int -> Special
Special Int
s) UGenId
NoId

-- | Unary math constructor.
mkUnaryOperator :: SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator :: SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
i Sample -> Sample
f UGen
a =
    let g :: [Sample] -> Sample
g [Sample
x] = Sample -> Sample
f Sample
x
        g [Sample]
_ = String -> Sample
forall a. HasCallStack => String -> a
error String
"mkUnaryOperator: non unary input"
    in ([Sample] -> Sample) -> String -> [UGen] -> Int -> UGen
mkOperator [Sample] -> Sample
g String
"UnaryOpUGen" [UGen
a] (SC3_Unary_Op -> Int
forall a. Enum a => a -> Int
fromEnum SC3_Unary_Op
i)

-- | Binary math constructor with constant optimisation.
--
-- > constant 2 * constant 3 == constant 6
--
-- > let o = sinOsc AR 440 0
--
-- > o * 1 == o && 1 * o == o && o * 2 /= o
-- > o + 0 == o && 0 + o == o && o + 1 /= o
-- > o - 0 == o && 0 - o /= o
-- > o / 1 == o && 1 / o /= o
-- > o ** 1 == o && o ** 2 /= o
mkBinaryOperator_optimise_constants :: SC3_Binary_Op -> (Sample -> Sample -> Sample) ->
                                       (Either Sample Sample -> Bool) ->
                                       UGen -> UGen -> UGen
mkBinaryOperator_optimise_constants :: SC3_Binary_Op
-> (Sample -> Sample -> Sample)
-> (Either Sample Sample -> Bool)
-> UGen
-> UGen
-> UGen
mkBinaryOperator_optimise_constants SC3_Binary_Op
i Sample -> Sample -> Sample
f Either Sample Sample -> Bool
o UGen
a UGen
b =
   let g :: [Sample] -> Sample
g [Sample
x,Sample
y] = Sample -> Sample -> Sample
f Sample
x Sample
y
       g [Sample]
_ = String -> Sample
forall a. HasCallStack => String -> a
error String
"mkBinaryOperator: non binary input"
       r :: Maybe UGen
r = case (UGen
a,UGen
b) of
             (Constant_U (Constant Sample
a'),UGen
_) ->
                 if Either Sample Sample -> Bool
o (Sample -> Either Sample Sample
forall a b. a -> Either a b
Left Sample
a') then UGen -> Maybe UGen
forall a. a -> Maybe a
Just UGen
b else Maybe UGen
forall a. Maybe a
Nothing
             (UGen
_,Constant_U (Constant Sample
b')) ->
                 if Either Sample Sample -> Bool
o (Sample -> Either Sample Sample
forall a b. b -> Either a b
Right Sample
b') then UGen -> Maybe UGen
forall a. a -> Maybe a
Just UGen
a else Maybe UGen
forall a. Maybe a
Nothing
             (UGen, UGen)
_ -> Maybe UGen
forall a. Maybe a
Nothing
   in UGen -> Maybe UGen -> UGen
forall a. a -> Maybe a -> a
fromMaybe (([Sample] -> Sample) -> String -> [UGen] -> Int -> UGen
mkOperator [Sample] -> Sample
g String
"BinaryOpUGen" [UGen
a, UGen
b] (SC3_Binary_Op -> Int
forall a. Enum a => a -> Int
fromEnum SC3_Binary_Op
i)) Maybe UGen
r

-- | Plain (non-optimised) binary math constructor.
mkBinaryOperator :: SC3_Binary_Op -> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator :: SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
i Sample -> Sample -> Sample
f UGen
a UGen
b =
   let g :: [Sample] -> Sample
g [Sample
x,Sample
y] = Sample -> Sample -> Sample
f Sample
x Sample
y
       g [Sample]
_ = String -> Sample
forall a. HasCallStack => String -> a
error String
"mkBinaryOperator: non binary input"
   in ([Sample] -> Sample) -> String -> [UGen] -> Int -> UGen
mkOperator [Sample] -> Sample
g String
"BinaryOpUGen" [UGen
a, UGen
b] (SC3_Binary_Op -> Int
forall a. Enum a => a -> Int
fromEnum SC3_Binary_Op
i)

-- * Numeric instances

-- | Is /u/ a binary math operator with SPECIAL of /k/.
is_math_binop :: Int -> UGen -> Bool
is_math_binop :: Int -> UGen -> Bool
is_math_binop Int
k UGen
u =
    case UGen
u of
      Primitive_U (Primitive Rate
_ String
"BinaryOpUGen" [UGen
_,UGen
_] [Rate
_] (Special Int
s) UGenId
NoId) -> Int
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
k
      UGen
_ -> Bool
False

-- | Is /u/ an ADD operator?
is_add_operator :: UGen -> Bool
is_add_operator :: UGen -> Bool
is_add_operator = Int -> UGen -> Bool
is_math_binop Int
0

assert_is_add_operator :: String -> UGen -> UGen
assert_is_add_operator :: String -> UGen -> UGen
assert_is_add_operator String
msg UGen
u = if UGen -> Bool
is_add_operator UGen
u then UGen
u else String -> UGen
forall a. HasCallStack => String -> a
error (String
"assert_is_add_operator: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg)

-- | Is /u/ an MUL operator?
is_mul_operator :: UGen -> Bool
is_mul_operator :: UGen -> Bool
is_mul_operator = Int -> UGen -> Bool
is_math_binop Int
2

-- | MulAdd re-writer, applicable only directly at add operator UGen.
--   The MulAdd UGen is very sensitive to input rates.
--   ADD=AR with IN|MUL=IR|CONST will CRASH scsynth.
mul_add_optimise_direct :: UGen -> UGen
mul_add_optimise_direct :: UGen -> UGen
mul_add_optimise_direct UGen
u =
  let reorder :: (UGen, UGen, UGen) -> Maybe (Rate, (UGen, UGen, UGen))
reorder (UGen
i,UGen
j,UGen
k) =
        let (Rate
ri,Rate
rj,Rate
rk) = (UGen -> Rate
rateOf UGen
i,UGen -> Rate
rateOf UGen
j,UGen -> Rate
rateOf UGen
k)
        in if Rate
rk Rate -> Rate -> Bool
forall a. Ord a => a -> a -> Bool
> Rate -> Rate -> Rate
forall a. Ord a => a -> a -> a
max Rate
ri Rate
rj
           then Maybe (Rate, (UGen, UGen, UGen))
forall a. Maybe a
Nothing
           else (Rate, (UGen, UGen, UGen)) -> Maybe (Rate, (UGen, UGen, UGen))
forall a. a -> Maybe a
Just (Rate -> Rate -> Rate
forall a. Ord a => a -> a -> a
max (Rate -> Rate -> Rate
forall a. Ord a => a -> a -> a
max Rate
ri Rate
rj) Rate
rk,if Rate
rj Rate -> Rate -> Bool
forall a. Ord a => a -> a -> Bool
> Rate
ri then (UGen
j,UGen
i,UGen
k) else (UGen
i,UGen
j,UGen
k))
  in case String -> UGen -> UGen
assert_is_add_operator String
"MUL-ADD" UGen
u of
       Primitive_U
         (Primitive Rate
_ String
_ [Primitive_U (Primitive Rate
_ String
"BinaryOpUGen" [UGen
i,UGen
j] [Rate
_] (Special Int
2) UGenId
NoId),UGen
k] [Rate
_] Special
_ UGenId
NoId) ->
         case (UGen, UGen, UGen) -> Maybe (Rate, (UGen, UGen, UGen))
reorder (UGen
i,UGen
j,UGen
k) of
           Just (Rate
rt,(UGen
p,UGen
q,UGen
r)) -> Primitive -> UGen
Primitive_U (Rate
-> String -> [UGen] -> [Rate] -> Special -> UGenId -> Primitive
Primitive Rate
rt String
"MulAdd" [UGen
p,UGen
q,UGen
r] [Rate
rt] (Int -> Special
Special Int
0) UGenId
NoId)
           Maybe (Rate, (UGen, UGen, UGen))
Nothing -> UGen
u
       Primitive_U
         (Primitive Rate
_ String
_ [UGen
k,Primitive_U (Primitive Rate
_ String
"BinaryOpUGen" [UGen
i,UGen
j] [Rate
_] (Special Int
2) UGenId
NoId)] [Rate
_] Special
_ UGenId
NoId) ->
         case (UGen, UGen, UGen) -> Maybe (Rate, (UGen, UGen, UGen))
reorder (UGen
i,UGen
j,UGen
k) of
           Just (Rate
rt,(UGen
p,UGen
q,UGen
r)) -> Primitive -> UGen
Primitive_U (Rate
-> String -> [UGen] -> [Rate] -> Special -> UGenId -> Primitive
Primitive Rate
rt String
"MulAdd" [UGen
p,UGen
q,UGen
r] [Rate
rt] (Int -> Special
Special Int
0) UGenId
NoId)
           Maybe (Rate, (UGen, UGen, UGen))
Nothing -> UGen
u
       UGen
_ -> UGen
u

{- | MulAdd optimiser, applicable at any UGen (ie. checks /u/ is an ADD ugen)

> import Sound.SC3
> g1 = sinOsc AR 440 0 * 0.1 + control IR "x" 0.05
> g2 = sinOsc AR 440 0 * control IR "x" 0.1 + 0.05
> g3 = control IR "x" 0.1 * sinOsc AR 440 0 + 0.05
> g4 = 0.05 + sinOsc AR 440 0 * 0.1
-}
mul_add_optimise :: UGen -> UGen
mul_add_optimise :: UGen -> UGen
mul_add_optimise UGen
u = if UGen -> Bool
is_add_operator UGen
u then UGen -> UGen
mul_add_optimise_direct UGen
u else UGen
u

-- | Sum3 re-writer, applicable only directly at add operator UGen.
sum3_optimise_direct :: UGen -> UGen
sum3_optimise_direct :: UGen -> UGen
sum3_optimise_direct UGen
u =
  case String -> UGen -> UGen
assert_is_add_operator String
"SUM3" UGen
u of
    Primitive_U
      (Primitive Rate
r String
_ [Primitive_U (Primitive Rate
_ String
"BinaryOpUGen" [UGen
i,UGen
j] [Rate
_] (Special Int
0) UGenId
NoId),UGen
k] [Rate
_] Special
_ UGenId
NoId) ->
      Primitive -> UGen
Primitive_U (Rate
-> String -> [UGen] -> [Rate] -> Special -> UGenId -> Primitive
Primitive Rate
r String
"Sum3" [UGen
i,UGen
j,UGen
k] [Rate
r] (Int -> Special
Special Int
0) UGenId
NoId)
    Primitive_U
      (Primitive Rate
r String
_ [UGen
k,Primitive_U (Primitive Rate
_ String
"BinaryOpUGen" [UGen
i,UGen
j] [Rate
_] (Special Int
0) UGenId
NoId)] [Rate
_] Special
_ UGenId
NoId) ->
      Primitive -> UGen
Primitive_U (Rate
-> String -> [UGen] -> [Rate] -> Special -> UGenId -> Primitive
Primitive Rate
r String
"Sum3" [UGen
i,UGen
j,UGen
k] [Rate
r] (Int -> Special
Special Int
0) UGenId
NoId)
    UGen
_ -> UGen
u

-- | /Sum3/ optimiser, applicable at any /u/ (ie. checks if /u/ is an ADD operator).
sum3_optimise :: UGen -> UGen
sum3_optimise :: UGen -> UGen
sum3_optimise UGen
u = if UGen -> Bool
is_add_operator UGen
u then UGen -> UGen
sum3_optimise_direct UGen
u else UGen
u

-- | 'sum3_optimise' of 'mul_add_optimise'.
add_optimise :: UGen -> UGen
add_optimise :: UGen -> UGen
add_optimise = UGen -> UGen
sum3_optimise (UGen -> UGen) -> (UGen -> UGen) -> UGen -> UGen
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UGen -> UGen
mul_add_optimise

-- | Unit generators are numbers.
instance Num UGen where
    negate :: UGen -> UGen
negate = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
Neg Sample -> Sample
forall a. Num a => a -> a
negate
    + :: UGen -> UGen -> UGen
(+) = (UGen -> UGen) -> (UGen -> UGen) -> UGen -> UGen
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UGen -> UGen
add_optimise ((UGen -> UGen) -> UGen -> UGen)
-> (UGen -> UGen -> UGen) -> UGen -> UGen -> UGen
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          SC3_Binary_Op
-> (Sample -> Sample -> Sample)
-> (Either Sample Sample -> Bool)
-> UGen
-> UGen
-> UGen
mkBinaryOperator_optimise_constants SC3_Binary_Op
Add Sample -> Sample -> Sample
forall a. Num a => a -> a -> a
(+) (Either Sample Sample -> [Either Sample Sample] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Sample -> Either Sample Sample
forall a b. a -> Either a b
Left Sample
0,Sample -> Either Sample Sample
forall a b. b -> Either a b
Right Sample
0])
    (-) = SC3_Binary_Op
-> (Sample -> Sample -> Sample)
-> (Either Sample Sample -> Bool)
-> UGen
-> UGen
-> UGen
mkBinaryOperator_optimise_constants SC3_Binary_Op
Sub (-) (Sample -> Either Sample Sample
forall a b. b -> Either a b
Right Sample
0 Either Sample Sample -> Either Sample Sample -> Bool
forall a. Eq a => a -> a -> Bool
==)
    * :: UGen -> UGen -> UGen
(*) = SC3_Binary_Op
-> (Sample -> Sample -> Sample)
-> (Either Sample Sample -> Bool)
-> UGen
-> UGen
-> UGen
mkBinaryOperator_optimise_constants SC3_Binary_Op
Mul Sample -> Sample -> Sample
forall a. Num a => a -> a -> a
(*) (Either Sample Sample -> [Either Sample Sample] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Sample -> Either Sample Sample
forall a b. a -> Either a b
Left Sample
1,Sample -> Either Sample Sample
forall a b. b -> Either a b
Right Sample
1])
    abs :: UGen -> UGen
abs = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
Abs Sample -> Sample
forall a. Num a => a -> a
abs
    signum :: UGen -> UGen
signum = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
Sign Sample -> Sample
forall a. Num a => a -> a
signum
    fromInteger :: Integer -> UGen
fromInteger = Constant -> UGen
Constant_U (Constant -> UGen) -> (Integer -> Constant) -> Integer -> UGen
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sample -> Constant
Constant (Sample -> Constant) -> (Integer -> Sample) -> Integer -> Constant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Sample
forall a. Num a => Integer -> a
fromInteger

-- | Unit generators are fractional.
instance Fractional UGen where
    recip :: UGen -> UGen
recip = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
Recip Sample -> Sample
forall a. Fractional a => a -> a
recip
    / :: UGen -> UGen -> UGen
(/) = SC3_Binary_Op
-> (Sample -> Sample -> Sample)
-> (Either Sample Sample -> Bool)
-> UGen
-> UGen
-> UGen
mkBinaryOperator_optimise_constants SC3_Binary_Op
FDiv Sample -> Sample -> Sample
forall a. Fractional a => a -> a -> a
(/) (Sample -> Either Sample Sample
forall a b. b -> Either a b
Right Sample
1 Either Sample Sample -> Either Sample Sample -> Bool
forall a. Eq a => a -> a -> Bool
==)
    fromRational :: Rational -> UGen
fromRational = Constant -> UGen
Constant_U (Constant -> UGen) -> (Rational -> Constant) -> Rational -> UGen
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sample -> Constant
Constant (Sample -> Constant)
-> (Rational -> Sample) -> Rational -> Constant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Sample
forall a. Fractional a => Rational -> a
fromRational

-- | Unit generators are floating point.
instance Floating UGen where
    pi :: UGen
pi = Constant -> UGen
Constant_U (Sample -> Constant
Constant Sample
forall a. Floating a => a
pi)
    exp :: UGen -> UGen
exp = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
Exp Sample -> Sample
forall a. Floating a => a -> a
exp
    log :: UGen -> UGen
log = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
Log Sample -> Sample
forall a. Floating a => a -> a
log
    sqrt :: UGen -> UGen
sqrt = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
Sqrt Sample -> Sample
forall a. Floating a => a -> a
sqrt
    ** :: UGen -> UGen -> UGen
(**) = SC3_Binary_Op
-> (Sample -> Sample -> Sample)
-> (Either Sample Sample -> Bool)
-> UGen
-> UGen
-> UGen
mkBinaryOperator_optimise_constants SC3_Binary_Op
Pow Sample -> Sample -> Sample
forall a. Floating a => a -> a -> a
(**) (Sample -> Either Sample Sample
forall a b. b -> Either a b
Right Sample
1 Either Sample Sample -> Either Sample Sample -> Bool
forall a. Eq a => a -> a -> Bool
==)
    logBase :: UGen -> UGen -> UGen
logBase UGen
a UGen
b = UGen -> UGen
forall a. Floating a => a -> a
log UGen
b UGen -> UGen -> UGen
forall a. Fractional a => a -> a -> a
/ UGen -> UGen
forall a. Floating a => a -> a
log UGen
a
    sin :: UGen -> UGen
sin = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
Sin Sample -> Sample
forall a. Floating a => a -> a
sin
    cos :: UGen -> UGen
cos = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
Cos Sample -> Sample
forall a. Floating a => a -> a
cos
    tan :: UGen -> UGen
tan = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
Tan Sample -> Sample
forall a. Floating a => a -> a
tan
    asin :: UGen -> UGen
asin = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
ArcSin Sample -> Sample
forall a. Floating a => a -> a
asin
    acos :: UGen -> UGen
acos = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
ArcCos Sample -> Sample
forall a. Floating a => a -> a
acos
    atan :: UGen -> UGen
atan = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
ArcTan Sample -> Sample
forall a. Floating a => a -> a
atan
    sinh :: UGen -> UGen
sinh = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
SinH Sample -> Sample
forall a. Floating a => a -> a
sinh
    cosh :: UGen -> UGen
cosh = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
CosH Sample -> Sample
forall a. Floating a => a -> a
cosh
    tanh :: UGen -> UGen
tanh = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
TanH Sample -> Sample
forall a. Floating a => a -> a
tanh
    asinh :: UGen -> UGen
asinh UGen
x = UGen -> UGen
forall a. Floating a => a -> a
log (UGen -> UGen
forall a. Floating a => a -> a
sqrt (UGen
xUGen -> UGen -> UGen
forall a. Num a => a -> a -> a
*UGen
xUGen -> UGen -> UGen
forall a. Num a => a -> a -> a
+UGen
1) UGen -> UGen -> UGen
forall a. Num a => a -> a -> a
+ UGen
x)
    acosh :: UGen -> UGen
acosh UGen
x = UGen -> UGen
forall a. Floating a => a -> a
log (UGen -> UGen
forall a. Floating a => a -> a
sqrt (UGen
xUGen -> UGen -> UGen
forall a. Num a => a -> a -> a
*UGen
xUGen -> UGen -> UGen
forall a. Num a => a -> a -> a
-UGen
1) UGen -> UGen -> UGen
forall a. Num a => a -> a -> a
+ UGen
x)
    atanh :: UGen -> UGen
atanh UGen
x = (UGen -> UGen
forall a. Floating a => a -> a
log (UGen
1UGen -> UGen -> UGen
forall a. Num a => a -> a -> a
+UGen
x) UGen -> UGen -> UGen
forall a. Num a => a -> a -> a
- UGen -> UGen
forall a. Floating a => a -> a
log (UGen
1UGen -> UGen -> UGen
forall a. Num a => a -> a -> a
-UGen
x)) UGen -> UGen -> UGen
forall a. Fractional a => a -> a -> a
/ UGen
2

-- | Unit generators are real.
instance Real UGen where
    toRational :: UGen -> Rational
toRational (Constant_U (Constant Sample
n)) = Sample -> Rational
forall a. Real a => a -> Rational
toRational Sample
n
    toRational UGen
_ = String -> Rational
forall a. HasCallStack => String -> a
error String
"UGen.toRational: non-constant"

-- | Unit generators are integral.
instance Integral UGen where
    quot :: UGen -> UGen -> UGen
quot = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
IDiv (String -> Sample -> Sample -> Sample
forall a. HasCallStack => String -> a
error String
"UGen.quot")
    rem :: UGen -> UGen -> UGen
rem = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
Mod (String -> Sample -> Sample -> Sample
forall a. HasCallStack => String -> a
error String
"UGen.rem")
    quotRem :: UGen -> UGen -> (UGen, UGen)
quotRem UGen
a UGen
b = (UGen -> UGen -> UGen
forall a. Integral a => a -> a -> a
quot UGen
a UGen
b, UGen -> UGen -> UGen
forall a. Integral a => a -> a -> a
rem UGen
a UGen
b)
    div :: UGen -> UGen -> UGen
div = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
IDiv (String -> Sample -> Sample -> Sample
forall a. HasCallStack => String -> a
error String
"UGen.div")
    mod :: UGen -> UGen -> UGen
mod = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
Mod (String -> Sample -> Sample -> Sample
forall a. HasCallStack => String -> a
error String
"UGen.mod")
    toInteger :: UGen -> Integer
toInteger (Constant_U (Constant Sample
n)) = Sample -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor Sample
n
    toInteger UGen
_ = String -> Integer
forall a. HasCallStack => String -> a
error String
"UGen.toInteger: non-constant"

instance RealFrac UGen where
  properFraction :: UGen -> (b, UGen)
properFraction = String -> UGen -> (b, UGen)
forall a. HasCallStack => String -> a
error String
"UGen.properFraction, see properFractionE"
  round :: UGen -> b
round = String -> UGen -> b
forall a. HasCallStack => String -> a
error String
"UGen.round, see roundE"
  ceiling :: UGen -> b
ceiling = String -> UGen -> b
forall a. HasCallStack => String -> a
error String
"UGen.ceiling, see ceilingE"
  floor :: UGen -> b
floor = String -> UGen -> b
forall a. HasCallStack => String -> a
error String
"UGen.floor, see floorE"

-- | Unit generators are orderable (when 'Constants').
--
-- > (constant 2 > constant 1) == True
instance Ord UGen where
    (Constant_U Constant
a) < :: UGen -> UGen -> Bool
< (Constant_U Constant
b) = Constant
a Constant -> Constant -> Bool
forall a. Ord a => a -> a -> Bool
< Constant
b
    UGen
_ < UGen
_ = String -> Bool
forall a. HasCallStack => String -> a
error String
"UGen.<, see <*"
    (Constant_U Constant
a) <= :: UGen -> UGen -> Bool
<= (Constant_U Constant
b) = Constant
a Constant -> Constant -> Bool
forall a. Ord a => a -> a -> Bool
<= Constant
b
    UGen
_ <= UGen
_ = String -> Bool
forall a. HasCallStack => String -> a
error String
"UGen.<= at, see <=*"
    (Constant_U Constant
a) > :: UGen -> UGen -> Bool
> (Constant_U Constant
b) = Constant
a Constant -> Constant -> Bool
forall a. Ord a => a -> a -> Bool
> Constant
b
    UGen
_ > UGen
_ = String -> Bool
forall a. HasCallStack => String -> a
error String
"UGen.>, see >*"
    (Constant_U Constant
a) >= :: UGen -> UGen -> Bool
>= (Constant_U Constant
b) = Constant
a Constant -> Constant -> Bool
forall a. Ord a => a -> a -> Bool
>= Constant
b
    UGen
_ >= UGen
_ = String -> Bool
forall a. HasCallStack => String -> a
error String
"UGen.>=, see >=*"
    min :: UGen -> UGen -> UGen
min = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
Min Sample -> Sample -> Sample
forall a. Ord a => a -> a -> a
min
    max :: UGen -> UGen -> UGen
max = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
Max Sample -> Sample -> Sample
forall a. Ord a => a -> a -> a
max

-- | Unit generators are enumerable.
instance Enum UGen where
    succ :: UGen -> UGen
succ UGen
u = UGen
u UGen -> UGen -> UGen
forall a. Num a => a -> a -> a
+ UGen
1
    pred :: UGen -> UGen
pred UGen
u = UGen
u UGen -> UGen -> UGen
forall a. Num a => a -> a -> a
- UGen
1
    toEnum :: Int -> UGen
toEnum Int
n = Constant -> UGen
Constant_U (Sample -> Constant
Constant (Int -> Sample
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n))
    fromEnum :: UGen -> Int
fromEnum (Constant_U (Constant Sample
n)) = Sample -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate Sample
n
    fromEnum UGen
_ = String -> Int
forall a. HasCallStack => String -> a
error String
"UGen.fromEnum: non-constant"
    enumFrom :: UGen -> [UGen]
enumFrom = (UGen -> UGen) -> UGen -> [UGen]
forall a. (a -> a) -> a -> [a]
iterate (UGen -> UGen -> UGen
forall a. Num a => a -> a -> a
+UGen
1)
    enumFromThen :: UGen -> UGen -> [UGen]
enumFromThen UGen
n UGen
m = (UGen -> UGen) -> UGen -> [UGen]
forall a. (a -> a) -> a -> [a]
iterate (UGen -> UGen -> UGen
forall a. Num a => a -> a -> a
+(UGen
mUGen -> UGen -> UGen
forall a. Num a => a -> a -> a
-UGen
n)) UGen
n
    enumFromTo :: UGen -> UGen -> [UGen]
enumFromTo UGen
n UGen
m = (UGen -> Bool) -> [UGen] -> [UGen]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (UGen -> UGen -> Bool
forall a. Ord a => a -> a -> Bool
<= UGen
mUGen -> UGen -> UGen
forall a. Num a => a -> a -> a
+UGen
1UGen -> UGen -> UGen
forall a. Fractional a => a -> a -> a
/UGen
2) (UGen -> [UGen]
forall a. Enum a => a -> [a]
enumFrom UGen
n)
    enumFromThenTo :: UGen -> UGen -> UGen -> [UGen]
enumFromThenTo UGen
n UGen
n' UGen
m =
        let p :: UGen -> UGen -> Bool
p = if UGen
n' UGen -> UGen -> Bool
forall a. Ord a => a -> a -> Bool
>= UGen
n then UGen -> UGen -> Bool
forall a. Ord a => a -> a -> Bool
(>=) else UGen -> UGen -> Bool
forall a. Ord a => a -> a -> Bool
(<=)
        in (UGen -> Bool) -> [UGen] -> [UGen]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (UGen -> UGen -> Bool
p (UGen
m UGen -> UGen -> UGen
forall a. Num a => a -> a -> a
+ (UGen
n'UGen -> UGen -> UGen
forall a. Num a => a -> a -> a
-UGen
n)UGen -> UGen -> UGen
forall a. Fractional a => a -> a -> a
/UGen
2)) (UGen -> UGen -> [UGen]
forall a. Enum a => a -> a -> [a]
enumFromThen UGen
n UGen
n')

-- | Unit generators are stochastic.
instance Random.Random UGen where
    randomR :: (UGen, UGen) -> g -> (UGen, g)
randomR (Constant_U (Constant Sample
l),Constant_U (Constant Sample
r)) g
g =
        let (Sample
n, g
g') = (Sample, Sample) -> g -> (Sample, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
Random.randomR (Sample
l,Sample
r) g
g
        in (Constant -> UGen
Constant_U (Sample -> Constant
Constant Sample
n), g
g')
    randomR (UGen, UGen)
_ g
_ = String -> (UGen, g)
forall a. HasCallStack => String -> a
error String
"UGen.randomR: non constant (l,r)"
    random :: g -> (UGen, g)
random = (UGen, UGen) -> g -> (UGen, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
Random.randomR (-UGen
1.0, UGen
1.0)

-- | UGens are bit patterns.
instance Bits UGen where
    .&. :: UGen -> UGen -> UGen
(.&.) = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
BitAnd Sample -> Sample -> Sample
forall a. HasCallStack => a
undefined
    .|. :: UGen -> UGen -> UGen
(.|.) = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
BitOr Sample -> Sample -> Sample
forall a. HasCallStack => a
undefined
    xor :: UGen -> UGen -> UGen
xor = SC3_Binary_Op
-> (Sample -> Sample -> Sample) -> UGen -> UGen -> UGen
mkBinaryOperator SC3_Binary_Op
BitXor Sample -> Sample -> Sample
forall a. HasCallStack => a
undefined
    complement :: UGen -> UGen
complement = SC3_Unary_Op -> (Sample -> Sample) -> UGen -> UGen
mkUnaryOperator SC3_Unary_Op
BitNot Sample -> Sample
forall a. HasCallStack => a
undefined
    shift :: UGen -> Int -> UGen
shift = String -> UGen -> Int -> UGen
forall a. HasCallStack => String -> a
error String
"UGen.shift"
    rotate :: UGen -> Int -> UGen
rotate = String -> UGen -> Int -> UGen
forall a. HasCallStack => String -> a
error String
"UGen.rotate"
    bitSize :: UGen -> Int
bitSize = String -> UGen -> Int
forall a. HasCallStack => String -> a
error String
"UGen.bitSize"
    bit :: Int -> UGen
bit = String -> Int -> UGen
forall a. HasCallStack => String -> a
error String
"UGen.bit"
    testBit :: UGen -> Int -> Bool
testBit = String -> UGen -> Int -> Bool
forall a. HasCallStack => String -> a
error String
"UGen.testBit"
    popCount :: UGen -> Int
popCount = String -> UGen -> Int
forall a. HasCallStack => String -> a
error String
"UGen.popCount"
    bitSizeMaybe :: UGen -> Maybe Int
bitSizeMaybe = String -> UGen -> Maybe Int
forall a. HasCallStack => String -> a
error String
"UGen.bitSizeMaybe"
    isSigned :: UGen -> Bool
isSigned UGen
_ = Bool
True