Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
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.
Synopsis
- data SC3_Unary_Op
- = Neg
- | Not
- | IsNil
- | NotNil
- | BitNot
- | Abs
- | AsFloat
- | AsInt
- | Ceil
- | Floor
- | Frac
- | Sign
- | Squared
- | Cubed
- | Sqrt
- | Exp
- | Recip
- | MIDICPS
- | CPSMIDI
- | MIDIRatio
- | RatioMIDI
- | DbAmp
- | AmpDb
- | OctCPS
- | CPSOct
- | Log
- | Log2
- | Log10
- | Sin
- | Cos
- | Tan
- | ArcSin
- | ArcCos
- | ArcTan
- | SinH
- | CosH
- | TanH
- | Rand_
- | Rand2
- | LinRand_
- | BiLinRand
- | Sum3Rand
- | Distort
- | SoftClip
- | Coin
- | DigitValue
- | Silence
- | Thru
- | RectWindow
- | HanWindow
- | WelchWindow
- | TriWindow
- | Ramp_
- | SCurve
- parse_unary :: Case_Rule -> String -> Maybe SC3_Unary_Op
- sc3_unary_op_tbl :: [(String, Int)]
- unary_sym_tbl :: [(SC3_Unary_Op, String)]
- unaryName :: Int -> String
- unaryIndex :: Case_Rule -> String -> Maybe Int
- is_unary :: Case_Rule -> String -> Bool
- data SC3_Binary_Op
- = Add
- | Sub
- | Mul
- | IDiv
- | FDiv
- | Mod
- | EQ_
- | NE
- | LT_
- | GT_
- | LE
- | GE
- | Min
- | Max
- | BitAnd
- | BitOr
- | BitXor
- | LCM
- | GCD
- | Round
- | RoundUp
- | Trunc
- | Atan2
- | Hypot
- | Hypotx
- | Pow
- | ShiftLeft
- | ShiftRight
- | UnsignedShift
- | Fill
- | Ring1
- | Ring2
- | Ring3
- | Ring4
- | DifSqr
- | SumSqr
- | SqrSum
- | SqrDif
- | AbsDif
- | Thresh
- | AMClip
- | ScaleNeg
- | Clip2
- | Excess
- | Fold2
- | Wrap2
- | FirstArg
- | RandRange
- | ExpRandRange
- sc3_binary_op_tbl :: [(String, Int)]
- parse_binary :: Case_Rule -> String -> Maybe SC3_Binary_Op
- binary_sym_tbl :: [(SC3_Binary_Op, String)]
- sc3_binary_op_sym_tbl :: [(String, Int)]
- binaryName :: Int -> String
- binaryIndex :: Case_Rule -> String -> Maybe Int
- is_binary :: Case_Rule -> String -> Bool
- ugen_operator_name :: String -> Int -> Maybe String
- resolve_operator :: Case_Rule -> String -> (String, Maybe Int)
- class (Eq a, Num a) => EqE a where
- equal_to :: a -> a -> a
- not_equal_to :: a -> a -> a
- class (Ord a, Num a) => OrdE a where
- less_than :: a -> a -> a
- less_than_or_equal_to :: a -> a -> a
- greater_than :: a -> a -> a
- greater_than_or_equal_to :: a -> a -> a
- class RealFrac a => RealFracE a where
- properFractionE :: a -> (a, a)
- truncateE :: a -> a
- roundE :: a -> a
- ceilingE :: a -> a
- floorE :: a -> a
- class (Floating a, Ord a) => UnaryOp a where
- ampDb :: a -> a
- asFloat :: a -> a
- asInt :: a -> a
- cpsMIDI :: a -> a
- cpsOct :: a -> a
- cubed :: a -> a
- dbAmp :: a -> a
- distort :: a -> a
- frac :: a -> a
- isNil :: a -> a
- log10 :: a -> a
- log2 :: a -> a
- midiCPS :: a -> a
- midiRatio :: a -> a
- notE :: a -> a
- notNil :: a -> a
- octCPS :: a -> a
- ramp_ :: a -> a
- ratioMIDI :: a -> a
- softClip :: a -> a
- squared :: a -> a
- class (Floating a, RealFrac a, Ord a) => BinaryOp a where
- absDif :: a -> a -> a
- amClip :: a -> a -> a
- atan2E :: a -> a -> a
- clip2 :: a -> a -> a
- difSqr :: a -> a -> a
- excess :: a -> a -> a
- exprandRange :: a -> a -> a
- fill :: a -> a -> a
- firstArg :: a -> a -> a
- fold2 :: a -> a -> a
- gcdE :: a -> a -> a
- hypot :: a -> a -> a
- hypotx :: a -> a -> a
- iDiv :: a -> a -> a
- lcmE :: a -> a -> a
- modE :: a -> a -> a
- randRange :: a -> a -> a
- ring1 :: a -> a -> a
- ring2 :: a -> a -> a
- ring3 :: a -> a -> a
- ring4 :: a -> a -> a
- roundUp :: a -> a -> a
- scaleNeg :: a -> a -> a
- sqrDif :: a -> a -> a
- sqrSum :: a -> a -> a
- sumSqr :: a -> a -> a
- thresh :: a -> a -> a
- trunc :: a -> a -> a
- wrap2 :: a -> a -> a
- (==**) :: EqE a => a -> a -> a
- (/=**) :: EqE a => a -> a -> a
- (<**) :: OrdE a => a -> a -> a
- (<=**) :: OrdE a => a -> a -> a
- (>**) :: OrdE a => a -> a -> a
- (>=**) :: OrdE a => a -> a -> a
- binop_hs_tbl :: (Real n, Floating n, RealFrac n) => [(SC3_Binary_Op, n -> n -> n)]
- binop_special_hs :: (RealFrac n, Floating n) => Int -> Maybe (n -> n -> n)
- uop_hs_tbl :: (RealFrac n, Floating n) => [(SC3_Unary_Op, n -> n)]
- uop_special_hs :: (RealFrac n, Floating n) => Int -> Maybe (n -> n)
Unary
data SC3_Unary_Op Source #
Enumeration of SC3
unary operator UGens.
zip (map show [minBound :: SC3_Unary_Op .. maxBound]) [0..]
Instances
parse_unary :: Case_Rule -> String -> Maybe SC3_Unary_Op Source #
Type-specialised parse_enum
.
mapMaybe (parse_unary Base.CS) (words "Abs Rand_") == [Abs,Rand_]
sc3_unary_op_tbl :: [(String, Int)] Source #
Table of operator names (non-symbolic) and indices.
map fst sc3_unary_op_tbl
unary_sym_tbl :: [(SC3_Unary_Op, String)] Source #
Table of symbolic names for standard unary operators.
unaryIndex :: Case_Rule -> String -> Maybe Int Source #
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
is_unary :: Case_Rule -> String -> Bool Source #
isJust
of unaryIndex
.
map (is_unary CI) (words "ABS MIDICPS NEG") map (is_unary CI) (words "- RAND") map (is_unary CI) (words "arctan atan")
Binary
data SC3_Binary_Op Source #
Enumeration of SC3
unary operator UGens.
zip (map show [minBound :: SC3_Binary_Op .. maxBound]) [0..]
Instances
sc3_binary_op_tbl :: [(String, Int)] Source #
Table of operator names (non-symbolic) and indices.
parse_binary :: Case_Rule -> String -> Maybe SC3_Binary_Op Source #
Type-specialised parse_enum
.
binary_sym_tbl :: [(SC3_Binary_Op, String)] Source #
Table of symbolic names for standard binary operators.
sc3_binary_op_sym_tbl :: [(String, Int)] Source #
Table of operator names (non-symbolic) and indices.
map fst sc3_binary_op_sym_tbl
binaryName :: Int -> String Source #
Lookup possibly symbolic name for standard binary operators.
map binaryName [1,2,8,12] == ["-","*","<","Min"]
binaryIndex :: Case_Rule -> String -> Maybe Int Source #
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)
is_binary :: Case_Rule -> String -> Bool Source #
isJust
of binaryIndex
.
map (is_binary CI) (words "== > % TRUNC MAX")
Operator
ugen_operator_name :: String -> Int -> Maybe String Source #
Lookup operator name for operator UGens, else UGen name.
resolve_operator :: Case_Rule -> String -> (String, Maybe Int) Source #
Order of lookup: binary then unary.
map (resolve_operator Sound.SC3.Common.Base.CI) (words "+ - ADD SUB NEG")
Classes
class (Eq a, Num a) => EqE a where Source #
Variant on Eq
class, result is of the same type as the values compared.
Nothing
class (Ord a, Num a) => OrdE a where Source #
Variant on Ord class, result is of the same type as the values compared.
Nothing
less_than :: a -> a -> a Source #
less_than_or_equal_to :: a -> a -> a Source #
greater_than :: a -> a -> a Source #
greater_than_or_equal_to :: a -> a -> a Source #
class RealFrac a => RealFracE a where Source #
Nothing
properFractionE :: a -> (a, a) Source #
class (Floating a, Ord a) => UnaryOp a where Source #
Unary operator class.
map (floor . (* 1e4) . dbAmp) [-90,-60,-30,0] == [0,10,316,10000]
Nothing
Instances
class (Floating a, RealFrac a, Ord a) => BinaryOp a where Source #
SC3_Binary_Op operator class.
Nothing
absDif :: a -> a -> a Source #
amClip :: a -> a -> a Source #
atan2E :: a -> a -> a Source #
difSqr :: a -> a -> a Source #
excess :: a -> a -> a Source #
exprandRange :: a -> a -> a Source #
firstArg :: a -> a -> a Source #
hypotx :: a -> a -> a Source #
randRange :: a -> a -> a Source #
roundUp :: a -> a -> a Source #
scaleNeg :: a -> a -> a Source #
sqrDif :: a -> a -> a Source #
sqrSum :: a -> a -> a Source #
sumSqr :: a -> a -> a Source #
Instances
Infix
Tables
binop_hs_tbl :: (Real n, Floating n, RealFrac n) => [(SC3_Binary_Op, n -> n -> n)] Source #
Association table for SC3_Binary_Op
to haskell function implementing operator.
binop_special_hs :: (RealFrac n, Floating n) => Int -> Maybe (n -> n -> n) Source #
lookup
binop_hs_tbl
via toEnum
.
uop_hs_tbl :: (RealFrac n, Floating n) => [(SC3_Unary_Op, n -> n)] Source #
Association table for Unary
to haskell function implementing operator.
uop_special_hs :: (RealFrac n, Floating n) => Int -> Maybe (n -> n) Source #
lookup
uop_hs_tbl
via toEnum
.