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

module User.Generic.Instrument.GeneralMidi where
import qualified Data.Text as Text

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.Expr as Expr
import qualified Midi.Midi as Midi
import qualified Perform.Midi.Patch as Patch

import           Global


synth :: MidiInst.Synth
synth :: Synth
synth =
    Text -> Text -> [Patch] -> Synth
MidiInst.synth Text
"gm" Text
"Yes it's General MIDI." ([Patch] -> Synth) -> [Patch] -> Synth
forall a b. (a -> b) -> a -> b
$
        [(Program, Control)] -> [Patch] -> [Patch]
MidiInst.synth_controls [(Program, Control)]
forall {a}. [a]
controls ([Patch] -> [Patch]) -> [Patch] -> [Patch]
forall a b. (a -> b) -> a -> b
$
        PbRange -> [(Program, Control)] -> Patch
MidiInst.default_patch PbRange
pb_range [] Patch -> [Patch] -> [Patch]
forall a. a -> [a] -> [a]
: [Patch]
patches
    where
    controls :: [a]
controls = []

-- Who knows really, but fluidsynth seems to hardcode this.
pb_range :: (Int, Int)
pb_range :: PbRange
pb_range = (-Int
2, Int
2)

patches :: [MidiInst.Patch]
patches :: [Patch]
patches = Patch
percussion Patch -> [Patch] -> [Patch]
forall a. a -> [a] -> [a]
: ((Program, Text) -> Patch) -> [(Program, Text)] -> [Patch]
forall a b. (a -> b) -> [a] -> [b]
map ((Program -> Text -> Patch) -> (Program, Text) -> Patch
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Program -> Text -> Patch
make_patch) ([Program] -> [Text] -> [(Program, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Program
0..] [Text]
patch_names)

percussion :: MidiInst.Patch
percussion :: Patch
percussion =
    Lens Patch Doc
MidiInst.doc Lens Patch Doc -> Doc -> Patch -> Patch
forall f a. Lens f a -> a -> f -> f
#= Doc
"This must be allocated on channel 10, GM says so." (Patch -> Patch) -> Patch -> Patch
forall a b. (a -> b) -> a -> b
$
    Thru -> Maybe Control -> [(Stroke, Key)] -> Patch -> Patch
CUtil.simple_drum Thru
CUtil.MidiThru Maybe Control
forall a. Maybe a
Nothing [(Stroke, Key)]
stroke_keys (Patch -> Patch) -> Patch -> Patch
forall a b. (a -> b) -> a -> b
$
    PbRange -> Text -> [(Program, Control)] -> Patch
MidiInst.named_patch PbRange
pb_range Text
"percussion" []

make_patch :: Midi.Program -> Text -> MidiInst.Patch
make_patch :: Program -> Text -> Patch
make_patch Program
pgm Text
name = Program -> Patch -> Patch
set_pgm Program
pgm (Patch -> Patch) -> Patch -> Patch
forall a b. (a -> b) -> a -> b
$ PbRange -> Text -> [(Program, Control)] -> Patch
MidiInst.named_patch PbRange
pb_range Text
name []

set_pgm :: Midi.Program -> MidiInst.Patch -> MidiInst.Patch
set_pgm :: Program -> Patch -> Patch
set_pgm Program
pgm = Patch :-> Patch
MidiInst.patch(Patch :-> Patch)
-> Lens Patch InitializePatch -> Lens Patch InitializePatch
forall a b c. Lens a b -> Lens b c -> Lens a c
#Lens Patch InitializePatch
Patch.initialize
    #= Patch.initialize_midi [Midi.ProgramChange pgm]

clean :: Text -> Text
clean :: Text -> Text
clean = Text -> Text -> Text -> Text
Text.replace Text
")" Text
"" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
Text.replace Text
"(" Text
"" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
Text.replace Text
" " Text
"-"
    (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.toLower

-- Copied and pasted from wikipedia.

patch_names :: [Text]
patch_names :: [Text]
patch_names = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
clean
    -- Piano
    [ Text
"Acoustic Grand Piano"
    , Text
"Bright Acoustic Piano"
    , Text
"Electric Grand Piano"
    , Text
"Honky-tonk Piano"
    , Text
"Electric Piano 1"
    , Text
"Electric Piano 2"
    , Text
"Harpsichord"
    , Text
"Clavi"
    -- Chromatic Percussion
    , Text
"Celesta"
    , Text
"Glockenspiel"
    , Text
"Music Box"
    , Text
"Vibraphone"
    , Text
"Marimba"
    , Text
"Xylophone"
    , Text
"Tubular Bells"
    , Text
"Dulcimer"
    -- Organ
    , Text
"Drawbar Organ"
    , Text
"Percussive Organ"
    , Text
"Rock Organ"
    , Text
"Church Organ"
    , Text
"Reed Organ"
    , Text
"Accordion"
    , Text
"Harmonica"
    , Text
"Tango Accordion"
    -- Guitar
    , Text
"Acoustic Guitar (nylon)"
    , Text
"Acoustic Guitar (steel)"
    , Text
"Electric Guitar (jazz)"
    , Text
"Electric Guitar (clean)"
    , Text
"Electric Guitar (muted)"
    , Text
"Overdriven Guitar"
    , Text
"Distortion Guitar"
    , Text
"Guitar Harmonics"
    -- Bass
    , Text
"Acoustic Bass"
    , Text
"Electric Bass (finger)"
    , Text
"Electric Bass (pick)"
    , Text
"Fretless Bass"
    , Text
"Slap Bass 1"
    , Text
"Slap Bass 2"
    , Text
"Synth Bass 1"
    , Text
"Synth Bass 2"
    -- Strings
    , Text
"Violin"
    , Text
"Viola"
    , Text
"Cello"
    , Text
"Contrabass"
    , Text
"Tremolo Strings"
    , Text
"Pizzicato Strings"
    , Text
"Orchestral Harp"
    , Text
"Timpani"
    -- Ensemble
    , Text
"String Ensemble 1"
    , Text
"String Ensemble 2"
    , Text
"Synth Strings 1"
    , Text
"Synth Strings 2"
    , Text
"Choir Aahs"
    , Text
"Voice Oohs"
    , Text
"Synth Voice"
    , Text
"Orchestra Hit"
    -- Brass
    , Text
"Trumpet"
    , Text
"Trombone"
    , Text
"Tuba"
    , Text
"Muted Trumpet"
    , Text
"French Horn"
    , Text
"Brass Section"
    , Text
"Synth Brass 1"
    , Text
"Synth Brass 2"
    -- Reed
    , Text
"Soprano Sax"
    , Text
"Alto Sax"
    , Text
"Tenor Sax"
    , Text
"Baritone Sax"
    , Text
"Oboe"
    , Text
"English Horn"
    , Text
"Bassoon"
    , Text
"Clarinet"
    -- Pipe
    , Text
"Piccolo"
    , Text
"Flute"
    , Text
"Recorder"
    , Text
"Pan Flute"
    , Text
"Blown bottle"
    , Text
"Shakuhachi"
    , Text
"Whistle"
    , Text
"Ocarina"
    -- Synth Lead
    , Text
"Lead 1 (square)"
    , Text
"Lead 2 (sawtooth)"
    , Text
"Lead 3 (calliope)"
    , Text
"Lead 4 (chiff)"
    , Text
"Lead 5 (charang)"
    , Text
"Lead 6 (voice)"
    , Text
"Lead 7 (fifths)"
    , Text
"Lead 8 (bass + lead)"
    -- Synth Pad
    , Text
"Pad 1 (new age)"
    , Text
"Pad 2 (warm)"
    , Text
"Pad 3 (polysynth)"
    , Text
"Pad 4 (choir)"
    , Text
"Pad 5 (bowed)"
    , Text
"Pad 6 (metallic)"
    , Text
"Pad 7 (halo)"
    , Text
"Pad 8 (sweep)"
    -- Synth Effects
    , Text
"FX 1 (rain)"
    , Text
"FX 2 (soundtrack)"
    , Text
"FX 3 (crystal)"
    , Text
"FX 4 (atmosphere)"
    , Text
"FX 5 (brightness)"
    , Text
"FX 6 (goblins)"
    , Text
"FX 7 (echoes)"
    , Text
"FX 8 (sci-fi)"
    -- Ethnic
    , Text
"Sitar"
    , Text
"Banjo"
    , Text
"Shamisen"
    , Text
"Koto"
    , Text
"Kalimba"
    , Text
"Bag pipe"
    , Text
"Fiddle"
    , Text
"Shanai"
    -- Percussive
    , Text
"Tinkle Bell"
    , Text
"Agogo"
    , Text
"Steel Drums"
    , Text
"Woodblock"
    , Text
"Taiko Drum"
    , Text
"Melodic Tom"
    , Text
"Synth Drum"
    , Text
"Reverse Cymbal"
    -- Sound Effects
    , Text
"Guitar Fret Noise"
    , Text
"Breath Noise"
    , Text
"Seashore"
    , Text
"Bird Tweet"
    , Text
"Telephone Ring"
    , Text
"Helicopter"
    , Text
"Applause"
    , Text
"Gunshot"
    ]

stroke_keys :: [(Drums.Stroke, Midi.Key)]
stroke_keys :: [(Stroke, Key)]
stroke_keys = ((Key, Text, Maybe Stroke) -> (Stroke, Key))
-> [(Key, Text, Maybe Stroke)] -> [(Stroke, Key)]
forall a b. (a -> b) -> [a] -> [b]
map (Key, Text, Maybe Stroke) -> (Stroke, Key)
forall {b}. (b, Text, Maybe Stroke) -> (Stroke, b)
make
    -- Clearly more of these could be mapped.  I'll do it someday if I need it.
    [ (Key
27, Text
"High Q",            Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
28, Text
"Slap",              Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
29, Text
"Scratch Push",      Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
30, Text
"Scratch Pull",      Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
31, Text
"Sticks",            Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
32, Text
"Square Click",      Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
33, Text
"Metronome Click",   Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
34, Text
"Metronome Bell",    Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
35, Text
"Acoustic Bass Drum", Stroke -> Maybe Stroke
forall a. a -> Maybe a
Just Stroke
Drums.c_bd)
    , (Key
36, Text
"Electric Bass Drum", Stroke -> Maybe Stroke
forall a. a -> Maybe a
Just Stroke
Drums.c_bd2)
    , (Key
37, Text
"Side Stick",        Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
38, Text
"Acoustic Snare",    Stroke -> Maybe Stroke
forall a. a -> Maybe a
Just Stroke
Drums.c_sn)
    , (Key
39, Text
"Hand Clap",         Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
40, Text
"Electric Snare",    Stroke -> Maybe Stroke
forall a. a -> Maybe a
Just Stroke
Drums.c_sn2)
    , (Key
41, Text
"Low Floor Tom",     Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
42, Text
"Closed Hi-hat",     Stroke -> Maybe Stroke
forall a. a -> Maybe a
Just Stroke
Drums.c_hh)
    , (Key
43, Text
"High Floor Tom",    Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
44, Text
"Pedal Hi-hat",      Stroke -> Maybe Stroke
forall a. a -> Maybe a
Just Stroke
Drums.c_phh)
    , (Key
45, Text
"Low Tom",           Stroke -> Maybe Stroke
forall a. a -> Maybe a
Just Stroke
Drums.c_ltom)
    , (Key
46, Text
"Open Hi-hat",       Stroke -> Maybe Stroke
forall a. a -> Maybe a
Just Stroke
Drums.c_ohh)
    , (Key
47, Text
"Low-Mid Tom",       Stroke -> Maybe Stroke
forall a. a -> Maybe a
Just Stroke
Drums.c_mtom)
    , (Key
48, Text
"Hi-Mid Tom",        Stroke -> Maybe Stroke
forall a. a -> Maybe a
Just Stroke
Drums.c_hmtom)
    , (Key
49, Text
"Crash Cymbal 1",    Stroke -> Maybe Stroke
forall a. a -> Maybe a
Just Stroke
Drums.c_crash)
    , (Key
50, Text
"High Tom",          Stroke -> Maybe Stroke
forall a. a -> Maybe a
Just Stroke
Drums.c_htom)
    , (Key
51, Text
"Ride Cymbal 1",     Stroke -> Maybe Stroke
forall a. a -> Maybe a
Just Stroke
Drums.c_ride)
    , (Key
52, Text
"Chinese Cymbal",    Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
53, Text
"Ride Bell",         Stroke -> Maybe Stroke
forall a. a -> Maybe a
Just Stroke
Drums.c_bell)
    , (Key
54, Text
"Tambourine",        Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
55, Text
"Splash Cymbal",     Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
56, Text
"Cowbell",           Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
57, Text
"Crash Cymbal 2",    Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
58, Text
"Vibra Slap",        Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
59, Text
"Ride Cymbal 2",     Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
60, Text
"High Bongo",        Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
61, Text
"Low Bongo",         Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
62, Text
"Mute High Conga",   Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
63, Text
"Open High Conga",   Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
64, Text
"Low Conga",         Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
65, Text
"High Timbale",      Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
66, Text
"Low Timbale",       Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
67, Text
"High Agogo",        Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
68, Text
"Low Agogo",         Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
69, Text
"Cabasa",            Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
70, Text
"Maracas",           Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
71, Text
"Short Whistle",     Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
72, Text
"Long Whistle",      Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
73, Text
"Short Guiro",       Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
74, Text
"Long Guiro",        Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
75, Text
"Claves",            Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
76, Text
"High Woodblock",    Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
77, Text
"Low Woodblock",     Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
78, Text
"Mute Cuica",        Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
79, Text
"Open Cuica",        Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
80, Text
"Mute Triangle",     Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
81, Text
"Open Triangle",     Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
82, Text
"Shaker",            Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
83, Text
"Jingle Bell",       Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
84, Text
"Belltree",          Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
85, Text
"Castanets",         Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
86, Text
"Mute Surdo",        Maybe Stroke
forall a. Maybe a
Nothing)
    , (Key
87, Text
"Open Surdo",        Maybe Stroke
forall a. Maybe a
Nothing)
    ]
    where
    make :: (b, Text, Maybe Stroke) -> (Stroke, b)
make (b
key, Text
name, Maybe Stroke
mb_stroke) = (Stroke -> Maybe Stroke -> Stroke
forall a. a -> Maybe a -> a
fromMaybe (Text -> Stroke
generic Text
name) Maybe Stroke
mb_stroke, b
key)
    -- Make a generic unbound stroke.
    generic :: Text -> Stroke
generic Text
name = Char -> Symbol -> Attributes -> Stroke
Drums.stroke Char
' ' (Text -> Symbol
Expr.Symbol Text
name) (Text -> Attributes
Attrs.attr Text
name)