-- | Proxy indicating an output port at a multi-channel Primitive.
module Sound.Sc3.Ugen.Proxy where

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

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

data Proxy t =
  Proxy
  {forall t. Proxy t -> Primitive t
proxySource :: Primitive t
  ,forall t. Proxy t -> Int
proxyIndex :: Int}
  deriving (Proxy t -> Proxy t -> Bool
Proxy t -> Proxy 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 (Proxy t)
forall t. Ord t => Proxy t -> Proxy t -> Bool
forall t. Ord t => Proxy t -> Proxy t -> Ordering
forall t. Ord t => Proxy t -> Proxy t -> Proxy t
min :: Proxy t -> Proxy t -> Proxy t
$cmin :: forall t. Ord t => Proxy t -> Proxy t -> Proxy t
max :: Proxy t -> Proxy t -> Proxy t
$cmax :: forall t. Ord t => Proxy t -> Proxy t -> Proxy t
>= :: Proxy t -> Proxy t -> Bool
$c>= :: forall t. Ord t => Proxy t -> Proxy t -> Bool
> :: Proxy t -> Proxy t -> Bool
$c> :: forall t. Ord t => Proxy t -> Proxy t -> Bool
<= :: Proxy t -> Proxy t -> Bool
$c<= :: forall t. Ord t => Proxy t -> Proxy t -> Bool
< :: Proxy t -> Proxy t -> Bool
$c< :: forall t. Ord t => Proxy t -> Proxy t -> Bool
compare :: Proxy t -> Proxy t -> Ordering
$ccompare :: forall t. Ord t => Proxy t -> Proxy t -> Ordering
Ord, Proxy t -> Proxy t -> Bool
forall t. Eq t => Proxy t -> Proxy t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Proxy t -> Proxy t -> Bool
$c/= :: forall t. Eq t => Proxy t -> Proxy t -> Bool
== :: Proxy t -> Proxy t -> Bool
$c== :: forall t. Eq t => Proxy t -> Proxy t -> Bool
Eq, ReadPrec [Proxy t]
ReadPrec (Proxy t)
ReadS [Proxy t]
forall t. Read t => ReadPrec [Proxy t]
forall t. Read t => ReadPrec (Proxy t)
forall t. Read t => Int -> ReadS (Proxy t)
forall t. Read t => ReadS [Proxy t]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Proxy t]
$creadListPrec :: forall t. Read t => ReadPrec [Proxy t]
readPrec :: ReadPrec (Proxy t)
$creadPrec :: forall t. Read t => ReadPrec (Proxy t)
readList :: ReadS [Proxy t]
$creadList :: forall t. Read t => ReadS [Proxy t]
readsPrec :: Int -> ReadS (Proxy t)
$creadsPrec :: forall t. Read t => Int -> ReadS (Proxy t)
Read, Int -> Proxy t -> ShowS
forall t. Show t => Int -> Proxy t -> ShowS
forall t. Show t => [Proxy t] -> ShowS
forall t. Show t => Proxy t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Proxy t] -> ShowS
$cshowList :: forall t. Show t => [Proxy t] -> ShowS
show :: Proxy t -> String
$cshow :: forall t. Show t => Proxy t -> String
showsPrec :: Int -> Proxy t -> ShowS
$cshowsPrec :: forall t. Show t => Int -> Proxy t -> ShowS
Show)

proxyRate :: Proxy t -> Rate
proxyRate :: forall t. Proxy t -> Rate
proxyRate = forall t. Primitive t -> Rate
ugenRate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Proxy t -> Primitive t
proxySource