module Music.Parts (
module Music.Parts.Division,
module Music.Parts.Subpart,
module Music.Parts.Solo,
module Music.Parts.Instrument,
Part(..),
_solo,
_subpart,
_instrument,
divide,
containsPart,
smallestPart,
smallestSubpart,
largestPart,
largestSubpart,
distinctFrom,
allDistinct,
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,
piccoloFlutes,
flutes,
altoFlutes,
oboes,
corAnglaises,
clarinets,
ebClarinets,
bassClarinets,
bassoons,
contraBassoons,
flutes1,
flutes2,
oboes1,
oboes2,
clarinets1,
clarinets2,
horns,
highHorns,
lowHorns,
trumpets,
trombones,
trumpets1,
trumpets2,
trombones1,
trombones2,
tubas,
violins,
violins1,
violins2,
violas,
cellos,
doubleBasses,
harp,
defaultClef,
defaultMidiProgram,
defaultMidiChannel,
defaultMidiNote,
module Music.Parts.Basic
) where
import Control.Applicative
import Control.Lens (toListOf, Lens, Lens', (^.))
import Data.Aeson (ToJSON (..), FromJSON(..))
import qualified Data.Aeson
import Data.Default
import Data.Functor.Adjunction (unzipR)
import qualified Data.List
import Data.Maybe
import Data.Semigroup
import Data.Semigroup.Option.Instances
import Data.Traversable (traverse)
import Data.Typeable
import Text.Numeral.Roman (toRoman)
import Music.Parts.Basic
import Music.Parts.Subpart
import Music.Parts.Division
import Music.Parts.Solo
import Music.Parts.Instrument
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
mempty = def
mappend x y
| x == mempty = y
|otherwise = x
instance Semigroup Part where
(<>) = mappend
instance Default Part where
def = Part def def def
instance ToJSON Part where
toJSON p = Data.Aeson.object [
("instrument", toJSON $p^._instrument),
("subpart", toJSON $p^._subpart),
("solo", toJSON $p^._solo)
]
instance FromJSON Part where
parseJSON (Data.Aeson.Object v) = do
s <- v Data.Aeson..: "solo"
i <- v Data.Aeson..: "instrument"
u <- v Data.Aeson..: "subpart"
return $ Part s i u
parseJSON _ = empty
containsPart :: Part -> Part -> Bool
Part solo1 instr1 subp1 `containsPart` Part solo2 instr2 subp2 =
solo1 == solo2
&& instr1 == instr2
&& subp1 `containsSubpart` subp2
smallestPart :: Part -> Part -> Part
smallestPart p1@(Part _ _ sp1) p2@(Part _ _ sp2)
| sp1 `smallestSubpart` sp2 == sp1 = p1
| sp1 `smallestSubpart` sp2 == sp2 = p2
smallestSubpart :: Subpart -> Subpart -> Subpart
smallestSubpart x y
| x `isProperSubpartOf` y = x
| y `isProperSubpartOf` x = y
| otherwise = x
largestPart :: Part -> Part -> Part
largestPart p1@(Part _ _ sp1) p2@(Part _ _ sp2)
| sp1 `largestSubpart` sp2 == sp1 = p1
| sp1 `largestSubpart` sp2 == sp2 = p2
largestSubpart :: Subpart -> Subpart -> Subpart
largestSubpart x y
| x `isProperSubpartOf` y = y
| y `isProperSubpartOf` x = x
| otherwise = x
allDistinct :: [Part] -> Bool
allDistinct [] = True
allDistinct (x:xs) = all (distinctFrom x) xs && allDistinct xs
distinctFrom :: Part -> Part -> Bool
distinctFrom (Part s1 i1 sp1) (Part s2 i2 sp2) = s1 /= s2 || i1 /= i2 || noneSubpart
where
noneSubpart = not (sp1 `isSubpartOf` sp2) && not (sp2 `isSubpartOf` sp1)
_solo :: Lens' Part Solo
_solo f (Part s i u) = fmap (\s -> Part s i u) $ f s
_subpart :: Lens' Part Subpart
_subpart f (Part s i u) = fmap (\u -> Part s i u) $ f u
_instrument :: Lens' Part Instrument
_instrument f (Part s i u) = fmap (\i -> Part s i u) $ f i
divide :: Int -> Part -> [Part]
divide n (Part solo instr subp) = fmap (\x -> Part solo instr (subp <> Subpart [x])) $ divisions n
solo instr = Part Solo instr def
tutti instr = Part Tutti instr def
piccoloFlute = fromMidiProgram 72
flute = fromMidiProgram 73
altoFlute = fromMusicXmlSoundId "wind.flutes.flute.alto"
bassFlute = fromMusicXmlSoundId "wind.flutes.flute.bass"
oboe = fromMidiProgram 68
corAnglais = fromMidiProgram 69
heckelphone = fromMusicXmlSoundId "wind.reed.oboes.heckelphone"
ebClarinet = fromMusicXmlSoundId "wind.reed.clarinet.eflat"
clarinet = fromMidiProgram 71
aClarinet = fromMusicXmlSoundId "wind.reed.clarinet.a"
bassClarinet = fromMusicXmlSoundId "wind.reed.clarinet.bass"
sopranoSax = fromMidiProgram 64
altoSax = fromMidiProgram 65
tenorSax = fromMidiProgram 66
baritoneSax = fromMidiProgram 67
bassoon = fromMidiProgram 70
contraBassoon = fromMusicXmlSoundId "wind.reed.contrabassoon"
horn = fromMidiProgram 60
piccoloTrumpet = fromMusicXmlSoundId "brass.trumpet.piccolo"
trumpet = fromMidiProgram 56
bassTrumpet = fromMusicXmlSoundId "brass.trumpet.bass"
altoTrombone = fromMusicXmlSoundId "brass.trombone.alto"
trombone = tenorTrombone
tenorTrombone = fromMidiProgram 57
bassTrombone = fromMusicXmlSoundId "brass.trombone.bass"
tuba = fromMidiProgram 58
timpani = fromMidiProgram 47
piano = fromMidiProgram 0
celesta = fromMidiProgram 8
glockenspiel = fromMidiProgram 9
vibraphone = fromMidiProgram 11
marimba = fromMidiProgram 12
xylophone = fromMidiProgram 13
xylorimba = fromMusicXmlSoundId "pitched-percussion.xylorimba"
tubularBells = fromMidiProgram 14
dulcimer = fromMidiProgram 15
accordion = fromMidiProgram 21
harmonica = fromMidiProgram 22
violin = fromMidiProgram 40
viola = fromMidiProgram 41
cello = fromMidiProgram 42
doubleBass = fromMidiProgram 43
defaultMidiProgram :: Part -> Int
defaultMidiProgram (Part _ instr _) = fromMaybe 0 $ toMidiProgram instr
defaultMidiNote :: Part -> Int
defaultMidiNote _ = 0
defaultMidiChannel :: Part -> Int
defaultMidiChannel = gmMidiChannel . defaultMidiProgram
defaultScoreOrder :: Part -> Double
defaultScoreOrder = gmScoreOrder . defaultMidiProgram
defaultClef :: Part -> Int
defaultClef = gmClef . defaultMidiProgram
piccoloFlutes = tutti piccoloFlute
flutes = tutti flute
oboes = tutti oboe
clarinets = tutti clarinet
bassoons = tutti bassoon
[flutes1, flutes2] = divide 2 flutes
altoFlutes = tutti altoFlute
[oboes1, oboes2] = divide 2 oboes
corAnglaises = tutti corAnglais
[clarinets1, clarinets2] = divide 2 clarinets
ebClarinets = tutti ebClarinet
bassClarinets = tutti bassClarinet
contraBassoons = tutti contraBassoon
horns = tutti horn
highHorns = zipWith (!!) (repeat $ divide 4 horns) [0,2]
lowHorns = zipWith (!!) (repeat $ divide 4 horns) [1,3]
trumpets = tutti trumpet
trombones = tutti trombone
[trumpets1, trumpets2] = divide 2 trumpets
[trombones1, trombones2] = divide 2 trombones
tubas = tutti tuba
violins = tutti violin
[violins1, violins2] = divide 2 violins
violas = tutti viola
cellos = tutti cello
doubleBasses = tutti doubleBass
harp' = fromMidiProgram 46
harp = tutti harp'