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

-- | Patches for my reyong samples.
module User.Elaforge.Instrument.Kontakt.Reyong 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.Reyong as Reyong
import qualified Derive.EnvKey as EnvKey
import qualified Derive.Instrument.DUtil as DUtil
import qualified Derive.Scale.BaliScales as BaliScales
import qualified Derive.Scale.Selisir as Selisir

import qualified Perform.Midi.Patch as Patch
import Global


patches :: [MidiInst.Patch]
patches :: [Patch]
patches =
    [ Patch -> Patch
set_scale forall a b. (a -> b) -> a -> b
$ Name -> Patch
patch Name
"reyong"
    , Name -> Patch
patch Name
"reyong12"
    ]
    where
    patch :: Name -> Patch
patch Name
name = Lens Patch Code
MidiInst.code forall f a. Lens f a -> a -> f -> f
#= Code
code forall a b. (a -> b) -> a -> b
$ Patch -> Patch
set_params forall a b. (a -> b) -> a -> b
$
        PbRange -> Name -> [(ControlValue, Control)] -> Patch
MidiInst.named_patch (-Int
24, Int
24) Name
name []
    code :: Code
code = Y -> Code
Bali.zero_dur_mute Y
1 forall a. Semigroup a => a -> a -> a
<> Generator Note -> Code
MidiInst.null_call Generator Note
DUtil.constant_pitch
    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)
    tuning :: Tuning
tuning = Tuning
BaliScales.Umbang -- TODO verify how mine are tuned
    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
    -- Trompong starts at 3a, trompong + reyong has 15 keys.
    instrument_scale :: Scale
instrument_scale =
        ([(Key, NoteNumber)] -> [(Key, NoteNumber)])
-> Laras -> Tuning -> Scale
Selisir.instrument_scale (forall a. Int -> [a] -> [a]
take Int
15 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
4) Laras
Selisir.laras_rambat Tuning
tuning

attribute_map :: Patch.AttributeMap
attribute_map :: AttributeMap
attribute_map = [(Attributes, [Keyswitch])] -> AttributeMap
Patch.keyswitches forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a}. (a, ControlValue) -> (a, [Keyswitch])
at
    [ (Attributes
Reyong.cek forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.open, ControlValue
4)
    , (Attributes
Reyong.cek, ControlValue
3)
    , (Attributes
Attrs.mute forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.open, ControlValue
2)
    , (Attributes
Attrs.mute, ControlValue
1)
    , (forall a. Monoid a => a
mempty, ControlValue
0)
    ]
    where at :: (a, ControlValue) -> (a, [Keyswitch])
at = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ControlValue -> Keyswitch
Patch.Aftertouch)