-- | Operating rate definitions and utilities.
module Sound.Sc3.Common.Rate where

import Data.Char {- base -}
import Data.Maybe {- base -}

-- | Enumeration of operating rates of unit generators.
data Rate = InitialisationRate | ControlRate | AudioRate | DemandRate
            deriving (Rate -> Rate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rate -> Rate -> Bool
$c/= :: Rate -> Rate -> Bool
== :: Rate -> Rate -> Bool
$c== :: Rate -> Rate -> Bool
Eq,Eq Rate
Rate -> Rate -> Bool
Rate -> Rate -> Ordering
Rate -> Rate -> Rate
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 :: Rate -> Rate -> Rate
$cmin :: Rate -> Rate -> Rate
max :: Rate -> Rate -> Rate
$cmax :: Rate -> Rate -> Rate
>= :: Rate -> Rate -> Bool
$c>= :: Rate -> Rate -> Bool
> :: Rate -> Rate -> Bool
$c> :: Rate -> Rate -> Bool
<= :: Rate -> Rate -> Bool
$c<= :: Rate -> Rate -> Bool
< :: Rate -> Rate -> Bool
$c< :: Rate -> Rate -> Bool
compare :: Rate -> Rate -> Ordering
$ccompare :: Rate -> Rate -> Ordering
Ord,Int -> Rate
Rate -> Int
Rate -> [Rate]
Rate -> Rate
Rate -> Rate -> [Rate]
Rate -> Rate -> Rate -> [Rate]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Rate -> Rate -> Rate -> [Rate]
$cenumFromThenTo :: Rate -> Rate -> Rate -> [Rate]
enumFromTo :: Rate -> Rate -> [Rate]
$cenumFromTo :: Rate -> Rate -> [Rate]
enumFromThen :: Rate -> Rate -> [Rate]
$cenumFromThen :: Rate -> Rate -> [Rate]
enumFrom :: Rate -> [Rate]
$cenumFrom :: Rate -> [Rate]
fromEnum :: Rate -> Int
$cfromEnum :: Rate -> Int
toEnum :: Int -> Rate
$ctoEnum :: Int -> Rate
pred :: Rate -> Rate
$cpred :: Rate -> Rate
succ :: Rate -> Rate
$csucc :: Rate -> Rate
Enum,Rate
forall a. a -> a -> Bounded a
maxBound :: Rate
$cmaxBound :: Rate
minBound :: Rate
$cminBound :: Rate
Bounded,Int -> Rate -> ShowS
[Rate] -> ShowS
Rate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rate] -> ShowS
$cshowList :: [Rate] -> ShowS
show :: Rate -> String
$cshow :: Rate -> String
showsPrec :: Int -> Rate -> ShowS
$cshowsPrec :: Int -> Rate -> ShowS
Show,ReadPrec [Rate]
ReadPrec Rate
Int -> ReadS Rate
ReadS [Rate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Rate]
$creadListPrec :: ReadPrec [Rate]
readPrec :: ReadPrec Rate
$creadPrec :: ReadPrec Rate
readList :: ReadS [Rate]
$creadList :: ReadS [Rate]
readsPrec :: Int -> ReadS Rate
$creadsPrec :: Int -> ReadS Rate
Read)

{- | Standard abbreviations of Rate values.
ir = initialisation, kr = control, ar = audio, dr = demand.
dr sorts to the right of the fixed clock rates.

> Data.List.sort [dr,ar,kr,ir] == [ir,kr,ar,dr]
-}
ir, kr, ar, dr :: Rate
ir :: Rate
ir = Rate
InitialisationRate
kr :: Rate
kr = Rate
ControlRate
ar :: Rate
ar = Rate
AudioRate
dr :: Rate
dr = Rate
DemandRate

{- | Standard SuperCollider rate abbreviations.

> map rateAbbrev [minBound .. maxBound] == ["ir","kr","ar","dr"]
-}
rateAbbrev :: Rate -> String
rateAbbrev :: Rate -> String
rateAbbrev Rate
rt =
  forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"rateAbbrev?")
  (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (forall a. Enum a => a -> Int
fromEnum Rate
rt) (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] (String -> [String]
words String
"ir kr ar dr")))

{- | Standard SuperCollider rate abbreviations.

> map rateName [minBound .. maxBound] == ["scalar","control","audio","demand"]
-}
rateName :: Rate -> String
rateName :: Rate -> String
rateName Rate
rt =
  forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"rateName?")
  (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (forall a. Enum a => a -> Int
fromEnum Rate
rt) (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] (String -> [String]
words String
"scalar control audio demand")))

-- | Integer rate identifier, as required for scsynth bytecode.
rateId :: Rate -> Int
rateId :: Rate -> Int
rateId = forall a. Enum a => a -> Int
fromEnum

-- | Color identifiers for each 'Rate'.
rate_color :: Rate -> String
rate_color :: Rate -> String
rate_color Rate
r =
    case Rate
r of
      Rate
AudioRate -> String
"black"
      Rate
ControlRate -> String
"blue"
      Rate
InitialisationRate -> String
"yellow"
      Rate
DemandRate -> String
"red"

-- | Set of all 'Rate' values.
all_rates :: [Rate]
all_rates :: [Rate]
all_rates = [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound]

{- | Case insensitive parser for rate.

> Data.Maybe.mapMaybe rate_parse (words "ar kR IR Dr") == [AudioRate,ControlRate,InitialisationRate,DemandRate]
-}
rate_parse :: String -> Maybe Rate
rate_parse :: String -> Maybe Rate
rate_parse String
r =
    case forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
r of
      String
"AR" -> forall a. a -> Maybe a
Just Rate
AudioRate
      String
"KR" -> forall a. a -> Maybe a
Just Rate
ControlRate
      String
"IR" -> forall a. a -> Maybe a
Just Rate
InitialisationRate
      String
"DR" -> forall a. a -> Maybe a
Just Rate
DemandRate
      String
_ -> forall a. Maybe a
Nothing

-- * Control rates

{- | Enumeration of the four operating rates for controls.
I = initialisation, K = control, T = trigger, A = audio.
-}
data K_Type = K_InitialisationRate | K_ControlRate | K_TriggerRate | K_AudioRate
             deriving (K_Type -> K_Type -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: K_Type -> K_Type -> Bool
$c/= :: K_Type -> K_Type -> Bool
== :: K_Type -> K_Type -> Bool
$c== :: K_Type -> K_Type -> Bool
Eq,Int -> K_Type -> ShowS
[K_Type] -> ShowS
K_Type -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [K_Type] -> ShowS
$cshowList :: [K_Type] -> ShowS
show :: K_Type -> String
$cshow :: K_Type -> String
showsPrec :: Int -> K_Type -> ShowS
$cshowsPrec :: Int -> K_Type -> ShowS
Show,Eq K_Type
K_Type -> K_Type -> Bool
K_Type -> K_Type -> Ordering
K_Type -> K_Type -> K_Type
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 :: K_Type -> K_Type -> K_Type
$cmin :: K_Type -> K_Type -> K_Type
max :: K_Type -> K_Type -> K_Type
$cmax :: K_Type -> K_Type -> K_Type
>= :: K_Type -> K_Type -> Bool
$c>= :: K_Type -> K_Type -> Bool
> :: K_Type -> K_Type -> Bool
$c> :: K_Type -> K_Type -> Bool
<= :: K_Type -> K_Type -> Bool
$c<= :: K_Type -> K_Type -> Bool
< :: K_Type -> K_Type -> Bool
$c< :: K_Type -> K_Type -> Bool
compare :: K_Type -> K_Type -> Ordering
$ccompare :: K_Type -> K_Type -> Ordering
Ord)

-- | Determine class of control given 'Rate' and /trigger/ status.
ktype :: Rate -> Bool -> K_Type
ktype :: Rate -> Bool -> K_Type
ktype Rate
r Bool
tr =
    if Bool
tr
    then case Rate
r of
           Rate
ControlRate -> K_Type
K_TriggerRate
           Rate
_ -> forall a. HasCallStack => String -> a
error String
"ktype: non ControlRate trigger control"
    else case Rate
r of
           Rate
InitialisationRate -> K_Type
K_InitialisationRate
           Rate
ControlRate -> K_Type
K_ControlRate
           Rate
AudioRate -> K_Type
K_AudioRate
           Rate
DemandRate -> forall a. HasCallStack => String -> a
error String
"ktype: DemandRate control"