-- Copyright 2013 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

-- | Native Instruments' Kontakt sampler.
--
-- Unfortunately the instruments here have to be hardcoded unless I want to
-- figure out how to parse .nki files or something.
module User.Elaforge.Instrument.Kontakt where
import qualified Data.Map as Map
import qualified Data.Tuple as Tuple

import qualified Cmd.Cmd as Cmd
import qualified Cmd.Instrument.CUtil as CUtil
import qualified Cmd.Instrument.MidiInst as MidiInst
import qualified Cmd.PhysicalKey as PhysicalKey

import qualified Derive.Attrs as Attrs
import qualified Derive.C.Prelude.Articulation as Articulation
import qualified Derive.C.Prelude.Highlight as Highlight
import qualified Derive.Call as Call
import qualified Derive.Call.GraceUtil as GraceUtil
import qualified Derive.Call.Make as Make
import qualified Derive.Call.Module as Module
import qualified Derive.Controls as Controls
import qualified Derive.Derive as Derive
import qualified Derive.EnvKey as EnvKey
import qualified Derive.Expr as Expr
import qualified Derive.Instrument.DUtil as DUtil
import qualified Derive.Scale.BaliScales as BaliScales
import qualified Derive.Scale.Selisir as Selisir
import qualified Derive.Scale.Twelve as Twelve
import qualified Derive.ScoreT as ScoreT
import qualified Derive.ShowVal as ShowVal

import qualified Instrument.InstT as InstT
import qualified Midi.CC as CC
import qualified Midi.Key as Key
import qualified Midi.Key2 as Key2
import qualified Midi.Midi as Midi

import qualified Perform.Midi.Control as Control
import qualified Perform.Midi.Patch as Patch
import qualified Perform.NN as NN

import qualified User.Elaforge.Instrument.Kontakt.Gong as Gong
import qualified User.Elaforge.Instrument.Kontakt.KendangBali as KendangBali
import qualified User.Elaforge.Instrument.Kontakt.KendangSunda as KendangSunda
import qualified User.Elaforge.Instrument.Kontakt.Mridangam as Mridangam
import qualified User.Elaforge.Instrument.Kontakt.Pakhawaj as Pakhawaj
import qualified User.Elaforge.Instrument.Kontakt.Reyong as Reyong
import qualified User.Elaforge.Instrument.Kontakt.ScGamelan as ScGamelan
import qualified User.Elaforge.Instrument.Kontakt.Wayang as Wayang
import qualified User.Elaforge.Instrument.Reaktor as Reaktor

import           Global


synth :: MidiInst.Synth
synth :: Synth
synth = Name -> Name -> [Patch] -> Synth
MidiInst.synth Name
synth_name Name
"Native Instrument Kontakt" [Patch]
patches

synth_name :: InstT.SynthName
synth_name :: Name
synth_name = Name
"kontakt"

patches :: [MidiInst.Patch]
patches :: [Patch]
patches =
    PbRange -> [(Control, Control)] -> Patch
MidiInst.default_patch PbRange
pb_range [] forall a. a -> [a] -> [a]
: forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [Patch]
mine_patches
    , [Patch]
misc_patches
    , [Patch]
hang_patches
    , [Patch]
dio8_patches
    , [Patch]
KendangBali.patches, [Patch]
KendangSunda.patches
    , [Patch]
Mridangam.patches, [Patch]
Pakhawaj.patches, [Patch]
Reyong.patches, [Patch]
Gong.patches
    , [Patch]
ScGamelan.patches
    , [Patch]
Wayang.patches
    ]

patch :: InstT.Name -> [(Midi.Control, ScoreT.Control)] -> MidiInst.Patch
patch :: Name -> [(Control, Control)] -> Patch
patch = PbRange -> Name -> [(Control, Control)] -> Patch
MidiInst.named_patch PbRange
pb_range

-- One pitch bend modulator can only do +-12, but if you put two on you get
-- +-24.
pb_range :: Patch.PbRange
pb_range :: PbRange
pb_range = (-Int
24, Int
24)

-- * mine

mine_patches :: [MidiInst.Patch]
mine_patches :: [Patch]
mine_patches =
    [ Patch -> Patch
MidiInst.make_patch forall a b. (a -> b) -> a -> b
$ Flag -> Patch -> Patch
MidiInst.add_flag Flag
Patch.ResumePlay forall a b. (a -> b) -> a -> b
$
        PbRange -> Name -> Patch
Patch.patch PbRange
pb_range Name
"tambura"
    , Patch -> Patch
set_scale forall a b. (a -> b) -> a -> b
$ Patch -> Patch
MidiInst.make_patch forall a b. (a -> b) -> a -> b
$ PbRange -> Name -> Patch
Patch.patch PbRange
pb_range Name
"bali-guitar"
    ]
    where
    set_scale :: Patch -> Patch
set_scale =
        (Patch :-> Patch
MidiInst.patchforall a b c. Lens a b -> Lens b c -> Lens a c
#Patch :-> Settings
Patch.defaultsforall a b c. Lens a b -> Lens b c -> Lens a c
#Settings :-> Maybe Scale
Patch.scale forall f a. Lens f a -> a -> f -> f
#= forall a. a -> Maybe a
Just Scale
instrument_scale)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToVal a => Name -> a -> Patch -> Patch
MidiInst.environ Name
EnvKey.tuning Tuning
tuning
    tuning :: Tuning
tuning = Tuning
BaliScales.Umbang
    instrument_scale :: Scale
instrument_scale =
        ([(Key, NoteNumber)] -> [(Key, NoteNumber)])
-> Laras -> Tuning -> Scale
Selisir.instrument_scale (forall a. Int -> [a] -> [a]
take Int
10 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
5) Laras
Selisir.laras_rambat Tuning
tuning

-- * misc

misc_patches :: [MidiInst.Patch]
misc_patches :: [Patch]
misc_patches = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [[Patch]
library, [Patch]
mcgill, [Patch]
balalaika, [Patch]
anthology_wind, [Patch]
sonic_couture, [Patch]
misc]

library :: [MidiInst.Patch]
library :: [Patch]
library =
    [ Name -> [(Control, Control)] -> Patch
patch Name
"choir" [(Control
1, Control
"vowel")]
    ]

-- | From the McGill sample library.
mcgill :: [MidiInst.Patch]
mcgill :: [Patch]
mcgill =
    [ Name -> Patch
pressure Name
"viol", Name -> Patch
pressure Name
"shawm", Name -> Patch
pressure Name
"crumhorn"
    , Name -> Patch
plucked Name
"lute"
    ]
    where
    plucked :: Name -> Patch
plucked Name
name = Name -> [(Control, Control)] -> Patch
patch Name
name []
    pressure :: Name -> Patch
pressure Name
name = Patch -> Patch
MidiInst.pressure forall a b. (a -> b) -> a -> b
$
        Name -> [(Control, Control)] -> Patch
patch Name
name [(Control
CC.cc14, Control
Controls.lpf), (Control
CC.cc15, Control
Controls.q)]

-- | Ilya Efimov Bailalaika Prima
-- I changed it to support (-24, 24) pb range.
balalaika :: [MidiInst.Patch]
balalaika :: [Patch]
balalaika =
    [ Lens Patch Code
MidiInst.code forall f a. Lens f a -> a -> f -> f
#= Code
code forall a b. (a -> b) -> a -> b
$
        Lens Patch AttributeMap
MidiInst.attribute_map forall f a. Lens f a -> a -> f -> f
#= [(Attributes, Key)] -> AttributeMap
Patch.single_keyswitches [(Attributes, Key)]
ks forall a b. (a -> b) -> a -> b
$
        Patch -> Patch
MidiInst.make_patch forall a b. (a -> b) -> a -> b
$
        Flag -> Patch -> Patch
MidiInst.add_flag Flag
Patch.HoldKeyswitch forall a b. (a -> b) -> a -> b
$
        Patch :-> ControlMap
Patch.control_map forall f a. Lens f a -> a -> f -> f
#= [(Control, Control)] -> ControlMap
Control.control_map [(Control, Control)]
controls forall a b. (a -> b) -> a -> b
$
        PbRange -> Name -> Patch
Patch.patch PbRange
pb_range Name
"balalaika"
    ]
    where
    code :: Code
code = [(Symbol, Generator Note)] -> Code
MidiInst.note_generators
        [(Symbol
"(", (Attributes -> Attributes -> Generator Note
Articulation.c_attr_slur forall a. Monoid a => a
mempty Attributes
Attrs.legato))]
    -- g6 strum, a6 solo, b6 harmony
    controls :: [(Control, Control)]
controls =
        [ (Control
1, Control
"trem-dyn")
        , (Control
2, Control
"trem-speed")
        ]
    ks :: [(Attributes, Key)]
ks =
        [ (Name -> Attributes
Attrs.attr Name
"str2", Key
Key.ds4)
        , (Attributes
Attrs.gliss, Key
Key.c4)
        , (Attributes
Attrs.legato, Key
Key.as3)
        , (Attributes
Attrs.vib, Key
Key.d4)
        , (Attributes
Attrs.harm, Key
Key.gs3)
        , (Attributes
Attrs.staccato, Key
Key.cs4)
        -- These are just pressed, not held, but hold_keyswitch is
        -- per-patch, not per-keyswitch.
        , (Attributes
Attrs.trem, Key
Key.a3)
        , (forall a. Monoid a => a
mempty, Key
Key.b3)
        ]

-- | Bela D Anthology Spiritual Wind
-- Change volume to cc 2.
-- Change b3 and c3 to be normal keyswitches instead of toggles.
anthology_wind :: [MidiInst.Patch]
anthology_wind :: [Patch]
anthology_wind =
    [ Patch -> Patch
MidiInst.pressure forall a b. (a -> b) -> a -> b
$
        Lens Patch AttributeMap
MidiInst.attribute_map forall f a. Lens f a -> a -> f -> f
#= [(Attributes, Key)] -> AttributeMap
Patch.single_keyswitches [(Attributes, Key)]
dizi_ks forall a b. (a -> b) -> a -> b
$
        Name -> [(Control, Control)] -> Patch
patch Name
"dizi" [(Control
CC.mod, Control
Controls.vib)]
    ]
    where
    -- blow and overblow as keyswitches instead of on/off
    dizi_ks :: [(Attributes, Key)]
dizi_ks =
        [ (forall a. Monoid a => a
mempty, Key
Key2.c2)
        , (Attributes
ornament forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.v1, Key
Key2.cs2)
        , (Attributes
Attrs.staccato, Key
Key2.d2)
        , (Attributes
ornament forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.v2, Key
Key2.ds2)
        , (Attributes
Attrs.staccato forall a. Semigroup a => a -> a -> a
<> Attributes
blow, Key
Key.e2) -- unpitched attack
        , (Attributes
ornament forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.v3, Key
Key2.fs2)
        , (Attributes
ornament forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.v4, Key
Key2.gs2)
        , (Attributes
ornament forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.long forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.v1, Key
Key2.as2)
        , (Attributes
blow, Key
Key2.b3) -- sustain with sharp attack
        , (Attributes
Attrs.accent, Key
Key2.c3) -- like 'blow', but softer attack
        , (Attributes
ornament forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.long forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.v2, Key
Key2.cs3)
        ]
    -- f2 slide 1 up / down
    -- g2 slide 2 up / down
    -- a2 slide 2 down
    ornament :: Attributes
ornament = Name -> Attributes
Attrs.attr Name
"o"
    blow :: Attributes
blow = Name -> Attributes
Attrs.attr Name
"blow"

-- * sonic couture

sonic_couture :: [MidiInst.Patch]
sonic_couture :: [Patch]
sonic_couture =
    [ Name -> [(Control, Control)] -> Patch
patch Name
"ebow"
        [(Control
1, Control
"harm"), (Control
21, Control
Controls.lpf), (Control
22, Control
Controls.q), (Control
23, Control
Controls.hpf)]
    , Patch
guzheng
    , Patch -> Patch
MidiInst.pressure forall a b. (a -> b) -> a -> b
$ (NoteNumber, NoteNumber) -> Patch -> Patch
MidiInst.nn_range (NoteNumber
NN.cs4, NoteNumber
NN.fs6) forall a b. (a -> b) -> a -> b
$
        Name -> [(Control, Control)] -> Patch
patch Name
"sheng" [(Control
1, Control
Controls.breath)]
    -- It's actually [NN.a4, NN.b4, NN.cs5, NN.d5, NN.e5, NN.fs5, NN.g5,
    -- NN.gs5, NN.a5, NN.b5, NN.c6, NN.cs6, NN.d6, NN.e6, NN.fs6], but I don't
    -- have the ability to set discontinuous pitches yet.
    , Patch -> Patch
MidiInst.pressure forall a b. (a -> b) -> a -> b
$ (NoteNumber, NoteNumber) -> Patch -> Patch
MidiInst.nn_range (NoteNumber
NN.a4, NoteNumber
NN.fs6) forall a b. (a -> b) -> a -> b
$
        Name -> [(Control, Control)] -> Patch
patch Name
"sho" [(Control
1, Control
Controls.breath)]
    -- Discontinuous range: [NN.g3, NN.a3, NN.as3, NN.c4, NN.d4, NN.ds4,
    -- NN.f4, NN.g4, NN.a4, NN.as4, NN.c5, NN.d5, NN.ds5, NN.f5, NN.g5]
    , (NoteNumber, NoteNumber) -> Patch -> Patch
MidiInst.nn_range (NoteNumber
NN.g3, NoteNumber
NN.g5) forall a b. (a -> b) -> a -> b
$ Name -> [(Control, Control)] -> Patch
patch Name
"khaen" []
    ]

guzheng :: MidiInst.Patch
guzheng :: Patch
guzheng = Lens Patch Code
MidiInst.code forall f a. Lens f a -> a -> f -> f
#= Code
code forall a b. (a -> b) -> a -> b
$ (NoteNumber, NoteNumber) -> Patch -> Patch
MidiInst.nn_range (NoteNumber, NoteNumber)
range forall a b. (a -> b) -> a -> b
$
    Lens Patch (Maybe RealTime)
MidiInst.decay forall f a. Lens f a -> a -> f -> f
#= forall a. a -> Maybe a
Just RealTime
5 forall a b. (a -> b) -> a -> b
$
    Lens Patch AttributeMap
MidiInst.attribute_map forall f a. Lens f a -> a -> f -> f
#= [(Attributes, Key)] -> AttributeMap
Patch.single_keyswitches [(Attributes, Key)]
ks forall a b. (a -> b) -> a -> b
$
    Name -> [(Control, Control)] -> Patch
patch Name
"guzheng" [(Control
23, Control
Controls.lpf), (Control
24, Control
Controls.q), (Control
27, Control
Controls.hpf)]
    where
    ks :: [(Attributes, Key)]
ks =
        [ (Attributes
Attrs.harm, Key
Key2.as5)
        , (Attributes
Attrs.left, Key
Key2.b5) -- left hand, no pick
        , (forall a. Monoid a => a
mempty, Key
Key2.c6) -- right hand, picked
        ]
    code :: Code
code = [Call Note] -> Code
MidiInst.note_calls
        [ forall d. Symbol -> Calls d -> Call d
MidiInst.both Symbol
"左" (Module -> Attributes -> Calls Note
Make.attributed_note Module
Module.instrument Attributes
Attrs.left)
        , forall d. Symbol -> Transformer d -> Call d
MidiInst.transformer Symbol
"standard-strings" Transformer Note
standard_strings
        ]
        forall a. Semigroup a => a -> a -> a
<> Generator Note -> Code
MidiInst.null_call Generator Note
Highlight.c_highlight_strings_note
    -- This can't go in the automatic env because it uses DeriveT.Pitch, which
    -- is not serializable, hence not in REnv.
    standard_strings :: Transformer Note
standard_strings = forall d.
Taggable d =>
CallName -> Doc -> TransformerF d -> Transformer d
DUtil.transformer0 CallName
"standard-strings"
        (Doc
"Set " forall a. Semigroup a => a -> a -> a
<> forall a. ShowVal a => a -> Doc
ShowVal.doc Name
EnvKey.open_strings
            forall a. Semigroup a => a -> a -> a
<> Doc
" to standard pitches: " forall a. Semigroup a => a -> a -> a
<> forall a. ShowVal a => a -> Doc
ShowVal.doc [NoteNumber]
open_strings)
        forall a b. (a -> b) -> a -> b
$ \PassedArgs Note
_ -> forall val a. ToVal val => Name -> val -> Deriver a -> Deriver a
Derive.with_val Name
EnvKey.open_strings
            (forall a b. (a -> b) -> [a] -> [b]
map NoteNumber -> Pitch
Twelve.nn_pitch [NoteNumber]
open_strings)
    open_strings :: [NoteNumber]
open_strings = forall a. Int -> [a] -> [a]
take (Int
4forall a. Num a => a -> a -> a
*Int
5 forall a. Num a => a -> a -> a
+ Int
1) forall a b. (a -> b) -> a -> b
$ -- 4 octaves + 1, so D to D
        forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((\[NoteNumber]
nns NoteNumber
oct -> forall a b. (a -> b) -> [a] -> [b]
map (NoteNumber
oct+) [NoteNumber]
nns) [NoteNumber]
notes) [NoteNumber]
octaves
        where
        notes :: [NoteNumber]
notes = [NoteNumber
NN.d2, NoteNumber
NN.e2, NoteNumber
NN.fs2, NoteNumber
NN.a2, NoteNumber
NN.b2]
        octaves :: [NoteNumber]
octaves = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Integer
0, Integer
12 ..]
    -- Let's say the top string can bend a minor third.
    range :: (NoteNumber, NoteNumber)
range = (forall a. [a] -> a
head [NoteNumber]
open_strings, forall a. [a] -> a
last [NoteNumber]
open_strings forall a. Num a => a -> a -> a
+ NoteNumber
3)

-- * hang

hang_patches :: [MidiInst.Patch]
hang_patches :: [Patch]
hang_patches = forall a b. (a -> b) -> [a] -> [b]
map (Lens Patch Code
MidiInst.code forall f a. Lens f a -> a -> f -> f
#= Code
hang_code)
    [ Lens Patch AttributeMap
MidiInst.attribute_map forall f a. Lens f a -> a -> f -> f
#= [(Attributes, Key)] -> AttributeMap
Patch.single_keyswitches [(Attributes, Key)]
hang_ks forall a b. (a -> b) -> a -> b
$
        Name -> [(Control, Control)] -> Patch
patch Name
"hang" []
    ]

hang_code :: MidiInst.Code
hang_code :: Code
hang_code =
    [Call Note] -> Code
MidiInst.note_calls
        [ forall d. Symbol -> Calls d -> Call d
MidiInst.both Symbol
call (Module -> Attributes -> Calls Note
Make.attributed_note Module
Module.instrument Attributes
attrs)
        | (Attributes
attrs, Key
_, Just Symbol
call, Maybe Char
_) <- [(Attributes, Key, Maybe Symbol, Maybe Char)]
hang_strokes
        -- Make sure to not shadow the default "" call.
        , Symbol
call forall a. Eq a => a -> a -> Bool
/= Symbol
""
        ]
    forall a. Semigroup a => a -> a -> a
<> HandlerId -> Code
MidiInst.cmd forall (m :: * -> *). M m => Handler m
hang_cmd

hang_cmd :: Cmd.M m => Cmd.Handler m
hang_cmd :: forall (m :: * -> *). M m => Handler m
hang_cmd = forall (m :: * -> *). M m => [(Char, Symbol, Key)] -> Handler m
CUtil.keyswitches [(Stack => Char -> Char
PhysicalKey.physical_key Char
char, Symbol
text, Key
key)
    | (Attributes
_, Key
key, Just Symbol
text, Just Char
char) <- [(Attributes, Key, Maybe Symbol, Maybe Char)]
hang_strokes]

-- | The order is important because it determines attr lookup priority.
hang_strokes :: [(Attrs.Attributes, Midi.Key, Maybe Expr.Symbol, Maybe Char)]
hang_strokes :: [(Attributes, Key, Maybe Symbol, Maybe Char)]
hang_strokes =
    [ (Attributes
Attrs.center,  Key
Key.c2,     forall a. a -> Maybe a
Just Symbol
"",   forall a. a -> Maybe a
Just Char
'Z')
    , (Attributes
Attrs.edge,    Key
Key.cs2,    forall a. a -> Maybe a
Just Symbol
"旁", forall a. a -> Maybe a
Just Char
'X')
    , (Attributes
Attrs.slap,    Key
Key.d2,     forall a. a -> Maybe a
Just Symbol
"打", forall a. a -> Maybe a
Just Char
'C')
    , (Attributes
Attrs.middle,  Key
Key.ds2,    forall a. a -> Maybe a
Just Symbol
"中", forall a. a -> Maybe a
Just Char
'V')
    , (Attributes
Attrs.knuckle, Key
Key.e2,     forall a. a -> Maybe a
Just Symbol
"指", forall a. a -> Maybe a
Just Char
'B')
    , (forall a. Monoid a => a
mempty,        Key
Key.c2,     forall a. Maybe a
Nothing,   forall a. Maybe a
Nothing)
    ]

hang_ks :: [(Attrs.Attributes, Midi.Key)]
hang_ks :: [(Attributes, Key)]
hang_ks = [(Attributes
attrs, Key
key) | (Attributes
attrs, Key
key, Maybe Symbol
_, Maybe Char
_) <- [(Attributes, Key, Maybe Symbol, Maybe Char)]
hang_strokes]

-- * 8 dio

dio8_patches :: [MidiInst.Patch]
dio8_patches :: [Patch]
dio8_patches =
    [ Patch -> Patch
pedal_down forall a b. (a -> b) -> a -> b
$
        Lens Patch AttributeMap
MidiInst.attribute_map forall f a. Lens f a -> a -> f -> f
#= AttributeMap
santur_ks forall a b. (a -> b) -> a -> b
$ Name -> [(Control, Control)] -> Patch
patch Name
"santur" []
    , Lens Patch Code
MidiInst.code forall f a. Lens f a -> a -> f -> f
#= Code
qanun_calls forall a b. (a -> b) -> a -> b
$ Patch -> Patch
pedal_down forall a b. (a -> b) -> a -> b
$
        Lens Patch AttributeMap
MidiInst.attribute_map forall f a. Lens f a -> a -> f -> f
#= AttributeMap
qanun_ks forall a b. (a -> b) -> a -> b
$ Name -> [(Control, Control)] -> Patch
patch Name
"qanun" []
    ]
    where
    santur_ks :: AttributeMap
santur_ks = Key -> [Attributes] -> AttributeMap
ks_from Key
Key2.c_1 forall a b. (a -> b) -> a -> b
$
        [ (Attributes
m forall a. Semigroup a => a -> a -> a
<> Attributes
art)
        -- wood-m is the default
        | Attributes
m <- [forall a. Monoid a => a
mempty, Name -> Attributes
Attrs.attr Name
"soft-m", Name -> Attributes
Attrs.attr Name
"softest-m"]
        -- sustain is the default
        , Attributes
art <- [forall a. Monoid a => a
mempty, Name -> Attributes
Attrs.attr Name
"half-mute", Attributes
Attrs.mute]
        ] forall a. [a] -> [a] -> [a]
++ [Name -> Attributes
Attrs.attr Name
"sfx"]
    qanun_ks :: AttributeMap
qanun_ks = Key -> [Attributes] -> AttributeMap
ks_from Key
Key2.d_2 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [forall a. Monoid a => a
mempty] -- thumb
        , forall a b. (a -> b) -> [a] -> [b]
map Name -> Attributes
Attrs.attr [Name
"fingertip", Name
"pick", Name
"pick-bridge", Name
"pizz"]
        , forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Attributes, Int)]
grace_intervals
        , [ Attributes
Attrs.trem, Name -> Attributes
Attrs.attr Name
"vib-peg", Attributes
Attrs.harm, Name -> Attributes
Attrs.attr Name
"fiske"
          , Name -> Attributes
Attrs.attr Name
"sfx"
          ]
        ]
    ks_from :: Key -> [Attributes] -> AttributeMap
ks_from Key
key [Attributes]
attrs = [(Attributes, Key)] -> AttributeMap
Patch.single_keyswitches forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Attributes]
attrs [Key
key..]
    pedal_down :: Patch -> Patch
pedal_down = [(Control, Y)] -> Patch -> Patch
MidiInst.control_defaults [(Control
Controls.pedal, Y
1)]
    qanun_calls :: Code
qanun_calls = [Call Note] -> Code
MidiInst.note_calls
        [ forall d. Symbol -> Generator d -> Call d
MidiInst.generator Symbol
"g" forall a b. (a -> b) -> a -> b
$
            forall a. Doc -> TransformerF a -> Generator a -> Generator a
Make.modify_generator_
                Doc
"Multiply %dyn by .65, since the grace samples are too loud."
                (\PassedArgs Note
_ -> forall a. Y -> Deriver a -> Deriver a
Call.multiply_dynamic Y
0.65) forall a b. (a -> b) -> a -> b
$
            Map Int Attributes -> Generator Note
GraceUtil.c_attr_grace forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$
            forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> (b, a)
Tuple.swap [(Attributes, Int)]
grace_intervals
        , forall d. Symbol -> Calls d -> Call d
MidiInst.both Symbol
"o" forall a b. (a -> b) -> a -> b
$
            forall a. Doc -> TransformerF a -> Calls a -> Calls a
Make.modify_calls_ Doc
"" (\PassedArgs Note
_ -> forall a. Control -> Y -> Deriver a -> Deriver a
Call.add_constant Control
Controls.octave (-Y
1))
                Calls Note
Articulation.c_harmonic
        ]
    grace_intervals :: [(Attributes, Int)]
grace_intervals =
        [ (Attributes
grace forall a. Semigroup a => a -> a -> a
<> Attributes
dir forall a. Semigroup a => a -> a -> a
<> Attributes
interval, Int
step forall a. Num a => a -> a -> a
* Int
sign)
        | (Attributes
interval, Int
step) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Attributes
Attrs.half, Attributes
Attrs.whole] [Int
1..]
        , (Attributes
dir, Int
sign) <- [(Attributes
Attrs.up, Int
1), (Attributes
Attrs.down, -Int
1)]
        ]
    grace :: Attributes
grace = Name -> Attributes
Attrs.attr Name
"grace"


-- * misc

misc :: [MidiInst.Patch]
misc :: [Patch]
misc = [Lens Patch Code
MidiInst.code forall f a. Lens f a -> a -> f -> f
#= Code
Reaktor.resonant_filter forall a b. (a -> b) -> a -> b
$ Name -> [(Control, Control)] -> Patch
patch Name
"filtered" []]