-- 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." forall a b. (a -> b) -> a -> b
$
        [(Program, Control)] -> [Patch] -> [Patch]
MidiInst.synth_controls forall {a}. [a]
controls forall a b. (a -> b) -> a -> b
$
        PbRange -> [(Program, Control)] -> Patch
MidiInst.default_patch PbRange
pb_range [] 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 forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Program -> Text -> Patch
make_patch) (forall a b. [a] -> [b] -> [(a, b)]
zip [Program
0..] [Text]
patch_names)

percussion :: MidiInst.Patch
percussion :: Patch
percussion =
    Lens Patch Doc
MidiInst.doc forall f a. Lens f a -> a -> f -> f
#= Doc
"This must be allocated on channel 10, GM says so." forall a b. (a -> b) -> a -> b
$
    Thru -> Maybe Control -> [(Stroke, Key)] -> Patch -> Patch
CUtil.simple_drum Thru
CUtil.MidiThru forall a. Maybe a
Nothing [(Stroke, Key)]
stroke_keys 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 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.patchforall a b c. Lens a b -> Lens b c -> Lens a c
#Patch :-> InitializePatch
Patch.initialize
    #= Patch.initialize_midi [Midi.ProgramChange pgm]

clean :: Text -> Text
clean :: Text -> Text
clean = HasCallStack => Text -> Text -> Text -> Text
Text.replace Text
")" Text
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text.replace Text
"(" Text
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text.replace 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 = 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 = forall a b. (a -> b) -> [a] -> [b]
map 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",            forall a. Maybe a
Nothing)
    , (Key
28, Text
"Slap",              forall a. Maybe a
Nothing)
    , (Key
29, Text
"Scratch Push",      forall a. Maybe a
Nothing)
    , (Key
30, Text
"Scratch Pull",      forall a. Maybe a
Nothing)
    , (Key
31, Text
"Sticks",            forall a. Maybe a
Nothing)
    , (Key
32, Text
"Square Click",      forall a. Maybe a
Nothing)
    , (Key
33, Text
"Metronome Click",   forall a. Maybe a
Nothing)
    , (Key
34, Text
"Metronome Bell",    forall a. Maybe a
Nothing)
    , (Key
35, Text
"Acoustic Bass Drum", forall a. a -> Maybe a
Just Stroke
Drums.c_bd)
    , (Key
36, Text
"Electric Bass Drum", forall a. a -> Maybe a
Just Stroke
Drums.c_bd2)
    , (Key
37, Text
"Side Stick",        forall a. Maybe a
Nothing)
    , (Key
38, Text
"Acoustic Snare",    forall a. a -> Maybe a
Just Stroke
Drums.c_sn)
    , (Key
39, Text
"Hand Clap",         forall a. Maybe a
Nothing)
    , (Key
40, Text
"Electric Snare",    forall a. a -> Maybe a
Just Stroke
Drums.c_sn2)
    , (Key
41, Text
"Low Floor Tom",     forall a. Maybe a
Nothing)
    , (Key
42, Text
"Closed Hi-hat",     forall a. a -> Maybe a
Just Stroke
Drums.c_hh)
    , (Key
43, Text
"High Floor Tom",    forall a. Maybe a
Nothing)
    , (Key
44, Text
"Pedal Hi-hat",      forall a. a -> Maybe a
Just Stroke
Drums.c_phh)
    , (Key
45, Text
"Low Tom",           forall a. a -> Maybe a
Just Stroke
Drums.c_ltom)
    , (Key
46, Text
"Open Hi-hat",       forall a. a -> Maybe a
Just Stroke
Drums.c_ohh)
    , (Key
47, Text
"Low-Mid Tom",       forall a. a -> Maybe a
Just Stroke
Drums.c_mtom)
    , (Key
48, Text
"Hi-Mid Tom",        forall a. a -> Maybe a
Just Stroke
Drums.c_hmtom)
    , (Key
49, Text
"Crash Cymbal 1",    forall a. a -> Maybe a
Just Stroke
Drums.c_crash)
    , (Key
50, Text
"High Tom",          forall a. a -> Maybe a
Just Stroke
Drums.c_htom)
    , (Key
51, Text
"Ride Cymbal 1",     forall a. a -> Maybe a
Just Stroke
Drums.c_ride)
    , (Key
52, Text
"Chinese Cymbal",    forall a. Maybe a
Nothing)
    , (Key
53, Text
"Ride Bell",         forall a. a -> Maybe a
Just Stroke
Drums.c_bell)
    , (Key
54, Text
"Tambourine",        forall a. Maybe a
Nothing)
    , (Key
55, Text
"Splash Cymbal",     forall a. Maybe a
Nothing)
    , (Key
56, Text
"Cowbell",           forall a. Maybe a
Nothing)
    , (Key
57, Text
"Crash Cymbal 2",    forall a. Maybe a
Nothing)
    , (Key
58, Text
"Vibra Slap",        forall a. Maybe a
Nothing)
    , (Key
59, Text
"Ride Cymbal 2",     forall a. Maybe a
Nothing)
    , (Key
60, Text
"High Bongo",        forall a. Maybe a
Nothing)
    , (Key
61, Text
"Low Bongo",         forall a. Maybe a
Nothing)
    , (Key
62, Text
"Mute High Conga",   forall a. Maybe a
Nothing)
    , (Key
63, Text
"Open High Conga",   forall a. Maybe a
Nothing)
    , (Key
64, Text
"Low Conga",         forall a. Maybe a
Nothing)
    , (Key
65, Text
"High Timbale",      forall a. Maybe a
Nothing)
    , (Key
66, Text
"Low Timbale",       forall a. Maybe a
Nothing)
    , (Key
67, Text
"High Agogo",        forall a. Maybe a
Nothing)
    , (Key
68, Text
"Low Agogo",         forall a. Maybe a
Nothing)
    , (Key
69, Text
"Cabasa",            forall a. Maybe a
Nothing)
    , (Key
70, Text
"Maracas",           forall a. Maybe a
Nothing)
    , (Key
71, Text
"Short Whistle",     forall a. Maybe a
Nothing)
    , (Key
72, Text
"Long Whistle",      forall a. Maybe a
Nothing)
    , (Key
73, Text
"Short Guiro",       forall a. Maybe a
Nothing)
    , (Key
74, Text
"Long Guiro",        forall a. Maybe a
Nothing)
    , (Key
75, Text
"Claves",            forall a. Maybe a
Nothing)
    , (Key
76, Text
"High Woodblock",    forall a. Maybe a
Nothing)
    , (Key
77, Text
"Low Woodblock",     forall a. Maybe a
Nothing)
    , (Key
78, Text
"Mute Cuica",        forall a. Maybe a
Nothing)
    , (Key
79, Text
"Open Cuica",        forall a. Maybe a
Nothing)
    , (Key
80, Text
"Mute Triangle",     forall a. Maybe a
Nothing)
    , (Key
81, Text
"Open Triangle",     forall a. Maybe a
Nothing)
    , (Key
82, Text
"Shaker",            forall a. Maybe a
Nothing)
    , (Key
83, Text
"Jingle Bell",       forall a. Maybe a
Nothing)
    , (Key
84, Text
"Belltree",          forall a. Maybe a
Nothing)
    , (Key
85, Text
"Castanets",         forall a. Maybe a
Nothing)
    , (Key
86, Text
"Mute Surdo",        forall a. Maybe a
Nothing)
    , (Key
87, Text
"Open Surdo",        forall a. Maybe a
Nothing)
    ]
    where
    make :: (b, Text, Maybe Stroke) -> (Stroke, b)
make (b
key, Text
name, Maybe Stroke
mb_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)