zwirn-0.2.2.0: src/zwirn-lang/Zwirn/Language/Builtin/Parameters.hs
{-# LANGUAGE OverloadedStrings #-}
module Zwirn.Language.Builtin.Parameters where
import qualified Data.Map as Map
import Data.Text (Text, append, uncons)
import Zwirn.Core.Cord (stack)
import Zwirn.Core.Lib.Cord (applyCord)
import Zwirn.Core.Lib.Map
import Zwirn.Language.Builtin.Internal
import Zwirn.Language.Environment
import Zwirn.Language.Evaluate (Expression, Zwirn, toExp)
builtinParams :: Map.Map Text AnnotatedExpression
builtinParams = addAliases aliases $ Map.unions [builtinTextParams, builtinNumberParams, builtinIntParams]
builtinTextParams :: Map.Map Text AnnotatedExpression
builtinTextParams = Map.unions $ map (\t -> noDesc $ t === toExp ((fmap toExp . singleton (pure t)) :: Zwirn Expression -> Zwirn Expression) <:: "Text -> Map") textParams
builtinNumberParams :: Map.Map Text AnnotatedExpression
builtinNumberParams = Map.unions $ map (\t -> noDesc $ t === toExp ((fmap toExp . singleton (pure t)) :: Zwirn Double -> Zwirn Expression) <:: "Number -> Map") numberParams
builtinIntParams :: Map.Map Text AnnotatedExpression
builtinIntParams = Map.unions $ map (\t -> noDesc $ t === toExp ((fmap toExp . singleton (pure t)) :: Zwirn Int -> Zwirn Expression) <:: "Number -> Map") intParams
textParams :: [Text]
textParams = ["s", "unit", "vowel", "toArg"]
intParams :: [Text]
intParams = ["cut", "orbit"]
numberParams :: [Text]
numberParams =
[ "accelerate",
"amp",
"attack",
"bandf",
"bandq",
"begin",
"binshift",
"ccn",
"ccv",
"channel",
"coarse",
"comb",
"crush",
"cutoff",
"decay",
"delay",
"delaytime",
"detune",
"distort",
"djf",
"dry",
"dur",
"end",
"enhance",
"expression",
"fadeInTime",
"fadeTime",
"freeze",
"freq",
"from",
"fshift",
"gain",
"gate",
"harmonic",
"hbrick",
"hcutoff",
"hold",
"hresonance",
"imag",
"krush",
"lagogo",
"lbrick",
"legato",
"leslie",
"lock",
"midibend",
"miditouch",
"modwheel",
"n",
"note",
"nudge",
"octave",
"octer",
"octersub",
"octersubsub",
"offset",
"overgain",
"overshape",
"pan",
"panorient",
"panspan",
"pansplay",
"panwidth",
"partials",
"phaserdepth",
"phaserrate",
"rate",
"real",
"release",
"resonance",
"ring",
"ringdf",
"ringf",
"room",
"sagogo",
"scram",
"shape",
"size",
"slide",
"smear",
"speed",
"squiz",
"sustain",
"sustainpedal",
"timescale",
"timescalewin",
"to",
"tremolodepth",
"tremolorate",
"triode",
"tsdelay",
"velocity",
"voice",
"waveloss",
"xsdelay"
]
aliases :: [(Text, Text)]
aliases =
[ ("sound", "s"),
("voi", "voice"),
("up", "n"),
("tremr", "tremolorate"),
("tremdp", "tremolodepth"),
("sz", "size"),
("sus", "sustain"),
("sld", "slide"),
("scr", "scrash"),
("rel", "release"),
("por", "portamento"),
("phasr", "phaserrate"),
("phasdp", "phaserdepth"),
("number", "n"),
("lpq", "resonance"),
("lpf", "cutoff"),
("hpq", "hresonance"),
("hpf", "hcutoff"),
("gat", "gate"),
("fadeOutTime", "fadeTime"),
("dt", "delaytime"),
("dfb", "delayfeedback"),
("det", "detune"),
("delayt", "delaytime"),
("delayfb", "delayfeedback"),
("ctf", "cutoff"),
("bpq", "bandq"),
("bpf", "bandf"),
("att", "attack")
]
addAliases :: [(Text, Text)] -> Map.Map Text AnnotatedExpression -> Map.Map Text AnnotatedExpression
addAliases as x = Map.unions $ map look as ++ [x]
where
look (y, n) = case Map.lookup n x of
Just a -> Map.singleton y a
Nothing -> Map.empty
----------------------------------------------------------
---------------- defining note names ---------------------
----------------------------------------------------------
noteExpressions :: Map.Map Text AnnotatedExpression
noteExpressions = Map.unions $ map (\n -> noDesc $ n === toExp ((pure $ toNote n) :: Zwirn Int) <:: "Number") notes
chordExpressions :: Map.Map Text AnnotatedExpression
chordExpressions = Map.unions $ map (\(n, cs) -> noDesc $ n === toExp ((\z -> applyCord z (stack $ map pure cs)) :: Zwirn Int -> Zwirn Int) <:: "Number -> Number") chordTable
noteNames :: [Text]
noteNames = ["c", "d", "e", "f", "g", "a", "b"]
noteMods :: [Text]
noteMods = ["", "f", "s"]
noteOctaves :: [Text]
noteOctaves = ["", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"]
notes :: [Text]
notes = [n `append` m `append` o | n <- noteNames, m <- noteMods, o <- noteOctaves]
modVal :: Char -> Int
modVal 'f' = -1
modVal 's' = 1
modVal _ = 0
nameVal :: Char -> Int
nameVal 'c' = 0
nameVal 'd' = 2
nameVal 'e' = 4
nameVal 'f' = 5
nameVal 'g' = 7
nameVal 'a' = 9
nameVal 'b' = 11
nameVal _ = 0
octVal :: Char -> Int
octVal '0' = -60
octVal '1' = -48
octVal '2' = -36
octVal '3' = -24
octVal '4' = -12
octVal '5' = 0
octVal '6' = 12
octVal '7' = 24
octVal '8' = 36
octVal '9' = 48
octVal _ = 0
toNote :: Text -> Int
toNote t = case uncons t of
Just (x, xs) -> case uncons xs of
Just (y, ys) -> case uncons ys of
Just (z, _) -> nameVal x + modVal y + octVal z
Nothing -> nameVal x + modVal y + octVal y
Nothing -> nameVal x
Nothing -> 0
-- the following is taken from https://hackage.haskell.org/package/tidal-1.9.5/docs/src/Sound.Tidal.Chords.html
chordTable :: (Num a) => [(Text, [a])]
chordTable =
[ ("major", major),
("maj", major),
("M", major),
("aug", aug),
("plus", aug),
("sharp5", aug),
("six", six),
("sixNine", sixNine),
("six9", sixNine),
("sixby9", sixNine),
("6by9", sixNine),
("major7", major7),
("maj7", major7),
("major9", major9),
("maj9", major9),
("add9", add9),
("major11", major11),
("maj11", major11),
("add11", add11),
("major13", major13),
("maj13", major13),
("add13", add13),
("dom7", dom7),
("dom9", dom9),
("dom11", dom11),
("dom13", dom13),
("sevenFlat5", sevenFlat5),
("7f5", sevenFlat5),
("sevenSharp5", sevenSharp5),
("7s5", sevenSharp5),
("sevenFlat9", sevenFlat9),
("7f9", sevenFlat9),
("nine", nine),
("eleven", eleven),
("thirteen", thirteen),
("minor", minor),
("min", minor),
("m", minor),
("diminished", diminished),
("dim", diminished),
("minorSharp5", minorSharp5),
("msharp5", minorSharp5),
("mS5", minorSharp5),
("minor6", minor6),
("min6", minor6),
("m6", minor6),
("minorSixNine", minorSixNine),
("minor69", minorSixNine),
("min69", minorSixNine),
("minSixNine", minorSixNine),
("m69", minorSixNine),
("mSixNine", minorSixNine),
("m6by9", minorSixNine),
("minor7flat5", minor7flat5),
("minor7f5", minor7flat5),
("min7flat5", minor7flat5),
("min7f5", minor7flat5),
("m7flat5", minor7flat5),
("m7f5", minor7flat5),
("minor7", minor7),
("min7", minor7),
("m7", minor7),
("minor7sharp5", minor7sharp5),
("minor7s5", minor7sharp5),
("min7sharp5", minor7sharp5),
("min7s5", minor7sharp5),
("m7sharp5", minor7sharp5),
("m7s5", minor7sharp5),
("minor7flat9", minor7flat9),
("minor7f9", minor7flat9),
("min7flat9", minor7flat9),
("min7f9", minor7flat9),
("m7flat9", minor7flat9),
("m7f9", minor7flat9),
("minor7sharp9", minor7sharp9),
("minor7s9", minor7sharp9),
("min7sharp9", minor7sharp9),
("min7s9", minor7sharp9),
("m7sharp9", minor7sharp9),
("m7s9", minor7sharp9),
("diminished7", diminished7),
("dim7", diminished7),
("minor9", minor9),
("min9", minor9),
("m9", minor9),
("minor11", minor11),
("min11", minor11),
("m11", minor11),
("minor13", minor13),
("min13", minor13),
("m13", minor13),
("minorMajor7", minorMajor7),
("minMaj7", minorMajor7),
("mmaj7", minorMajor7),
("one", one),
("five", five),
("sus2", sus2),
("sus4", sus4),
("sevenSus2", sevenSus2),
("7sus2", sevenSus2),
("sevenSus4", sevenSus4),
("7sus4", sevenSus4),
("nineSus4", nineSus4),
("ninesus4", nineSus4),
("9sus4", nineSus4),
("sevenFlat10", sevenFlat10),
("7f10", sevenFlat10),
("nineSharp5", nineSharp5),
("9sharp5", nineSharp5),
("9s5", nineSharp5),
("minor9sharp5", minor9sharp5),
("minor9s5", minor9sharp5),
("min9sharp5", minor9sharp5),
("min9s5", minor9sharp5),
("m9sharp5", minor9sharp5),
("m9s5", minor9sharp5),
("sevenSharp5flat9", sevenSharp5flat9),
("7s5f9", sevenSharp5flat9),
("minor7sharp5flat9", minor7sharp5flat9),
("m7sharp5flat9", minor7sharp5flat9),
("elevenSharp", elevenSharp),
("minor11sharp", minor11sharp),
("m11sharp", minor11sharp),
("m11s", minor11sharp)
]
where
major :: (Num a) => [a]
major = [0, 4, 7]
aug :: (Num a) => [a]
aug = [0, 4, 8]
six :: (Num a) => [a]
six = [0, 4, 7, 9]
sixNine :: (Num a) => [a]
sixNine = [0, 4, 7, 9, 14]
major7 :: (Num a) => [a]
major7 = [0, 4, 7, 11]
major9 :: (Num a) => [a]
major9 = [0, 4, 7, 11, 14]
add9 :: (Num a) => [a]
add9 = [0, 4, 7, 14]
major11 :: (Num a) => [a]
major11 = [0, 4, 7, 11, 14, 17]
add11 :: (Num a) => [a]
add11 = [0, 4, 7, 17]
major13 :: (Num a) => [a]
major13 = [0, 4, 7, 11, 14, 21]
add13 :: (Num a) => [a]
add13 = [0, 4, 7, 21]
-- \** Dominant chords
dom7 :: (Num a) => [a]
dom7 = [0, 4, 7, 10]
dom9 :: (Num a) => [a]
dom9 = [0, 4, 7, 14]
dom11 :: (Num a) => [a]
dom11 = [0, 4, 7, 17]
dom13 :: (Num a) => [a]
dom13 = [0, 4, 7, 21]
sevenFlat5 :: (Num a) => [a]
sevenFlat5 = [0, 4, 6, 10]
sevenSharp5 :: (Num a) => [a]
sevenSharp5 = [0, 4, 8, 10]
sevenFlat9 :: (Num a) => [a]
sevenFlat9 = [0, 4, 7, 10, 13]
nine :: (Num a) => [a]
nine = [0, 4, 7, 10, 14]
eleven :: (Num a) => [a]
eleven = [0, 4, 7, 10, 14, 17]
thirteen :: (Num a) => [a]
thirteen = [0, 4, 7, 10, 14, 17, 21]
-- \** Minor chords
minor :: (Num a) => [a]
minor = [0, 3, 7]
diminished :: (Num a) => [a]
diminished = [0, 3, 6]
minorSharp5 :: (Num a) => [a]
minorSharp5 = [0, 3, 8]
minor6 :: (Num a) => [a]
minor6 = [0, 3, 7, 9]
minorSixNine :: (Num a) => [a]
minorSixNine = [0, 3, 9, 7, 14]
minor7flat5 :: (Num a) => [a]
minor7flat5 = [0, 3, 6, 10]
minor7 :: (Num a) => [a]
minor7 = [0, 3, 7, 10]
minor7sharp5 :: (Num a) => [a]
minor7sharp5 = [0, 3, 8, 10]
minor7flat9 :: (Num a) => [a]
minor7flat9 = [0, 3, 7, 10, 13]
minor7sharp9 :: (Num a) => [a]
minor7sharp9 = [0, 3, 7, 10, 15]
diminished7 :: (Num a) => [a]
diminished7 = [0, 3, 6, 9]
minor9 :: (Num a) => [a]
minor9 = [0, 3, 7, 10, 14]
minor11 :: (Num a) => [a]
minor11 = [0, 3, 7, 10, 14, 17]
minor13 :: (Num a) => [a]
minor13 = [0, 3, 7, 10, 14, 17, 21]
minorMajor7 :: (Num a) => [a]
minorMajor7 = [0, 3, 7, 11]
-- \** Other chords
one :: (Num a) => [a]
one = [0]
five :: (Num a) => [a]
five = [0, 7]
sus2 :: (Num a) => [a]
sus2 = [0, 2, 7]
sus4 :: (Num a) => [a]
sus4 = [0, 5, 7]
sevenSus2 :: (Num a) => [a]
sevenSus2 = [0, 2, 7, 10]
sevenSus4 :: (Num a) => [a]
sevenSus4 = [0, 5, 7, 10]
nineSus4 :: (Num a) => [a]
nineSus4 = [0, 5, 7, 10, 14]
-- \** Questionable chords
sevenFlat10 :: (Num a) => [a]
sevenFlat10 = [0, 4, 7, 10, 15]
nineSharp5 :: (Num a) => [a]
nineSharp5 = [0, 1, 13]
minor9sharp5 :: (Num a) => [a]
minor9sharp5 = [0, 1, 14]
sevenSharp5flat9 :: (Num a) => [a]
sevenSharp5flat9 = [0, 4, 8, 10, 13]
minor7sharp5flat9 :: (Num a) => [a]
minor7sharp5flat9 = [0, 3, 8, 10, 13]
elevenSharp :: (Num a) => [a]
elevenSharp = [0, 4, 7, 10, 14, 18]
minor11sharp :: (Num a) => [a]
minor11sharp = [0, 3, 7, 10, 14, 18]