{- |
General-MIDI definitions.

Taken from Haskore.
-}

module Sound.MIDI.General where

import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg
import           Sound.MIDI.Message.Channel (Channel, toChannel, )
import           Data.Ix(Ix)
import qualified Data.List as List

import Sound.MIDI.Utility
          (enumRandomR, boundedEnumRandom, chooseEnum, )
import Data.Tuple.HT (mapSnd, )
import Test.QuickCheck (Arbitrary(arbitrary), )
import System.Random (Random(random,randomR), )


{- * Instrument definitions -}

instrumentNameToProgram :: String -> Maybe VoiceMsg.Program
instrumentNameToProgram :: String -> Maybe Program
instrumentNameToProgram =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Program
VoiceMsg.toProgram forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Eq a => a -> [a] -> Maybe Int
List.elemIndex [String]
instrumentNames

instrumentNames :: [String]
instrumentNames :: [String]
instrumentNames = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(String, Program)]
instrumentPrograms

instrumentPrograms :: [(String, VoiceMsg.Program)]
instrumentPrograms :: [(String, Program)]
instrumentPrograms =
   forall a b. (a -> b) -> [a] -> [b]
map (forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd Int -> Program
VoiceMsg.toProgram) [
      (String
"Acoustic Grand Piano",Int
0),       (String
"Bright Acoustic Piano",Int
1),
      (String
"Electric Grand Piano",Int
2),       (String
"Honky Tonk Piano",Int
3),
      (String
"Rhodes Piano",Int
4),               (String
"Chorused Piano",Int
5),
      (String
"Harpsichord",Int
6),                (String
"Clavinet",Int
7),
      (String
"Celesta",Int
8),                    (String
"Glockenspiel",Int
9),
      (String
"Music Box",Int
10),                 (String
"Vibraphone",Int
11),
      (String
"Marimba",Int
12),                   (String
"Xylophone",Int
13),
      (String
"Tubular Bells",Int
14),             (String
"Dulcimer",Int
15),
      (String
"Hammond Organ",Int
16),             (String
"Percussive Organ",Int
17),
      (String
"Rock Organ",Int
18),                (String
"Church Organ",Int
19),
      (String
"Reed Organ",Int
20),                (String
"Accordion",Int
21),
      (String
"Harmonica",Int
22),                 (String
"Tango Accordion",Int
23),
      (String
"Acoustic Guitar (nylon)",Int
24),   (String
"Acoustic Guitar (steel)",Int
25),
      (String
"Electric Guitar (jazz)",Int
26),    (String
"Electric Guitar (clean)",Int
27),
      (String
"Electric Guitar (muted)",Int
28),   (String
"Overdriven Guitar",Int
29),
      (String
"Distortion Guitar",Int
30),         (String
"Guitar Harmonics",Int
31),
      (String
"Acoustic Bass",Int
32),             (String
"Electric Bass (fingered)",Int
33),
      (String
"Electric Bass (picked)",Int
34),    (String
"Fretless Bass",Int
35),
      (String
"Slap Bass 1",Int
36),               (String
"Slap Bass 2",Int
37),
      (String
"Synth Bass 1",Int
38),              (String
"Synth Bass 2",Int
39),
      (String
"Violin",Int
40),                    (String
"Viola",Int
41),
      (String
"Cello",Int
42),                     (String
"Contrabass",Int
43),
      (String
"Tremolo Strings",Int
44),           (String
"Pizzicato Strings",Int
45),
      (String
"Orchestral Harp",Int
46),           (String
"Timpani",Int
47),
      (String
"String Ensemble 1",Int
48),         (String
"String Ensemble 2",Int
49),
      (String
"Synth Strings 1",Int
50),           (String
"Synth Strings 2",Int
51),
      (String
"Choir Aahs",Int
52),                (String
"Voice Oohs",Int
53),
      (String
"Synth Voice",Int
54),               (String
"Orchestra Hit",Int
55),
      (String
"Trumpet",Int
56),                   (String
"Trombone",Int
57),
      (String
"Tuba",Int
58),                      (String
"Muted Trumpet",Int
59),
      (String
"French Horn",Int
60),               (String
"Brass Section",Int
61),
      (String
"Synth Brass 1",Int
62),             (String
"Synth Brass 2",Int
63),
      (String
"Soprano Sax",Int
64),               (String
"Alto Sax",Int
65),
      (String
"Tenor Sax",Int
66),                 (String
"Baritone Sax",Int
67),
      (String
"Oboe",Int
68),                      (String
"Bassoon",Int
69),
      (String
"English Horn",Int
70),              (String
"Clarinet",Int
71),
      (String
"Piccolo",Int
72),                   (String
"Flute",Int
73),
      (String
"Recorder",Int
74),                  (String
"Pan Flute",Int
75),
      (String
"Blown Bottle",Int
76),              (String
"Shakuhachi",Int
77),
      (String
"Whistle",Int
78),                   (String
"Ocarina",Int
79),
      (String
"Lead 1 (square)",Int
80),           (String
"Lead 2 (sawtooth)",Int
81),
      (String
"Lead 3 (calliope)",Int
82),         (String
"Lead 4 (chiff)",Int
83),
      (String
"Lead 5 (charang)",Int
84),          (String
"Lead 6 (voice)",Int
85),
      (String
"Lead 7 (fifths)",Int
86),           (String
"Lead 8 (bass+lead)",Int
87),
      (String
"Pad 1 (new age)",Int
88),           (String
"Pad 2 (warm)",Int
89),
      (String
"Pad 3 (polysynth)",Int
90),         (String
"Pad 4 (choir)",Int
91),
      (String
"Pad 5 (bowed)",Int
92),             (String
"Pad 6 (metallic)",Int
93),
      (String
"Pad 7 (halo)",Int
94),              (String
"Pad 8 (sweep)",Int
95),
      (String
"FX1 (train)",Int
96),               (String
"FX2 (soundtrack)",Int
97),
      (String
"FX3 (crystal)",Int
98),             (String
"FX4 (atmosphere)",Int
99),
      (String
"FX5 (brightness)",Int
100),         (String
"FX6 (goblins)",Int
101),
      (String
"FX7 (echoes)",Int
102),             (String
"FX8 (sci-fi)",Int
103),
      (String
"Sitar",Int
104),                    (String
"Banjo",Int
105),
      (String
"Shamisen",Int
106),                 (String
"Koto",Int
107),
      (String
"Kalimba",Int
108),                  (String
"Bagpipe",Int
109),
      (String
"Fiddle",Int
110),                   (String
"Shanai",Int
111),
      (String
"Tinkle Bell",Int
112),              (String
"Agogo",Int
113),
      (String
"Steel Drums",Int
114),              (String
"Woodblock",Int
115),
      (String
"Taiko Drum",Int
116),               (String
"Melodic Drum",Int
117),
      (String
"Synth Drum",Int
118),               (String
"Reverse Cymbal",Int
119),
      (String
"Guitar Fret Noise",Int
120),        (String
"Breath Noise",Int
121),
      (String
"Seashore",Int
122),                 (String
"Bird Tweet",Int
123),
      (String
"Telephone Ring",Int
124),           (String
"Helicopter",Int
125),
      (String
"Applause",Int
126),                 (String
"Gunshot",Int
127)
   ]

instrumentFromProgram :: VoiceMsg.Program -> Instrument
instrumentFromProgram :: Program -> Instrument
instrumentFromProgram = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> Int
VoiceMsg.fromProgram

instrumentToProgram :: Instrument -> VoiceMsg.Program
instrumentToProgram :: Instrument -> Program
instrumentToProgram = Int -> Program
VoiceMsg.toProgram forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum

instrumentChannels :: [Channel]
instrumentChannels :: [Channel]
instrumentChannels = forall a b. (a -> b) -> [a] -> [b]
map Int -> Channel
toChannel forall a b. (a -> b) -> a -> b
$ [Int
0..Int
8] forall a. [a] -> [a] -> [a]
++ [Int
10..Int
15]

instruments :: [Instrument]
instruments :: [Instrument]
instruments = forall a. Enum a => a -> a -> [a]
enumFromTo forall a. Bounded a => a
minBound forall a. Bounded a => a
maxBound

data Instrument =
     AcousticGrandPiano              | BrightAcousticPiano
   | ElectricGrandPiano              | HonkyTonk
   | ElectricPiano1                  | ElectricPiano2
   | Harpsichord                     | Clavinet
   | Celesta                         | Glockenspiel
   | MusicBox                        | Vibraphone
   | Marimba                         | Xylophone
   | TubularBells                    | Dulcimer
   | DrawbarOrgan                    | PercussiveOrgan
   | RockOrgan                       | ChurchOrgan
   | ReedOrgan                       | Accordion
   | Harmonica                       | TangoAccordian
   | AcousticGuitarNylon             | AcousticGuitarSteel
   | ElectricGuitarJazz              | ElectricGuitarClean
   | ElectricGuitarMuted             | OverdrivenGuitar
   | DistortionGuitar                | GuitarHarmonics
   | AcousticBass                    | ElectricBassFinger
   | ElectricBassPick                | FretlessBass
   | SlapBass1                       | SlapBass2
   | SynthBass1                      | SynthBass2
   | Violin                          | Viola
   | Cello                           | Contrabass
   | TremoloStrings                  | PizzicatoStrings
   | OrchestralHarp                  | Timpani
   | StringEnsemble1                 | StringEnsemble2
   | SynthStrings1                   | SynthStrings2
   | ChoirAahs                       | VoiceOohs
   | SynthVoice                      | OrchestraHit
   | Trumpet                         | Trombone
   | Tuba                            | MutedTrumpet
   | FrenchHorn                      | BrassSection
   | SynthBrass1                     | SynthBrass2
   | SopranoSax                      | AltoSax
   | TenorSax                        | BaritoneSax
   | Oboe                            | EnglishHorn
   | Bassoon                         | Clarinet
   | Piccolo                         | Flute
   | Recorder                        | PanFlute
   | BlownBottle                     | Skakuhachi
   | Whistle                         | Ocarina
   | Lead1Square                     | Lead2Sawtooth
   | Lead3Calliope                   | Lead4Chiff
   | Lead5Charang                    | Lead6Voice
   | Lead7Fifths                     | Lead8BassLead
   | Pad1NewAge                      | Pad2Warm
   | Pad3Polysynth                   | Pad4Choir
   | Pad5Bowed                       | Pad6Metallic
   | Pad7Halo                        | Pad8Sweep
   | FX1Rain                         | FX2Soundtrack
   | FX3Crystal                      | FX4Atmosphere
   | FX5Brightness                   | FX6Goblins
   | FX7Echoes                       | FX8SciFi
   | Sitar                           | Banjo
   | Shamisen                        | Koto
   | Kalimba                         | Bagpipe
   | Fiddle                          | Shanai
   | TinkleBell                      | Agogo
   | SteelDrums                      | Woodblock
   | TaikoDrum                       | MelodicTom
   | SynthDrum                       | ReverseCymbal
   | GuitarFretNoise                 | BreathNoise
   | Seashore                        | BirdTweet
   | TelephoneRing                   | Helicopter
   | Applause                        | Gunshot
     deriving (Int -> Instrument -> ShowS
[Instrument] -> ShowS
Instrument -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Instrument] -> ShowS
$cshowList :: [Instrument] -> ShowS
show :: Instrument -> String
$cshow :: Instrument -> String
showsPrec :: Int -> Instrument -> ShowS
$cshowsPrec :: Int -> Instrument -> ShowS
Show, Instrument -> Instrument -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Instrument -> Instrument -> Bool
$c/= :: Instrument -> Instrument -> Bool
== :: Instrument -> Instrument -> Bool
$c== :: Instrument -> Instrument -> Bool
Eq, Eq Instrument
Instrument -> Instrument -> Bool
Instrument -> Instrument -> Ordering
Instrument -> Instrument -> Instrument
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Instrument -> Instrument -> Instrument
$cmin :: Instrument -> Instrument -> Instrument
max :: Instrument -> Instrument -> Instrument
$cmax :: Instrument -> Instrument -> Instrument
>= :: Instrument -> Instrument -> Bool
$c>= :: Instrument -> Instrument -> Bool
> :: Instrument -> Instrument -> Bool
$c> :: Instrument -> Instrument -> Bool
<= :: Instrument -> Instrument -> Bool
$c<= :: Instrument -> Instrument -> Bool
< :: Instrument -> Instrument -> Bool
$c< :: Instrument -> Instrument -> Bool
compare :: Instrument -> Instrument -> Ordering
$ccompare :: Instrument -> Instrument -> Ordering
Ord, Ord Instrument
(Instrument, Instrument) -> Int
(Instrument, Instrument) -> [Instrument]
(Instrument, Instrument) -> Instrument -> Bool
(Instrument, Instrument) -> Instrument -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Instrument, Instrument) -> Int
$cunsafeRangeSize :: (Instrument, Instrument) -> Int
rangeSize :: (Instrument, Instrument) -> Int
$crangeSize :: (Instrument, Instrument) -> Int
inRange :: (Instrument, Instrument) -> Instrument -> Bool
$cinRange :: (Instrument, Instrument) -> Instrument -> Bool
unsafeIndex :: (Instrument, Instrument) -> Instrument -> Int
$cunsafeIndex :: (Instrument, Instrument) -> Instrument -> Int
index :: (Instrument, Instrument) -> Instrument -> Int
$cindex :: (Instrument, Instrument) -> Instrument -> Int
range :: (Instrument, Instrument) -> [Instrument]
$crange :: (Instrument, Instrument) -> [Instrument]
Ix, Int -> Instrument
Instrument -> Int
Instrument -> [Instrument]
Instrument -> Instrument
Instrument -> Instrument -> [Instrument]
Instrument -> Instrument -> Instrument -> [Instrument]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Instrument -> Instrument -> Instrument -> [Instrument]
$cenumFromThenTo :: Instrument -> Instrument -> Instrument -> [Instrument]
enumFromTo :: Instrument -> Instrument -> [Instrument]
$cenumFromTo :: Instrument -> Instrument -> [Instrument]
enumFromThen :: Instrument -> Instrument -> [Instrument]
$cenumFromThen :: Instrument -> Instrument -> [Instrument]
enumFrom :: Instrument -> [Instrument]
$cenumFrom :: Instrument -> [Instrument]
fromEnum :: Instrument -> Int
$cfromEnum :: Instrument -> Int
toEnum :: Int -> Instrument
$ctoEnum :: Int -> Instrument
pred :: Instrument -> Instrument
$cpred :: Instrument -> Instrument
succ :: Instrument -> Instrument
$csucc :: Instrument -> Instrument
Enum, Instrument
forall a. a -> a -> Bounded a
maxBound :: Instrument
$cmaxBound :: Instrument
minBound :: Instrument
$cminBound :: Instrument
Bounded)

instance Random Instrument where
   random :: forall g. RandomGen g => g -> (Instrument, g)
random  = forall a g. (Enum a, Bounded a, RandomGen g) => g -> (a, g)
boundedEnumRandom
   randomR :: forall g.
RandomGen g =>
(Instrument, Instrument) -> g -> (Instrument, g)
randomR = forall a g. (Enum a, RandomGen g) => (a, a) -> g -> (a, g)
enumRandomR

instance Arbitrary Instrument where
   arbitrary :: Gen Instrument
arbitrary = forall a. (Enum a, Bounded a, Random a) => Gen a
chooseEnum



{- * Drum definitions -}


drumChannel :: Channel
drumChannel :: Channel
drumChannel = Int -> Channel
toChannel Int
9

drumProgram :: VoiceMsg.Program
drumProgram :: Program
drumProgram = Int -> Program
VoiceMsg.toProgram Int
0

drumMinKey :: VoiceMsg.Pitch
drumMinKey :: Pitch
drumMinKey = Int -> Pitch
VoiceMsg.toPitch Int
35

drumKeyTable :: [(Drum, VoiceMsg.Pitch)]
drumKeyTable :: [(Drum, Pitch)]
drumKeyTable = forall a b. [a] -> [b] -> [(a, b)]
zip [Drum]
drums [Pitch
drumMinKey ..]

drumFromKey :: VoiceMsg.Pitch -> Drum
drumFromKey :: Pitch -> Drum
drumFromKey = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pitch -> Pitch -> Int
VoiceMsg.subtractPitch Pitch
drumMinKey

drumToKey :: Drum -> VoiceMsg.Pitch
drumToKey :: Drum -> Pitch
drumToKey = forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Pitch -> Pitch
VoiceMsg.increasePitch Pitch
drumMinKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum

drums :: [Drum]
drums :: [Drum]
drums = forall a. Enum a => a -> a -> [a]
enumFromTo forall a. Bounded a => a
minBound forall a. Bounded a => a
maxBound


data Drum =
        AcousticBassDrum  -- Midi Key 35
      | BassDrum1         -- Midi Key 36
      | SideStick         -- ...
      | AcousticSnare | HandClap      | ElectricSnare | LowFloorTom
      | ClosedHiHat   | HighFloorTom  | PedalHiHat    | LowTom
      | OpenHiHat     | LowMidTom     | HiMidTom      | CrashCymbal1
      | HighTom       | RideCymbal1   | ChineseCymbal | RideBell
      | Tambourine    | SplashCymbal  | Cowbell       | CrashCymbal2
      | Vibraslap     | RideCymbal2   | HiBongo       | LowBongo
      | MuteHiConga   | OpenHiConga   | LowConga      | HighTimbale
      | LowTimbale    | HighAgogo     | LowAgogo      | Cabasa
      | Maracas       | ShortWhistle  | LongWhistle   | ShortGuiro
      | LongGuiro     | Claves        | HiWoodBlock   | LowWoodBlock
      | MuteCuica     | OpenCuica     | MuteTriangle
      | OpenTriangle      -- Midi Key 81
   deriving (Int -> Drum -> ShowS
[Drum] -> ShowS
Drum -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Drum] -> ShowS
$cshowList :: [Drum] -> ShowS
show :: Drum -> String
$cshow :: Drum -> String
showsPrec :: Int -> Drum -> ShowS
$cshowsPrec :: Int -> Drum -> ShowS
Show, Drum -> Drum -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Drum -> Drum -> Bool
$c/= :: Drum -> Drum -> Bool
== :: Drum -> Drum -> Bool
$c== :: Drum -> Drum -> Bool
Eq, Eq Drum
Drum -> Drum -> Bool
Drum -> Drum -> Ordering
Drum -> Drum -> Drum
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Drum -> Drum -> Drum
$cmin :: Drum -> Drum -> Drum
max :: Drum -> Drum -> Drum
$cmax :: Drum -> Drum -> Drum
>= :: Drum -> Drum -> Bool
$c>= :: Drum -> Drum -> Bool
> :: Drum -> Drum -> Bool
$c> :: Drum -> Drum -> Bool
<= :: Drum -> Drum -> Bool
$c<= :: Drum -> Drum -> Bool
< :: Drum -> Drum -> Bool
$c< :: Drum -> Drum -> Bool
compare :: Drum -> Drum -> Ordering
$ccompare :: Drum -> Drum -> Ordering
Ord, Ord Drum
(Drum, Drum) -> Int
(Drum, Drum) -> [Drum]
(Drum, Drum) -> Drum -> Bool
(Drum, Drum) -> Drum -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Drum, Drum) -> Int
$cunsafeRangeSize :: (Drum, Drum) -> Int
rangeSize :: (Drum, Drum) -> Int
$crangeSize :: (Drum, Drum) -> Int
inRange :: (Drum, Drum) -> Drum -> Bool
$cinRange :: (Drum, Drum) -> Drum -> Bool
unsafeIndex :: (Drum, Drum) -> Drum -> Int
$cunsafeIndex :: (Drum, Drum) -> Drum -> Int
index :: (Drum, Drum) -> Drum -> Int
$cindex :: (Drum, Drum) -> Drum -> Int
range :: (Drum, Drum) -> [Drum]
$crange :: (Drum, Drum) -> [Drum]
Ix, Int -> Drum
Drum -> Int
Drum -> [Drum]
Drum -> Drum
Drum -> Drum -> [Drum]
Drum -> Drum -> Drum -> [Drum]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Drum -> Drum -> Drum -> [Drum]
$cenumFromThenTo :: Drum -> Drum -> Drum -> [Drum]
enumFromTo :: Drum -> Drum -> [Drum]
$cenumFromTo :: Drum -> Drum -> [Drum]
enumFromThen :: Drum -> Drum -> [Drum]
$cenumFromThen :: Drum -> Drum -> [Drum]
enumFrom :: Drum -> [Drum]
$cenumFrom :: Drum -> [Drum]
fromEnum :: Drum -> Int
$cfromEnum :: Drum -> Int
toEnum :: Int -> Drum
$ctoEnum :: Int -> Drum
pred :: Drum -> Drum
$cpred :: Drum -> Drum
succ :: Drum -> Drum
$csucc :: Drum -> Drum
Enum, Drum
forall a. a -> a -> Bounded a
maxBound :: Drum
$cmaxBound :: Drum
minBound :: Drum
$cminBound :: Drum
Bounded)

-- http://oxygen.cside6.com/gallery/ins_gm.html

instance Random Drum where
   random :: forall g. RandomGen g => g -> (Drum, g)
random  = forall a g. (Enum a, Bounded a, RandomGen g) => g -> (a, g)
boundedEnumRandom
   randomR :: forall g. RandomGen g => (Drum, Drum) -> g -> (Drum, g)
randomR = forall a g. (Enum a, RandomGen g) => (a, a) -> g -> (a, g)
enumRandomR

instance Arbitrary Drum where
   arbitrary :: Gen Drum
arbitrary = forall a. (Enum a, Bounded a, Random a) => Gen a
chooseEnum