GHC-6.4.1 runs out of memory with optimization. Unfortunately we cannot override Cabal's option here, so you have to configure with --disable-optimization > {-# OPTIONS_GHC -Onot #-} New Resolutions by Jean-Luc Ponty, Scott O'Neil, and John Garvin > module Haskore.Example.NewResolutions where > import qualified Haskore.Basic.Pitch as Pitch > import qualified Haskore.Basic.Tempo as Tempo > import qualified Haskore.Interface.MIDI.Write as WriteMidi > import qualified Sound.MIDI.File.Save as SaveMidi > import qualified Sound.MIDI.File as MidiFile > import qualified Haskore.Performance.Context as Context > import qualified Haskore.Performance.Fancy as FancyPf > import Haskore.Basic.Duration((%+)) > import Haskore.Basic.Pitch > import Haskore.Basic.Interval as Interval > import qualified Haskore.Music as Music > import Haskore.Melody as Melody > import Haskore.Melody.Standard as StdMelody > import Haskore.Music.GeneralMIDI as MidiMusic > import qualified Haskore.Music.Rhythmic as RhyMusic > import qualified Data.List as List > import qualified Numeric.NonNegative.Wrapper as NonNeg > import qualified Data.Accessor.Basic as Accessor > piano, marimba, xylo, vib, glock :: MidiMusic.Instr > piano = MidiMusic.AcousticGrandPiano > marimba = MidiMusic.Marimba > xylo = MidiMusic.Xylophone > vib = MidiMusic.Vibraphone > glock = MidiMusic.Glockenspiel > pattern, melPattern, > melody1, bellPart, vibesLine, vibesPart, > melody2, vibeLine3, vibePart3, > melody3, endRun :: StdMelody.T > part1, part2, part3, bridge, ending, harmony3 :: MidiMusic.T > comp2 :: (c -> d) -> (a -> b -> c) -> (a -> b -> d) > comp2 func = ((func .) .) % comp2 func1 func0 = curry (func1 . uncurry func0) > arpeggio :: [Int] -> Pitch.T -> Dur -> StdMelody.T > arpeggio trs p d' = line (map (\tr -> note (Pitch.transpose tr p) d' na) trs) > minArpegUp, minArpegDown, majArpegDown, six3ArpegDown > :: Pitch.T -> Dur -> StdMelody.T > minArpegUp = arpeggio [unison, minorThird, fifth, octave] > minArpegDown = arpeggio [octave, fifth, minorThird, unison] > majArpegDown = arpeggio [octave, fifth, majorThird, unison] > six3ArpegDown = arpeggio [octave, majorSixth, majorThird, unison] > pattern = minArpegUp (5,D) sn > +:+ minArpegDown (5,C) sn > +:+ minArpegUp (4,A) sn > +:+ minArpegDown (4,G) sn > +:+ minArpegUp (4,F) sn > +:+ d 5 sn na +:+ a 4 sn na +:+ f 4 sn na +:+ a 4 sn na > melPattern = d 6 en na +:+ c 6 en na +:+ d 6 en na > +:+ snr > +:+ a 5 en na +:+ g 5 en na +:+ a 5 en na > melody1 = melPattern +:+ enr +:+ d 5 sn na > +:+ f 5 sn na +:+ g 5 en na +:+ f 5 sn na +:+ d 5 en na +:+ c 5 en na > +:+ d 5 en na +:+ melPattern +:+ d 5 sn na > +:+ f 5 sn na +:+ f 5 sn na +:+ g 5 sn na +:+ f 5 sn na > +:+ d 5 sn na +:+ c 5 en na +:+ d 5 den na > +:+ melPattern +:+ d 5 sn na > +:+ f 5 sn na +:+ g 5 sn na +:+ f 5 sn na +:+ d 5 en na > +:+ c 5 sn na +:+ d 5 en na > +:+ d 6 en na +:+ c 6 en na +:+ d 6 den na +:+ c 6 en na > +:+ a 5 en na +:+ c 6 en na +:+ a 5 sn na +:+ g 5 en na > +:+ f 5 en na +:+ af 5 en na > +:+ g 5 sn na +:+ f 5 sn na +:+ d 5 sn na +:+ c 5 sn na > -- last note removed to make fit with pattern > bellPart = d 7 en na +:+ f 7 en na +:+ c 7 en na +:+ d 7 en na > +:+ a 6 en na +:+ c 7 en na +:+ g 6 en na +:+ a 6 en na > +:+ f 6 en na +:+ g 6 en na > +:+ d 6 sn na +:+ f 6 sn na +:+ a 6 sn na +:+ c 7 sn na > vibesLine = d 5 qn na +:+ c 5 qn na +:+ a 4 qn na > +:+ g 4 qn na +:+ f 4 qn na +:+ d 4 qn na > vibesPart = vibesLine =:= Music.transpose 12 vibesLine > cMajorScale, gMajorScale, dPentMinScale :: [Pitch.T] > cMajorScale = [(0,C), (0,D), (0,E), (0,F), (0,G), (0,A), (0,B)] > gMajorScale = [(0,G), (0,A), (0,B), (1,C), (1,D), (1,E), (1,Fs)] > dPentMinScale = [(0,D), (0,F), (0,G), (0,A), (1,C)] > prevNote, nextNote :: [Pitch.T] -> Pitch.T -> Pitch.T > prevNote [] _ = error ("Scale empty") > prevNote [_] _ = error ("Note not found in scale") > prevNote ((n,y):ys) (oct,p) | y == p = let (m,x) = last ys > in (oct + m - n - 1, x) > prevNote ((m,x):(n,y):xys) (oct,p) | y == p = (oct + m - n, x) > | otherwise = prevNote ((n,y):xys) (oct,p) > nextNote scale n = nextNote' (head scale) scale n > nextNote' :: Pitch.T -> [Pitch.T] -> Pitch.T -> Pitch.T > nextNote' _ [] _ = error ("Scale empty") > nextNote' (fstO,fstP) [(m,x)] (oct,p) > | x == p = (oct - m + fstO + 1, fstP) > | otherwise = error ("Note not found in scale") > nextNote' fst' ((m,x):(n,y):xys) (oct,p) > | x == p = (oct - m + n, y) > | otherwise = nextNote' fst' ((n,y):xys) (oct,p) > back2Note :: [Pitch.T] -> Pitch.T -> Pitch.T > back2Note s = prevNote s . prevNote s > nextNR, prevNR, back2NR :: Pitch.T -> Pitch.T > nextNR = nextNote dPentMinScale > prevNR = prevNote dPentMinScale > back2NR = back2Note dPentMinScale > makeSN, diddle :: Pitch.T -> StdMelody.T > makeSN p = note p sn na > diddle p = line $ snr : map makeSN [p, prevNR p, p] > melody2 = d 6 sn na +:+ d 6 en na +:+ c 6 en na +:+ d 6 sn na +:+ c 6 en na > +:+ a 5 en na +:+ g 5 sn na +:+ f 5 sn na > +:+ g 5 sn na +:+ f 5 sn na +:+ d 5 sn na +:+ f 5 sn na > +:+ diddle (5,D) +:+ diddle (5,C) > +:+ diddle (6,D) +:+ diddle (6,C) +:+ diddle (5,A) > +:+ diddle (5,G) +:+ diddle (5,F) +:+ diddle (5,D) > +:+ snr +:+ d 6 en na +:+ c 6 en na +:+ d 6 den na > +:+ c 6 en na +:+ a 5 en na +:+ g 5 den na > +:+ f 5 en na +:+ g 5 en na +:+ f 5 sn na > +:+ g 5 sn na +:+ f 5 sn na +:+ d 5 sn na +:+ c 5 sn na > +:+ d 5 den na +:+ d 6 en na +:+ c 6 den na +:+ a 5 en na +:+ g 5 den na > +:+ f 5 en na +:+ d 5 den na +:+ c 5 en na +:+ d 5 qn na > part1 = MidiMusic.fromStdMelody marimba (loudness1 0.7 pattern) > +:+ > MidiMusic.fromStdMelody xylo (loudness1 1.2 melody1) > =:= MidiMusic.fromStdMelody marimba (loudness1 0.7 (Music.replicate 4 pattern)) > bridge = MidiMusic.fromStdMelody xylo (d 5 hn (Accessor.set velocity1 1.2 na)) > =:= (Music.replicate 2 $ > MidiMusic.fromStdMelody marimba (loudness1 0.6 (Music.transpose (-12) bellPart)) > =:= MidiMusic.fromStdMelody vib (loudness1 0.4 vibesPart) > =:= MidiMusic.fromStdMelody glock (loudness1 0.8 bellPart)) > part2 = MidiMusic.fromStdMelody xylo (loudness1 1.2 melody2) > =:= MidiMusic.fromStdMelody marimba (loudness1 0.7 (Music.replicate 3 pattern > +:+ minArpegUp (5,D) sn > +:+ minArpegDown (5,C) sn > +:+ minArpegUp (4,A) sn > +:+ minArpegDown (4,G) sn > +:+ minArpegUp (4,F) sn > +:+ d 5 sn na)) > =:= Music.replicate 4 (MidiMusic.fromStdMelody vib (loudness1 0.4 vibesPart)) > run1, run2, run3 :: Pitch.T -> Dur -> StdMelody.T > run1 = arpeggio [unison, minorThird, fifth, > minorSeventh, octave, octaveMinorThird, > octaveFifth, octaveMinorThird, octave, > minorSeventh, fifth, minorThird] > part3Pattern :: (Num t) => > ((t, Pitch.Class) -> Dur -> StdMelody.T) -> MidiMusic.T > part3Pattern el = MidiMusic.fromStdMelody piano $ > el (4,D) sn +:+ el (4,C) sn +:+ el (4,D) sn +:+ el (4,F) sn > run2 = Music.replicate 2 `comp2` > arpeggio [fifth, minorSeventh, octave, > octaveMinorThird, octave, minorSeventh] > run3 = Music.replicate 3 `comp2` > arpeggio [octaveMinorThird, octave, minorSeventh, fifth] > vibeLine3 = let el p = arpeggio [octave, fifth, minorSeventh, octave] p den > in el (4,D) +:+ el (4,C) +:+ el (4,D) > +:+ f 5 den na +:+ c 5 den na > +:+ ef 5 en na +:+ f 5 en na +:+ af 5 en na > vibePart3 = vibeLine3 =:= Music.transpose 12 vibeLine3 > melody3 = a 5 (11%+16) na +:+ f 6 sn na > +:+ ef 6 en na +:+ d 6 en na +:+ c 6 en na +:+ g 5 dqn na > +:+ Music.replicate 3 (a 5 sn na +:+ f 6 en na) +:+ a 5 en na > +:+ f 6 en na +:+ af 5 en na +:+ f 6 en na +:+ af 5 en na > +:+ minArpegDown (5,F) sn +:+ snr > +:+ majArpegDown (5,F) sn +:+ snr > +:+ six3ArpegDown (5,F) sn +:+ snr +:+ f 6 sn na +:+ d 6 sn na > +:+ ef 6 sn na +:+ d 6 sn na +:+ c 6 sn na +:+ g 5 sn na +:+ snr > +:+ majArpegDown (5,Ef) sn +:+ snr +:+ ef 6 sn na +:+ c 6 sn na > +:+ majArpegDown (5,F) sn +:+ snr > +:+ six3ArpegDown (5,F) sn +:+ snr +:+ f 6 sn na +:+ d 6 sn na > +:+ minArpegDown (5,F) sn +:+ snr > +:+ minArpegDown (5,F) sn +:+ af 5 sn na +:+ c 6 sn na +:+ f 6 sn na > +:+ line (map (Music.replicate 2) [f 6 sn na, d 6 sn na, c 6 sn na, > a 5 sn na, g 5 sn na, f 5 sn na]) > +:+ ef 5 sn na +:+ f 5 sn na +:+ g 5 sn na +:+ bf 5 sn na > +:+ c 6 sn na +:+ d 6 sn na +:+ ef 6 sn na +:+ d 6 sn na > +:+ c 6 sn na +:+ bf 5 sn na +:+ a 5 sn na +:+ g 5 sn na > +:+ Music.replicate 4 (a 5 sn na +:+ a 5 sn na +:+ g 5 sn na) > +:+ Music.replicate 2 (af 5 sn na +:+ af 5 sn na +:+ g 5 sn na) > +:+ Music.replicate 2 (af 5 sn na +:+ g 5 sn na +:+ f 5 sn na) > +:+ a 5 dqn na > +:+ f 6 sn na +:+ d 6 sn na +:+ c 6 sn na > +:+ a 5 sn na +:+ g 5 sn na +:+ f 5 sn na > +:+ g 5 sn na +:+ bf 5 sn na +:+ ef 6 dqn na > +:+ bf 6 den na +:+ bf 6 sn na > +:+ a 6 en na +:+ a 6 sn na +:+ g 6 en na +:+ g 6 sn na > +:+ f 6 den na +:+ a 5 sn na +:+ c 6 sn na +:+ d 6 sn na > +:+ f 6 den na +:+ f 6 sn na +:+ d 6 sn na +:+ c 6 sn na > +:+ af 5 sn na +:+ af 5 sn na +:+ g 5 sn na > +:+ f 5 sn na +:+ d 5 sn na +:+ c 5 sn na > harmony3 = loudness1 0.6 (part3Pattern run1 > =:= part3Pattern run2 > =:= Music.transpose 12 (part3Pattern run3)) > =:= loudness1 0.5 (MidiMusic.fromStdMelody vib vibePart3) > part3 = loudness1 0.6 (part3Pattern run1) > +:+ (loudness1 0.6 (part3Pattern run1) > =:= loudness1 0.9 (part3Pattern run2)) > +:+ (loudness1 0.6 ((part3Pattern run1) > =:= (part3Pattern run2)) > =:= loudness1 1.0 (Music.transpose 12 (part3Pattern run3))) > +:+ loudness1 0.6 (part3Pattern run1 > =:= part3Pattern run2 > =:= Music.transpose 12 (part3Pattern run3)) > =:= loudness1 0.7 (MidiMusic.fromStdMelody vib vibePart3) > +:+ (Music.replicate 4 harmony3 =:= > loudness1 1.0 (MidiMusic.fromStdMelody xylo melody3 =:= > MidiMusic.fromStdMelody marimba melody3)) > all3Insts :: StdMelody.T -> MidiMusic.T > all3Insts m = chord [MidiMusic.fromStdMelody marimba m, > MidiMusic.fromStdMelody xylo m, > MidiMusic.fromStdMelody vib m] > endEl :: Pitch.T -> StdMelody.T > endEl p = line $ map makeSN [p, back2NR p, prevNR p, p] > endRun = line $ map endEl $ List.take 10 $ iterate nextNR (5,D) > ending = all3Insts $ > d 5 qn na > +:+ loudness1 1.2 (endRun +:+ d 7 sn na) > song :: MidiMusic.T > song = Music.transpose (-48) $ line [part1, bridge, part2, part3, ending] > > -- context :: Context.T NonNeg.Float Float MidiMusic.Note -- rejected by Hugs > context :: Context.T NonNeg.Float Float (RhyMusic.Note MidiMusic.Drum MidiMusic.Instr) > context = > Context.setDur (Tempo.metro 120 qn) $ > FancyPf.context > > midi :: MidiFile.T > midi = WriteMidi.fromGMMusicAuto (context, song) > > main :: IO () > main = SaveMidi.toFile "newresolutions.mid" midi