--------------------------------------------------------------------------------
-- |
-- Module      :  HarmTrace.Play
-- Copyright   :  (c) 2010-2012 Universiteit Utrecht, 2012 University of Oxford
-- License     :  GPL3
--
-- Maintainer  :  bash@cs.uu.nl, jpm@cs.ox.ac.uk
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Summary: Play stuff. Interfaces with Haskore.
--------------------------------------------------------------------------------

module HarmTrace.Play where

import HarmTrace.Base.MusicRep
import HarmTrace.Song

import qualified Haskore.Composition.Chord as C
import qualified Haskore.Music             as H
import qualified Haskore.Basic.Pitch       as H
import qualified Haskore.Basic.Duration    as H
import qualified Haskore.Basic.Interval    as H
import           Haskore.Melody.Standard   as Melody
import qualified Haskore.Music.GeneralMIDI as MIDI
import Haskore.Interface.MIDI.Render  ( generalMidiDeflt, playTimidityJack  )

import Sound.MIDI.File.Save           ( toFile )

import Data.List    ( genericLength )
import System.Exit  ( ExitCode )

songToChords :: Song -> Melody.T
songToChords (Song _ l) = H.line $ map clToHChord (map fst l)

clToHChord :: ChordLabel -> Melody.T
clToHChord cl =
  let pitch (Note (Just Fl) A) = H.Af
      pitch (Note Nothing   A) = H.A
      pitch (Note (Just Sh) A) = H.As
      pitch (Note (Just Fl) B) = H.Bf
      pitch (Note Nothing   B) = H.B
      pitch (Note (Just Sh) B) = H.Bs
      pitch (Note (Just Fl) C) = H.Cf
      pitch (Note Nothing   C) = H.C
      pitch (Note (Just Sh) C) = H.Cs
      pitch (Note (Just Fl) D) = H.Df
      pitch (Note Nothing   D) = H.D
      pitch (Note (Just Sh) D) = H.Ds
      pitch (Note (Just Fl) E) = H.Ef
      pitch (Note Nothing   E) = H.E
      pitch (Note (Just Sh) E) = H.Es
      pitch (Note (Just Fl) F) = H.Ff
      pitch (Note Nothing   F) = H.F
      pitch (Note (Just Sh) F) = H.Fs
      pitch (Note (Just Fl) G) = H.Gf
      pitch (Note Nothing   G) = H.G
      pitch (Note (Just Sh) G) = H.Gs
      pitch x                  = error $ "pitch: " ++ show x

      clss Maj = C.majorInt
      clss Min = C.minorInt
      clss Sev = C.dominantSeventhInt
      clss Dim = [H.unison, H.minorThird, 6]
      clss x   = error $ "clss: " ++ show x
      
      dur   = H.qn
      attr  = na
      
      gc = C.generic (pitch (chordRoot cl)) (clss (chordShorthand cl)) dur attr
  in H.chord $ C.genericToNotes 0 gc

songToMelody :: Song -> Melody.T
songToMelody (Song _ l) =
  let mel :: [[MelodyNote]]
      mel = map snd l
  in H.line $
       map (\ns -> H.line $ 
              map (H.changeTempo (genericLength ns H.%+ 1) . mnToHNote) ns) mel

mnToHNote :: MelodyNote -> Melody.T
mnToHNote (MelodyNote (Note (Just Fl) A) o) = Melody.af o H.qn na
mnToHNote (MelodyNote (Note Nothing   A) o) = Melody.a  o H.qn na
mnToHNote (MelodyNote (Note (Just Sh) A) o) = Melody.as o H.qn na
mnToHNote (MelodyNote (Note (Just Fl) B) o) = Melody.bf o H.qn na
mnToHNote (MelodyNote (Note Nothing   B) o) = Melody.b  o H.qn na
mnToHNote (MelodyNote (Note (Just Sh) B) o) = Melody.bs o H.qn na
mnToHNote (MelodyNote (Note (Just Fl) C) o) = Melody.cf o H.qn na
mnToHNote (MelodyNote (Note Nothing   C) o) = Melody.c  o H.qn na
mnToHNote (MelodyNote (Note (Just Sh) C) o) = Melody.cs o H.qn na
mnToHNote (MelodyNote (Note (Just Fl) D) o) = Melody.df o H.qn na
mnToHNote (MelodyNote (Note Nothing   D) o) = Melody.d  o H.qn na
mnToHNote (MelodyNote (Note (Just Sh) D) o) = Melody.ds o H.qn na
mnToHNote (MelodyNote (Note (Just Fl) E) o) = Melody.ef o H.qn na
mnToHNote (MelodyNote (Note Nothing   E) o) = Melody.e  o H.qn na
mnToHNote (MelodyNote (Note (Just Sh) E) o) = Melody.es o H.qn na
mnToHNote (MelodyNote (Note (Just Fl) F) o) = Melody.ff o H.qn na
mnToHNote (MelodyNote (Note Nothing   F) o) = Melody.f  o H.qn na
mnToHNote (MelodyNote (Note (Just Sh) F) o) = Melody.fs o H.qn na
mnToHNote (MelodyNote (Note (Just Fl) G) o) = Melody.gf o H.qn na
mnToHNote (MelodyNote (Note Nothing   G) o) = Melody.g  o H.qn na
mnToHNote (MelodyNote (Note (Just Sh) G) o) = Melody.gs o H.qn na
mnToHNote x                                 = error $ "mnToHNote: " ++ show x

songToMIDI :: Song -> MIDI.T
songToMIDI s = 
  let melody = songToMelody s
      chords = songToChords s
  in       MIDI.fromStdMelody MIDI.Flute              melody
     H.=:= MIDI.fromStdMelody MIDI.AcousticGrandPiano chords

writeMIDI :: FilePath -> MIDI.T -> IO ()
writeMIDI fp = toFile fp . generalMidiDeflt

playMIDI :: MIDI.T -> IO ExitCode
playMIDI = playTimidityJack