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

-- | Miscellaneous gong instruments.
module User.Elaforge.Instrument.Kontakt.Gong (
    patches, write_ksp
    , kajar_resolve_errors
) where
import qualified Cmd.Instrument.CUtil as CUtil
import qualified Cmd.Instrument.Drums as Drums
import qualified Cmd.Instrument.MidiInst as MidiInst

import qualified Derive.Attrs as Attrs
import qualified Derive.C.Bali.Gong as Gong
import qualified Derive.Call.Module as Module
import qualified Derive.Call.Sub as Sub
import qualified Derive.Derive as Derive
import qualified Derive.Eval as Eval
import qualified Derive.Expr as Expr
import qualified Derive.Instrument.DUtil as DUtil

import qualified Instrument.InstT as InstT
import qualified Midi.Key as Key
import qualified Perform.RealTime as RealTime
import qualified Ui.Meter.Meter as Meter
import qualified User.Elaforge.Instrument.Kontakt.Util as Util

import           Global


patches :: [MidiInst.Patch]
patches :: [Patch]
patches = [Patch
kajar_patch]

patch :: InstT.Name -> MidiInst.Patch
patch :: Text -> Patch
patch Text
name = PbRange -> Text -> [(Control, Control)] -> Patch
MidiInst.named_patch (-Int
24, Int
24) Text
name []

kajar_patch :: MidiInst.Patch
kajar_patch :: Patch
kajar_patch =
    Lens Patch Code
MidiInst.code forall f a. Lens f a -> a -> f -> f
#= Code
code forall a b. (a -> b) -> a -> b
$
        PitchedStrokes -> Patch -> Patch
CUtil.pitched_drum_patch PitchedStrokes
kajar_pitched_strokes forall a b. (a -> b) -> a -> b
$ Text -> Patch
patch Text
"kajar"
    where
    code :: Code
code = HandlerId -> Code
MidiInst.cmd (forall (m :: * -> *). M m => Thru -> [(Char, Symbol)] -> Handler m
CUtil.insert_call Thru
CUtil.MidiThru [(Char, Symbol)]
char_to_call)
        forall a. Semigroup a => a -> a -> a
<> [(Symbol, Generator Event)] -> Code
MidiInst.note_generators [(Symbol, Generator Event)]
generators
    generators :: [(Symbol, Generator Event)]
generators = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [(Stroke, CallConfig)] -> [(Symbol, Generator Event)]
CUtil.drum_calls (forall a b. (a -> b) -> [a] -> [b]
map (,CallConfig
config) [Stroke]
strokes)
        , [(Symbol
sym, Generator Event
call) | (Char
_, Symbol
sym, Generator Event
call) <- [(Char, Symbol, Generator Event)]
kajar_special]
        , [(Symbol
"k", CallName
-> Maybe (Either Text [Quoted])
-> Maybe (Either Rank DefaultScore)
-> Generator Event
Gong.make_cycle CallName
"kajar" (forall a. a -> Maybe a
Just (forall a b. a -> Either a b
Left Text
"o"))
            (forall a. a -> Maybe a
Just (forall a b. a -> Either a b
Left Rank
Meter.Q)))]
        ]
    config :: CallConfig
config = CallConfig
CUtil.call_config { _tuning_control :: Maybe Control
CUtil._tuning_control = forall a. a -> Maybe a
Just Control
"kajar-tune" }
    char_to_call :: [(Char, Symbol)]
char_to_call = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [(Stroke -> Char
Drums._char Stroke
s, Stroke -> Symbol
Drums._name Stroke
s) | Stroke
s <- [Stroke]
strokes]
        , [(Char
char, Symbol
sym) | (Char
char, Symbol
sym, Generator Event
_) <- [(Char, Symbol, Generator Event)]
kajar_special]
        ]
    strokes :: [Stroke]
strokes = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst PitchedStrokes
kajar_pitched_strokes

kajar_pitched_strokes :: CUtil.PitchedStrokes
(PitchedStrokes
kajar_pitched_strokes, [Text]
kajar_resolve_errors) =
    Y
-> Map Attributes KeyswitchRange
-> [(Char, Symbol, Attributes, Text)]
-> (PitchedStrokes, [Text])
CUtil.resolve_strokes Y
0.35 Map Attributes KeyswitchRange
keymap [(Char, Symbol, Attributes, Text)]
kajar_strokes

kajar_special :: [(Char, Expr.Symbol, Derive.Generator Derive.Note)]
kajar_special :: [(Char, Symbol, Generator Event)]
kajar_special =
    [ (Char
'c', Symbol
"oo", Symbol -> CallName -> Placement -> RealTime -> Y -> Generator Event
DUtil.doubled_call Symbol
"o" CallName
"oo" Placement
DUtil.After
        (Y -> RealTime
RealTime.seconds Y
0.09) Y
0.75)
    , (Char
'f', Symbol
"o..", Generator Event
c_nruk)
    ]

c_nruk :: Derive.Generator Derive.Note
c_nruk :: Generator Event
c_nruk = Module
-> CallName -> Doc -> (NoteArgs -> NoteDeriver) -> Generator Event
Gong.nruk_generator Module
Module.instrument CallName
"nruk" Doc
"Nruktuk on `o`." forall a b. (a -> b) -> a -> b
$
    forall d.
(PassedArgs d -> NoteDeriver) -> PassedArgs d -> NoteDeriver
Sub.inverting forall a b. (a -> b) -> a -> b
$ \NoteArgs
args -> do
        Generator Event
gen <- forall d. Callable (Generator d) => Symbol -> Deriver (Generator d)
Eval.get_generator Symbol
"o"
        forall d. Context d -> Generator d -> [Val] -> Deriver (Stream d)
Eval.apply_generator (forall val. PassedArgs val -> Context val
Derive.passed_ctx NoteArgs
args) Generator Event
gen []

kajar_strokes :: [(Char, Expr.Symbol, Attrs.Attributes, Drums.Group)]
kajar_stops :: [(Drums.Group, [Drums.Group])]
([(Text, [Text])]
kajar_stops, [(Char, Symbol, Attributes, Text)]
kajar_strokes) = (,) [(Text, [Text])]
stops
    [ (Char
'q', Symbol
"P", Attributes
rim forall a. Semigroup a => a -> a -> a
<> Attributes
closed,             Text
s_closed)

    , (Char
'a', Symbol
"+/", Attributes
rim forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.staccato,    Text
s_open)
    , (Char
'z', Symbol
"+", Attributes
rim forall a. Semigroup a => a -> a -> a
<> Attributes
open,               Text
s_open)
    , (Char
's', Symbol
".", Attributes
center forall a. Semigroup a => a -> a -> a
<> Attributes
closed forall a. Semigroup a => a -> a -> a
<> Attributes
soft,  Text
s_closed)
    , (Char
'x', Symbol
"o", Attributes
center forall a. Semigroup a => a -> a -> a
<> Attributes
closed,          Text
s_closed)
    -- 'c' is for oo

    -- This is not commonly used.
    , (Char
'v', Symbol
"c", Attributes
center forall a. Semigroup a => a -> a -> a
<> Attributes
open,            Text
s_open)
    , (Char
'm', Symbol
"m", Attributes
Attrs.damp,                Text
s_closed)
    ]
    where
    rim :: Attributes
rim = Attributes
Attrs.rim
    center :: Attributes
center = Attributes
Attrs.center
    soft :: Attributes
soft = Attributes
Attrs.soft
    open :: Attributes
open = Attributes
Attrs.open
    closed :: Attributes
closed = Attributes
Attrs.closed
    s_closed :: Text
s_closed = Text
"closed"
    s_open :: Text
s_open = Text
"open"
    stops :: [(Text, [Text])]
stops = [(Text
s_closed, [Text
s_open])]

keymap :: Map Attrs.Attributes CUtil.KeyswitchRange
keymap :: Map Attributes KeyswitchRange
keymap = Maybe Key
-> Key
-> Key
-> Key
-> Key
-> [[Attributes]]
-> Map Attributes KeyswitchRange
CUtil.make_keymap2 forall a. Maybe a
Nothing Key
24 Key
6 Key
12 Key
Key.c4
    [ [Attributes
Attrs.center forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.closed]
    , [Attributes
Attrs.center forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.open]
    , [Attributes
Attrs.rim forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.closed]
    , [Attributes
Attrs.rim forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.open]
    , [Attributes
Attrs.rim forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.staccato]
    , [Attributes
Attrs.damp]
    ]

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
"kajar.ksp.txt",
        Text -> PitchedStrokes -> [(Text, [Text])] -> Either Text Text
Util.drum_mute_ksp Text
"kajar" PitchedStrokes
kajar_pitched_strokes [(Text, [Text])]
kajar_stops)
    ]