-- | Data types for enumerated and non signal unit generator inputs.
module Sound.Sc3.Common.Enum where

-- * Loop

-- | Loop indicator input.
data Loop t
  = -- | 0
    NoLoop
  | -- | 1
    Loop
  | WithLoop t
  deriving (Loop t -> Loop t -> Bool
(Loop t -> Loop t -> Bool)
-> (Loop t -> Loop t -> Bool) -> Eq (Loop t)
forall t. Eq t => Loop t -> Loop t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall t. Eq t => Loop t -> Loop t -> Bool
== :: Loop t -> Loop t -> Bool
$c/= :: forall t. Eq t => Loop t -> Loop t -> Bool
/= :: Loop t -> Loop t -> Bool
Eq, Int -> Loop t -> ShowS
[Loop t] -> ShowS
Loop t -> String
(Int -> Loop t -> ShowS)
-> (Loop t -> String) -> ([Loop t] -> ShowS) -> Show (Loop t)
forall t. Show t => Int -> Loop t -> ShowS
forall t. Show t => [Loop t] -> ShowS
forall t. Show t => Loop t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall t. Show t => Int -> Loop t -> ShowS
showsPrec :: Int -> Loop t -> ShowS
$cshow :: forall t. Show t => Loop t -> String
show :: Loop t -> String
$cshowList :: forall t. Show t => [Loop t] -> ShowS
showList :: [Loop t] -> ShowS
Show)

-- | Apply /f/ at 'WithLoop'.
loop_map :: (t -> u) -> Loop t -> Loop u
loop_map :: forall t u. (t -> u) -> Loop t -> Loop u
loop_map t -> u
f Loop t
lp =
  case Loop t
lp of
    Loop t
NoLoop -> Loop u
forall t. Loop t
NoLoop
    Loop t
Loop -> Loop u
forall t. Loop t
Loop
    WithLoop t
t -> u -> Loop u
forall t. t -> Loop t
WithLoop (t -> u
f t
t)

-- | fmap is 'loop_map'
instance Functor Loop where
  fmap :: forall t u. (t -> u) -> Loop t -> Loop u
fmap = (a -> b) -> Loop a -> Loop b
forall t u. (t -> u) -> Loop t -> Loop u
loop_map

-- | Resolve 'Loop'.
from_loop :: Num t => Loop t -> t
from_loop :: forall t. Num t => Loop t -> t
from_loop Loop t
e =
  case Loop t
e of
    Loop t
NoLoop -> t
0
    Loop t
Loop -> t
1
    WithLoop t
u -> t
u

-- * Interpolation

-- | Interpolation indicator input.
data Interpolation t
  = NoInterpolation
  | LinearInterpolation
  | CubicInterpolation
  | WithInterpolation t
  deriving (Interpolation t -> Interpolation t -> Bool
(Interpolation t -> Interpolation t -> Bool)
-> (Interpolation t -> Interpolation t -> Bool)
-> Eq (Interpolation t)
forall t. Eq t => Interpolation t -> Interpolation t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall t. Eq t => Interpolation t -> Interpolation t -> Bool
== :: Interpolation t -> Interpolation t -> Bool
$c/= :: forall t. Eq t => Interpolation t -> Interpolation t -> Bool
/= :: Interpolation t -> Interpolation t -> Bool
Eq, Int -> Interpolation t -> ShowS
[Interpolation t] -> ShowS
Interpolation t -> String
(Int -> Interpolation t -> ShowS)
-> (Interpolation t -> String)
-> ([Interpolation t] -> ShowS)
-> Show (Interpolation t)
forall t. Show t => Int -> Interpolation t -> ShowS
forall t. Show t => [Interpolation t] -> ShowS
forall t. Show t => Interpolation t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall t. Show t => Int -> Interpolation t -> ShowS
showsPrec :: Int -> Interpolation t -> ShowS
$cshow :: forall t. Show t => Interpolation t -> String
show :: Interpolation t -> String
$cshowList :: forall t. Show t => [Interpolation t] -> ShowS
showList :: [Interpolation t] -> ShowS
Show)

-- | Resolve 'Interpolation'.
from_interpolation :: Num t => Interpolation t -> t
from_interpolation :: forall t. Num t => Interpolation t -> t
from_interpolation Interpolation t
e =
  case Interpolation t
e of
    Interpolation t
NoInterpolation -> t
1
    Interpolation t
LinearInterpolation -> t
2
    Interpolation t
CubicInterpolation -> t
4
    WithInterpolation t
u -> t
u

-- * DoneAction

-- | Completion mode indicator input.
data DoneAction t
  = DoNothing
  | PauseSynth
  | RemoveSynth
  | RemoveGroup
  | WithDoneAction t
  deriving (DoneAction t -> DoneAction t -> Bool
(DoneAction t -> DoneAction t -> Bool)
-> (DoneAction t -> DoneAction t -> Bool) -> Eq (DoneAction t)
forall t. Eq t => DoneAction t -> DoneAction t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall t. Eq t => DoneAction t -> DoneAction t -> Bool
== :: DoneAction t -> DoneAction t -> Bool
$c/= :: forall t. Eq t => DoneAction t -> DoneAction t -> Bool
/= :: DoneAction t -> DoneAction t -> Bool
Eq, Int -> DoneAction t -> ShowS
[DoneAction t] -> ShowS
DoneAction t -> String
(Int -> DoneAction t -> ShowS)
-> (DoneAction t -> String)
-> ([DoneAction t] -> ShowS)
-> Show (DoneAction t)
forall t. Show t => Int -> DoneAction t -> ShowS
forall t. Show t => [DoneAction t] -> ShowS
forall t. Show t => DoneAction t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall t. Show t => Int -> DoneAction t -> ShowS
showsPrec :: Int -> DoneAction t -> ShowS
$cshow :: forall t. Show t => DoneAction t -> String
show :: DoneAction t -> String
$cshowList :: forall t. Show t => [DoneAction t] -> ShowS
showList :: [DoneAction t] -> ShowS
Show)

-- | Apply /f/ at 'WithDoneAction'.
done_action_map :: (t -> u) -> DoneAction t -> DoneAction u
done_action_map :: forall t u. (t -> u) -> DoneAction t -> DoneAction u
done_action_map t -> u
f DoneAction t
e =
  case DoneAction t
e of
    DoneAction t
DoNothing -> DoneAction u
forall t. DoneAction t
DoNothing
    DoneAction t
PauseSynth -> DoneAction u
forall t. DoneAction t
PauseSynth
    DoneAction t
RemoveSynth -> DoneAction u
forall t. DoneAction t
RemoveSynth
    DoneAction t
RemoveGroup -> DoneAction u
forall t. DoneAction t
RemoveGroup
    WithDoneAction t
x -> u -> DoneAction u
forall t. t -> DoneAction t
WithDoneAction (t -> u
f t
x)

-- | fmap is 'done_action_map'
instance Functor DoneAction where
  fmap :: forall t u. (t -> u) -> DoneAction t -> DoneAction u
fmap = (a -> b) -> DoneAction a -> DoneAction b
forall t u. (t -> u) -> DoneAction t -> DoneAction u
done_action_map

-- | Resolve 'DoneAction'.
from_done_action :: Num t => DoneAction t -> t
from_done_action :: forall t. Num t => DoneAction t -> t
from_done_action DoneAction t
e =
  case DoneAction t
e of
    DoneAction t
DoNothing -> t
0
    DoneAction t
PauseSynth -> t
1
    DoneAction t
RemoveSynth -> t
2
    DoneAction t
RemoveGroup -> t
14
    WithDoneAction t
x -> t
x

-- * Warp

-- | Warp interpolation indicator input.
data Warp t
  = Linear
  | Exponential
  | WithWarp t
  deriving (Warp t -> Warp t -> Bool
(Warp t -> Warp t -> Bool)
-> (Warp t -> Warp t -> Bool) -> Eq (Warp t)
forall t. Eq t => Warp t -> Warp t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall t. Eq t => Warp t -> Warp t -> Bool
== :: Warp t -> Warp t -> Bool
$c/= :: forall t. Eq t => Warp t -> Warp t -> Bool
/= :: Warp t -> Warp t -> Bool
Eq, Int -> Warp t -> ShowS
[Warp t] -> ShowS
Warp t -> String
(Int -> Warp t -> ShowS)
-> (Warp t -> String) -> ([Warp t] -> ShowS) -> Show (Warp t)
forall t. Show t => Int -> Warp t -> ShowS
forall t. Show t => [Warp t] -> ShowS
forall t. Show t => Warp t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall t. Show t => Int -> Warp t -> ShowS
showsPrec :: Int -> Warp t -> ShowS
$cshow :: forall t. Show t => Warp t -> String
show :: Warp t -> String
$cshowList :: forall t. Show t => [Warp t] -> ShowS
showList :: [Warp t] -> ShowS
Show)

{- | Resolve 'Warp'.

>>> map from_warp [Linear,Exponential]
[0,1]
-}
from_warp :: Num t => Warp t -> t
from_warp :: forall t. Num t => Warp t -> t
from_warp Warp t
e =
  case Warp t
e of
    Warp t
Linear -> t
0
    Warp t
Exponential -> t
1
    WithWarp t
u -> t
u

-- | Apply /f/ at 'WithWarp'
warp_map :: (t -> u) -> Warp t -> Warp u
warp_map :: forall t u. (t -> u) -> Warp t -> Warp u
warp_map t -> u
f Warp t
e =
  case Warp t
e of
    Warp t
Linear -> Warp u
forall t. Warp t
Linear
    Warp t
Exponential -> Warp u
forall t. Warp t
Exponential
    WithWarp t
u -> u -> Warp u
forall t. t -> Warp t
WithWarp (t -> u
f t
u)

-- | fmap = 'warp_map'
instance Functor Warp where
  fmap :: forall t u. (t -> u) -> Warp t -> Warp u
fmap = (a -> b) -> Warp a -> Warp b
forall t u. (t -> u) -> Warp t -> Warp u
warp_map

-- * Buffer

-- | Unification of integer and 'Ugen' buffer identifiers.
data Buffer t
  = Buffer_Id Int
  | Buffer t
  deriving (Buffer t -> Buffer t -> Bool
(Buffer t -> Buffer t -> Bool)
-> (Buffer t -> Buffer t -> Bool) -> Eq (Buffer t)
forall t. Eq t => Buffer t -> Buffer t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall t. Eq t => Buffer t -> Buffer t -> Bool
== :: Buffer t -> Buffer t -> Bool
$c/= :: forall t. Eq t => Buffer t -> Buffer t -> Bool
/= :: Buffer t -> Buffer t -> Bool
Eq, Int -> Buffer t -> ShowS
[Buffer t] -> ShowS
Buffer t -> String
(Int -> Buffer t -> ShowS)
-> (Buffer t -> String) -> ([Buffer t] -> ShowS) -> Show (Buffer t)
forall t. Show t => Int -> Buffer t -> ShowS
forall t. Show t => [Buffer t] -> ShowS
forall t. Show t => Buffer t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall t. Show t => Int -> Buffer t -> ShowS
showsPrec :: Int -> Buffer t -> ShowS
$cshow :: forall t. Show t => Buffer t -> String
show :: Buffer t -> String
$cshowList :: forall t. Show t => [Buffer t] -> ShowS
showList :: [Buffer t] -> ShowS
Show)