module HeilandHimmel where

{- |
Christman song "O Heiland, reiß die Himmel auf"
from "Du wurdest meine Sonne - Heft I:
Advents- und Weihnachtslieder in einfachen Sätzen"
Evangelische Verlagsanstalt Berlin
-}

import SynthiLLVM
import Midi
import Pitch
import List ( concat, (++), replicate )
import Prelude ( (*), ($) )


main :: [Event (Channel Message)] ;
main =
   concat $ replicate 7 $
   block melody0 bass0 ++
   block melody1 bass1 ++
   block melody2 bass2 ++
   block melody3 bass3 ++
   [] ;

block :: [Event Message] -> [Event Message] -> [Event (Channel Message)] ;
block melody bass =
   channel 0
      (program ooh ++
       controller volumeCC 120 ++
       controller attackCC 100 ++
       controller releaseCC 120 ++
       controller brightnessCC 36 ++
       transpose 48 melody)
{-
      (program fmbell ++
       controller decayCC 100 ++
       controller releaseCC 120 ++
       controller brightnessCC 100 ++
       controller timbreCC 30 ++
       transpose 48 melody)
-}
   =:=
   channel 1
      (program bassString ++
       controller volumeCC 115 ++
       controller brightnessCC 100 ++
       transpose 24 bass)
   ;


melody0, melody1, melody2, melody3 :: [Event Message] ;
bass0, bass1, bass2, bass3 :: [Event Message] ;

melody0 =
   note qn (d 0) +:+
   notep hn (d 0) (f 0) +:+
   notep qn (e 0) (g 0) +:+
   ((notes qn (f 0) (e 0)) =:= note hn (a 0)) +:+
   note qn (d 0) +:+
   (note hn (d 0) +:+ note qn (cs 0) =:= note qn (f 0) +:+ note hn (e 0)) +:+
   note dhn (d 0)
   ;

bass0 =
   note qn (d  1) ++ note qn (d  1) ++ note qn (c  1) ++ note qn (bf 0) ++
   note hn (a  0) ++ note qn (bf 0) ++ note qn (bf 0) ++ note qn (g  0) ++ note qn (a  0) ++
   note qn (d  0) ++ note qn (a  0) ++ note qn (d  1) ++ 
   [] ;

melody1 =
   notep qn (f 0) (a 0) +:+
   notep qn (e 0) (a 0) +:+
   notep qn (d 0) (b 0) +:+
   ((notes qn (c 0) (d 0)) =:= note hn (c 1)) +:+
   note qn (f 0) +:+
   (note hn (f 0) +:+ note qn (e 0) =:= note qn (a 0) +:+ note hn (g 0)) +:+
   note dhn (f 0)
   ;

bass1 =
   note qn (d  1) ++ note qn (c  1) ++ note qn (b  0) ++
   note hn (a  0) ++ note qn (d  1) ++ note qn (d  1) ++ note qn (bf 0) ++ note qn (c  1) ++
   note qn (f  0) ++ note qn (c  1) ++ note qn (f  1) ++
   [] ;

melody2 =
   (note hn (g 0) =:= notes qn (c 1) (c 1)) +:+
   notep qn (f 0) (c 1) +:+
   (notes qn (e 0) (g 0) =:= note hn (c 1)) +:+
   note qn (a 0) +:+
   (notes qn (a 0) (g 0) =:= note hn (d 1)) +:+
   notep qn (f 0) (d 1) +:+
   (notes qn (f 0) (d 0) +:+ note qn (e 0) =:= note qn (c 1))
   ;

bass2 =
   note  qn (f  1) ++ note qn (e  1) ++ note qn (d  1) ++ note qn (c  1) ++ note qn (e  1) ++ note qn (f  1) ++
   note dhn (bf 0) ++ note qn (c  1) ++ note qn (g  0) ++ note qn (c  0) ++
   [] ;

melody3 =
   notep qn (f 0) (a 0) +:+
   notep qn (e 0) (a 0) +:+
   notep qn (d 0) (g 0) +:+
   (notes qn (d 0) (cs 0) =:= note hn (a 0)) +:+
   notep qn (d 0) (f 0) +:+
   (note hn (d 0) +:+ note qn (cs 0) =:= note qn (g 0) +:+ note hn (e 0)) +:+
   note qn (d 0)
   ;

bass3 =
   note hn (d  0) ++ note qn (e  0) ++ note hn (a  0) ++ note qn (bf 0) ++
   note qn (bf 0) ++ note qn (g  0) ++ note qn (a  0) ++ note hn (d  0) ++
   [] ;


notep :: Time -> Pitch -> Pitch -> [Event Message] ;
notep dur p0 p1 =
   note dur p0 =:= note dur p1 ;

notes :: Time -> Pitch -> Pitch -> [Event Message] ;
notes dur p0 p1 =
   note dur p0 +:+ note dur p1 ;


qn, hn, dhn :: Time ;
qn = 650 ;
hn = 2 * qn ; dhn = 3 * qn ;