Tomatosalad.hs

{-
The famous song, that is named "Tomatensalat" in German.
-}
module Main where

import qualified Sound.MIDI.File      as MidiFile
import qualified Sound.MIDI.File.Save as Save

import Sound.MIDI.File (ElapsedTime, )

import qualified Sound.MIDI.File.Event.Meta as MetaEvent
import qualified Sound.MIDI.File.Event      as Event

import qualified Sound.MIDI.Message.Channel       as ChannelMsg
import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg

-- import qualified Sound.MIDI.Parser.Report as Report

import qualified Data.EventList.Relative.TimeMixed as EventListTM
import qualified Data.EventList.Relative.BodyTime  as EventListBT
import qualified Data.EventList.Relative.MixedTime as EventListMT
import qualified Data.EventList.Relative.TimeBody  as EventList
-- import Data.EventList.Relative.MixedBody ((/.), (./), )

import qualified Data.ByteString.Lazy as B

-- import qualified Numeric.NonNegative.Wrapper as NonNeg

-- import Data.Tuple.HT (mapSnd, )



g0,c1,d1,e1,f1,g1,a1 :: ElapsedTime -> (VoiceMsg.Pitch, ElapsedTime)
[g0,c1,d1,e1,f1,g1,a1] =
   map (\p t -> (VoiceMsg.toPitch (p-12), t))
      [55,60,62,64,65,67,69]

melody :: [(VoiceMsg.Pitch, ElapsedTime)]
melody =
   g0 3 :
   c1 1 :
   c1 1 :
   c1 1 :
   e1 1 :
   d1 1 :
   c1 1 :
   d1 1 :
   g0 1 :
   g0 1 :
   g0 3 :
   c1 1 :
   c1 1 :
   c1 1 :
   e1 1 :
   d1 1 :
   c1 1 :
   g1 3 :
   e1 3 :
   f1 1 :
   f1 1 :
   f1 1 :
   a1 1 :
   g1 1 :
   f1 1 :
   e1 1 :
   e1 1 :
   e1 1 :
   g1 1 :
   f1 1 :
   e1 1 :
   d1 1 :
   d1 1 :
   d1 1 :
   f1 1 :
   e1 1 :
   d1 1 :
   c1 3 :
   []



song :: Int -> MidiFile.T
song pn =
   let chan = ChannelMsg.toChannel 0
       vel = VoiceMsg.toVelocity VoiceMsg.normalVelocity
       event =
          Event.MIDIEvent .
          ChannelMsg.Cons chan .
          ChannelMsg.Voice
   in  MidiFile.Cons MidiFile.Parallel (MidiFile.Ticks 4)
          [EventList.cons 0
              (Event.MetaEvent $ MetaEvent.SetTempo 1500000) $
           EventListTM.switchTimeR const $
           EventListMT.consTime 0 $
           EventListBT.fromPairList $
           concatMap (\(pgm, (n,t)) ->
              [(event $ VoiceMsg.ProgramChange pgm, 0),
               (event $ VoiceMsg.NoteOn  n vel, t),
               (event $ VoiceMsg.NoteOff n vel, 0)]) $
           zip (cycle $ map VoiceMsg.toProgram [pn..(pn+4)]) $
           concat (replicate 5 melody)]

main :: IO ()
main =
   B.writeFile "tomatosalad.mid" (Save.toByteString (song  8)) >>
   B.writeFile "hal.mid"         (Save.toByteString (song 16)) >>
   B.writeFile "graphtheory.mid" (Save.toByteString (song 24))