-- 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 [] Patch -> [Patch] -> [Patch]
forall a. a -> [a] -> [a]
: [[Patch]] -> [Patch]
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 (Patch -> Patch) -> Patch -> Patch
forall a b. (a -> b) -> a -> b
$ Flag -> Patch -> Patch
MidiInst.add_flag Flag
Patch.ResumePlay (Patch -> Patch) -> Patch -> Patch
forall a b. (a -> b) -> a -> b
$
        PbRange -> Name -> Patch
Patch.patch PbRange
pb_range Name
"tambura"
    , Patch -> Patch
set_scale (Patch -> Patch) -> Patch -> Patch
forall a b. (a -> b) -> a -> b
$ Patch -> Patch
MidiInst.make_patch (Patch -> Patch) -> Patch -> 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.patch(Patch :-> Patch)
-> Lens Patch (Maybe Scale) -> Lens Patch (Maybe Scale)
forall a b c. Lens a b -> Lens b c -> Lens a c
#Patch :-> Settings
Patch.defaults(Patch :-> Settings)
-> Lens Settings (Maybe Scale) -> Lens Patch (Maybe Scale)
forall a b c. Lens a b -> Lens b c -> Lens a c
#Lens Settings (Maybe Scale)
Patch.scale Lens Patch (Maybe Scale) -> Maybe Scale -> Patch -> Patch
forall f a. Lens f a -> a -> f -> f
#= Scale -> Maybe Scale
forall a. a -> Maybe a
Just Scale
instrument_scale)
        (Patch -> Patch) -> (Patch -> Patch) -> Patch -> Patch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScaleId -> Patch -> Patch
MidiInst.default_scale ScaleId
Selisir.scale_id
        (Patch -> Patch) -> (Patch -> Patch) -> Patch -> Patch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Tuning -> Patch -> Patch
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 (Int -> [(Key, NoteNumber)] -> [(Key, NoteNumber)]
forall a. Int -> [a] -> [a]
take Int
10 ([(Key, NoteNumber)] -> [(Key, NoteNumber)])
-> ([(Key, NoteNumber)] -> [(Key, NoteNumber)])
-> [(Key, NoteNumber)]
-> [(Key, NoteNumber)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(Key, NoteNumber)] -> [(Key, NoteNumber)]
forall a. Int -> [a] -> [a]
drop Int
5) Laras
Selisir.laras_rambat Tuning
tuning

-- * misc

misc_patches :: [MidiInst.Patch]
misc_patches :: [Patch]
misc_patches = [[Patch]] -> [Patch]
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 (Patch -> Patch) -> Patch -> Patch
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 Lens Patch Code -> Code -> Patch -> Patch
forall f a. Lens f a -> a -> f -> f
#= Code
code (Patch -> Patch) -> Patch -> Patch
forall a b. (a -> b) -> a -> b
$
        Lens Patch AttributeMap
MidiInst.attribute_map Lens Patch AttributeMap -> AttributeMap -> Patch -> Patch
forall f a. Lens f a -> a -> f -> f
#= [(Attributes, Key)] -> AttributeMap
Patch.single_keyswitches [(Attributes, Key)]
ks (Patch -> Patch) -> Patch -> Patch
forall a b. (a -> b) -> a -> b
$
        Patch -> Patch
MidiInst.make_patch (Patch -> Patch) -> Patch -> Patch
forall a b. (a -> b) -> a -> b
$
        Flag -> Patch -> Patch
MidiInst.add_flag Flag
Patch.HoldKeyswitch (Patch -> Patch) -> Patch -> Patch
forall a b. (a -> b) -> a -> b
$
        Patch :-> ControlMap
Patch.control_map (Patch :-> ControlMap) -> ControlMap -> Patch -> Patch
forall f a. Lens f a -> a -> f -> f
#= [(Control, Control)] -> ControlMap
Control.control_map [(Control, Control)]
controls (Patch -> Patch) -> Patch -> Patch
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 Attributes
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)
        , (Attributes
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 (Patch -> Patch) -> Patch -> Patch
forall a b. (a -> b) -> a -> b
$
        Lens Patch AttributeMap
MidiInst.attribute_map Lens Patch AttributeMap -> AttributeMap -> Patch -> Patch
forall f a. Lens f a -> a -> f -> f
#= [(Attributes, Key)] -> AttributeMap
Patch.single_keyswitches [(Attributes, Key)]
dizi_ks (Patch -> Patch) -> Patch -> Patch
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 =
        [ (Attributes
forall a. Monoid a => a
mempty, Key
Key2.c2)
        , (Attributes
ornament Attributes -> Attributes -> Attributes
forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.v1, Key
Key2.cs2)
        , (Attributes
Attrs.staccato, Key
Key2.d2)
        , (Attributes
ornament Attributes -> Attributes -> Attributes
forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.v2, Key
Key2.ds2)
        , (Attributes
Attrs.staccato Attributes -> Attributes -> Attributes
forall a. Semigroup a => a -> a -> a
<> Attributes
blow, Key
Key.e2) -- unpitched attack
        , (Attributes
ornament Attributes -> Attributes -> Attributes
forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.v3, Key
Key2.fs2)
        , (Attributes
ornament Attributes -> Attributes -> Attributes
forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.v4, Key
Key2.gs2)
        , (Attributes
ornament Attributes -> Attributes -> Attributes
forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.long Attributes -> Attributes -> Attributes
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 Attributes -> Attributes -> Attributes
forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.long Attributes -> Attributes -> Attributes
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 (Patch -> Patch) -> Patch -> Patch
forall a b. (a -> b) -> a -> b
$ (NoteNumber, NoteNumber) -> Patch -> Patch
MidiInst.nn_range (NoteNumber
NN.cs4, NoteNumber
NN.fs6) (Patch -> Patch) -> Patch -> Patch
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 (Patch -> Patch) -> Patch -> Patch
forall a b. (a -> b) -> a -> b
$ (NoteNumber, NoteNumber) -> Patch -> Patch
MidiInst.nn_range (NoteNumber
NN.a4, NoteNumber
NN.fs6) (Patch -> Patch) -> Patch -> Patch
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) (Patch -> Patch) -> Patch -> Patch
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 Lens Patch Code -> Code -> Patch -> Patch
forall f a. Lens f a -> a -> f -> f
#= Code
code (Patch -> Patch) -> Patch -> Patch
forall a b. (a -> b) -> a -> b
$ (NoteNumber, NoteNumber) -> Patch -> Patch
MidiInst.nn_range (NoteNumber, NoteNumber)
range (Patch -> Patch) -> Patch -> Patch
forall a b. (a -> b) -> a -> b
$
    Lens Patch (Maybe RealTime)
MidiInst.decay Lens Patch (Maybe RealTime) -> Maybe RealTime -> Patch -> Patch
forall f a. Lens f a -> a -> f -> f
#= RealTime -> Maybe RealTime
forall a. a -> Maybe a
Just RealTime
5 (Patch -> Patch) -> Patch -> Patch
forall a b. (a -> b) -> a -> b
$
    Lens Patch AttributeMap
MidiInst.attribute_map Lens Patch AttributeMap -> AttributeMap -> Patch -> Patch
forall f a. Lens f a -> a -> f -> f
#= [(Attributes, Key)] -> AttributeMap
Patch.single_keyswitches [(Attributes, Key)]
ks (Patch -> Patch) -> Patch -> Patch
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
        , (Attributes
forall a. Monoid a => a
mempty, Key
Key2.c6) -- right hand, picked
        ]
    code :: Code
code = [Call Note] -> Code
MidiInst.note_calls
        [ Symbol -> Calls Note -> Call Note
forall d. Symbol -> Calls d -> Call d
MidiInst.both Symbol
"左" (Module -> Attributes -> Calls Note
Make.attributed_note Module
Module.instrument Attributes
Attrs.left)
        , Symbol -> Transformer Note -> Call Note
forall d. Symbol -> Transformer d -> Call d
MidiInst.transformer Symbol
"standard-strings" Transformer Note
standard_strings
        ]
        Code -> Code -> Code
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 = CallName -> Doc -> TransformerF Note -> Transformer Note
forall d.
Taggable d =>
CallName -> Doc -> TransformerF d -> Transformer d
DUtil.transformer0 CallName
"standard-strings"
        (Doc
"Set " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Name -> Doc
forall a. ShowVal a => a -> Doc
ShowVal.doc Name
EnvKey.open_strings
            Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
" to standard pitches: " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [NoteNumber] -> Doc
forall a. ShowVal a => a -> Doc
ShowVal.doc [NoteNumber]
open_strings)
        (TransformerF Note -> Transformer Note)
-> TransformerF Note -> Transformer Note
forall a b. (a -> b) -> a -> b
$ \PassedArgs Note
_ -> Name -> [Pitch] -> Deriver (Stream Note) -> Deriver (Stream Note)
forall val a. ToVal val => Name -> val -> Deriver a -> Deriver a
Derive.with_val Name
EnvKey.open_strings
            ((NoteNumber -> Pitch) -> [NoteNumber] -> [Pitch]
forall a b. (a -> b) -> [a] -> [b]
map NoteNumber -> Pitch
Twelve.nn_pitch [NoteNumber]
open_strings)
    open_strings :: [NoteNumber]
open_strings = Int -> [NoteNumber] -> [NoteNumber]
forall a. Int -> [a] -> [a]
take (Int
4Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ([NoteNumber] -> [NoteNumber]) -> [NoteNumber] -> [NoteNumber]
forall a b. (a -> b) -> a -> b
$ -- 4 octaves + 1, so D to D
        (NoteNumber -> [NoteNumber]) -> [NoteNumber] -> [NoteNumber]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((\[NoteNumber]
nns NoteNumber
oct -> (NoteNumber -> NoteNumber) -> [NoteNumber] -> [NoteNumber]
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 = (Integer -> NoteNumber) -> [Integer] -> [NoteNumber]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> NoteNumber
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 = ([NoteNumber] -> NoteNumber
forall a. [a] -> a
head [NoteNumber]
open_strings, [NoteNumber] -> NoteNumber
forall a. [a] -> a
last [NoteNumber]
open_strings NoteNumber -> NoteNumber -> NoteNumber
forall a. Num a => a -> a -> a
+ NoteNumber
3)

-- * hang

hang_patches :: [MidiInst.Patch]
hang_patches :: [Patch]
hang_patches = (Patch -> Patch) -> [Patch] -> [Patch]
forall a b. (a -> b) -> [a] -> [b]
map (Lens Patch Code
MidiInst.code Lens Patch Code -> Code -> Patch -> Patch
forall f a. Lens f a -> a -> f -> f
#= Code
hang_code)
    [ Lens Patch AttributeMap
MidiInst.attribute_map Lens Patch AttributeMap -> AttributeMap -> Patch -> Patch
forall f a. Lens f a -> a -> f -> f
#= [(Attributes, Key)] -> AttributeMap
Patch.single_keyswitches [(Attributes, Key)]
hang_ks (Patch -> Patch) -> Patch -> Patch
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
        [ Symbol -> Calls Note -> Call Note
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 Symbol -> Symbol -> Bool
forall a. Eq a => a -> a -> Bool
/= Symbol
""
        ]
    Code -> Code -> Code
forall a. Semigroup a => a -> a -> a
<> HandlerId -> Code
MidiInst.cmd HandlerId
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 = [(Char, Symbol, Key)] -> Handler m
forall (m :: * -> *). M m => [(Char, Symbol, Key)] -> Handler m
CUtil.keyswitches [(Stack => Char -> Char
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,     Symbol -> Maybe Symbol
forall a. a -> Maybe a
Just Symbol
"",   Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'Z')
    , (Attributes
Attrs.edge,    Key
Key.cs2,    Symbol -> Maybe Symbol
forall a. a -> Maybe a
Just Symbol
"旁", Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'X')
    , (Attributes
Attrs.slap,    Key
Key.d2,     Symbol -> Maybe Symbol
forall a. a -> Maybe a
Just Symbol
"打", Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'C')
    , (Attributes
Attrs.middle,  Key
Key.ds2,    Symbol -> Maybe Symbol
forall a. a -> Maybe a
Just Symbol
"中", Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'V')
    , (Attributes
Attrs.knuckle, Key
Key.e2,     Symbol -> Maybe Symbol
forall a. a -> Maybe a
Just Symbol
"指", Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'B')
    , (Attributes
forall a. Monoid a => a
mempty,        Key
Key.c2,     Maybe Symbol
forall a. Maybe a
Nothing,   Maybe Char
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 (Patch -> Patch) -> Patch -> Patch
forall a b. (a -> b) -> a -> b
$
        Lens Patch AttributeMap
MidiInst.attribute_map Lens Patch AttributeMap -> AttributeMap -> Patch -> Patch
forall f a. Lens f a -> a -> f -> f
#= AttributeMap
santur_ks (Patch -> Patch) -> Patch -> Patch
forall a b. (a -> b) -> a -> b
$ Name -> [(Control, Control)] -> Patch
patch Name
"santur" []
    , Lens Patch Code
MidiInst.code Lens Patch Code -> Code -> Patch -> Patch
forall f a. Lens f a -> a -> f -> f
#= Code
qanun_calls (Patch -> Patch) -> Patch -> Patch
forall a b. (a -> b) -> a -> b
$ Patch -> Patch
pedal_down (Patch -> Patch) -> Patch -> Patch
forall a b. (a -> b) -> a -> b
$
        Lens Patch AttributeMap
MidiInst.attribute_map Lens Patch AttributeMap -> AttributeMap -> Patch -> Patch
forall f a. Lens f a -> a -> f -> f
#= AttributeMap
qanun_ks (Patch -> Patch) -> Patch -> Patch
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 ([Attributes] -> AttributeMap) -> [Attributes] -> AttributeMap
forall a b. (a -> b) -> a -> b
$
        [ (Attributes
m Attributes -> Attributes -> Attributes
forall a. Semigroup a => a -> a -> a
<> Attributes
art)
        -- wood-m is the default
        | Attributes
m <- [Attributes
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 <- [Attributes
forall a. Monoid a => a
mempty, Name -> Attributes
Attrs.attr Name
"half-mute", Attributes
Attrs.mute]
        ] [Attributes] -> [Attributes] -> [Attributes]
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 ([Attributes] -> AttributeMap) -> [Attributes] -> AttributeMap
forall a b. (a -> b) -> a -> b
$ [[Attributes]] -> [Attributes]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [Attributes
forall a. Monoid a => a
mempty] -- thumb
        , (Name -> Attributes) -> [Name] -> [Attributes]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Attributes
Attrs.attr [Name
"fingertip", Name
"pick", Name
"pick-bridge", Name
"pizz"]
        , ((Attributes, Int) -> Attributes)
-> [(Attributes, Int)] -> [Attributes]
forall a b. (a -> b) -> [a] -> [b]
map (Attributes, Int) -> Attributes
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 ([(Attributes, Key)] -> AttributeMap)
-> [(Attributes, Key)] -> AttributeMap
forall a b. (a -> b) -> a -> b
$ [Attributes] -> [Key] -> [(Attributes, Key)]
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
        [ Symbol -> Generator Note -> Call Note
forall d. Symbol -> Generator d -> Call d
MidiInst.generator Symbol
"g" (Generator Note -> Call Note) -> Generator Note -> Call Note
forall a b. (a -> b) -> a -> b
$
            Doc -> TransformerF Note -> Generator Note -> Generator Note
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
_ -> Y -> Deriver (Stream Note) -> Deriver (Stream Note)
forall a. Y -> Deriver a -> Deriver a
Call.multiply_dynamic Y
0.65) (Generator Note -> Generator Note)
-> Generator Note -> Generator Note
forall a b. (a -> b) -> a -> b
$
            Map Int Attributes -> Generator Note
GraceUtil.c_attr_grace (Map Int Attributes -> Generator Note)
-> Map Int Attributes -> Generator Note
forall a b. (a -> b) -> a -> b
$ [(Int, Attributes)] -> Map Int Attributes
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Int, Attributes)] -> Map Int Attributes)
-> [(Int, Attributes)] -> Map Int Attributes
forall a b. (a -> b) -> a -> b
$
            ((Attributes, Int) -> (Int, Attributes))
-> [(Attributes, Int)] -> [(Int, Attributes)]
forall a b. (a -> b) -> [a] -> [b]
map (Attributes, Int) -> (Int, Attributes)
forall a b. (a, b) -> (b, a)
Tuple.swap [(Attributes, Int)]
grace_intervals
        , Symbol -> Calls Note -> Call Note
forall d. Symbol -> Calls d -> Call d
MidiInst.both Symbol
"o" (Calls Note -> Call Note) -> Calls Note -> Call Note
forall a b. (a -> b) -> a -> b
$
            Doc -> TransformerF Note -> Calls Note -> Calls Note
forall a. Doc -> TransformerF a -> Calls a -> Calls a
Make.modify_calls_ Doc
"" (\PassedArgs Note
_ -> Control -> Y -> Deriver (Stream Note) -> Deriver (Stream 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 Attributes -> Attributes -> Attributes
forall a. Semigroup a => a -> a -> a
<> Attributes
dir Attributes -> Attributes -> Attributes
forall a. Semigroup a => a -> a -> a
<> Attributes
interval, Int
step Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sign)
        | (Attributes
interval, Int
step) <- [Attributes] -> [Int] -> [(Attributes, Int)]
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 Lens Patch Code -> Code -> Patch -> Patch
forall f a. Lens f a -> a -> f -> f
#= Code
Reaktor.resonant_filter (Patch -> Patch) -> Patch -> Patch
forall a b. (a -> b) -> a -> b
$ Name -> [(Control, Control)] -> Patch
patch Name
"filtered" []]