temporal-music-notation-demo (empty) → 0.1.2
raw patch · 9 files changed
+1292/−0 lines, 9 filesdep +HCodecsdep +basedep +binarysetup-changed
Dependencies added: HCodecs, base, binary, cmath, temporal-music-notation
Files
- LICENSE +30/−0
- Setup.hs +3/−0
- examples/break.hs +45/−0
- examples/choral.hs +256/−0
- examples/readme.hs +12/−0
- gen/genGM.hs +186/−0
- src/Temporal/Music/Notation/Demo.hs +287/−0
- src/Temporal/Music/Notation/Demo/GeneralMidi.hs +436/−0
- temporal-music-notation-demo.cabal +37/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Anton Kholomiov 2011++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Anton Kholomiov nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMain
+ examples/break.hs view
@@ -0,0 +1,45 @@+-- break beat++import System(system)++import Temporal.Music.Notation+import Temporal.Music.Western+import Temporal.Music.Western.TwelveTone++import Temporal.Music.Notation.Demo+import Temporal.Music.Notation.Demo.GeneralMidi++tom11 = line [qd 0, qd 0, qnr, qd 0, hd 0.5, dhnr]+tom12 = line [qd 0, qd 0, qnr, qd 0, hd 0.5, qnr, qd 0]++scoTom = ff' $ line [tom11, tom12]+scoSnare = mp' $ line [hnr, hd 0, hnr, hd 0]++scoMaracas = mp' $ line [dhnr, tri $ line [ed 0.5, ed 0, ed 0]]++drums = loop 8 $ chord [+ bassDrum1 scoTom,+ loop 2 $ acousticSnare scoSnare,+ loop 3 $ maracas scoMaracas+ ]+++scoAccomp = dynamicsRel [0, 1, 0.5, 1.5, 0.5, 1, 0] $ + loop 2 $ + mp' $ high $ sustain 0.5 $ chord [+ loop 2 $ line $ map qn [f, c, e, f, c, e, f, c],+ accent 1 $ low $ line [dwn a, dwn gs, hnr],+ accent 1.5 $ line [bnr, hnr, tri $ line [dhn gs, dhn e, dhn d]]+ ]++accomp = loop 4 $ glockenspiel scoAccomp ++-- fade out after 0.7*totalDur+res = dynamicsSeg [0, 0.7, 0, 0.3, -2] $ chord [+ drums,+ accomp+ ]++main = do+ exportMidi "break.mid" res+ system "timidity break.mid"
+ examples/choral.hs view
@@ -0,0 +1,256 @@+-- J.S. Bach - Choral prelude F-moll 'Ich ruf zu dir Herr Jesu Christ'++import System(system)++import Temporal.Music.Notation+import Temporal.Music.Western+import Temporal.Music.Western.TwelveTone++import Temporal.Music.Notation.Demo+import Temporal.Music.Notation.Demo.GeneralMidi++-- alto dynamics++up :: Double -> [Tone Chromatic] -> Score (NoteW Chromatic ())+up x = dynamicsRel [x, x + accDiap] . line . map sn ++down :: Double -> [Tone Chromatic] -> Score (NoteW Chromatic ())+down x = dynamicsRel [x + accDiap, x] . line . map sn ++upDown :: Double -> [Tone Chromatic] -> Score (NoteW Chromatic ())+upDown x = dynamicsRel [x, x + accDiap, x] . line . map sn ++downUp :: Double -> [Tone Chromatic] -> Score (NoteW Chromatic ())+downUp x = dynamicsRel [x, x-accDiap, x] . line . map sn ++flat :: Double -> [Tone Chromatic] -> Score (NoteW Chromatic ())+flat x = accent x . line . map sn++accDiap = 0.5++--------------------------------------------------+-- solo++-- Part I++solo0 = qn $ high c++solo1 = line [+-- 1 bar+ qn af, qn bf, den af, sn g, den f, sn g,+-- 2 bar+ dynamicsRel [0, 0.2, 0] $ line [line $ map sn [af, bf, af, bf],+ trill 3 (accent 0.2 $ tn $ high c) (tn bf), tn af, tn bf], + high $ line [accent 0.2 $ qn $ c, den c, sn df, +-- 3 bar+ qn ef, tn df, stretch (1/4 - 3/32) $ wn c, + sn $ low bf, qn $ low af, en $ low bf, en c] + ]++solo11 = high $ line [+ stretch (1/4 + 1/16) $ wn df, + line $ map tn [ef, f, ef, df], sn c, qn c, qn c]+++solo12 = high $ line [+ qn df, sn df,+ line $ map tn [ef, f, ef, df],sn c, qn c, qn ef]++ +soloI = line [solo0, reprise solo1 solo11 solo12]+++-- Part II++solo21 = high $ line [+-- 1 bar+ qn f, en ef, tn df, tn c, sn df,+ low $ line $ map en [high c, bf, af, bf],+-- 2 bar+ qn c, qn c, qn $ low bf, qn $ low af,+-- 3 bar+ low $ line [hn g, hn f, +-- 4 bar + qn af, qn g, hn f]+ ]++solo22 = line [+-- 5 bar+ dhn ef, qn ef,+-- 6 bar+ qn af, qn af, qn bf, qn bf,+-- 7 bar + high $ line [dhn c, qn df],+-- 8 bar+ high $ qn c, qn bf, qn af, den f, sn g,+-- 9 bar+ qn af, qn g, qn f+ ]++soloII = solo21 +:+ solo22++solo = pedal (1/128) $ soloI +:+ soloII++---------------------------------------------------+-- alto++-- Part I++alto0 = high $ up 0 [low af, c, f, e] ++alto1 = line [+-- 1 bar+ high $ down 0.5 [f, c, low af, low f], + upDown 0 [g, bf, high df, high c],+ upDown 0 [f, af, high c, bf],+ downUp 0 [af, f, af, high c],++-- 2 bar+ high $ downUp 0.2 [f, e, f, af],+ high $ down 0 [g, f, e, f],+ high $ downUp 0 [e, c, low g, low bf, low af, c, f, af],++-- 3 bar+ high $ flat 0 [g, ef, af, g],+ high $ up 0 [af, ef, f, gf, f, df, f, af, g, df, c, gf]+ ] ++alto11 = high $ line [+ upDown 0 [f, low bf, df, f, bf, af, g, af, g, c, e, low bf],+ upDown 0 [low f, c, f, e]+ ]++alto12 = high $ line [+ upDown 0 [f, low bf, df, f, bf, af, g, af],+ down 0 [g, low bf, low af, f, low g, df, low af, c]+ ]++ +altoI = line [alto0, reprise alto1 alto11 alto12]++-- Part II++alto21 = high $ line [+-- 1 bar+ upDown 0 [+ low af, c, low bf, df, low bf, df, af, g, + af, ef, df, g, c, f, af, g],+-- 2 bar+ down (-accDiap) [+ af, ef, low af, gf, f, low af, low g, df, + c, low af, c, ef, g, c, low bf, g,+-- 3 bar + df, f, g, f],+ up (-accDiap) [+ e, low bf, df, c,+ low af, c, f, e, f, c, low af, low f],+-- 4 bar+ flat 0 [+ low bf, f, g, f, low bf, ef, f, ef,+ c, ef, f, ef, d, low g, low b, d+ ]+ ]++alto22 = high $ line [+-- 5 bar+ down (-accDiap) $ [+ low g, c, ef, df, low g, low bf, df, c] +++ map low [ef, af, high c, bf, high df, bf, c, high df,+-- 6 bar+ f, af, high df, high c, f, af, high c, bf, + f, af, bf, af, g, bf, high df, high c],++-- 7 bar+ up (-accDiap) [+ low af, c, ef, af, ef, bf, high c, bf,+ a, ef, gf, low a, low bf, g, low af, f+ ],++-- 8 bar+ down (-accDiap) [+ low af, ef, d, ef, low f, df, ef, df, + low ef, c, df, c, low bf, f, g, f,+-- 9 bar+ d, f, g, f, e, df, low bf, low g, + low a, c]++ ]++alto23 = en $ high f++altoII = line [alto21, alto22, alto23]++alto = pedal (1/132) $ lower 3 $ line [altoI, altoII]+++----------------------------------------------------------+-- bass ++-- Part I++bass0 = lower 1 $ line [en f, en f]++bass1 = (line $ map en [+-- 1 bar+ f, f, f, e, f, f, f, ef,+-- 2 bar+ df, df, df, df, c, c, f, f]) +:++-- 3 bar+ (high $ line $ map en [c, c, c, c, c, c, low bf, low a])++bass11 = line $ map en [bf, af, g, f, e, c, low f, low f]++bass12 = line $ map en [bf, af, g, f, e, f, c, c]++bassI = line [bass0, reprise bass1 bass11 bass12]+++-- Part II++bass21 = line $ map en [+-- 1 bar+ df, df, ef, ef, af, ef, f, df,+-- 2 bar+ low f, low f, f, f, d, e, f, df,+-- 3 bar+ low bf, low g, c, c, df, df, df , df,+-- 4 bar+ d, d, d, d, low a, low a, low b, low b+ ] + +bass22 = low $ line $ map en [+-- 5 bar+ high c, high c, bf, bf, af, af, g, g,+-- 6 bar+ f, f, ef, ef, d, d, ef, ef, +-- 7 bar+ af, af, gf, gf, f, f, bf, bf,+-- 8 bar+ bf, af, af, g, g, f, high df, high df,+-- 9 bar+ b, b, high c, high c+ ]++bass23 = qn $ low f++ +bassII = line [bass21, bass22, bass23]++bass = lower 3 $ line [bassI, bassII]++sco = delay (-4) $ bpm (lento $ -0.5) $ chord [+ solo, + p' $ higher 2 alto, + accent (-0.5) $ higher 2 $ bass,+ rest 0+ ]++file = "out.csd"+flags = "-d"++out = acousticGrandPiano sco++main = do+ exportMidi "choral.mid" $ out+ system "timidity choral.mid"+
+ examples/readme.hs view
@@ -0,0 +1,12 @@+{-+Readme+'temporal-music-notation-demo' examples.+++Examples rely on one external package 'temporal-music-notation-western'.+This package contains names specific to western music tradition.+So to run them do first.++>>cabal update+>>cabal install temporal-music-notation-western+-}
+ gen/genGM.hs view
@@ -0,0 +1,186 @@+-- | Generates module 'GeneralMidi'++import Data.Char+import Data.List.Split++import Language.Haskell.Exts.Syntax+import Language.Haskell.Exts.Pretty+import Language.Haskell.Exts.Build'++import qualified Text.PrettyPrint as P++toFunName :: String -> String+toFunName x = map toLower pref ++ suff+ where pref = takeWhile isUpper x+ suff = dropWhile isUpper x ++-- module+++moduleGM name instrs drums = P.vcat $ P.punctuate wspace [+ P.text "-- | General MIDI names",+ moduleHead name instrs drums,+ imports,+ division "Instruments",+ pp $ instrSig instrs,+ P.vcat $ map pp $ instrFuns instrs,+ division "Percussion",+ pp $ drumSig drums,+ P.vcat $ map pp $ drumFuns drums]+ where pp = P.text . prettyPrint+ wspace = P.text "\n\n"+ division x = (P.text $ replicate 20 '-') + P.$$ (P.text $ "--" ++ x)+++moduleHead name instrs drums = P.vcat [+ P.text $ "module " ++ name ++ "(",+ P.nest 4 $ exports instrs drums P.<> P.rparen,+ P.text "where"]++exports instrs drums =+ P.vcat [+ P.text (toSec1 "Instruments"),+ + P.vcat $ map ( P.<> P.comma) $+ map (uncurry expFunNames) $ + expInstrFunNames (map toSec2 familyNames) instrs, + P.text "\n\n",+ expFunNames (toSec1 "Percussion") drums]++toSec1 = ("-- * " ++ )+toSec2 = ("-- ** " ++)++expInstrFunNames fams names = zip fams $ splitEvery 8 names ++expFunNames :: String -> [String] -> P.Doc+expFunNames sec names = (P.text sec P.$$ ) $ P.vcat $ + P.punctuate P.comma $ map P.text names++imports :: P.Doc+imports = P.vcat [+ P.text "import Temporal.Music.Notation(Score, Seg)",+ P.text "import Temporal.Music.Notation.Note(Note, Drum)",+ P.text "import Temporal.Music.Notation.Demo"]++-- instruments++zSrcLoc = SrcLoc "" 0 0 ++instrSig :: [String] -> Decl+instrSig xs = typeSig zSrcLoc xs $ + [var "Seg" "nVol", var "Seg" "nPch"] + =>> var "Score" <$> var "Note" `apps` [var "nVol", var "nPch", var "a"] + ->> var "Score" <$> var "MidiEvent"++instrFuns = toFuns 0 "instr"++-- drums++drumSig :: [String] -> Decl+drumSig xs = typeSig zSrcLoc xs $ + [var "Seg" "nVol"] + =>> var "Score" <$> var "Drum" `apps` [var "nVol", var "a"] + ->> var "Score" <$> var "MidiEvent"++drumFuns = toFuns 35 "drumInstr"++-- funs++toFuns :: Integer -> String -> [String] -> [Decl]+toFuns i0 constr = map (uncurry $ toFun constr) . zip [i0 .. ]++toFun :: String -> Integer -> String -> Decl+toFun constr id name = fun zSrcLoc name [] <=> (var constr <$> int id)++out :: Pretty a => a -> IO ()+out = putStrLn . prettyPrint+++main = do+ let i = map (toFunName . show) $ [(minBound :: InstrumentName) .. maxBound]+ d = map (toFunName . show) $ [(minBound :: PercussionName) .. maxBound] ++ writeFile "GeneralMidi.hs" $ show $ + moduleGM "Temporal.Music.Notation.Demo.GeneralMidi" i d ++ +familyNames :: [String]+familyNames = map (splitAtUpper . show) + [(minBound :: InstrumentFamily) .. maxBound] + where splitAtUpper = unwords . split (keepDelimsL $ whenElt isUpper) +++data InstrumentFamily = + Piano | ChromaticPercussion | Organ | Guitar+ | Bass | Strings | Ensemble | Brass + | Reed | Pipe | SynthLead | SynthPad + | SynthEffects | Ethnic | Percussive | SoundEffects+ deriving (Show, Enum, Bounded)+++data InstrumentName = + AcousticGrandPiano | BrightAcousticPiano | ElectricGrandPiano+ | HonkyTonkPiano | RhodesPiano | ChorusedPiano+ | Harpsichord | Clavinet | Celesta + | Glockenspiel | MusicBox | Vibraphone + | Marimba | Xylophone | TubularBells+ | Dulcimer | HammondOrgan | PercussiveOrgan + | RockOrgan | ChurchOrgan | ReedOrgan+ | Accordion | Harmonica | TangoAccordion+ | AcousticGuitarNylon | AcousticGuitarSteel | ElectricGuitarJazz+ | ElectricGuitarClean | ElectricGuitarMuted | OverdrivenGuitar+ | DistortionGuitar | GuitarHarmonics | AcousticBass+ | ElectricBassFingered | ElectricBassPicked | 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 + | Bassoon | EnglishHorn | Clarinet+ | Piccolo | Flute | Recorder+ | PanFlute | BlownBottle | Shakuhachi+ | Whistle | Ocarina | Lead1Square+ | Lead2Sawtooth | Lead3Calliope | Lead4Chiff+ | Lead5Charang | Lead6Voice | Lead7Fifths+ | Lead8BassLead | Pad1NewAge | Pad2Warm+ | Pad3Polysynth | Pad4Choir | Pad5Bowed+ | Pad6Metallic | Pad7Halo | Pad8Sweep+ | FX1Train | FX2Soundtrack | FX3Crystal+ | FX4Atmosphere | FX5Brightness | FX6Goblins+ | FX7Echoes | FX8SciFi | Sitar+ | Banjo | Shamisen | Koto+ | Kalimba | Bagpipe | Fiddle + | Shanai | TinkleBell | Agogo + | SteelDrums | Woodblock | TaikoDrum+ | MelodicDrum | SynthDrum | ReverseCymbal+ | GuitarFretNoise | BreathNoise | Seashore+ | BirdTweet | TelephoneRing | Helicopter+ | Applause | Gunshot + deriving (Show, Enum, Bounded)++data PercussionName = + AcousticBassDrum | BassDrum1 | 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+ deriving (Show, Enum, Bounded)+
+ src/Temporal/Music/Notation/Demo.hs view
@@ -0,0 +1,287 @@+{-# LANGUAGE ExistentialQuantification #-}++-- | Library provides functions to render 'Score' made with+-- 'temporal-music-notation' library to midi file from 'HCodecs' package.+module Temporal.Music.Notation.Demo(+ -- * Types+ MidiEvent,++ -- * Instruments+ instr, drumInstr, ++ -- * Render+ renderMidi, FilePath, exportMidi)+where++import Data.List(sortBy, partition)+import Data.Function(on)++import Data.Word++import Data.Binary+import Data.Binary.Put++import Foreign.C.Math.Double(log10)+import Codec.Midi hiding (Time)++import Temporal.Music.Notation+import Temporal.Music.Notation.Note++-- cmath++log2 :: Double -> Double+log2 x = log10 x / log10 2++logB :: Double -> Double -> Double+logB b x = log10 x / log10 b+++-----------------------------------------------------------------+-- Types++type Instr = Int+type VolumeId = Int+type PitchId = (Int, Bend)+++data MidiEvent = forall nVol nPch . (+ Seg nVol, Seg nPch) => MidiEvent+ { meventInstr :: Instr+ , meventVol :: Volume nVol+ , meventPch :: Maybe (Pitch nPch)+ }+++data LowMidiEvent = LowMidiEvent+ { lmeventVol :: VolumeId+ , lmeventPch :: PitchId+ }+++instance LevelFunctor MidiEvent where+ mapLevel f (MidiEvent i v p) = MidiEvent i (mapLevel f v) p ++instance VolumeFunctor MidiEvent where+ mapVolume f (MidiEvent i v p) = MidiEvent i (mapVolume f v) p ++instance ToneFunctor MidiEvent where+ mapTone f (MidiEvent i v p) = MidiEvent i v (fmap (mapTone f) p) ++instance PitchFunctor MidiEvent where+ mapPitch f (MidiEvent i v p) = MidiEvent i v (fmap (mapPitch f) p) +++-----------------------------------------------------------------+-- instruments++-- | Apply midi instrument.+instr :: (Seg nVol, Seg nPch) => + Preset -> Score (Note nVol nPch a) -> Score MidiEvent+instr id = fmap $ \(Note v p a) -> MidiEvent id v (Just p)+++-- | Apply midi drum instrument.+drumInstr :: Seg nVol => + Key -> Score (Drum nVol a) -> Score MidiEvent+drumInstr id = fmap $ \(Drum v a) -> MidiEvent id v drumPch++drumPch :: Maybe (Pitch DrumPitch)+drumPch = Nothing++data DrumPitch = DrumPitch+ deriving (Enum, Bounded)++instance Seg DrumPitch++-----------------------------------------------------------------+-- interpretation++-- | Render 'Score' to midi file and save results in current+-- directory.+exportMidi :: FilePath -> Score MidiEvent -> IO ()+exportMidi file sco = exportFile file $ renderMidi sco++-- | Render to 'Midi'.+renderMidi :: Score MidiEvent -> Midi+renderMidi = render' . renderScore++render' :: EventList Dur MidiEvent -> Midi+render' (EventList totalDur xs) = setMidi tracks + where td = totalDiapason $ map eventContent xs + tracks = map (formTrack td totalDur) $ + assignChannels $ groupByInstr xs+++formTrack :: Diapason -> Dur + -> (Channel, (Maybe Instr, [Event Dur MidiEvent]))+ -> Track Ticks+formTrack td d (ch, (i, es)) = + renderTrack d i ch $ fmap (fmap $ lowLevel td) $ sortEvents es+ ++sortEvents :: Ord t => [Event t a] -> [Event t a]+sortEvents = sortBy (compare `on` eventStart)++setMidi :: [Track Ticks] -> Midi+setMidi = Midi MultiTrack (TicksPerBeat division) ++assignChannels :: [(Maybe Instr, [Event Dur MidiEvent])] + -> [(Channel, (Maybe Instr, [Event Dur MidiEvent]))]+assignChannels xs = zip (assignIds xs') xs'+ where xs' = sortBy (compare `on` fst) $ take 16 xs+ assignIds = maybe drumIds (const noteIds) . fst . head+ drumIds = 9 : [0 .. 8] ++ [10 .. 15]+ noteIds = [0 .. 15]++groupByInstr :: [Event Dur MidiEvent] + -> [(Maybe Instr, [Event Dur MidiEvent])]+groupByInstr es = + case es of+ [] -> []+ x:xs -> + let (a, b) = partition ((instrId x == ) . instrId) xs+ in (instrId x, x : a) : groupByInstr b ++instrId :: Event Dur MidiEvent -> Maybe Instr+instrId x = + case eventContent x of+ MidiEvent i _ p -> fmap (const i) p+++defST :: Int+defST = 1000000++renderTrack :: Dur -> Maybe Instr -> Channel + -> [Event Dur LowMidiEvent] -> Track Ticks+renderTrack totalDur instr ch xs = sets ++ body+ where sets = trackSettings instr ch + body = fromAbsTime $ trackBody ch xs + ++ return (toTicks totalDur, TrackEnd)+++trackSettings :: Maybe Instr -> Channel -> Track Ticks +trackSettings instr ch = tempo : program+ where tempo = (0, TempoChange defST) + program = maybe [] + (return . \x -> (0, ProgramChange ch x)) instr +++trackBody :: Channel + -> [Event Dur LowMidiEvent] -> Track Ticks+trackBody ch es =+ case es of+ [] -> []+ x:xs -> let (n, m) = toMessages ch $ eventContent x+ tn = toTicks $ eventStart x + tm = toTicks $ eventStart x + eventDur x+ xs' = insertNoteOff (tm, m) (trackBody ch xs) + in map (markTime tn) n ++ xs'++markTime :: t -> Message -> (t, Message)+markTime = (,)++insertNoteOff :: (Ticks, Message) -> Track Ticks -> Track Ticks+insertNoteOff a ms = + case ms of+ [] -> [a]+ x:xs -> if t a <= t x + then a:ms + else x:insertNoteOff a xs+ where t = fst++++{-+toMessages :: Channel -> LowMidiEvent -> (Message, Message) +toMessages ch x = (NoteOn ch key vel, NoteOff ch key 64)+ where key = fst $ lmeventPch x+ vel = lmeventVol x +-}++toMessages :: Channel -> LowMidiEvent -> ([Message], Message) +toMessages ch x = toMessages' ch vel key tune+ where key = fst $ lmeventPch x+ vel = lmeventVol x + tune = uncurry tuneParams $ lmeventPch x++toMessages' :: Channel -> VolumeId -> Key -> Maybe TuneId + -> ([Message], Message)+toMessages' ch v p t = (tune ++ [NoteOn ch p v], NoteOff ch p 64)+ where tune = maybe [] (return . tuneMessage) t++totalDiapason :: [MidiEvent] -> Diapason+totalDiapason = foldl1 merge . map diap + where diap (MidiEvent _ v _) = volumeDiapason v+ merge (a, b) (a', b') = (min a a', max b b')+ +++lowLevel :: Diapason -> MidiEvent -> LowMidiEvent+lowLevel diap (MidiEvent i v p) = LowMidiEvent vol pch+ where vol = fitToMidiDiapason diap $ absVolume v+ pch = maybe (i, 0) (midiPch . absPitch) p++fitToMidiDiapason :: Diapason -> Amplitude -> VolumeId+fitToMidiDiapason (a, b) x = round $ 127 * logB (b/a) (x/a) + {- logBase (b/a) (x/a) -}++midiPch :: Frequency -> PitchId+midiPch x = properFraction $ bound $ 69 + 12 * log2 (x/440) + {- logBase 2 (x / 440) -}+ where bound = max 0 . min 127 ++++toTicks :: Time -> Ticks+toTicks = round . ( * division2)++division :: Ticks+division = 96++division2 :: Time+division2 = fromIntegral 96+++-----------------------------------------------------+-- Microsound++type TuneId = (KeyId, Cents)+type KeyId = Word8++type Cent0 = Word8+type Cent1 = Word8++type Cents = (Cent0, Cent1)++tuneParams :: Int -> Double -> Maybe TuneId+tuneParams p d = Just (fromIntegral p, c) + -- | c == (0, 0) = Nothing+ -- | otherwise = Just (fromIntegral p, c)+ where c = cents d++cents :: Double -> (Cent0, Cent1)+cents d = (fromIntegral c0, fromIntegral c1)+ where (c0, c1) = flip divMod (128::Int) $ + fst $ properFraction (d/deltaTune)++-- | 1 semitone / 2^14 +deltaTune :: Double+deltaTune = 0.000061+++tuneMessage :: TuneId -> Message +tuneMessage (x, (a, b)) = Sysex 240 $ + runPut $ do+ putWord8 127+ putWord8 0+ putWord8 8+ putWord8 2+ putWord8 0+ putWord8 1+ putWord8 x+ putWord8 x+ putWord8 a+ putWord8 b+ putWord8 247 ++
+ src/Temporal/Music/Notation/Demo/GeneralMidi.hs view
@@ -0,0 +1,436 @@+-- | General MIDI names+++module Temporal.Music.Notation.Demo.GeneralMidi(+ -- * Instruments+ -- ** Piano+ acousticGrandPiano,+ brightAcousticPiano,+ electricGrandPiano,+ honkyTonkPiano,+ rhodesPiano,+ chorusedPiano,+ harpsichord,+ clavinet,+ -- ** Chromatic Percussion+ celesta,+ glockenspiel,+ musicBox,+ vibraphone,+ marimba,+ xylophone,+ tubularBells,+ dulcimer,+ -- ** Organ+ hammondOrgan,+ percussiveOrgan,+ rockOrgan,+ churchOrgan,+ reedOrgan,+ accordion,+ harmonica,+ tangoAccordion,+ -- ** Guitar+ acousticGuitarNylon,+ acousticGuitarSteel,+ electricGuitarJazz,+ electricGuitarClean,+ electricGuitarMuted,+ overdrivenGuitar,+ distortionGuitar,+ guitarHarmonics,+ -- ** Bass+ acousticBass,+ electricBassFingered,+ electricBassPicked,+ fretlessBass,+ slapBass1,+ slapBass2,+ synthBass1,+ synthBass2,+ -- ** Strings+ violin,+ viola,+ cello,+ contrabass,+ tremoloStrings,+ pizzicatoStrings,+ orchestralHarp,+ timpani,+ -- ** Ensemble+ stringEnsemble1,+ stringEnsemble2,+ synthStrings1,+ synthStrings2,+ choirAahs,+ voiceOohs,+ synthVoice,+ orchestraHit,+ -- ** Brass+ trumpet,+ trombone,+ tuba,+ mutedTrumpet,+ frenchHorn,+ brassSection,+ synthBrass1,+ synthBrass2,+ -- ** Reed+ sopranoSax,+ altoSax,+ tenorSax,+ baritoneSax,+ oboe,+ bassoon,+ englishHorn,+ clarinet,+ -- ** Pipe+ piccolo,+ flute,+ recorder,+ panFlute,+ blownBottle,+ shakuhachi,+ whistle,+ ocarina,+ -- ** Synth Lead+ lead1Square,+ lead2Sawtooth,+ lead3Calliope,+ lead4Chiff,+ lead5Charang,+ lead6Voice,+ lead7Fifths,+ lead8BassLead,+ -- ** Synth Pad+ pad1NewAge,+ pad2Warm,+ pad3Polysynth,+ pad4Choir,+ pad5Bowed,+ pad6Metallic,+ pad7Halo,+ pad8Sweep,+ -- ** Synth Effects+ fx1Train,+ fx2Soundtrack,+ fx3Crystal,+ fx4Atmosphere,+ fx5Brightness,+ fx6Goblins,+ fx7Echoes,+ fx8SciFi,+ -- ** Ethnic+ sitar,+ banjo,+ shamisen,+ koto,+ kalimba,+ bagpipe,+ fiddle,+ shanai,+ -- ** Percussive+ tinkleBell,+ agogo,+ steelDrums,+ woodblock,+ taikoDrum,+ melodicDrum,+ synthDrum,+ reverseCymbal,+ -- ** Sound Effects+ guitarFretNoise,+ breathNoise,+ seashore,+ birdTweet,+ telephoneRing,+ helicopter,+ applause,+ gunshot,+ +++ -- * Percussion+ acousticBassDrum,+ bassDrum1,+ 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)+where+++import Temporal.Music.Notation(Score, Seg)+import Temporal.Music.Notation.Note(Note, Drum)+import Temporal.Music.Notation.Demo+++--------------------+--Instruments+++ +acousticGrandPiano, brightAcousticPiano, electricGrandPiano,+ honkyTonkPiano, rhodesPiano, chorusedPiano, harpsichord, clavinet,+ celesta, glockenspiel, musicBox, vibraphone, marimba, xylophone,+ tubularBells, dulcimer, hammondOrgan, percussiveOrgan, rockOrgan,+ churchOrgan, reedOrgan, accordion, harmonica, tangoAccordion,+ acousticGuitarNylon, acousticGuitarSteel, electricGuitarJazz,+ electricGuitarClean, electricGuitarMuted, overdrivenGuitar,+ distortionGuitar, guitarHarmonics, acousticBass,+ electricBassFingered, electricBassPicked, 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, bassoon, englishHorn, clarinet, piccolo, flute,+ recorder, panFlute, blownBottle, shakuhachi, whistle, ocarina,+ lead1Square, lead2Sawtooth, lead3Calliope, lead4Chiff,+ lead5Charang, lead6Voice, lead7Fifths, lead8BassLead, pad1NewAge,+ pad2Warm, pad3Polysynth, pad4Choir, pad5Bowed, pad6Metallic,+ pad7Halo, pad8Sweep, fx1Train, fx2Soundtrack, fx3Crystal,+ fx4Atmosphere, fx5Brightness, fx6Goblins, fx7Echoes, fx8SciFi,+ sitar, banjo, shamisen, koto, kalimba, bagpipe, fiddle, shanai,+ tinkleBell, agogo, steelDrums, woodblock, taikoDrum, melodicDrum,+ synthDrum, reverseCymbal, guitarFretNoise, breathNoise, seashore,+ birdTweet, telephoneRing, helicopter, applause, gunshot ::+ (Seg nVol, Seg nPch) => Score (Note nVol nPch a) -> Score MidiEvent+++acousticGrandPiano = instr 0+brightAcousticPiano = instr 1+electricGrandPiano = instr 2+honkyTonkPiano = instr 3+rhodesPiano = instr 4+chorusedPiano = instr 5+harpsichord = instr 6+clavinet = instr 7+celesta = instr 8+glockenspiel = instr 9+musicBox = instr 10+vibraphone = instr 11+marimba = instr 12+xylophone = instr 13+tubularBells = instr 14+dulcimer = instr 15+hammondOrgan = instr 16+percussiveOrgan = instr 17+rockOrgan = instr 18+churchOrgan = instr 19+reedOrgan = instr 20+accordion = instr 21+harmonica = instr 22+tangoAccordion = instr 23+acousticGuitarNylon = instr 24+acousticGuitarSteel = instr 25+electricGuitarJazz = instr 26+electricGuitarClean = instr 27+electricGuitarMuted = instr 28+overdrivenGuitar = instr 29+distortionGuitar = instr 30+guitarHarmonics = instr 31+acousticBass = instr 32+electricBassFingered = instr 33+electricBassPicked = instr 34+fretlessBass = instr 35+slapBass1 = instr 36+slapBass2 = instr 37+synthBass1 = instr 38+synthBass2 = instr 39+violin = instr 40+viola = instr 41+cello = instr 42+contrabass = instr 43+tremoloStrings = instr 44+pizzicatoStrings = instr 45+orchestralHarp = instr 46+timpani = instr 47+stringEnsemble1 = instr 48+stringEnsemble2 = instr 49+synthStrings1 = instr 50+synthStrings2 = instr 51+choirAahs = instr 52+voiceOohs = instr 53+synthVoice = instr 54+orchestraHit = instr 55+trumpet = instr 56+trombone = instr 57+tuba = instr 58+mutedTrumpet = instr 59+frenchHorn = instr 60+brassSection = instr 61+synthBrass1 = instr 62+synthBrass2 = instr 63+sopranoSax = instr 64+altoSax = instr 65+tenorSax = instr 66+baritoneSax = instr 67+oboe = instr 68+bassoon = instr 69+englishHorn = instr 70+clarinet = instr 71+piccolo = instr 72+flute = instr 73+recorder = instr 74+panFlute = instr 75+blownBottle = instr 76+shakuhachi = instr 77+whistle = instr 78+ocarina = instr 79+lead1Square = instr 80+lead2Sawtooth = instr 81+lead3Calliope = instr 82+lead4Chiff = instr 83+lead5Charang = instr 84+lead6Voice = instr 85+lead7Fifths = instr 86+lead8BassLead = instr 87+pad1NewAge = instr 88+pad2Warm = instr 89+pad3Polysynth = instr 90+pad4Choir = instr 91+pad5Bowed = instr 92+pad6Metallic = instr 93+pad7Halo = instr 94+pad8Sweep = instr 95+fx1Train = instr 96+fx2Soundtrack = instr 97+fx3Crystal = instr 98+fx4Atmosphere = instr 99+fx5Brightness = instr 100+fx6Goblins = instr 101+fx7Echoes = instr 102+fx8SciFi = instr 103+sitar = instr 104+banjo = instr 105+shamisen = instr 106+koto = instr 107+kalimba = instr 108+bagpipe = instr 109+fiddle = instr 110+shanai = instr 111+tinkleBell = instr 112+agogo = instr 113+steelDrums = instr 114+woodblock = instr 115+taikoDrum = instr 116+melodicDrum = instr 117+synthDrum = instr 118+reverseCymbal = instr 119+guitarFretNoise = instr 120+breathNoise = instr 121+seashore = instr 122+birdTweet = instr 123+telephoneRing = instr 124+helicopter = instr 125+applause = instr 126+gunshot = instr 127+++--------------------+--Percussion+++ +acousticBassDrum, bassDrum1, 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 ::+ (Seg nVol) => Score (Drum nVol a) -> Score MidiEvent+++acousticBassDrum = drumInstr 35+bassDrum1 = drumInstr 36+sideStick = drumInstr 37+acousticSnare = drumInstr 38+handClap = drumInstr 39+electricSnare = drumInstr 40+lowFloorTom = drumInstr 41+closedHiHat = drumInstr 42+highFloorTom = drumInstr 43+pedalHiHat = drumInstr 44+lowTom = drumInstr 45+openHiHat = drumInstr 46+lowMidTom = drumInstr 47+hiMidTom = drumInstr 48+crashCymbal1 = drumInstr 49+highTom = drumInstr 50+rideCymbal1 = drumInstr 51+chineseCymbal = drumInstr 52+rideBell = drumInstr 53+tambourine = drumInstr 54+splashCymbal = drumInstr 55+cowbell = drumInstr 56+crashCymbal2 = drumInstr 57+vibraslap = drumInstr 58+rideCymbal2 = drumInstr 59+hiBongo = drumInstr 60+lowBongo = drumInstr 61+muteHiConga = drumInstr 62+openHiConga = drumInstr 63+lowConga = drumInstr 64+highTimbale = drumInstr 65+lowTimbale = drumInstr 66+highAgogo = drumInstr 67+lowAgogo = drumInstr 68+cabasa = drumInstr 69+maracas = drumInstr 70+shortWhistle = drumInstr 71+longWhistle = drumInstr 72+shortGuiro = drumInstr 73+longGuiro = drumInstr 74+claves = drumInstr 75+hiWoodBlock = drumInstr 76+lowWoodBlock = drumInstr 77+muteCuica = drumInstr 78+openCuica = drumInstr 79+muteTriangle = drumInstr 80+openTriangle = drumInstr 81
+ temporal-music-notation-demo.cabal view
@@ -0,0 +1,37 @@+Name: temporal-music-notation-demo+Version: 0.1.2+Cabal-Version: >= 1.2+License: BSD3+License-file: LICENSE+Author: Anton Kholomiov+Maintainer: Anton Kholomiov+Synopsis: Library: generates midi from score notation.+Description: Library for playing scores made with 'temporal-music-notation'+ via midi. It binds 'temporal-media-notation' and 'HCodecs' + packages. Features composable score representation and+ microsound composition. It relies on+ Midi Tuning Standart (MTS) so it's better to listen results+ with TiMidity or another soft that undestands MTS. + Examples can be found source directory.++Category: Music+Stability: Experimental+Tested-With: GHC==6.12.3+Build-Type: Simple++Extra-Source-Files : + gen/genGM.hs+ examples/choral.hs+ examples/break.hs+ examples/readme.hs++Library+ Build-Depends:+ base >= 4, base < 5,+ temporal-music-notation >= 0.1.2,+ HCodecs >= 0.2, binary >= 0.5.0.2,+ cmath >= 0.3+ Hs-Source-Dirs: src/+ Exposed-Modules:+ Temporal.Music.Notation.Demo+ Temporal.Music.Notation.Demo.GeneralMidi