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

-- | Spicy guitar, free at http://www.spicyguitar.com/
module User.Elaforge.Instrument.Spicy where
import qualified Data.Text as Text

import qualified Util.Doc as Doc
import qualified Util.Seq as Seq
import qualified Cmd.Instrument.MidiInst as MidiInst
import qualified Derive.Attrs as Attrs
import qualified Derive.C.Prelude.Note as Note
import qualified Derive.Call as Call
import qualified Derive.Derive as Derive
import qualified Derive.ScoreT as ScoreT

import qualified Instrument.InstT as InstT
import qualified Midi.Key as Key
import qualified Midi.Midi as Midi
import qualified Perform.Midi.Patch as Patch
import qualified Ui.UiConfig as UiConfig

import           Global


synth_name :: InstT.SynthName
synth_name :: Text
synth_name = Text
"spicy"

synth :: MidiInst.Synth
synth :: Synth
synth = Text -> Text -> [Patch] -> Synth
MidiInst.synth Text
synth_name Text
"Spicy Guitar, http://www.spicyguitar.com" ([Patch] -> Synth) -> [Patch] -> Synth
forall a b. (a -> b) -> a -> b
$
    [(Control, Control)] -> [Patch] -> [Patch]
MidiInst.synth_controls [(Control, Control)]
controls [Patch]
patches

patches :: [MidiInst.Patch]
patches :: [Patch]
patches = (Patch -> [Patch] -> [Patch]
forall a. a -> [a] -> [a]
:[]) (Patch -> [Patch]) -> Patch -> [Patch]
forall a b. (a -> b) -> a -> b
$
    Lens Patch Code
MidiInst.code Lens Patch Code -> Code -> Patch -> Patch
forall f a. Lens f a -> a -> f -> f
#= Generator Note -> Code
MidiInst.null_call Generator Note
note_call (Patch -> Patch) -> Patch -> Patch
forall a b. (a -> b) -> a -> b
$
    Patch -> Patch
MidiInst.make_patch (Patch -> Patch) -> Patch -> Patch
forall a b. (a -> b) -> a -> b
$
    Flag -> Patch -> Patch
MidiInst.add_flag Flag
Patch.HoldKeyswitch (Patch -> Patch) -> Patch -> Patch
forall a b. (a -> b) -> a -> b
$
    Patch :-> AttributeMap
Patch.attribute_map (Patch :-> AttributeMap) -> AttributeMap -> Patch -> Patch
forall f a. Lens f a -> a -> f -> f
#= [(Attributes, Key)] -> AttributeMap
Patch.single_keyswitches [(Attributes, Key)]
keyswitches (Patch -> Patch) -> Patch -> Patch
forall a b. (a -> b) -> a -> b
$
    PbRange -> Text -> Patch
Patch.patch (-Int
3, Int
3) Text
Patch.default_name


-- | WARNING: changing these while playing tends to crash the VST.
controls :: [(Midi.Control, ScoreT.Control)]
controls :: [(Control, Control)]
controls =
    [ (Control
20, Control
"position") -- 0 for bridge, 1 for middle
    , (Control
21, Control
"finger") -- 0 for finger plucking, 1 for pick
    , (Control
22, Control
"inharmonicity")
    , (Control
23, Control
"twang")
    , (Control
24, Control
"color")
    , (Control
25, Control
"impedance")
    , (Control
26, Control
"vibrato") -- speed of vibrato
    , (Control
27, Control
"mute") -- amount of palm mute effect
    , (Control
28, Control
"harm")
    ]

keyswitches :: [(Attrs.Attributes, Midi.Key)]
keyswitches :: [(Attributes, Key)]
keyswitches =
    [ (Attributes
Attrs.legato, Key
Key.b2)
    , (Attributes
Attrs.mute, Key
Key.c3)
    , (Attributes
Attrs.harm, Key
Key.cs3)
    ]

note_call :: Derive.Generator Derive.Note
note_call :: Generator Note
note_call = Doc
-> Tags
-> (NoteArgs -> NoteDeriver -> NoteDeriver)
-> Generator Note
Note.transformed_note
    (Doc
"If given a string-name attribute in " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
attrs_doc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
", suffix the"
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
" instrument with the string name.  When combined with the proper"
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
" midi config, this will redirect the note to the proper channel"
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
" for that string.") Tags
forall a. Monoid a => a
mempty
    ((NoteDeriver -> NoteDeriver)
-> NoteArgs -> NoteDeriver -> NoteDeriver
forall a b. a -> b -> a
const NoteDeriver -> NoteDeriver
forall {b}. Deriver b -> Deriver b
transform)
    where
    attrs_doc :: Doc
attrs_doc = Text -> Doc
Doc.Doc (Text -> Doc) -> Text -> Doc
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
Text.intercalate Text
", " [Text
"`" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`" | Text
a <- [Text]
strings]
    transform :: Deriver b -> Deriver b
transform Deriver b
deriver = do
        Attributes
attrs <- Deriver Attributes
Call.get_attributes
        Maybe Instrument
inst <- Deriver (Maybe Instrument)
Call.lookup_instrument
        let string :: Maybe Text
string = [Text] -> Maybe Text
forall a. [a] -> Maybe a
Seq.head
                [ Text
string
                | Text
attr <- Attributes -> [Text]
Attrs.to_list Attributes
attrs, Text
string <- [Text]
strings
                , Text
attr Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
string
                ]
        case (Maybe Instrument
inst, Maybe Text
string) of
            (Just Instrument
inst, Just Text
string) ->
                Instrument -> Deriver b -> Deriver b
forall d. Instrument -> Deriver d -> Deriver d
Derive.with_instrument (Instrument -> Text -> Instrument
string_inst Instrument
inst Text
string) Deriver b
deriver
            (Maybe Instrument, Maybe Text)
_ -> Deriver b
deriver
    string_inst :: Instrument -> Text -> Instrument
string_inst Instrument
inst Text
string =
        Text -> Instrument
ScoreT.Instrument (Text -> Instrument) -> Text -> Instrument
forall a b. (a -> b) -> a -> b
$ Instrument -> Text
ScoreT.instrument_name Instrument
inst Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
string

strings :: [Text]
strings :: [Text]
strings = [Text
"e1", Text
"a", Text
"d", Text
"g", Text
"b", Text
"e2"]

-- | Create the proper midi config to work with the string attrs used by
-- 'note_call'.
allocations :: Text -> InstT.Name -> UiConfig.Allocations
allocations :: Text -> Text -> Allocations
allocations Text
dev_name Text
name = [(Instrument, (Qualified, Config))] -> Allocations
UiConfig.midi_allocations ([(Instrument, (Qualified, Config))] -> Allocations)
-> [(Instrument, (Qualified, Config))] -> Allocations
forall a b. (a -> b) -> a -> b
$
    Text -> Control -> (Instrument, (Qualified, Config))
inst Text
name Control
0 (Instrument, (Qualified, Config))
-> [(Instrument, (Qualified, Config))]
-> [(Instrument, (Qualified, Config))]
forall a. a -> [a] -> [a]
: [Text -> Control -> (Instrument, (Qualified, Config))
inst (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
string) Control
chan
        | (Text
string, Control
chan) <- [Text] -> [Control] -> [(Text, Control)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
strings [Control
1..]]
    where
    inst :: Text -> Control -> (Instrument, (Qualified, Config))
inst Text
name Control
chan =
        ( Text -> Instrument
ScoreT.Instrument Text
name
        , (Text -> Text -> Qualified
InstT.Qualified Text
synth_name Text
name, WriteDevice -> Control -> Config
MidiInst.config1 WriteDevice
dev Control
chan)
        )
    dev :: WriteDevice
dev = Text -> WriteDevice
Midi.write_device Text
dev_name