module Traumzauberbaum where

import Traumzauberbaum.Drum
import Chords
import Pitch
import Midi
import List ( concat, map, concatMap, cycle, (++), )
import Prelude ( (*), ($), negate )


main :: [ Event (Channel Message) ] ;
main = music ;


music :: [ Event (Channel Message) ] ;
music =
    concatMap renderPart $
        partA : partA : partB : partB :
        partC : partA : partD : [] ;

rhythmic :: [ Event (Channel Message) ] ;
rhythmic =
    drumTrack en
    =:=
    cycle music ;


type PartTrack = [ [ Event Message ] ] ;

data Part = Part PartTrack PartTrack PartTrack [ Pitch ] ;

renderPart :: Part -> [ Event (Channel Message) ] ;
renderPart (Part melody chords bass harmony) =
    channel 0 ( program  1 ++ concat melody ) =:=
    channel 1 ( program 16 ++ concat chords ) =:=
    channel 2 ( program 38 ++ transpose (negate 36) (concat bass) ) =:=
    channel 3 ( program  0 ++ concat (map (note en) harmony) ) =:=
    [] ;

partA, partB, partC, partD :: Part ;
partA = Part melodyA chordsA bassA harmonyA ;
partB = Part melodyB chordsB bassB harmonyB ;
partC = Part melodyC chordsC bassC harmonyC ;
partD = Part melodyD chordsD bassD harmonyD ;


melodyA, melodyB, melodyC, melodyD :: [ [ Event Message ] ] ;
melodyA =
    melodyPart (g 4) (c 4) (d 4) (e 4) ;

melodyB =
    melodyPart (c 4) (d 4) (d 4) (e 4) ;

melodyC =
    melodyPart (a 4) (f 4) (f 4) (d 4) ;

melodyD =
    melodyPart (a 4) (g 4) (g 4) (f 4) ++
    melodyPart (g 4) (c 4) (d 4) (c 4) ;

melodyPart ::
    Pitch -> Pitch ->
    Pitch -> Pitch ->
    [ [ Event Message ] ] ;
melodyPart p0 p1 p2 p3 =
    note qn p0 : note en p0 : note qn p1 : note en p2 : note dhn p3 : [] ;


chordsA, chordsB, chordsC, chordsD :: [ [ Event Message ] ] ;
chordsA =
    cMajor  dqn : fMajor   qn : gMajor   en : cMajor1 dhn : [] ;

chordsB =
    aMinor  dqn : gMajor  dqn : cMajor1 dhn : [] ;

chordsC =
    fMajor  dqn : dMinor  dqn : gMajor  dhn : [] ;

chordsD =
    fMajor  dqn : eMinor  dqn : dMinor1 dhn :
    cMajor  dqn : fMajor   qn : gMajor   en : cMajor2 dhn : [] ;


aMinor, cMajor1, cMajor2, cMajor,
 dMinor1, dMinor, eMinor, fMajor, gMajor :: Time -> [ Event Message ] ;

aMinor  dur = chord3 dur (a 3) (c 4) (e 4) ;
cMajor1 dur = chord3 dur (g 3) (c 4) (e 4) ;
cMajor2 dur = chord3 dur (e 3) (g 3) (c 4) ;
cMajor  dur = chord3 dur (c 4) (e 4) (g 4) ;
dMinor1 dur = chord3 dur (f 3) (a 3) (d 4) ;
dMinor  dur = chord3 dur (a 3) (d 4) (f 4) ;
eMinor  dur = chord3 dur (g 3) (b 3) (e 4) ;
fMajor  dur = chord3 dur (a 3) (c 4) (f 4) ;
gMajor  dur = chord3 dur (g 3) (b 3) (d 4) ;



bassA, bassB, bassC, bassD :: [ [ Event Message ] ] ;
bassA =
    note dqn (c 5) : note  qn (f 4) : note  en (g 4) : note  dhn (c 5) : [] ;

bassB =
    note  qn (a 4) : note  en (a 4) : note  qn (g 4) : note   en (g 4) : note dhn (c 5) : [] ;

bassC =
    note  qn (f 4) : note  en (f 4) : note  qn (d 4) : note   en (d 4) : note dhn (g 4) : [] ;

bassD =
    note dqn (f 5) : note dqn (e 5) : note dhn (d 5) :
    note dqn (c 5) : note  qn (f 4) : note  en (g 4) : note  dhn (c 4) :
    [] ;


harmonyA, harmonyB, harmonyC, harmonyD :: [ Pitch ] ;
harmonyA =
    c 4 : g 4 : c 5 : f 3 : c 4 : g 3 :
    c 4 : g 4 : c 5 : c 4 : g 4 : c 5 : [] ;

harmonyB =
    a 3 : e 4 : a 4 : g 3 : d 4 : g 4 :
    c 4 : g 4 : c 5 : c 4 : g 4 : c 5 : [] ;

harmonyC =
    f 3 : c 4 : f 4 : a 3 : d 4 : a 4 :
    g 3 : d 4 : g 4 : g 3 : d 4 : g 4 : [] ;

harmonyD =
    f 3 : c 4 : f 4 : e 3 : b 3 : e 4 :
    d 3 : a 3 : d 4 : a 3 : d 4 : a 4 :
    c 4 : g 4 : c 5 : f 3 : c 4 : g 3 :
    c 4 : g 4 : c 5 : c 4 :
--    c 4 : g 4 : c 5 : c 4 : g 4 : c 5 :
    [] ;


-- * durations

en, qn, dhn, dqn :: Time ;
dhn = 3 * qn ;
dqn = 3 * en ;
qn = 2 * en ;
en = 300 ;