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

-- | Pakhawaj patch.  The notation is based on mridangam notation.
module User.Elaforge.Instrument.Kontakt.Pakhawaj where
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 Derive.Attrs as Attrs
import qualified Derive.C.India.Pakhawaj as Pakhawaj
import Derive.C.India.Pakhawaj (Stroke(..))
import qualified Derive.Expr as Expr

import qualified Midi.Key2 as Key2
import qualified Perform.NN as NN
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
code forall a b. (a -> b) -> a -> b
$ Text -> PitchedStrokes -> Patch
patch Text
"pakhawaj" PitchedStrokes
pitched_strokes]
    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 :: Code
code = Thru
-> [Attributes]
-> NoteNumber
-> Maybe (TransformerF Note)
-> [Stroke]
-> [(Symbol, [Symbol], Maybe Char)]
-> Code
Mridangam.make_code Thru
CUtil.MidiThru [Attributes]
pitched_attributes NoteNumber
NN.c4 forall a. Maybe a
Nothing
        [Stroke]
all_strokes [(Symbol, [Symbol], Maybe Char)]
both_calls

pitched_strokes :: CUtil.PitchedStrokes
(PitchedStrokes
pitched_strokes, ([Stroke], [Attributes])
_pitched_strokes) = [Stroke]
-> Map Attributes KeyswitchRange
-> (PitchedStrokes, ([Stroke], [Attributes]))
CUtil.drum_pitched_strokes [Stroke]
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
Key2.fs2
        [ [Stroke -> Attributes
attr Stroke
Ka]
        , [Stroke -> Attributes
attr Stroke
Ge]
        , [Stroke -> Attributes
attr Stroke
Tet]
        , [Stroke -> Attributes
attr Stroke
Te]
        , [Stroke -> Attributes
attr Stroke
Ne]
        , [Stroke -> Attributes
attr Stroke
Na, Attributes
nam]
        , [Attributes
din]
        , [Stroke -> Attributes
attr Stroke
Ta]
        , [Stroke -> Attributes
attr Stroke
Di]
        ]
    where attr :: Stroke -> Attributes
attr = Stroke -> Attributes
Pakhawaj.stroke_to_attribute

-- | Create calls for all simultaneous left and right hand combinations, and
-- key bindings for a few common ones.
both_calls :: [(Expr.Symbol, [Expr.Symbol], Maybe Char)]
both_calls :: [(Symbol, [Symbol], Maybe Char)]
both_calls = [Stroke]
-> [Stroke]
-> [(Symbol, [Symbol])]
-> [(Symbol, Char)]
-> [(Symbol, [Symbol], Maybe Char)]
Mridangam.make_both [Stroke]
left_strokes [Stroke]
right_strokes [(Symbol, [Symbol])]
special_names
    [ (Symbol
"D", Char
'c')
    , (Symbol
"T", Char
'f')
    , (Symbol
"E", Char
'v')
    ]
    where
    special_names :: [(Symbol, [Symbol])]
special_names =
        [ (Symbol
"D", [Symbol
"o", Symbol
"u"]) -- dha
        , (Symbol
"E", [Symbol
"o", Symbol
"k"]) -- dhet
        , (Symbol
"T", [Symbol
"+", Symbol
"k"]) -- thet
        ]

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
"pakhawaj.ksp.txt", Text -> PitchedStrokes -> [(Text, [Text])] -> Either Text Text
Util.drum_mute_ksp Text
"pakhawaj" PitchedStrokes
pitched_strokes [(Text, [Text])]
stops)
    ]

-- | The symbols follow the same scheme as mridangam.
left_strokes, right_strokes :: [Drums.Stroke]
stops :: Drums.Stops
([Stroke]
left_strokes, [Stroke]
right_strokes, [(Text, [Text])]
stops) = ([Stroke]
left_strokes, [Stroke]
right_strokes, [(Text, [Text])]
stops)
    where
    left_strokes :: [Stroke]
left_strokes = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ Text -> [Stroke] -> [Stroke]
group Text
l_closed
            [ Char -> Symbol -> Attributes -> Y -> Stroke
n Char
'a' Symbol
"-" (Stroke -> Attributes
attr Stroke
Ka) Y
0.5
            , Char -> Symbol -> Attributes -> Y -> Stroke
n Char
'z' Symbol
"+" (Stroke -> Attributes
attr Stroke
Ka) Y
1
            ]
        , Text -> [Stroke] -> [Stroke]
group Text
l_open
            [ Char -> Symbol -> Attributes -> Y -> Stroke
n Char
's' Symbol
"." (Stroke -> Attributes
attr Stroke
Ge) Y
0.5
            , Char -> Symbol -> Attributes -> Y -> Stroke
n Char
'x' Symbol
"o" (Stroke -> Attributes
attr Stroke
Ge) Y
1
            ]
        ]
    right_strokes :: [Stroke]
right_strokes = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ Text -> [Stroke] -> [Stroke]
group Text
r_closed
            [ Char -> Symbol -> Attributes -> Y -> Stroke
n Char
'1' Symbol
"l" (Stroke -> Attributes
attr Stroke
Tet) Y
0.5
            , Char -> Symbol -> Attributes -> Y -> Stroke
n Char
'q' Symbol
"k" (Stroke -> Attributes
attr Stroke
Tet) Y
1
            , Char -> Symbol -> Attributes -> Y -> Stroke
n Char
'2' Symbol
"p" (Stroke -> Attributes
attr Stroke
Ne)  Y
0.75
            , Char -> Symbol -> Attributes -> Y -> Stroke
n Char
'w' Symbol
"t" (Stroke -> Attributes
attr Stroke
Te)  Y
1
            ]
        , Text -> [Stroke] -> [Stroke]
group Text
r_syahi
            [ Char -> Symbol -> Attributes -> Y -> Stroke
n Char
'3' Symbol
"m" Attributes
nam Y
1
            , Char -> Symbol -> Attributes -> Y -> Stroke
n Char
'e' Symbol
"n" (Stroke -> Attributes
attr Stroke
Na) Y
1
            , Char -> Symbol -> Attributes -> Y -> Stroke
n Char
'r' Symbol
"d" Attributes
din Y
1
            ]
        , Text -> [Stroke] -> [Stroke]
group Text
r_syahi_open
            [ Char -> Symbol -> Attributes -> Y -> Stroke
n Char
't' Symbol
"u" (Stroke -> Attributes
attr Stroke
Ta) Y
1
            ]
        , Text -> [Stroke] -> [Stroke]
group Text
r_dheem [Char -> Symbol -> Attributes -> Y -> Stroke
n Char
'y' Symbol
"i" (Stroke -> Attributes
attr Stroke
Di) Y
1]
        ]

    stops :: [(Text, [Text])]
stops =
        [ (Text
l_closed, [Text
l_open])
        , (Text
r_closed, [Text
r_syahi, Text
r_syahi_open, Text
r_dheem])
        , (Text
r_syahi, [Text
r_syahi_open, Text
r_dheem])
        , (Text
r_syahi_open, [Text
r_dheem])
        ]
    r_closed :: Text
r_closed = Text
"r-closed"
    r_syahi :: Text
r_syahi = Text
"r-syahi"
    r_syahi_open :: Text
r_syahi_open = Text
"r-syahi_open"
    r_dheem :: Text
r_dheem = Text
"r-dheem"
    l_closed :: Text
l_closed = Text
"l-closed"
    l_open :: Text
l_open = Text
"l-open"
    group :: Text -> [Stroke] -> [Stroke]
group Text
name = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a -> b) -> a -> b
$ \Stroke
n -> Stroke
n { _group :: Text
Drums._group = Text
name }
    n :: Char -> Symbol -> Attributes -> Y -> Stroke
n = Char -> Symbol -> Attributes -> Y -> Stroke
Drums.stroke_dyn
    attr :: Stroke -> Attributes
attr = Stroke -> Attributes
Pakhawaj.stroke_to_attribute

pitched_attributes :: [Attrs.Attributes]
pitched_attributes :: [Attributes]
pitched_attributes = forall a b. (a -> b) -> [a] -> [b]
map Stroke -> Attributes
Pakhawaj.stroke_to_attribute [Stroke
Ge, Stroke
Na, Stroke
Ta, Stroke
Di]

all_strokes :: [Drums.Stroke]
all_strokes :: [Stroke]
all_strokes = [Stroke]
left_strokes forall a. [a] -> [a] -> [a]
++ [Stroke]
right_strokes

-- mridangam strokes
din :: Attributes
din = Text -> Attributes
Attrs.attr Text
"din"
nam :: Attributes
nam = Text -> Attributes
Attrs.attr Text
"nam"