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

-- | Kendang patches for "User.Elaforge.Instrument.Kontakt".
module User.Elaforge.Instrument.Kontakt.KendangBali where
import qualified Data.List as List

import qualified Cmd.Instrument.CUtil as CUtil
import qualified Cmd.Instrument.Drums as Drums
import qualified Cmd.Instrument.KendangBali as K
import qualified Cmd.Instrument.MidiInst as MidiInst

import qualified Derive.Attrs as Attrs
import           Derive.Attrs (soft)
import qualified Derive.ScoreT as ScoreT

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

import qualified Ui.UiConfig as UiConfig
import qualified User.Elaforge.Instrument.Kontakt.Util as Util

import           Global


patches :: [MidiInst.Patch]
patches :: [Patch]
patches =
    [ Lens Patch Code
MidiInst.code forall f a. Lens f a -> a -> f -> f
#= Code
tunggal_code forall a b. (a -> b) -> a -> b
$ PitchedStrokes -> Patch -> Patch
CUtil.pitched_drum_patch PitchedStrokes
tunggal_strokes forall a b. (a -> b) -> a -> b
$
        Text -> Patch
patch Text
"kendang-bali"
    , Lens Patch Code
MidiInst.code forall f a. Lens f a -> a -> f -> f
#= Code
tunggal_code forall a b. (a -> b) -> a -> b
$ [(Stroke, Key)] -> Patch -> Patch
CUtil.drum_patch [(Stroke, Key)]
old_tunggal_strokes forall a b. (a -> b) -> a -> b
$
        Text -> Patch
patch Text
"kendang-bali-old"
    , Text -> Patch -> Patch
MidiInst.dummy Text
"requires realize-kendang" forall a b. (a -> b) -> a -> b
$
        Lens Patch Code
MidiInst.code forall f a. Lens f a -> a -> f -> f
#= Code
K.pasang_code forall a b. (a -> b) -> a -> b
$ Patch -> Patch
MidiInst.triggered forall a b. (a -> b) -> a -> b
$
        Text -> Patch
patch Text
"kendang-bali-pasang"
    ]
    where
    tunggal_code :: Code
tunggal_code = Thru -> [(Stroke, CallConfig)] -> Code
CUtil.drum_code Thru
CUtil.MidiThru
        (forall a b. (a -> b) -> [a] -> [b]
map ((,CallConfig
config) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) PitchedStrokes
tunggal_strokes)
    config :: CallConfig
config = CallConfig
CUtil.call_config { _tuning_control :: Maybe Control
CUtil._tuning_control = forall a. a -> Maybe a
Just Control
"kendang-tune" }
    patch :: Text -> Patch
patch Text
name = PbRange -> Text -> [(Channel, Control)] -> Patch
MidiInst.named_patch (-Int
24, Int
24) Text
name []

tunggal_strokes :: CUtil.PitchedStrokes
(PitchedStrokes
tunggal_strokes, [Text]
resolve_errors) =
    Y
-> Map Attributes KeyswitchRange
-> [(Char, Symbol, Attributes, Text)]
-> (PitchedStrokes, [Text])
CUtil.resolve_strokes Y
K.soft_dyn Map Attributes KeyswitchRange
tunggal_keymap
        [ (Char
char, Note -> Symbol
K.to_call Note
note, Attributes
attrs, Text
group)
        | (Char
char, note :: Note
note@(K.Note Stroke
_ Attributes
attrs), Text
group) <- [(Char, Note, Text)]
K.tunggal_table
        ]

tunggal_keymap :: Map Attrs.Attributes CUtil.KeyswitchRange
tunggal_keymap :: Map Attributes KeyswitchRange
tunggal_keymap = Maybe Key
-> Key
-> Key
-> Key
-> [[Attributes]]
-> Map Attributes KeyswitchRange
CUtil.make_keymap (forall a. a -> Maybe a
Just Key
Key2.e_2) Key
Key2.c_1 Key
12 Key
Key.fs3
    [ [Attributes
K.de forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.staccato, Attributes
K.plak]
    , [Attributes
K.de forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.thumb, Attributes
K.dag forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.staccato]
    , [Attributes
K.de, Attributes
K.dag]
    , [Attributes
K.de forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.closed, Attributes
K.tek]
    , [Attributes
K.tut]
    , [Attributes
K.ka]
    , [Attributes
K.pang]
    , [Attributes
K.pak]
    , [Attributes
K.de forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.left, Attributes
K.tut forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.left]
    ]

-- | Mapping for the old kendang patches.
old_tunggal_strokes :: [(Drums.Stroke, Midi.Key)]
old_tunggal_strokes :: [(Stroke, Key)]
old_tunggal_strokes = forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Attributes -> Stroke
stroke)
    [ (Attributes
K.plak, Key
Key.g1)
    -- left
    , (Attributes
K.pak, Key
Key.c5)
    , (Attributes
K.pang, Key
Key.g4)
    , (Attributes
K.pak forall a. Semigroup a => a -> a -> a
<> Attributes
soft, Key
Key.c5)
    , (Attributes
K.de forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.left, Key
Key.d4)
    , (Attributes
K.tut forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.left, Key
Key.c4)
    -- right
    , (Attributes
K.de, Key
Key.c2)
    , (Attributes
K.de forall a. Semigroup a => a -> a -> a
<> Attributes
soft, Key
Key.c2)
    , (Attributes
K.de forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.thumb, Key
Key.f2)
    , (Attributes
K.de forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.staccato, Key
Key.c1)
    , (Attributes
K.tut, Key
Key.c3)
    , (Attributes
K.ka forall a. Semigroup a => a -> a -> a
<> Attributes
soft, Key
Key.g3)
    , (Attributes
K.ka, Key
Key.g3)
    , (Attributes
K.dag, Key
Key.c2)
    , (Attributes
K.dag forall a. Semigroup a => a -> a -> a
<> Attributes
soft, Key
Key.c2)
    , (Attributes
K.tek forall a. Semigroup a => a -> a -> a
<> Attributes
soft, Key
Key.c1)
    , (Attributes
K.tek, Key
Key.c1)
    ]
    where
    stroke :: Attributes -> Stroke
stroke Attributes
attrs =
        Char -> Symbol -> Attributes -> Y -> Stroke
Drums.stroke_dyn Char
char (Note -> Symbol
K.to_call (Stroke -> Attributes -> Note
K.Note Stroke
stroke Attributes
attrs)) Attributes
attrs
            (if Attributes -> Attributes -> Bool
Attrs.contain Attributes
attrs Attributes
soft then Y
K.soft_dyn else Y
1)
        where
        Just (Char
char, (K.Note Stroke
stroke Attributes
_), Text
_) =
            forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find ((forall a. Eq a => a -> a -> Bool
==Attributes
attrs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {c}. (a, Note, c) -> Attributes
attrs_of) [(Char, Note, Text)]
K.tunggal_table
    attrs_of :: (a, Note, c) -> Attributes
attrs_of (a
_, (K.Note Stroke
_ Attributes
a), c
_) = Attributes
a

write_ksp :: IO ()
write_ksp :: IO ()
write_ksp = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry FilePath -> Either Text Text -> IO ()
Util.write)
    [ (FilePath
"kendang-bali.ksp",
        Text -> PitchedStrokes -> [(Text, [Text])] -> Either Text Text
Util.drum_mute_ksp Text
"kendang bali" PitchedStrokes
tunggal_strokes [(Text, [Text])]
K.stops)
    ]

-- * config

-- | @LInst.merge $ KendangBali.allocations ...@
allocations :: Text -> Text -> UiConfig.Allocations
allocations :: Text -> Text -> Allocations
allocations Text
name Text
dev_ = [(Instrument, Qualified, Config -> Config, Backend)] -> Allocations
MidiInst.allocations
    [ (Text -> Instrument
inst forall a b. (a -> b) -> a -> b
$ Text
name forall a. Semigroup a => a -> a -> a
<> Text
"w", Text -> Qualified
qual Text
"kendang-bali", forall a. a -> a
id, Channel -> Backend
midi_channel Channel
0)
    , (Text -> Instrument
inst forall a b. (a -> b) -> a -> b
$ Text
name forall a. Semigroup a => a -> a -> a
<> Text
"l", Text -> Qualified
qual Text
"kendang-bali", forall a. a -> a
id, Channel -> Backend
midi_channel Channel
1)
    , ( Text -> Instrument
inst Text
name, Text -> Qualified
qual Text
"kendang-bali-pasang"
      , forall a. ToVal a => Text -> a -> Config -> Config
Common.add_cenviron Text
"wadon" (Text -> Instrument
inst forall a b. (a -> b) -> a -> b
$ Text
name forall a. Semigroup a => a -> a -> a
<> Text
"w")
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToVal a => Text -> a -> Config -> Config
Common.add_cenviron Text
"lanang" (Text -> Instrument
inst forall a b. (a -> b) -> a -> b
$ Text
name forall a. Semigroup a => a -> a -> a
<> Text
"l")
      , Text -> Backend
UiConfig.Dummy Text
"requires realize-kendang"
      )
    ]
    where
    qual :: Text -> Qualified
qual = Text -> Text -> Qualified
InstT.Qualified Text
"kontakt"
    midi_channel :: Channel -> Backend
midi_channel = Config -> Backend
UiConfig.Midi forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriteDevice -> Channel -> Config
MidiInst.config1 WriteDevice
dev
    dev :: WriteDevice
dev = Text -> WriteDevice
Midi.write_device Text
dev_
    inst :: Text -> Instrument
inst = Text -> Instrument
ScoreT.Instrument