-- Copyright 2015 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

-- | Gender wayang patches.
module User.Elaforge.Instrument.Kontakt.Wayang where
import qualified Cmd.Instrument.Bali as Bali
import qualified Cmd.Instrument.MidiInst as MidiInst
import qualified Derive.Attrs as Attrs
import qualified Derive.C.Bali.Gangsa as Gangsa
import qualified Derive.C.Bali.Gender as Gender
import qualified Derive.C.Prelude.Note as Note
import qualified Derive.Call.Sub as Sub
import qualified Derive.EnvKey as EnvKey
import qualified Derive.Instrument.DUtil as DUtil
import qualified Derive.Scale.BaliScales as BaliScales
import qualified Derive.Scale.Wayang as Wayang

import qualified Instrument.Common as Common
import qualified Midi.Key2 as Key2
import qualified Perform.Midi.Patch as Patch

import           Global


{- | Layout:

    > 0         10        20        30        40        50        60        70        80        90        100       110       120    127
    > 01234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567
    > c-2         c-1         c0          c1          c2          c3d ef g ab c4d ef g ab c5d ef      c6          c7          c8     g8
    >                  o---eu-a---io---eu-a---i
    >                              k----------------------|
    >          X X|-----------------------------------------------|
    >                                                                  o---eu-a---io---eu-a---i
    >                                                                              k----------------------|
    >                                                             |-----------------------------------------------|

    > pemade mute: (f_1, e1), open: (f3, e5)
    > kantil mute: (f0, e2), open: (f4, e6)
    > mute keyswitch: a_2, b_2

    TODO if I want to support both +mute and +mute+loose, perhaps null_call
    should add just +mute, and can inherit +loose if it's set.

    The patches are quite complicated, to capture the structural relations of
    the 4 instruments in the ensemble.  It can be allocated together in LAlloc.

    k           kontakt/wayang-kantilan dummy -> (k-umbang, k-isep)
    k-umbang    kontakt/wayang-umbang
    k-isep      kontakt/wayang-isep
    p           kontakt/wayang-pemade dummy -> (p-umbang, p-isep)
    p-umbang    kontakt/wayang-umbang
    p-isep      kontakt/wayang-isep
-}
patches :: [MidiInst.Patch]
patches :: [Patch]
patches = forall a b. (a -> b) -> [a] -> [b]
map (Lens Patch Code
MidiInst.code forall f a. Lens f a -> a -> f -> f
#= Code
code forall a. Semigroup a => a -> a -> a
<> Code
with_weak)
    [ Tuning -> Patch -> Patch
set_scale Tuning
BaliScales.Umbang forall a b. (a -> b) -> a -> b
$ Name -> Patch
patch Name
"wayang-umbang"
    , Tuning -> Patch -> Patch
set_scale Tuning
BaliScales.Isep forall a b. (a -> b) -> a -> b
$ Name -> Patch
patch Name
"wayang-isep"
    , Lens Patch Doc
MidiInst.doc forall f a. Lens f a -> a -> f -> f
#= Doc
"Tuned to 12TET." forall a b. (a -> b) -> a -> b
$ Name -> Patch
patch Name
"wayang12"
    ] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map Patch -> Patch
pasang
    [ Name -> Patch
patch Name
"wayang"
    , Range -> Patch -> Patch
MidiInst.range (Instrument -> Range
BaliScales.instrument_range Instrument
Wayang.pemade) forall a b. (a -> b) -> a -> b
$
        Name -> Patch
patch Name
"wayang-pemade"
    , Range -> Patch -> Patch
MidiInst.range (Instrument -> Range
BaliScales.instrument_range Instrument
Wayang.kantilan) forall a b. (a -> b) -> a -> b
$
        Name -> Patch
patch Name
"wayang-kantilan"
    ]
    where
    pasang :: Patch -> Patch
pasang = Name -> Patch -> Patch
MidiInst.dummy Name
Bali.pasang_msg
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Lens Patch Code
MidiInst.code forall f a. Lens f a -> a -> f -> f
#= Code
Bali.pasang_code forall a. Semigroup a => a -> a -> a
<> Code
with_weak)
    code :: Code
code = InstrumentPostproc -> Code
MidiInst.postproc (Attributes -> InstrumentPostproc
Gangsa.mute_postproc (Attributes
Attrs.mute forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.loose))
        forall a. Semigroup a => a -> a -> a
<> Generator Note -> Code
MidiInst.null_call Generator Note
DUtil.constant_pitch
    with_weak :: Code
with_weak = Generator Note -> Code
MidiInst.null_call forall a b. (a -> b) -> a -> b
$ CallName
-> Doc
-> (NoteArgs -> NoteDeriver)
-> (NoteArgs -> NoteDeriver)
-> Generator Note
DUtil.zero_duration CallName
"note"
        Doc
"This a normal note with non-zero duration, but when the duration is\
        \ zero, it uses the `weak` call."
        (forall d.
(PassedArgs d -> NoteDeriver) -> PassedArgs d -> NoteDeriver
Sub.inverting forall a. PassedArgs a -> NoteDeriver
Gender.weak_call)
        (forall d.
(PassedArgs d -> NoteDeriver) -> PassedArgs d -> NoteDeriver
Sub.inverting forall a b. (a -> b) -> a -> b
$ Config -> NoteArgs -> NoteDeriver
Note.default_note Config
Note.use_attributes)
    patch :: Name -> Patch
patch Name
name = Patch -> Patch
set_params forall a b. (a -> b) -> a -> b
$ PbRange -> Name -> [(Control, Control)] -> Patch
MidiInst.named_patch (-Int
24, Int
24) Name
name []
    set_params :: Patch -> Patch
set_params = Patch :-> Patch
MidiInst.patch
        forall f a. Lens f a -> (a -> a) -> f -> f
%= [Flag] -> Patch -> Patch
MidiInst.add_flags [Flag
Patch.UseFinalNoteOff]
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Patch :-> Settings
Patch.defaultsforall a b c. Lens a b -> Lens b c -> Lens a c
#Settings :-> Maybe RealTime
Patch.decay forall f a. Lens f a -> a -> f -> f
#= forall a. a -> Maybe a
Just RealTime
0)
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Patch :-> AttributeMap
Patch.attribute_map forall f a. Lens f a -> a -> f -> f
#= AttributeMap
attribute_map)
    set_scale :: Tuning -> Patch -> Patch
set_scale Tuning
tuning =
        (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
            #= Just (Wayang.instrument_scale False Wayang.laras_sawan tuning))
        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

attribute_map :: Patch.AttributeMap
attribute_map :: AttributeMap
attribute_map = forall a. [(Attributes, a)] -> AttributeMap a
Common.attribute_map
    [ (Attributes
Attrs.mute forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.loose, ([Key -> Keyswitch
Patch.Keyswitch Key
Key2.a_2], Maybe Keymap
keymap))
    , (Attributes
Attrs.mute,                ([Key -> Keyswitch
Patch.Keyswitch Key
Key2.b_2], Maybe Keymap
keymap))
    , (forall a. Monoid a => a
mempty, ([], forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Key -> Key -> Key -> Keymap
Patch.PitchedKeymap Key
Key2.c3 Key
Key2.c7 Key
Key2.c3))
    ]
    where keymap :: Maybe Keymap
keymap = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Key -> Key -> Key -> Keymap
Patch.PitchedKeymap Key
Key2.c_1 Key
Key2.b2 Key
Key2.c3