{- | Non-standard mathematical enumerations, classes and base instances.

Enumerations of the unary and binary math unit generators.
Names that conflict with existing names have a @_@ suffix.

The Eq and Ord classes in the Prelude require Bool, hence EqE and OrdE.
True is 1.0, False is 0.0

The RealFrac class requires Integral results, hence RealFracE.

-}
module Sound.SC3.Common.Math.Operator where

import Control.Monad {- base -}
import qualified Data.Fixed as F {- base -}
import Data.Int {- base -}
import Data.Maybe {- base -}

import qualified Sound.SC3.Common.Base as Base {- hsc3 -}
import qualified Sound.SC3.Common.Math as Math {- hsc3 -}

-- * Unary

-- | Enumeration of @SC3@ unary operator UGens.
--
-- > zip (map show [minBound :: SC3_Unary_Op .. maxBound]) [0..]
data SC3_Unary_Op
            = Neg -- -
            | Not -- !
            | IsNil
            | NotNil
            | BitNot
            | Abs -- 5
            | AsFloat
            | AsInt
            | Ceil -- 8
            | Floor -- 9
            | Frac -- 10
            | Sign
            | Squared
            | Cubed
            | Sqrt
            | Exp -- 15
            | Recip -- 16
            | MIDICPS -- 17
            | CPSMIDI
            | MIDIRatio
            | RatioMIDI -- 20
            | DbAmp
            | AmpDb
            | OctCPS
            | CPSOct
            | Log -- 25
            | Log2
            | Log10
            | Sin -- 28
            | Cos
            | Tan -- 30
            | ArcSin
            | ArcCos
            | ArcTan
            | SinH
            | CosH -- 35
            | TanH -- 36
            | Rand_ -- UGen
            | Rand2
            | LinRand_ -- UGen
            | BiLinRand -- 40
            | Sum3Rand
            | Distort -- 42
            | SoftClip
            | Coin
            | DigitValue
            | Silence
            | Thru
            | RectWindow
            | HanWindow
            | WelchWindow
            | TriWindow
            | Ramp_ -- UGen
            | SCurve
              deriving (SC3_Unary_Op -> SC3_Unary_Op -> Bool
(SC3_Unary_Op -> SC3_Unary_Op -> Bool)
-> (SC3_Unary_Op -> SC3_Unary_Op -> Bool) -> Eq SC3_Unary_Op
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SC3_Unary_Op -> SC3_Unary_Op -> Bool
$c/= :: SC3_Unary_Op -> SC3_Unary_Op -> Bool
== :: SC3_Unary_Op -> SC3_Unary_Op -> Bool
$c== :: SC3_Unary_Op -> SC3_Unary_Op -> Bool
Eq,Int -> SC3_Unary_Op -> ShowS
[SC3_Unary_Op] -> ShowS
SC3_Unary_Op -> String
(Int -> SC3_Unary_Op -> ShowS)
-> (SC3_Unary_Op -> String)
-> ([SC3_Unary_Op] -> ShowS)
-> Show SC3_Unary_Op
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SC3_Unary_Op] -> ShowS
$cshowList :: [SC3_Unary_Op] -> ShowS
show :: SC3_Unary_Op -> String
$cshow :: SC3_Unary_Op -> String
showsPrec :: Int -> SC3_Unary_Op -> ShowS
$cshowsPrec :: Int -> SC3_Unary_Op -> ShowS
Show,Int -> SC3_Unary_Op
SC3_Unary_Op -> Int
SC3_Unary_Op -> [SC3_Unary_Op]
SC3_Unary_Op -> SC3_Unary_Op
SC3_Unary_Op -> SC3_Unary_Op -> [SC3_Unary_Op]
SC3_Unary_Op -> SC3_Unary_Op -> SC3_Unary_Op -> [SC3_Unary_Op]
(SC3_Unary_Op -> SC3_Unary_Op)
-> (SC3_Unary_Op -> SC3_Unary_Op)
-> (Int -> SC3_Unary_Op)
-> (SC3_Unary_Op -> Int)
-> (SC3_Unary_Op -> [SC3_Unary_Op])
-> (SC3_Unary_Op -> SC3_Unary_Op -> [SC3_Unary_Op])
-> (SC3_Unary_Op -> SC3_Unary_Op -> [SC3_Unary_Op])
-> (SC3_Unary_Op -> SC3_Unary_Op -> SC3_Unary_Op -> [SC3_Unary_Op])
-> Enum SC3_Unary_Op
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 :: SC3_Unary_Op -> SC3_Unary_Op -> SC3_Unary_Op -> [SC3_Unary_Op]
$cenumFromThenTo :: SC3_Unary_Op -> SC3_Unary_Op -> SC3_Unary_Op -> [SC3_Unary_Op]
enumFromTo :: SC3_Unary_Op -> SC3_Unary_Op -> [SC3_Unary_Op]
$cenumFromTo :: SC3_Unary_Op -> SC3_Unary_Op -> [SC3_Unary_Op]
enumFromThen :: SC3_Unary_Op -> SC3_Unary_Op -> [SC3_Unary_Op]
$cenumFromThen :: SC3_Unary_Op -> SC3_Unary_Op -> [SC3_Unary_Op]
enumFrom :: SC3_Unary_Op -> [SC3_Unary_Op]
$cenumFrom :: SC3_Unary_Op -> [SC3_Unary_Op]
fromEnum :: SC3_Unary_Op -> Int
$cfromEnum :: SC3_Unary_Op -> Int
toEnum :: Int -> SC3_Unary_Op
$ctoEnum :: Int -> SC3_Unary_Op
pred :: SC3_Unary_Op -> SC3_Unary_Op
$cpred :: SC3_Unary_Op -> SC3_Unary_Op
succ :: SC3_Unary_Op -> SC3_Unary_Op
$csucc :: SC3_Unary_Op -> SC3_Unary_Op
Enum,SC3_Unary_Op
SC3_Unary_Op -> SC3_Unary_Op -> Bounded SC3_Unary_Op
forall a. a -> a -> Bounded a
maxBound :: SC3_Unary_Op
$cmaxBound :: SC3_Unary_Op
minBound :: SC3_Unary_Op
$cminBound :: SC3_Unary_Op
Bounded,ReadPrec [SC3_Unary_Op]
ReadPrec SC3_Unary_Op
Int -> ReadS SC3_Unary_Op
ReadS [SC3_Unary_Op]
(Int -> ReadS SC3_Unary_Op)
-> ReadS [SC3_Unary_Op]
-> ReadPrec SC3_Unary_Op
-> ReadPrec [SC3_Unary_Op]
-> Read SC3_Unary_Op
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SC3_Unary_Op]
$creadListPrec :: ReadPrec [SC3_Unary_Op]
readPrec :: ReadPrec SC3_Unary_Op
$creadPrec :: ReadPrec SC3_Unary_Op
readList :: ReadS [SC3_Unary_Op]
$creadList :: ReadS [SC3_Unary_Op]
readsPrec :: Int -> ReadS SC3_Unary_Op
$creadsPrec :: Int -> ReadS SC3_Unary_Op
Read)

-- | Type-specialised 'Base.parse_enum'.
--
-- > mapMaybe (parse_unary Base.CS) (words "Abs Rand_") == [Abs,Rand_]
parse_unary :: Base.Case_Rule -> String -> Maybe SC3_Unary_Op
parse_unary :: Case_Rule -> String -> Maybe SC3_Unary_Op
parse_unary = Case_Rule -> String -> Maybe SC3_Unary_Op
forall t.
(Show t, Enum t, Bounded t) =>
Case_Rule -> String -> Maybe t
Base.parse_enum

-- | Table of operator names (non-symbolic) and indices.
--
-- > map fst sc3_unary_op_tbl
sc3_unary_op_tbl :: [(String,Int)]
sc3_unary_op_tbl :: [(String, Int)]
sc3_unary_op_tbl = [String] -> [Int] -> [(String, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((SC3_Unary_Op -> String) -> [SC3_Unary_Op] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map SC3_Unary_Op -> String
forall a. Show a => a -> String
show [SC3_Unary_Op
Neg .. SC3_Unary_Op
SCurve]) [Int
0..]

-- | Table of symbolic names for standard unary operators.
unary_sym_tbl :: [(SC3_Unary_Op,String)]
unary_sym_tbl :: [(SC3_Unary_Op, String)]
unary_sym_tbl = [] -- (Neg,"-"),(Not,"!")

-- | Lookup possibly symbolic name for standard unary operators.
unaryName :: Int -> String
unaryName :: Int -> String
unaryName Int
n =
    let e :: SC3_Unary_Op
e = Int -> SC3_Unary_Op
forall a. Enum a => Int -> a
toEnum Int
n
    in String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (SC3_Unary_Op -> String
forall a. Show a => a -> String
show SC3_Unary_Op
e) (SC3_Unary_Op -> [(SC3_Unary_Op, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup SC3_Unary_Op
e [(SC3_Unary_Op, String)]
unary_sym_tbl)

-- | Given name of unary operator derive index.
--
-- > mapMaybe (unaryIndex Base.CI) (words "abs CUBED midicps NEG") == [5,13,17,0]
-- > unaryIndex Base.CS "SinOsc" == Nothing
unaryIndex :: Base.Case_Rule -> String -> Maybe Int
unaryIndex :: Case_Rule -> String -> Maybe Int
unaryIndex Case_Rule
cr String
nm =
    let ix :: Maybe SC3_Unary_Op
ix = Case_Rule
-> String -> [(SC3_Unary_Op, String)] -> Maybe SC3_Unary_Op
forall a. Case_Rule -> String -> [(a, String)] -> Maybe a
Base.rlookup_str Case_Rule
cr String
nm [(SC3_Unary_Op, String)]
unary_sym_tbl
        ix' :: Maybe SC3_Unary_Op
ix' = Case_Rule -> String -> Maybe SC3_Unary_Op
parse_unary Case_Rule
cr String
nm
    in (SC3_Unary_Op -> Int) -> Maybe SC3_Unary_Op -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SC3_Unary_Op -> Int
forall a. Enum a => a -> Int
fromEnum (Maybe SC3_Unary_Op -> Maybe SC3_Unary_Op -> Maybe SC3_Unary_Op
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus Maybe SC3_Unary_Op
ix' Maybe SC3_Unary_Op
ix)

-- | 'isJust' of 'unaryIndex'.
--
-- > map (is_unary CI) (words "ABS MIDICPS NEG")
-- > map (is_unary CI) (words "- RAND")
-- > map (is_unary CI) (words "arctan atan")
is_unary :: Base.Case_Rule -> String -> Bool
is_unary :: Case_Rule -> String -> Bool
is_unary Case_Rule
cr = Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Int -> Bool) -> (String -> Maybe Int) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Case_Rule -> String -> Maybe Int
unaryIndex Case_Rule
cr

-- * Binary

-- | Enumeration of @SC3@ unary operator UGens.
--
-- > zip (map show [minBound :: SC3_Binary_Op .. maxBound]) [0..]
data SC3_Binary_Op
            = Add -- 0
            | Sub -- 1
            | Mul -- 2
            | IDiv
            | FDiv -- 4
            | Mod -- 5
            | EQ_ -- 6
            | NE -- 7
            | LT_ -- 8
            | GT_ -- 9
            | LE -- 10
            | GE -- 11
            | Min -- 12
            | Max -- 13
            | BitAnd -- 14
            | BitOr -- 15
            | BitXor
            | LCM -- 17
            | GCD -- 18
            | Round -- 19
            | RoundUp -- 20
            | Trunc
            | Atan2
            | Hypot
            | Hypotx
            | Pow -- 25
            | ShiftLeft -- 26
            | ShiftRight -- 27
            | UnsignedShift
            | Fill
            | Ring1 -- 30
            | Ring2
            | Ring3
            | Ring4
            | DifSqr
            | SumSqr -- 35
            | SqrSum
            | SqrDif
            | AbsDif
            | Thresh
            | AMClip -- 40
            | ScaleNeg
            | Clip2 -- 42
            | Excess
            | Fold2
            | Wrap2
            | FirstArg
            | RandRange
            | ExpRandRange
              deriving (SC3_Binary_Op -> SC3_Binary_Op -> Bool
(SC3_Binary_Op -> SC3_Binary_Op -> Bool)
-> (SC3_Binary_Op -> SC3_Binary_Op -> Bool) -> Eq SC3_Binary_Op
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SC3_Binary_Op -> SC3_Binary_Op -> Bool
$c/= :: SC3_Binary_Op -> SC3_Binary_Op -> Bool
== :: SC3_Binary_Op -> SC3_Binary_Op -> Bool
$c== :: SC3_Binary_Op -> SC3_Binary_Op -> Bool
Eq,Int -> SC3_Binary_Op -> ShowS
[SC3_Binary_Op] -> ShowS
SC3_Binary_Op -> String
(Int -> SC3_Binary_Op -> ShowS)
-> (SC3_Binary_Op -> String)
-> ([SC3_Binary_Op] -> ShowS)
-> Show SC3_Binary_Op
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SC3_Binary_Op] -> ShowS
$cshowList :: [SC3_Binary_Op] -> ShowS
show :: SC3_Binary_Op -> String
$cshow :: SC3_Binary_Op -> String
showsPrec :: Int -> SC3_Binary_Op -> ShowS
$cshowsPrec :: Int -> SC3_Binary_Op -> ShowS
Show,Int -> SC3_Binary_Op
SC3_Binary_Op -> Int
SC3_Binary_Op -> [SC3_Binary_Op]
SC3_Binary_Op -> SC3_Binary_Op
SC3_Binary_Op -> SC3_Binary_Op -> [SC3_Binary_Op]
SC3_Binary_Op -> SC3_Binary_Op -> SC3_Binary_Op -> [SC3_Binary_Op]
(SC3_Binary_Op -> SC3_Binary_Op)
-> (SC3_Binary_Op -> SC3_Binary_Op)
-> (Int -> SC3_Binary_Op)
-> (SC3_Binary_Op -> Int)
-> (SC3_Binary_Op -> [SC3_Binary_Op])
-> (SC3_Binary_Op -> SC3_Binary_Op -> [SC3_Binary_Op])
-> (SC3_Binary_Op -> SC3_Binary_Op -> [SC3_Binary_Op])
-> (SC3_Binary_Op
    -> SC3_Binary_Op -> SC3_Binary_Op -> [SC3_Binary_Op])
-> Enum SC3_Binary_Op
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 :: SC3_Binary_Op -> SC3_Binary_Op -> SC3_Binary_Op -> [SC3_Binary_Op]
$cenumFromThenTo :: SC3_Binary_Op -> SC3_Binary_Op -> SC3_Binary_Op -> [SC3_Binary_Op]
enumFromTo :: SC3_Binary_Op -> SC3_Binary_Op -> [SC3_Binary_Op]
$cenumFromTo :: SC3_Binary_Op -> SC3_Binary_Op -> [SC3_Binary_Op]
enumFromThen :: SC3_Binary_Op -> SC3_Binary_Op -> [SC3_Binary_Op]
$cenumFromThen :: SC3_Binary_Op -> SC3_Binary_Op -> [SC3_Binary_Op]
enumFrom :: SC3_Binary_Op -> [SC3_Binary_Op]
$cenumFrom :: SC3_Binary_Op -> [SC3_Binary_Op]
fromEnum :: SC3_Binary_Op -> Int
$cfromEnum :: SC3_Binary_Op -> Int
toEnum :: Int -> SC3_Binary_Op
$ctoEnum :: Int -> SC3_Binary_Op
pred :: SC3_Binary_Op -> SC3_Binary_Op
$cpred :: SC3_Binary_Op -> SC3_Binary_Op
succ :: SC3_Binary_Op -> SC3_Binary_Op
$csucc :: SC3_Binary_Op -> SC3_Binary_Op
Enum,SC3_Binary_Op
SC3_Binary_Op -> SC3_Binary_Op -> Bounded SC3_Binary_Op
forall a. a -> a -> Bounded a
maxBound :: SC3_Binary_Op
$cmaxBound :: SC3_Binary_Op
minBound :: SC3_Binary_Op
$cminBound :: SC3_Binary_Op
Bounded,ReadPrec [SC3_Binary_Op]
ReadPrec SC3_Binary_Op
Int -> ReadS SC3_Binary_Op
ReadS [SC3_Binary_Op]
(Int -> ReadS SC3_Binary_Op)
-> ReadS [SC3_Binary_Op]
-> ReadPrec SC3_Binary_Op
-> ReadPrec [SC3_Binary_Op]
-> Read SC3_Binary_Op
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SC3_Binary_Op]
$creadListPrec :: ReadPrec [SC3_Binary_Op]
readPrec :: ReadPrec SC3_Binary_Op
$creadPrec :: ReadPrec SC3_Binary_Op
readList :: ReadS [SC3_Binary_Op]
$creadList :: ReadS [SC3_Binary_Op]
readsPrec :: Int -> ReadS SC3_Binary_Op
$creadsPrec :: Int -> ReadS SC3_Binary_Op
Read)

-- | Table of operator names (non-symbolic) and indices.
sc3_binary_op_tbl :: [(String,Int)]
sc3_binary_op_tbl :: [(String, Int)]
sc3_binary_op_tbl = [String] -> [Int] -> [(String, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((SC3_Binary_Op -> String) -> [SC3_Binary_Op] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map SC3_Binary_Op -> String
forall a. Show a => a -> String
show [SC3_Binary_Op
Add .. SC3_Binary_Op
ExpRandRange]) [Int
0..]

-- | Type-specialised 'parse_enum'.
parse_binary :: Base.Case_Rule -> String -> Maybe SC3_Binary_Op
parse_binary :: Case_Rule -> String -> Maybe SC3_Binary_Op
parse_binary = Case_Rule -> String -> Maybe SC3_Binary_Op
forall t.
(Show t, Enum t, Bounded t) =>
Case_Rule -> String -> Maybe t
Base.parse_enum

-- | Table of symbolic names for standard binary operators.
binary_sym_tbl :: [(SC3_Binary_Op,String)]
binary_sym_tbl :: [(SC3_Binary_Op, String)]
binary_sym_tbl =
    [(SC3_Binary_Op
Add,String
"+")
    ,(SC3_Binary_Op
Sub,String
"-")
    ,(SC3_Binary_Op
Mul,String
"*")
    ,(SC3_Binary_Op
FDiv,String
"/")
    ,(SC3_Binary_Op
Mod,String
"%")
    ,(SC3_Binary_Op
EQ_,String
"==")
    ,(SC3_Binary_Op
NE,String
"/=") -- or !=
    ,(SC3_Binary_Op
LT_,String
"<")
    ,(SC3_Binary_Op
GT_,String
">")
    ,(SC3_Binary_Op
LE,String
"<=")
    ,(SC3_Binary_Op
GE,String
">=")
    ,(SC3_Binary_Op
BitAnd,String
".&.") -- or &
    ,(SC3_Binary_Op
BitOr,String
".|.") -- or |
    ,(SC3_Binary_Op
Pow,String
"**")]

-- | Table of operator names (non-symbolic) and indices.
--
-- > map fst sc3_binary_op_sym_tbl
sc3_binary_op_sym_tbl :: [(String,Int)]
sc3_binary_op_sym_tbl :: [(String, Int)]
sc3_binary_op_sym_tbl =
  let f :: SC3_Binary_Op -> String
f SC3_Binary_Op
x = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (SC3_Binary_Op -> String
forall a. Show a => a -> String
show SC3_Binary_Op
x) (SC3_Binary_Op -> [(SC3_Binary_Op, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup SC3_Binary_Op
x [(SC3_Binary_Op, String)]
binary_sym_tbl)
  in [String] -> [Int] -> [(String, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((SC3_Binary_Op -> String) -> [SC3_Binary_Op] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map SC3_Binary_Op -> String
f [SC3_Binary_Op
Add .. SC3_Binary_Op
ExpRandRange]) [Int
0..]

-- | Lookup possibly symbolic name for standard binary operators.
--
-- > map binaryName [1,2,8,12] == ["-","*","<","Min"]
binaryName :: Int -> String
binaryName :: Int -> String
binaryName Int
n =
    let e :: SC3_Binary_Op
e = Int -> SC3_Binary_Op
forall a. Enum a => Int -> a
toEnum Int
n
    in String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (SC3_Binary_Op -> String
forall a. Show a => a -> String
show SC3_Binary_Op
e) (SC3_Binary_Op -> [(SC3_Binary_Op, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup SC3_Binary_Op
e [(SC3_Binary_Op, String)]
binary_sym_tbl)

-- | Given name of binary operator derive index.
--
-- > mapMaybe (binaryIndex Base.CI) (words "* MUL RING1 +") == [2,2,30,0]
-- > binaryIndex Base.CI "SINOSC" == Nothing
-- > map (\x -> (x,binaryIndex Base.CI x)) (map snd binary_sym_tbl)
binaryIndex :: Base.Case_Rule -> String -> Maybe Int
binaryIndex :: Case_Rule -> String -> Maybe Int
binaryIndex Case_Rule
cr String
nm =
    let ix :: Maybe SC3_Binary_Op
ix = Case_Rule
-> String -> [(SC3_Binary_Op, String)] -> Maybe SC3_Binary_Op
forall a. Case_Rule -> String -> [(a, String)] -> Maybe a
Base.rlookup_str Case_Rule
cr String
nm [(SC3_Binary_Op, String)]
binary_sym_tbl
        ix' :: Maybe SC3_Binary_Op
ix' = Case_Rule -> String -> Maybe SC3_Binary_Op
parse_binary Case_Rule
cr String
nm
    in (SC3_Binary_Op -> Int) -> Maybe SC3_Binary_Op -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SC3_Binary_Op -> Int
forall a. Enum a => a -> Int
fromEnum (Maybe SC3_Binary_Op -> Maybe SC3_Binary_Op -> Maybe SC3_Binary_Op
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus Maybe SC3_Binary_Op
ix' Maybe SC3_Binary_Op
ix)

-- | 'isJust' of 'binaryIndex'.
--
-- > map (is_binary CI) (words "== > % TRUNC MAX")
is_binary :: Base.Case_Rule -> String -> Bool
is_binary :: Case_Rule -> String -> Bool
is_binary Case_Rule
cr = Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Int -> Bool) -> (String -> Maybe Int) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Case_Rule -> String -> Maybe Int
binaryIndex Case_Rule
cr

-- * Operator

-- | Lookup operator name for operator UGens, else UGen name.
ugen_operator_name :: String -> Int -> Maybe String
ugen_operator_name :: String -> Int -> Maybe String
ugen_operator_name String
nm Int
n =
    case String
nm of
      String
"UnaryOpUGen" -> String -> Maybe String
forall a. a -> Maybe a
Just (Int -> String
unaryName Int
n)
      String
"BinaryOpUGen" -> String -> Maybe String
forall a. a -> Maybe a
Just (Int -> String
binaryName Int
n)
      String
_ -> Maybe String
forall a. Maybe a
Nothing

-- | Order of lookup: binary then unary.
--
-- > map (resolve_operator Sound.SC3.Common.Base.CI) (words "+ - ADD SUB NEG")
resolve_operator :: Base.Case_Rule -> String -> (String,Maybe Int)
resolve_operator :: Case_Rule -> String -> (String, Maybe Int)
resolve_operator Case_Rule
cr String
nm =
    case Case_Rule -> String -> Maybe Int
binaryIndex Case_Rule
cr String
nm of
      Just Int
sp -> (String
"BinaryOpUGen",Int -> Maybe Int
forall a. a -> Maybe a
Just Int
sp)
      Maybe Int
Nothing -> case Case_Rule -> String -> Maybe Int
unaryIndex Case_Rule
cr String
nm of
                   Just Int
sp -> (String
"UnaryOpUGen",Int -> Maybe Int
forall a. a -> Maybe a
Just Int
sp)
                   Maybe Int
_ -> (String
nm,Maybe Int
forall a. Maybe a
Nothing)

-- * Classes

-- | Variant on 'Eq' class, result is of the same type as the values compared.
class (Eq a,Num a) => EqE a where
  equal_to :: a -> a -> a
  equal_to = a -> a -> a
forall n. (Num n, Eq n) => n -> n -> n
Math.sc3_eq
  not_equal_to :: a -> a -> a
  not_equal_to = a -> a -> a
forall n. (Num n, Eq n) => n -> n -> n
Math.sc3_neq

instance EqE Int where
instance EqE Integer where
instance EqE Int32 where
instance EqE Int64 where
instance EqE Float where
instance EqE Double where

-- | Variant on Ord class, result is of the same type as the values compared.
class (Ord a,Num a) => OrdE a where
    less_than :: a -> a -> a
    less_than = a -> a -> a
forall n. (Num n, Ord n) => n -> n -> n
Math.sc3_lt
    less_than_or_equal_to :: a -> a -> a
    less_than_or_equal_to = a -> a -> a
forall n. (Num n, Ord n) => n -> n -> n
Math.sc3_lte
    greater_than :: a -> a -> a
    greater_than = a -> a -> a
forall n. (Num n, Ord n) => n -> n -> n
Math.sc3_gt
    greater_than_or_equal_to :: a -> a -> a
    greater_than_or_equal_to = a -> a -> a
forall n. (Num n, Ord n) => n -> n -> n
Math.sc3_gte

instance OrdE Int
instance OrdE Integer
instance OrdE Int32
instance OrdE Int64
instance OrdE Float
instance OrdE Double

-- | Variant of 'RealFrac' with non 'Integral' results.
class RealFrac a => RealFracE a where
  properFractionE :: a -> (a,a)
  properFractionE = a -> (a, a)
forall t. RealFrac t => t -> (t, t)
Math.sc3_properFraction
  truncateE :: a -> a
  truncateE = a -> a
forall a. RealFrac a => a -> a
Math.sc3_truncate
  roundE :: a -> a
  roundE = a -> a
forall a. RealFrac a => a -> a
Math.sc3_round
  ceilingE :: a -> a
  ceilingE = a -> a
forall a. RealFrac a => a -> a
Math.sc3_ceiling
  floorE :: a -> a
  floorE = a -> a
forall a. RealFrac a => a -> a
Math.sc3_floor

instance RealFracE Float
instance RealFracE Double

-- | Unary operator class.
--
-- > map (floor . (* 1e4) . dbAmp) [-90,-60,-30,0] == [0,10,316,10000]
class (Floating a, Ord a) => UnaryOp a where
    ampDb :: a -> a
    ampDb = a -> a
forall a. Floating a => a -> a
Math.amp_to_db
    asFloat :: a -> a
    asFloat = String -> a -> a
forall a. HasCallStack => String -> a
error String
"asFloat"
    asInt :: a -> a
    asInt = String -> a -> a
forall a. HasCallStack => String -> a
error String
"asInt"
    cpsMIDI :: a -> a
    cpsMIDI = a -> a
forall a. Floating a => a -> a
Math.cps_to_midi
    cpsOct :: a -> a
    cpsOct = a -> a
forall a. Floating a => a -> a
Math.cps_to_oct
    cubed :: a -> a
    cubed a
n = a
n a -> a -> a
forall a. Num a => a -> a -> a
* a
n a -> a -> a
forall a. Num a => a -> a -> a
* a
n
    dbAmp :: a -> a
    dbAmp = a -> a
forall a. Floating a => a -> a
Math.db_to_amp
    distort :: a -> a
    distort = a -> a
forall n. Fractional n => n -> n
Math.sc3_distort
    frac :: a -> a
    frac = String -> a -> a
forall a. HasCallStack => String -> a
error String
"frac"
    isNil :: a -> a
    isNil a
a = if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0.0 then a
0.0 else a
1.0
    log10 :: a -> a
    log10 = a -> a -> a
forall a. Floating a => a -> a -> a
logBase a
10
    log2 :: a -> a
    log2 = a -> a -> a
forall a. Floating a => a -> a -> a
logBase a
2
    midiCPS :: a -> a
    midiCPS = a -> a
forall a. Floating a => a -> a
Math.midi_to_cps
    midiRatio :: a -> a
    midiRatio = a -> a
forall a. Floating a => a -> a
Math.midi_to_ratio
    notE :: a -> a
    notE a
a = if a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0.0 then a
0.0 else a
1.0
    notNil :: a -> a
    notNil a
a = if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0.0 then a
0.0 else a
1.0
    octCPS :: a -> a
    octCPS = a -> a
forall a. Floating a => a -> a
Math.oct_to_cps
    ramp_ :: a -> a
    ramp_ a
_ = String -> a
forall a. HasCallStack => String -> a
error String
"ramp_"
    ratioMIDI :: a -> a
    ratioMIDI = a -> a
forall a. Floating a => a -> a
Math.ratio_to_midi
    softClip :: a -> a
    softClip = a -> a
forall n. (Ord n, Fractional n) => n -> n
Math.sc3_softclip
    squared :: a -> a
    squared = \a
z -> a
z a -> a -> a
forall a. Num a => a -> a -> a
* a
z

instance UnaryOp Float where
instance UnaryOp Double where

-- | SC3_Binary_Op operator class.
class (Floating a,RealFrac a, Ord a) => BinaryOp a where
    absDif :: a -> a -> a
    absDif a
a a
b = a -> a
forall a. Num a => a -> a
abs (a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
b)
    amClip :: a -> a -> a
    amClip a
a a
b = if a
b a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0 then a
0 else a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
b
    atan2E :: a -> a -> a
    atan2E a
a a
b = a -> a
forall a. Floating a => a -> a
atan (a
ba -> a -> a
forall a. Fractional a => a -> a -> a
/a
a)
    clip2 :: a -> a -> a
    clip2 a
a a
b = a -> a -> a -> a
forall a. Ord a => a -> a -> a -> a
Math.sc3_clip a
a (-a
b) a
b
    difSqr :: a -> a -> a
    difSqr = a -> a -> a
forall a. Num a => a -> a -> a
Math.sc3_dif_sqr
    excess :: a -> a -> a
    excess a
a a
b = a
a a -> a -> a
forall a. Num a => a -> a -> a
- a -> a -> a -> a
forall a. Ord a => a -> a -> a -> a
Math.sc3_clip a
a (-a
b) a
b
    exprandRange :: a -> a -> a
    exprandRange = String -> a -> a -> a
forall a. HasCallStack => String -> a
error String
"exprandRange"
    fill :: a -> a -> a
    fill = String -> a -> a -> a
forall a. HasCallStack => String -> a
error String
"fill"
    firstArg :: a -> a -> a
    firstArg a
a a
_ = a
a
    fold2 :: a -> a -> a
    fold2 a
a a
b = a -> a -> a -> a
forall a. (Ord a, Num a) => a -> a -> a -> a
Math.sc3_fold a
a (-a
b) a
b
    gcdE :: a -> a -> a
    gcdE = a -> a -> a
forall t. t -> t -> t
Math.sc3_gcd
    hypot :: a -> a -> a
    hypot = a -> a -> a
forall a. Floating a => a -> a -> a
Math.sc3_hypot
    hypotx :: a -> a -> a
    hypotx = a -> a -> a
forall a. (Ord a, Floating a) => a -> a -> a
Math.sc3_hypotx
    iDiv :: a -> a -> a
    iDiv = a -> a -> a
forall n. RealFrac n => n -> n -> n
Math.sc3_idiv
    lcmE :: a -> a -> a
    lcmE = a -> a -> a
forall t. t -> t -> t
Math.sc3_lcm
    modE :: a -> a -> a
    modE = a -> a -> a
forall n. RealFrac n => n -> n -> n
Math.sc3_mod
    randRange :: a -> a -> a
    randRange = String -> a -> a -> a
forall a. HasCallStack => String -> a
error String
"randRange"
    ring1 :: a -> a -> a
    ring1 a
a a
b = a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
b a -> a -> a
forall a. Num a => a -> a -> a
+ a
a
    ring2 :: a -> a -> a
    ring2 a
a a
b = a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
b a -> a -> a
forall a. Num a => a -> a -> a
+ a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
b
    ring3 :: a -> a -> a
    ring3 a
a a
b = a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
b
    ring4 :: a -> a -> a
    ring4 a
a a
b = a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
b a -> a -> a
forall a. Num a => a -> a -> a
- a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
b a -> a -> a
forall a. Num a => a -> a -> a
* a
b
    roundUp :: a -> a -> a
    roundUp = String -> a -> a -> a
forall a. HasCallStack => String -> a
error String
"roundUp"
    scaleNeg :: a -> a -> a
    scaleNeg a
a a
b = (a -> a
forall a. Num a => a -> a
abs a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
a) a -> a -> a
forall a. Num a => a -> a -> a
* a
b' a -> a -> a
forall a. Num a => a -> a -> a
+ a
a where b' :: a
b' = a
0.5 a -> a -> a
forall a. Num a => a -> a -> a
* a
b a -> a -> a
forall a. Num a => a -> a -> a
+ a
0.5
    sqrDif :: a -> a -> a
    sqrDif a
a a
b = (a
aa -> a -> a
forall a. Num a => a -> a -> a
-a
b) a -> a -> a
forall a. Num a => a -> a -> a
* (a
aa -> a -> a
forall a. Num a => a -> a -> a
-a
b)
    sqrSum :: a -> a -> a
    sqrSum a
a a
b = (a
aa -> a -> a
forall a. Num a => a -> a -> a
+a
b) a -> a -> a
forall a. Num a => a -> a -> a
* (a
aa -> a -> a
forall a. Num a => a -> a -> a
+a
b)
    sumSqr :: a -> a -> a
    sumSqr a
a a
b = (a
aa -> a -> a
forall a. Num a => a -> a -> a
*a
a) a -> a -> a
forall a. Num a => a -> a -> a
+ (a
ba -> a -> a
forall a. Num a => a -> a -> a
*a
b)
    thresh :: a -> a -> a
    thresh a
a a
b = if a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  a
b then a
0 else a
a
    trunc :: a -> a -> a
    trunc = String -> a -> a -> a
forall a. HasCallStack => String -> a
error String
"trunc"
    wrap2 :: a -> a -> a
    wrap2 = String -> a -> a -> a
forall a. HasCallStack => String -> a
error String
"wrap2"

instance BinaryOp Float where
    fold2 :: Float -> Float -> Float
fold2 Float
a Float
b = Float -> Float -> Float -> Float
forall a. (Ord a, Num a) => a -> a -> a -> a
Math.sc3_fold Float
a (-Float
b) Float
b
    modE :: Float -> Float -> Float
modE = Float -> Float -> Float
forall a. Real a => a -> a -> a
F.mod'
    roundUp :: Float -> Float -> Float
roundUp Float
a Float
b = if Float
b Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0 then Float
a else Float -> Float
forall a. RealFracE a => a -> a
ceilingE (Float
aFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
0.5) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
b
    wrap2 :: Float -> Float -> Float
wrap2 Float
a Float
b = Float -> Float -> Float -> Float
forall a. RealFrac a => a -> a -> a -> a
Math.sc3_wrap_ni (-Float
b) Float
b Float
a

instance BinaryOp Double where
    fold2 :: Double -> Double -> Double
fold2 Double
a Double
b = Double -> Double -> Double -> Double
forall a. (Ord a, Num a) => a -> a -> a -> a
Math.sc3_fold Double
a (-Double
b) Double
b
    modE :: Double -> Double -> Double
modE = Double -> Double -> Double
forall a. Real a => a -> a -> a
F.mod'
    roundUp :: Double -> Double -> Double
roundUp Double
a Double
b = if Double
b Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0 then Double
a else Double -> Double
forall a. RealFracE a => a -> a
ceilingE (Double
aDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.5) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
b
    wrap2 :: Double -> Double -> Double
wrap2 Double
a Double
b = Double -> Double -> Double -> Double
forall a. RealFrac a => a -> a -> a -> a
Math.sc3_wrap_ni (-Double
b) Double
b Double
a

-- * Infix

(==**) :: EqE a => a -> a -> a
==** :: a -> a -> a
(==**) = a -> a -> a
forall a. EqE a => a -> a -> a
equal_to

(/=**) :: EqE a => a -> a -> a
/=** :: a -> a -> a
(/=**) = a -> a -> a
forall a. EqE a => a -> a -> a
not_equal_to

(<**) :: OrdE a => a -> a -> a
<** :: a -> a -> a
(<**) = a -> a -> a
forall a. OrdE a => a -> a -> a
less_than

(<=**) :: OrdE a => a -> a -> a
<=** :: a -> a -> a
(<=**) = a -> a -> a
forall a. OrdE a => a -> a -> a
less_than_or_equal_to

(>**) :: OrdE a => a -> a -> a
>** :: a -> a -> a
(>**) = a -> a -> a
forall a. OrdE a => a -> a -> a
greater_than

(>=**) :: OrdE a => a -> a -> a
>=** :: a -> a -> a
(>=**) = a -> a -> a
forall a. OrdE a => a -> a -> a
greater_than_or_equal_to

-- * Tables

-- | Association table for 'SC3_Binary_Op' to haskell function implementing operator.
binop_hs_tbl :: (Real n,Floating n,RealFrac n) => [(SC3_Binary_Op,n -> n -> n)]
binop_hs_tbl :: [(SC3_Binary_Op, n -> n -> n)]
binop_hs_tbl =
    [(SC3_Binary_Op
Add,n -> n -> n
forall a. Num a => a -> a -> a
(+))
    ,(SC3_Binary_Op
Sub,(-))
    ,(SC3_Binary_Op
FDiv,n -> n -> n
forall a. Fractional a => a -> a -> a
(/))
    ,(SC3_Binary_Op
IDiv,n -> n -> n
forall n. RealFrac n => n -> n -> n
Math.sc3_idiv)
    ,(SC3_Binary_Op
Mod,n -> n -> n
forall n. RealFrac n => n -> n -> n
Math.sc3_mod)
    ,(SC3_Binary_Op
EQ_,n -> n -> n
forall n. (Num n, Eq n) => n -> n -> n
Math.sc3_eq)
    ,(SC3_Binary_Op
NE,n -> n -> n
forall n. (Num n, Eq n) => n -> n -> n
Math.sc3_neq)
    ,(SC3_Binary_Op
LT_,n -> n -> n
forall n. (Num n, Ord n) => n -> n -> n
Math.sc3_lt)
    ,(SC3_Binary_Op
LE,n -> n -> n
forall n. (Num n, Ord n) => n -> n -> n
Math.sc3_lte)
    ,(SC3_Binary_Op
GT_,n -> n -> n
forall n. (Num n, Ord n) => n -> n -> n
Math.sc3_gt)
    ,(SC3_Binary_Op
GE,n -> n -> n
forall n. (Num n, Ord n) => n -> n -> n
Math.sc3_gte)
    ,(SC3_Binary_Op
Min,n -> n -> n
forall a. Ord a => a -> a -> a
min)
    ,(SC3_Binary_Op
Max,n -> n -> n
forall a. Ord a => a -> a -> a
max)
    ,(SC3_Binary_Op
Mul,n -> n -> n
forall a. Num a => a -> a -> a
(*))
    ,(SC3_Binary_Op
Pow,n -> n -> n
forall a. Floating a => a -> a -> a
(**))
    ,(SC3_Binary_Op
Min,n -> n -> n
forall a. Ord a => a -> a -> a
min)
    ,(SC3_Binary_Op
Max,n -> n -> n
forall a. Ord a => a -> a -> a
max)
    ,(SC3_Binary_Op
Round,n -> n -> n
forall n. RealFrac n => n -> n -> n
Math.sc3_round_to)]

-- | 'lookup' 'binop_hs_tbl' via 'toEnum'.
binop_special_hs :: (RealFrac n,Floating n) => Int -> Maybe (n -> n -> n)
binop_special_hs :: Int -> Maybe (n -> n -> n)
binop_special_hs Int
z = SC3_Binary_Op
-> [(SC3_Binary_Op, n -> n -> n)] -> Maybe (n -> n -> n)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Int -> SC3_Binary_Op
forall a. Enum a => Int -> a
toEnum Int
z) [(SC3_Binary_Op, n -> n -> n)]
forall n.
(Real n, Floating n, RealFrac n) =>
[(SC3_Binary_Op, n -> n -> n)]
binop_hs_tbl

-- | Association table for 'Unary' to haskell function implementing operator.
uop_hs_tbl :: (RealFrac n,Floating n) => [(SC3_Unary_Op,n -> n)]
uop_hs_tbl :: [(SC3_Unary_Op, n -> n)]
uop_hs_tbl =
    [(SC3_Unary_Op
Neg,n -> n
forall a. Num a => a -> a
negate)
    ,(SC3_Unary_Op
Not,\n
z -> if n
z n -> n -> Bool
forall a. Ord a => a -> a -> Bool
> n
0 then n
0 else n
1)
    ,(SC3_Unary_Op
Abs,n -> n
forall a. Num a => a -> a
abs)
    ,(SC3_Unary_Op
Ceil,n -> n
forall a. RealFrac a => a -> a
Math.sc3_ceiling)
    ,(SC3_Unary_Op
Floor,n -> n
forall a. RealFrac a => a -> a
Math.sc3_floor)
    ,(SC3_Unary_Op
Squared,\n
z -> n
z n -> n -> n
forall a. Num a => a -> a -> a
* n
z)
    ,(SC3_Unary_Op
Cubed,\n
z -> n
z n -> n -> n
forall a. Num a => a -> a -> a
* n
z n -> n -> n
forall a. Num a => a -> a -> a
* n
z)
    ,(SC3_Unary_Op
Sqrt,n -> n
forall a. Floating a => a -> a
sqrt)
    ,(SC3_Unary_Op
Recip,n -> n
forall n. Fractional n => n -> n
recip)
    ,(SC3_Unary_Op
MIDICPS,n -> n
forall a. Floating a => a -> a
Math.midi_to_cps)
    ,(SC3_Unary_Op
CPSMIDI,n -> n
forall a. Floating a => a -> a
Math.cps_to_midi)
    ,(SC3_Unary_Op
Sin,n -> n
forall a. Floating a => a -> a
sin)
    ,(SC3_Unary_Op
Cos,n -> n
forall a. Floating a => a -> a
cos)
    ,(SC3_Unary_Op
Tan,n -> n
forall a. Floating a => a -> a
tan)]

-- | 'lookup' 'uop_hs_tbl' via 'toEnum'.
uop_special_hs :: (RealFrac n,Floating n) => Int -> Maybe (n -> n)
uop_special_hs :: Int -> Maybe (n -> n)
uop_special_hs Int
z = SC3_Unary_Op -> [(SC3_Unary_Op, n -> n)] -> Maybe (n -> n)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Int -> SC3_Unary_Op
forall a. Enum a => Int -> a
toEnum Int
z) [(SC3_Unary_Op, n -> n)]
forall n. (RealFrac n, Floating n) => [(SC3_Unary_Op, n -> n)]
uop_hs_tbl