module Key where

import Pitch ;
import Drum ;
import Midi ;
import List ( (++), concat, cycle )
import Prelude ( Int, negate, (+), (*), ($) ) ;


main, loop, struct ::
  [Midi.Event (Midi.Channel Midi.Message)] ;
main = struct ;

struct =
  channel 0 (cycle $
    melodyA0 +:+ melodyA0 +:+ melodyA1 +:+
    melodyA0 +:+ melodyA0 +:+ melodyB +:+ melodyC)
  =:=
  drumLoop ;

loop =
  cycle (channel 0 (melodyA0 +:+ melodyA0 +:+ melodyA1))
  =:=
  drumLoop ;

melodyA0, melodyA1, melodyB, melodyC ::
  [Midi.Event Midi.Message] ;
melodyA0 =
  concat $
  note en (a 4) : rest (7*en) :
  note den (a 4) : note den (g 4) : note den (fs 4) :
  note den (f 4) : note qn (e 4) :
  [] ;

melodyA1 =
  concat $
  note en (c 5) : rest (7*en) :
  note den (e 5) : note den (d 5) : note den (c 5) :
  note den (b 4) : note en (a 4) : note en (g 4) :
  [] ;

partB ::
  Pitch -> Pitch -> Pitch ->
  Pitch -> Pitch -> Pitch -> [Event Message] ;
partB p0 p1 p2 p3 p4 p5 =
  concat $
  note den p0 : note den p1 : note en p2 :
  note dqn p3 : note en p4 : note (2*hn) p5 :
  [] ;

melodyB =
  concat $
  note (3*hn) (c 5) :
  partB (c 5) (d 5) (e 5) (d 5) (b 4) (g 4) :
  partB (g 4) (a 4) (b 4) (c 5) (b 4) (a 4) :
  partB (f 4) (g 4) (a 4) (b 4) (e 5) (b 4) :
  [] ;

melodyC =
  concat $
  note den (b 4) : note den (e 5) : note en (fs 5) : note hn (g 5) : rest en :
  note den (fs 5) : note den (e 5) : note hn (a 5) : rest qn :
  note qn (g 5) : note den (fs 5) : note den (g 5) : note hn (d 5) : rest dhn :
  note en (b 4) : note en (a 4) : note hn (b 4) :
  rest (wn+hn+en) :
  [] ;


-- * rhythm

drumTrack, drumLoop :: [ Event (Channel Message) ] ;
drumTrack = drumLoop ;

drumLoop =
   drumChannel (
      drum bassDrum1 en ++
      drum pedalHiHat en ++
      emphasize (negate 20) (drum electricSnare en) ++
      drum pedalHiHat en
   ) ++ drumLoop ;


-- * durations

sn, en, den, qn, dqn, hn, dhn, wn :: Midi.Time ;

sn = 140 ;
en = 2*sn ; den = 3*sn ;
qn = 2*en ; dqn = 3*en ;
hn = 2*qn ; dhn = 3*qn ;
wn = 2*hn ;