module GeschichtenErzaehlen where
{-
Geschichten erzählen von Freude und Fleiß.
-}

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


main ::
  [Midi.Event (Midi.Channel Midi.Message)] ;
main =
  (rest (5*qn) ++
   (channel 0 $
    concat $ cycle $
    melodyA0 : melodyA1 :
    melodyB : melodyC : melodyD :
    []))
  =:=
  drumLoop ;

melodyA0, melodyA1, melodyB, melodyC, melodyD ::
  [Midi.Event Midi.Message] ;
melodyA0 =
  concat $
  note qn (g 4) : note dqn (g 4) : note en (e 4) :
  note qn (f 4) : note  qn (g 4) : note qn (g 4) :
  note qn (g 4) : note dqn (a 4) : note en (b 4) :
  note qn (c 5) : note  hn (g 4) : [] ;

melodyA1 =
  concat $
  note qn (g 4) : note dqn (g 4) : note en (e 4) :
  note qn (f 4) : note  qn (g 4) : note qn (g 4) :
  note qn (g 4) : note  qn (a 4) : note qn (b 4) :
  note qn (c 5) : note  hn (g 4) : [] ;

melodyB =
  concat $
  rest qn :
  note dqn (a 4) : note en (f 4) : note qn (g 4) :
  note  qn (a 4) : note hn (c 5) : [] ;

melodyC =
  concat $
  note dqn (g 4) : note en (e 4) : note qn (f 4) :
  note  qn (g 4) : note hn (c 5) : [] ;

melodyD =
  concat $
  note dhn (g 4) : note dhn (g 4) : note dhn (c 4) :
  rest hn : [] ;


-- * rhythm

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

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


-- * durations

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

en = 200 ;
qn = 2*en ; dqn = 3*en ;
hn = 2*qn ; dhn = 3*qn ;
wn = 2*hn ;
