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

-- | Mridangam patch.
module User.Elaforge.Instrument.Kontakt.Mridangam where
import qualified Data.Map as Map

import qualified Cmd.Instrument.CUtil as CUtil
import qualified Cmd.Instrument.Drums as Drums
import qualified Cmd.Instrument.MidiInst as MidiInst
import qualified Cmd.Instrument.Mridangam as Mridangam
import qualified Cmd.Instrument.Mridangam as M

import qualified Derive.Attrs as Attrs
import qualified Midi.Key as Key
import qualified Midi.Key2 as Key2
import qualified Midi.Midi as Midi

import qualified Perform.NN as NN
import qualified User.Elaforge.Instrument.Kontakt.Util as Util

import Global


patches :: [MidiInst.Patch]
patches :: [Patch]
patches =
    [ NoteNumber -> Patch -> Patch
code NoteNumber
NN.d4 forall a b. (a -> b) -> a -> b
$ Text -> PitchedStrokes -> Patch
patch Text
"mridangam-d" PitchedStrokes
strokes_d
    , NoteNumber -> Patch -> Patch
code NoteNumber
NN.g4 forall a b. (a -> b) -> a -> b
$ Text -> PitchedStrokes -> Patch
patch Text
"mridangam-g" PitchedStrokes
strokes_g
    , NoteNumber -> Patch -> Patch
code NoteNumber
NN.g4 forall a b. (a -> b) -> a -> b
$ Text -> PitchedStrokes -> Patch
patch Text
"mridangam-old" PitchedStrokes
pitched_strokes_old
    ]
    where
    patch :: Text -> PitchedStrokes -> Patch
patch Text
name PitchedStrokes
strokes = PitchedStrokes -> Patch -> Patch
CUtil.pitched_drum_patch PitchedStrokes
strokes forall a b. (a -> b) -> a -> b
$
        PbRange -> Text -> [(Control, Control)] -> Patch
MidiInst.named_patch (-Int
24, Int
24) Text
name []
    code :: NoteNumber -> Patch -> Patch
code NoteNumber
natural_nn = Lens Patch Code
MidiInst.code
        #= Mridangam.code CUtil.MidiThru natural_nn Nothing

strokes_d, strokes_g :: CUtil.PitchedStrokes
(PitchedStrokes
strokes_d, ([Stroke], [Attributes])
_unmapped_strokes_d) = Key -> (PitchedStrokes, ([Stroke], [Attributes]))
make_strokes Key
Key.gs3
(PitchedStrokes
strokes_g, ([Stroke], [Attributes])
_unmapped_strokes_g) = Key -> (PitchedStrokes, ([Stroke], [Attributes]))
make_strokes Key
Key.d4
    -- The given pitch is the natural pitch of the instrument.  The root note
    -- is the bottom of the pitch range.

make_strokes :: Midi.Key
    -> (CUtil.PitchedStrokes, ([Drums.Stroke], [Attrs.Attributes]))
make_strokes :: Key -> (PitchedStrokes, ([Stroke], [Attributes]))
make_strokes Key
root_nn = [Stroke]
-> Map Attributes KeyswitchRange
-> (PitchedStrokes, ([Stroke], [Attributes]))
CUtil.drum_pitched_strokes [Stroke]
Mridangam.all_strokes forall a b. (a -> b) -> a -> b
$
    Key
-> Key -> Key -> [[Attributes]] -> Map Attributes KeyswitchRange
CUtil.make_cc_keymap Key
Key2.c_1 Key
12 Key
root_nn
        [ [Attributes
M.tha]
        , [Attributes
M.thom, Attributes
M.gumki, Attributes
M.gumki forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.up, Attributes
M.thom forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.dry]
        , [Attributes
M.ki]
        , [Attributes
M.ta]
        , [Attributes
M.nam]
        , [Attributes
M.din]
        , [Attributes
M.arai forall a. Semigroup a => a -> a -> a
<> Attributes
M.chapu, Attributes
M.muru forall a. Semigroup a => a -> a -> a
<> Attributes
M.chapu]
        , [Attributes
M.kin, Attributes
M.dheem]
        , [Attributes
M.tan]
        ]

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)
    -- Util.drum_mute_ksp ignores the root pitch so I don't need to worry about
    -- 'strokes_g'.
    [ ( FilePath
"mridangam.ksp.txt"
      , Text -> PitchedStrokes -> [(Text, [Text])] -> Either Text Text
Util.drum_mute_ksp Text
"mridangam" PitchedStrokes
strokes_d [(Text, [Text])]
Mridangam.stops
      )
    , ( FilePath
"mridangam-old.ksp.txt"
      , Text -> PitchedStrokes -> [(Text, [Text])] -> Either Text Text
Util.drum_mute_ksp Text
"mridangam" PitchedStrokes
pitched_strokes_old [(Text, [Text])]
Mridangam.stops
      )
    ]

pitched_strokes_old :: CUtil.PitchedStrokes
(PitchedStrokes
pitched_strokes_old, ([Stroke], [Attributes])
_pitched_strokes_old) =
    [Stroke]
-> Map Attributes KeyswitchRange
-> (PitchedStrokes, ([Stroke], [Attributes]))
CUtil.drum_pitched_strokes [Stroke]
Mridangam.all_strokes 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} {c} {a}. (a, (b, c)) -> (a, ([a], b, c, Key))
make
    -- left
    [ (Attributes
M.tha, (Key
Key.g_1, Key
Key.e0))
    , (Attributes
M.thom, (Key
Key.g0, Key
Key.e1))
    , (Attributes
M.thom forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.staccato, (Key
Key.g1, Key
Key.e2))
    -- right
    , (Attributes
M.ki, (Key
Key.g2, Key
Key.e3))
    , (Attributes
M.ta, (Key
Key.g3, Key
Key.e4))
    , (Attributes
M.nam, (Key
Key.g4, Key
Key.e5))
    , (Attributes
M.din, (Key
Key.g5, Key
Key.e6))
    , (Attributes
M.din forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.v2, (Key
Key.g6, Key
Key.e7))
    , (Attributes
M.dheem, (Key
Key.g7, Key
Key.e8))
    , (Attributes
M.arai forall a. Semigroup a => a -> a -> a
<> Attributes
M.chapu, (Key
Key.g8, Key
Key.e9))
    , (Attributes
M.muru forall a. Semigroup a => a -> a -> a
<> Attributes
M.chapu, (Key
Key.g9, Key
Key.g9))
    ]
    where make :: (a, (b, c)) -> (a, ([a], b, c, Key))
make (a
attrs, (b
low, c
high)) = (a
attrs, ([], b
low, c
high, Key
Key.e4))