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

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