module Autobahn where

import Chords
import Pitch
import Midi
import List
import Prelude ( (*) )


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

loop =
   double blockA ++ double blockAt ++
   blockB ++ blockC ++
   loop ;

block bass chords =
   bassTrack bass =:= chordTrack chords ;

chordTrack body =
   chordChannel $ slapSetup ++ body ;

blockA, blockAt, blockB, blockC :: [Midi.Event Midi.Message] ;
blockA  = block bassA chordA ;
blockAt = block (transpose 2 bassA) (transpose 2 chordA) ;
blockB  = block bassB chordB ;
blockC  = block bassC chordC ;

chordA =
   chord wn  [c 4, f   4, a 4] ++
   chord hn  [f 3, ais 3, d 4] ++
   chord hn  [g 3, c   4, e 4] ++
   chord wn2 [c 3, f   3, a 3] ++
   [] ;

chordB =
   chord (4*wn2) [a 3, fis 4] =:=
   double (concatMap (note wn) [d 4, c 4, b 3, a 3]) ;

chordC =
   chord wn  [ais 3, d 4, f   4] ++
   chord wn  [c   4, e 4, g   4] ++
   chord wn2 [a   3, d 4, fis 4] ;


bassTrack body =
   bassChannel $ bassSetup ++ body ;

bassA, bassB, bassC
   :: [Midi.Event Midi.Message] ;

bassA = rep 8 $ bassPattern (f 2) (c 2) ;

bassB =
   rep 16 (bassPattern (d   2) (a   1)) ;

bassC =
   double (bassPattern (d   2) (ais 1)) ++
   double (bassPattern (e   2) (c   2)) ++
   quad   (bassPattern (fis 2) (d   2)) ;

bassPattern p0 p1 =
   concatMap (note en) [p0, p0, p0, p1] ;


-- * concatenation

rep :: Int -> [a] -> [a] ;
rep n x  =  concat $ replicate n x ;

double :: [a] -> [a] ;
double x  =  x ++ x ;

quad :: [a] -> [a] ;
quad x  =  x ++ x ++ x ++ x ;

quadAlt :: [a] -> [a] -> [a] ;
quadAlt x y  =  x ++ x ++ x ++ y ;


-- * durations

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

en = 170 ;
qn = 2 * en ; dqn = 3 * en ;
hn = 2 * qn ; dhn = 3 * qn ;
wn = 2 * hn ; dwn = 3 * hn ;
wn2 = 2 * wn ;


-- * MIDI program

slapSetup =
   slap ++
   controller decayCC 120 ++
   controller releaseCC 40 ++
   controller volumeCC 70 ++
   controller brightnessCC 100 ++
   controller filterDecayCC 124 ++
   [] ;

bassSetup =
   ping ++
   controller decayCC 30 ++
   controller releaseCC 30 ++
   controller volumeCC 70 ++
   controller brightnessCC 80 ++
   [] ;


ping, slap, bell, pad, bass :: [Midi.Event Midi.Message] ;

ping = program 0 ;
slap = program 2 ;
bell = program 3 ;
pad  = program 4 ;
bass = program 9 ;


-- * MIDI channels

melodyChannel, patternChannel, chordChannel, bassChannel
   :: [Midi.Event a] -> [Midi.Event (Midi.Channel a)] ;

melodyChannel  = channel 0 ;
patternChannel = channel 1 ;
chordChannel   = channel 2 ;
bassChannel    = channel 3 ;


-- * MIDI controllers

volumeCC, brightnessCC, attackCC, decayCC, releaseCC :: Midi.Controller ;

volumeCC = 7 ;
brightnessCC = 70 ;
filterDecayCC = 71 ;
attackCC = 73 ;
decayCC = 73 ;
releaseCC = 72 ;