module Music.Parts (
Division,
divisions,
getDivision,
Subpart,
Instrument(..),
Solo(..),
Part(..),
divide,
containsPart,
containsSubpart,
solo,
tutti,
piccoloFlute,
flute,
altoFlute,
bassFlute,
oboe,
corAnglais,
heckelphone,
ebClarinet,
clarinet,
aClarinet,
bassClarinet,
sopranoSax,
altoSax,
tenorSax,
baritoneSax,
bassoon,
contraBassoon,
horn,
piccoloTrumpet,
trumpet,
bassTrumpet,
altoTrombone,
tenorTrombone,
trombone,
bassTrombone,
tuba,
timpani,
piano,
celesta,
glockenspiel,
vibraphone,
marimba,
xylophone,
xylorimba,
tubularBells,
dulcimer,
accordion,
harmonica,
violin,
viola,
cello,
doubleBass,
defaultClef,
defaultMidiProgram,
defaultMidiChannel,
defaultMidiNote,
BasicPart,
) where
import Data.Default
import Data.Semigroup
import Data.Typeable
import Data.Maybe
import Data.Traversable (traverse)
import Control.Lens (toListOf)
import Data.Functor.Adjunction (unzipR)
import Control.Applicative
import Text.Numeral.Roman (toRoman)
import qualified Data.List
newtype Division = Division { getDivision :: (Int, Int) }
deriving (Eq, Ord, Show)
instance Default Division where
def = Division (0,1)
showDivisionR :: Division -> String
showDivisionR = toRoman . succ . fst . getDivision
showDivision :: Division -> String
showDivision = show . succ . fst . getDivision
divisions :: Int -> [Division]
divisions n = [Division (x,n) | x <- [0..n1]]
divide :: Int -> Part -> [Part]
divide n (Part solo instr subp) = fmap (\x -> Part solo instr (subp <> Subpart [x])) $ divisions n
newtype Subpart = Subpart [Division]
deriving (Eq, Ord, Default, Semigroup, Monoid)
instance Show Subpart where
show (Subpart ps) = Data.List.intercalate "." $ mapFR showDivisionR showDivision $ ps
where
mapFR f g [] = []
mapFR f g (x:xs) = f x : fmap g xs
data Instrument
= StdInstrument Int
|OtherInstrument String
deriving (Eq)
instance Show Instrument where
show (StdInstrument x) = fromMaybe "(unknown)" $gmInstrName x
show (OtherInstrument str) = str
instance Enum Instrument where
toEnum = StdInstrument
fromEnum (StdInstrument x) = x
fromEnum (OtherInstrument _) = error "Instrument.fromEnum used on unknown instrument"
instance Ord Instrument where
StdInstrument x `compare` StdInstrument y = gmScoreOrder x `compare` gmScoreOrder y
instance Default Instrument where
def = StdInstrument 0
data Solo
= Solo
|Tutti
deriving (Eq, Show, Ord, Enum)
instance Default Solo where
def = Tutti
data Part = Part Solo Instrument Subpart
deriving (Eq, Ord)
instance Show Part where
show (Part Solo instr subp) = "Solo " ++ show instr ++ addS (show subp)
where
addS "" = ""
addS x = " " ++ x
show (Part _ instr subp) = show instr ++ addS (show subp)
where
addS "" = ""
addS x = " " ++ x
instance Enum Part where
toEnum x = Part Tutti (toEnum x) def
fromEnum (Part solo instr subp) = fromEnum instr
instance Monoid Part where
mappend x _ = x
mempty = def
instance Semigroup Part where
(<>) = mappend
instance Default Part where
def = Part def def def
containsPart :: Part -> Part -> Bool
Part solo1 instr1 subp1 `containsPart` Part solo2 instr2 subp2 =
solo1 == solo2
&& instr1 == instr2
&& subp1 `containsSubpart` subp2
containsSubpart :: Subpart -> Subpart -> Bool
Subpart x `containsSubpart` Subpart y = y `Data.List.isPrefixOf` x
solo instr = Part Solo instr def
tutti instr = Part Tutti instr def
piccoloFlute = StdInstrument 72
flute = StdInstrument 73
altoFlute = OtherInstrument "Woodwind.Flute.Alto"
bassFlute = OtherInstrument "Woodwind.Flute.Bass"
oboe = StdInstrument 68
corAnglais = StdInstrument 69
heckelphone = OtherInstrument "Woodwind.DoubleReed.Heckelphone"
ebClarinet = OtherInstrument "Woodwind.SingleReed.Clarinet.Eb"
clarinet = StdInstrument 71
aClarinet = OtherInstrument "Woodwind.SingleReed.Clarinet.A"
bassClarinet = OtherInstrument "Woodwind.SingleReed.Clarinet.Bass"
sopranoSax = StdInstrument 64
altoSax = StdInstrument 65
tenorSax = StdInstrument 66
baritoneSax = StdInstrument 67
bassoon = StdInstrument 70
contraBassoon = OtherInstrument "Woodwind.DoubleReed.Bassoon.Contra"
horn = StdInstrument 60
piccoloTrumpet = OtherInstrument "Brass.Trumpet.Piccolo"
trumpet = StdInstrument 56
bassTrumpet = OtherInstrument "Brass.Trumpet.Bass"
altoTrombone = OtherInstrument "Brass.Trombone.Alto"
tenorTrombone = StdInstrument 57
trombone = StdInstrument 57
bassTrombone = OtherInstrument "Brass.Trombone.Bass"
tuba = StdInstrument 58
timpani = StdInstrument 47
piano = StdInstrument 0
celesta = StdInstrument 8
glockenspiel = StdInstrument 9
vibraphone = StdInstrument 11
marimba = StdInstrument 12
xylophone = StdInstrument 13
xylorimba = OtherInstrument "Percussion.Pitched.Xylorimba"
tubularBells = StdInstrument 14
dulcimer = StdInstrument 15
accordion = StdInstrument 21
harmonica = StdInstrument 22
violin = StdInstrument 40
viola = StdInstrument 41
cello = StdInstrument 42
doubleBass = StdInstrument 43
defaultClef :: Part -> Int
defaultMidiNote :: Part -> Int
defaultMidiProgram :: Part -> Int
defaultMidiChannel :: Part -> Int
defaultScoreOrder :: Part -> Double
defaultMidiNote _ = 0
defaultMidiProgram (Part _ (StdInstrument x) _) = x
defaultMidiChannel = fromMaybe 0 . fmap get . (`lookup` gmInstrs) . defaultMidiProgram
where get (x,_,_,_) = x
defaultScoreOrder = fromMaybe 0 . fmap get . (`lookup` gmInstrs) . defaultMidiProgram
where get (_,x,_,_) = x
defaultClef = fromMaybe 0 . fmap get . (`lookup` gmInstrs) . defaultMidiProgram
where get (_,_,x,_) = x
gmClef :: Int -> Int
gmMidiChannel :: Int -> Int
gmScoreOrder :: Int -> Double
gmMidiChannel = fromMaybe 0 . fmap get . (`lookup` gmInstrs)
where get (x,_,_,_) = x
gmScoreOrder = fromMaybe 0 . fmap get . (`lookup` gmInstrs)
where get (_,x,_,_) = x
gmClef = fromMaybe 0 . fmap get . (`lookup` gmInstrs)
where get (_,_,x,_) = x
gmInstrName :: Int -> Maybe String
gmInstrName = fmap get . (`lookup` gmInstrs)
where get (_,_,_,x) = x
gmInstrs :: [(Int, (Int, Double, Int, String))]
gmInstrs = [
(0, (0, 5.0, 0, "Acoustic Grand Piano")),
(1, (0, 5.0, 0, "Bright Acoustic Piano")),
(2, (0, 5.0, 0, "Electric Grand Piano")),
(3, (0, 5.0, 0, "Honky-tonk Piano")),
(4, (0, 5.0, 0, "Electric Piano 1")),
(5, (0, 5.0, 0, "Electric Piano 2")),
(6, (0, 5.0, 0, "Harpsichord")),
(7, (0, 5.0, 0, "Clavinet")),
(8, (0, 5.0, 0, "Celesta")),
(9, (0, 5.0, 0, "Glockenspiel")),
(9, (0, 5.0, 0, "Music Box")),
(11, (0, 4.0, 0, "Vibraphone")),
(12, (0, 4.0, 0, "Marimba")),
(13, (0, 4.0, 0, "Xylophone")),
(14, (0, 4.0, 0, "Tubular Bells")),
(15, (0, 4.0, 0, "Dulcimer")),
(16, (0, 5.0, 0, "Drawbar Organ")),
(17, (0, 5.0, 0, "Percussive Organ")),
(18, (0, 5.0, 0, "Rock Organ")),
(19, (0, 5.0, 0, "Church Organ")),
(20, (0, 5.0, 0, "Reed Organ")),
(21, (0, 5.0, 0, "Accordion")),
(22, (0, 5.0, 0, "Harmonica")),
(23, (0, 5.0, 0, "Tango Accordion")),
(24, (0, 5.0, 0, "Acoustic Guitar (nylon)")),
(25, (0, 5.0, 0, "Acoustic Guitar (steel)")),
(26, (0, 5.0, 0, "Electric Guitar (jazz)")),
(27, (0, 5.0, 0, "Electric Guitar (clean)")),
(28, (0, 5.0, 0, "Electric Guitar (muted)")),
(29, (0, 5.0, 0, "Overdriven Guitar")),
(30, (0, 5.0, 0, "Distortion Guitar")),
(31, (0, 5.0, 0, "Guitar Harmonics")),
(32, (0, 8.0, 2, "Acoustic Bass")),
(33, (0, 8.0, 2, "Electric Bass (finger)")),
(34, (0, 8.0, 2, "Electric Bass (pick)")),
(35, (0, 8.0, 2, "Fretless Bass")),
(36, (0, 8.0, 2, "Slap Bass 1")),
(37, (0, 8.0, 2, "Slap Bass 2")),
(38, (0, 8.0, 2, "Synth Bass 1")),
(39, (0, 8.0, 2, "Synth Bass 2")),
(40, (12, 7.1, 0, "Violin")),
(41, (13, 7.2, 1, "Viola")),
(42, (14, 7.3, 2, "Violoncello")),
(43, (15, 7.4, 2, "Contrabass")),
(44, (0, 7.0, 0, "Tremolo Strings")),
(45, (0, 7.0, 0, "Pizzicato Strings")),
(46, (11, 5.9, 0, "Orchestral Harp")),
(47, (8, 2.5, 2, "Timpani")),
(48, (0, 7.0, 0, "String Ensemble 1")),
(49, (0, 7.0, 0, "String Ensemble 2")),
(50, (0, 7.0, 0, "Synth Strings 1")),
(51, (0, 7.0, 0, "Synth Strings 2")),
(52, (0, 1.0, 0, "Choir Aahs")),
(53, (0, 1.0, 0, "Voice Oohs")),
(54, (0, 1.0, 0, "Synth Choir")),
(55, (0, 1.0, 0, "Orchestra Hit")),
(56, (5, 2.2, 0, "Trumpet in Bb")),
(57, (6, 2.3, 2, "Trombone")),
(58, (7, 2.4, 2, "Tuba")),
(59, (0, 2.2, 0, "Muted Trumpet")),
(60, (4, 2.1, 0, "Horn in F")),
(61, (0, 2.0, 0, "Brass Section")),
(62, (0, 2.0, 0, "Synth Brass 1")),
(63, (0, 2.0, 0, "Synth Brass 2")),
(64, (0, 1.51, 0, "Soprano Sax")),
(65, (0, 1.52, 0, "Alto Sax")),
(66, (0, 1.53, 0, "Tenor Sax")),
(67, (0, 1.54, 0, "Baritone Sax")),
(68, (1, 1.3, 0, "Oboe")),
(69, (1, 1.4, 0, "English Horn")),
(70, (3, 1.7, 2, "Bassoon")),
(71, (2, 1.6, 0, "Clarinet in Bb")),
(72, (0, 1.1, 0, "Piccolo")),
(73, (0, 1.2, 0, "Flute")),
(74, (0, 1.0, 0, "Recorder")),
(75, (0, 1.0, 0, "Pan Flute")),
(76, (0, 1.0, 0, "Blown bottle")),
(77, (0, 1.0, 0, "Shakuhachi")),
(78, (0, 1.0, 0, "Whistle")),
(79, (0, 1.0, 0, "Ocarina")),
(80, (0, 1.0, 0, "Lead 1 (square)")),
(81, (0, 1.0, 0, "Lead 2 (sawtooth)")),
(82, (0, 1.0, 0, "Lead 3 (calliope)")),
(83, (0, 1.0, 0, "Lead 4 (chiff)")),
(84, (0, 1.0, 0, "Lead 5 (charang)")),
(85, (0, 1.0, 0, "Lead 6 (voice)")),
(86, (0, 1.0, 0, "Lead 7 (fifths)")),
(87, (0, 1.0, 0, "Lead 8 (bass + lead)")),
(88, (0, 1.0, 0, "Pad 1 (new age)")),
(89, (0, 1.0, 0, "Pad 2 (warm)")),
(90, (0, 1.0, 0, "Pad 3 (polysynth)")),
(91, (0, 1.0, 0, "Pad 4 (choir)")),
(92, (0, 1.0, 0, "Pad 5 (bowed)")),
(93, (0, 1.0, 0, "Pad 6 (metallic)")),
(94, (0, 1.0, 0, "Pad 7 (halo)")),
(95, (0, 1.0, 0, "Pad 8 (sweep)")),
(96, (0, 1.0, 0, "FX 1 (rain)")),
(97, (0, 1.0, 0, "FX 2 (soundtrack)")),
(98, (0, 1.0, 0, "FX 3 (crystal)")),
(99, (0, 1.0, 0, "FX 4 (atmosphere)")),
(100, (0, 1.0, 0, "FX 5 (brightness)")),
(101, (0, 1.0, 0, "FX 6 (goblins)")),
(102, (0, 1.0, 0, "FX 7 (echoes)")),
(103, (0, 1.0, 0, "FX 8 (sci-fi)")),
(104, (0, 1.0, 0, "Sitar")),
(105, (0, 1.0, 0, "Banjo")),
(106, (0, 1.0, 0, "Shamisen")),
(107, (0, 1.0, 0, "Koto")),
(108, (0, 1.0, 0, "Kalimba")),
(109, (0, 1.0, 0, "Bagpipe")),
(110, (0, 1.0, 0, "Fiddle")),
(111, (0, 1.0, 0, "Shanai")),
(112, (0, 1.0, 0, "Tinkle Bell")),
(113, (0, 1.0, 0, "Agogo")),
(114, (0, 1.0, 0, "Steel Drums")),
(115, (0, 1.0, 0, "Woodblock")),
(116, (0, 1.0, 0, "Taiko Drum")),
(117, (0, 1.0, 0, "Melodic Tom")),
(118, (0, 1.0, 0, "Synth Drum")),
(119, (0, 1.0, 0, "Reverse Cymbal")),
(120, (0, 1.0, 0, "Guitar Fret Noise")),
(121, (0, 1.0, 0, "Breath Noise")),
(122, (0, 1.0, 0, "Seashore")),
(123, (0, 1.0, 0, "Bird Tweet")),
(124, (0, 1.0, 0, "Telephone Ring")),
(125, (0, 1.0, 0, "Helicopter")),
(126, (0, 1.0, 0, "Applause")),
(127, (0, 1.0, 0, "Gunshot"))
]
gmPerc :: [(Int, String)]
gmPerc = [
(35, "Bass Drum 2"),
(36, "Bass Drum 1"),
(37, "Side Stick/Rimshot"),
(38, "Snare Drum 1"),
(39, "Hand Clap"),
(40, "Snare Drum 2"),
(41, "Low Tom 2"),
(42, "Closed Hi-hat"),
(43, "Low Tom 1"),
(44, "Pedal Hi-hat"),
(45, "Mid Tom 2"),
(46, "Open Hi-hat"),
(47, "Mid Tom 1"),
(48, "High Tom 2"),
(49, "Crash Cymbal 1"),
(50, "High Tom 1"),
(51, "Ride Cymbal 1"),
(52, "Chinese Cymbal"),
(53, "Ride Bell"),
(54, "Tambourine"),
(55, "Splash Cymbal"),
(56, "Cowbell"),
(57, "Crash Cymbal 2"),
(58, "Vibra Slap"),
(59, "Ride Cymbal 2"),
(60, "High Bongo"),
(61, "Low Bongo"),
(62, "Mute High Conga"),
(63, "Open High Conga"),
(64, "Low Conga"),
(65, "High Timbale"),
(66, "Low Timbale"),
(67, "High Agogô"),
(68, "Low Agogô"),
(69, "Cabasa"),
(70, "Maracas"),
(71, "Short Whistle"),
(72, "Long Whistle"),
(73, "Short Güiro"),
(74, "Long Güiro"),
(75, "Claves"),
(76, "High Wood Block"),
(77, "Low Wood Block"),
(78, "Mute Cuíca"),
(79, "Open Cuíca"),
(80, "Mute Triangle"),
(81, "Open Triangle")
]
instance Num a => Num (Option a) where
(+) = liftA2 (+)
() = liftA2 ()
(*) = liftA2 (*)
abs = fmap abs
signum = fmap signum
fromInteger = pure . fromInteger
instance Integral a => Integral (Option a) where
quotRem x y = unzipR $ liftA2 quotRem x y
toInteger = toInteger . get where get = (head.toListOf traverse)
instance Real a => Real (Option a) where
toRational = toRational . get where get = (head.toListOf traverse)
instance Enum a => Enum (Option a) where
fromEnum = fromEnum . get where get = (head.toListOf traverse)
toEnum = pure . toEnum
instance Num a => Num (First a) where
(+) = liftA2 (+)
() = liftA2 ()
(*) = liftA2 (*)
abs = fmap abs
signum = fmap signum
fromInteger = pure . fromInteger
instance Integral a => Integral (First a) where
quotRem x y = unzipR $ liftA2 quotRem x y
toInteger = toInteger . get where get = (head.toListOf traverse)
instance Real a => Real (First a) where
toRational = toRational . get where get = (head.toListOf traverse)
newtype BasicPart = BasicPart { getBasicPart :: Option (First Integer) }
deriving (Eq, Ord, Num, Integral, Real, Enum, Typeable, Semigroup, Monoid)
instance Default BasicPart where
def = mempty
instance Show BasicPart where
show _ = ""