module DD.Html where

import Text.XHtml
import Music.Diatonic
import Music.Diatonic.Scale
import Music.Diatonic.Key
import Music.Diatonic.Chord
import Music.Diatonic.Harmony
import List (intersperse)
import Maybe (fromJust)



majorKeys = map majorKey . take 15 . iterate (Music.Diatonic.above Perf5th) $ (flat C)
minorKeys = map minorKey . take 15 . iterate (Music.Diatonic.above Perf5th) $ (flat A)

allNotes = [C, sharp C, flat D, D, sharp D, flat E, E, F,
            sharp F, flat G, G, sharp G, flat A, A, sharp A, flat B, B, flat C]

chordTypes = [majorChord, minorChord, diminishedChord, dominant7thChord, major7thChord, minor7thChord, minor7thFlat5thChord]


displayMusicHTML :: String -> Html
displayMusicHTML "" = noHtml
displayMusicHTML (c:cs) = sub c +++ displayMusicHTML cs
  where subs = [('b', primHtmlChar "#x266D"), 
                ('#', primHtmlChar "#x266F"), 
                ('o', primHtmlChar "#176")]
        sub c = case lookup c subs of
                  Nothing  -> stringToHtml [c]
                  Just (s) -> s


displayMusicURL :: String -> String
displayMusicURL "" = ""
displayMusicURL (c:cs) = sub c ++ displayMusicURL cs
  where subs = [('#', "s"), ('{', ""), ('}', ""), ('(', ""), (')', "")]
        sub c = case lookup c subs of
                  Nothing  -> [c]
                  Just (s) -> s


linkNote :: Note -> Html
linkNote n = bold << hotlink url html 
  where url = "note" ++ (displayMusicURL . show $ n) ++ ".html"
        html = displayMusicHTML . show $ n


linkKey :: Key -> Html
linkKey k = bold << hotlink url html 
  where url = "key" ++ (displayMusicURL . show $ k) ++ ".html"
        html = displayMusicHTML . show $ k


linkChord :: Chord -> Html
linkChord c = bold << hotlink url html 
  where url = "chord" ++ (displayMusicURL . show $ c) ++ ".html"
        html = displayMusicHTML . show $ c


displayScale :: Scale -> Html
displayScale s = tr << (desc +++ (concatHtml . intersperse sep . map cell $ noteList))
  where sep = td << ("|" +++ br +++ "|")
        cell (d, n) = td << (concatHtml . intersperse br $ [displayMusicHTML . show $ d, linkNote n])
        noteList = degrees s
        desc = td << ((linkKey . key $ s) +++ ": ")


displayScales :: [Scale] -> Int -> Maybe String -> Html
displayScales ss n desc = table ! [theclass "center", cellspacing 2, cellpadding 4] << (header +++ rows)
  where header = case desc of
                   Nothing -> noHtml
                   Just d -> tr << (td ! [colspan (n*2)] << (h4 << desc))
        rows = concatHtml . map displayScale $ ss


displayHarmony :: Harmony -> Html
displayHarmony h = tr << (desc +++ (concatHtml . intersperse sep . map cell $ chordList))
  where sep = td << ("|" +++ br +++ "|")
        cell (d, c) = td << (concatHtml . intersperse br $ [displayMusicHTML . showRoman c $ d, linkChord c])
        chordList = degrees h
        desc = td << ((linkKey . key . scale $ h) +++ ": ")


displayHarmonies :: [Harmony] -> Int -> String -> Html
displayHarmonies hs n desc = table ! [theclass "center", cellspacing 2, cellpadding 4] << (header +++ rows)
  where header = tr << (td ! [colspan (n*2)] << (h4 << desc))
        rows = concatHtml . map displayHarmony $ hs


displayScaleDegrees :: [(Degree, [a])] -> (a -> Html) -> Html
displayScaleDegrees degList f = tr << (concatHtml . intersperse sep . map cell $ degList)
  where sep = td << ("|" +++ br +++ "|" +++ br +++ "|")
        cell (d, as) = td ! [valign "top"] << (concatHtml . intersperse br $ (displayMusicHTML . show $ d) : map (\a -> f a) as)


fifths n f fh =
  table ! [theclass "center", cellspacing 2, cellpadding 4] <<
    tr <<
      cells
  where cells = concatHtml . intersperse sep . map cell $ noteList
        sep = td << ("|" +++ br +++ "|")
        cell (d, n) = td ! [width "40"] << (concatHtml . intersperse br $ [stringToHtml ("(" ++ showDist d ++ ")"), fh n])
        noteList = zip [-6 .. 6] (map f . circleOfFifths $ n)
        showDist d | d == 0 = "-"
        showDist d | d > 0 = "+" ++ show d
        showDist d  = show d


equivKey :: Key -> Key
equivKey k | k == majorKey (sharp G) = majorKey . flat $ A
equivKey k | k == majorKey (sharp A) = majorKey . flat $ B
equivKey k | k == majorKey (sharp D) = majorKey . flat $ E
equivKey k | k == minorKey (flat D)  = minorKey . sharp $ C
equivKey k | k == minorKey (flat G)  = minorKey . sharp $ A
equivKey k | k == minorKey (flat C)  = minorKey . sharp $ D
equivKey k = k