-- | SuperCollider Ugen primitive.
module Sound.Sc3.Ugen.Primitive where

import Sound.Sc3.Common.Rate {- hsc3 -}

import Sound.Sc3.Ugen.Brackets {- hsc3 -}

-- | Identifier used to distinguish otherwise equal non-deterministic nodes.
data UgenId = NoId | Uid Int deriving (Eq UgenId
UgenId -> UgenId -> Bool
UgenId -> UgenId -> Ordering
UgenId -> UgenId -> UgenId
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 :: UgenId -> UgenId -> UgenId
$cmin :: UgenId -> UgenId -> UgenId
max :: UgenId -> UgenId -> UgenId
$cmax :: UgenId -> UgenId -> UgenId
>= :: UgenId -> UgenId -> Bool
$c>= :: UgenId -> UgenId -> Bool
> :: UgenId -> UgenId -> Bool
$c> :: UgenId -> UgenId -> Bool
<= :: UgenId -> UgenId -> Bool
$c<= :: UgenId -> UgenId -> Bool
< :: UgenId -> UgenId -> Bool
$c< :: UgenId -> UgenId -> Bool
compare :: UgenId -> UgenId -> Ordering
$ccompare :: UgenId -> UgenId -> Ordering
Ord, UgenId -> UgenId -> Bool
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]
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
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

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

-- | Selector for unary and binary operators.
newtype Special = Special Int
    deriving (Eq Special
Special -> Special -> Bool
Special -> Special -> Ordering
Special -> Special -> Special
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 :: Special -> Special -> Special
$cmin :: Special -> Special -> Special
max :: Special -> Special -> Special
$cmax :: Special -> Special -> Special
>= :: Special -> Special -> Bool
$c>= :: Special -> Special -> Bool
> :: Special -> Special -> Bool
$c> :: Special -> Special -> Bool
<= :: Special -> Special -> Bool
$c<= :: Special -> Special -> Bool
< :: Special -> Special -> Bool
$c< :: Special -> Special -> Bool
compare :: Special -> Special -> Ordering
$ccompare :: Special -> Special -> Ordering
Ord, Special -> Special -> Bool
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]
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
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)

-- | Sc Ugen primitive.
data Primitive t =
  Primitive
  {forall t. Primitive t -> Rate
ugenRate :: Rate
  ,forall t. Primitive t -> String
ugenName :: String
  ,forall t. Primitive t -> [t]
ugenInputs :: [t]
  ,forall t. Primitive t -> [Rate]
ugenOutputs :: [Output]
  ,forall t. Primitive t -> Special
ugenSpecial :: Special
  ,forall t. Primitive t -> UgenId
ugenId :: UgenId
  ,forall t. Primitive t -> Brackets
primitiveBrackets :: Brackets}
  deriving (Primitive t -> Primitive t -> Bool
Primitive t -> Primitive t -> Ordering
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
forall {t}. Ord t => Eq (Primitive t)
forall t. Ord t => Primitive t -> Primitive t -> Bool
forall t. Ord t => Primitive t -> Primitive t -> Ordering
forall t. Ord t => Primitive t -> Primitive t -> Primitive t
min :: Primitive t -> Primitive t -> Primitive t
$cmin :: forall t. Ord t => Primitive t -> Primitive t -> Primitive t
max :: Primitive t -> Primitive t -> Primitive t
$cmax :: forall t. Ord t => Primitive t -> Primitive t -> Primitive t
>= :: Primitive t -> Primitive t -> Bool
$c>= :: forall t. Ord t => Primitive t -> Primitive t -> Bool
> :: Primitive t -> Primitive t -> Bool
$c> :: forall t. Ord t => Primitive t -> Primitive t -> Bool
<= :: Primitive t -> Primitive t -> Bool
$c<= :: forall t. Ord t => Primitive t -> Primitive t -> Bool
< :: Primitive t -> Primitive t -> Bool
$c< :: forall t. Ord t => Primitive t -> Primitive t -> Bool
compare :: Primitive t -> Primitive t -> Ordering
$ccompare :: forall t. Ord t => Primitive t -> Primitive t -> Ordering
Ord, Primitive t -> Primitive t -> Bool
forall t. Eq t => Primitive t -> Primitive t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Primitive t -> Primitive t -> Bool
$c/= :: forall t. Eq t => Primitive t -> Primitive t -> Bool
== :: Primitive t -> Primitive t -> Bool
$c== :: forall t. Eq t => Primitive t -> Primitive t -> Bool
Eq, ReadPrec [Primitive t]
ReadPrec (Primitive t)
ReadS [Primitive t]
forall t. Read t => ReadPrec [Primitive t]
forall t. Read t => ReadPrec (Primitive t)
forall t. Read t => Int -> ReadS (Primitive t)
forall t. Read t => ReadS [Primitive t]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Primitive t]
$creadListPrec :: forall t. Read t => ReadPrec [Primitive t]
readPrec :: ReadPrec (Primitive t)
$creadPrec :: forall t. Read t => ReadPrec (Primitive t)
readList :: ReadS [Primitive t]
$creadList :: forall t. Read t => ReadS [Primitive t]
readsPrec :: Int -> ReadS (Primitive t)
$creadsPrec :: forall t. Read t => Int -> ReadS (Primitive t)
Read, Int -> Primitive t -> ShowS
forall t. Show t => Int -> Primitive t -> ShowS
forall t. Show t => [Primitive t] -> ShowS
forall t. Show t => Primitive t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Primitive t] -> ShowS
$cshowList :: forall t. Show t => [Primitive t] -> ShowS
show :: Primitive t -> String
$cshow :: forall t. Show t => Primitive t -> String
showsPrec :: Int -> Primitive t -> ShowS
$cshowsPrec :: forall t. Show t => Int -> Primitive t -> ShowS
Show)