{-# OPTIONS -fno-implicit-prelude #-}
module Music.FMBassLine where

import PreludeBase
import NumericPrelude

import qualified Synthesizer                  as Syn
import qualified Synthesizer.Plain.Oscillator as Osci
import Instruments
import Sox.File

import qualified Haskore.Basic.Pitch as Pitch
import qualified Haskore.Melody          as Melody
import           Haskore.Melody.Standard as StdMelody
import qualified Haskore.Music           as Music
import           Haskore.Music.Standard  as StdMusic
import           Haskore.Performance.Player  as Player
import qualified Haskore.Interface.Signal.Note  as Note
import qualified Haskore.Interface.Signal.Write as MusicSignal
import Haskore.Interface.Signal.Write(Time,Volume)

import System.Random
import qualified Algebra.Transcendental as Trans
import qualified Algebra.Module         as Module

import System.Exit(ExitCode)
import qualified Data.List as List

------------ The song description -------------


data MyNote =
      Bass ModIndex ModDepth Pitch.T
    | Saw  Volume Vibrato Pitch.T
   deriving (Show, Eq, Ord)

type ModIndex = Int
type ModDepth = Time
type ModParam = (ModIndex, ModDepth)

type Vibrato  = Time

type NoteIon = Music.Dur -> () -> Melody.T ()


makeBassLine :: [NoteIon] -> [ModIndex] -> [ModDepth] -> Music.T MyNote
makeBassLine mel indexes depths = line
   (zipWith3 (\n index depth ->
                 Music.mapNote
                    (\(Melody.Note _ p) -> (Bass index depth p))
                    (n en ()))
             mel indexes depths)

bassPattern :: [NoteIon]
bassPattern =
   cycle [a 0, a 0, a 0, e 1, a 0, a 0, f 1, a 0, a 0, d 1, a 0, a 0]

bassLine :: Music.T MyNote
bassLine =
   transpose (-12)
      (makeBassLine bassPattern
         (randomRs (1,4)   (mkStdGen 12354))
         (randomRs (0,2)   (mkStdGen 35902)))


makeSawLine :: [([NoteIon], [(Dur, Dur, Vibrato)])] -> Music.T MyNote
makeSawLine = line . concatMap
   (\(chrd, params) ->
        map (\(durTone,durRest,vib) ->
               let mkNote dur vel =
                      chord (map (\n ->
                                     Music.mapNote
                                        (\(Melody.Note _ p) ->
                                          (Saw vel vib p))
                                        (n dur ()))
                                 chrd)
               in  mkNote durTone 1 +:+ mkNote durRest 0.3)
            params)

sawPattern :: [([NoteIon], [(Dur, Dur, Vibrato)])]
sawPattern =
   let v0 = (sn,sn,0.01)
       v1 = (en,0,0.02)
       v2 = (qn,0,0.05)
       v3 = (qn,0,0.00)
   in  cycle [([a 0, c 1, e 1], replicate 8 v0 ++ [v0,v0,v0,v1]),
              ([g 0, b 0, d 1], [v2]),
              ([a 0, c 1, e 1], [v3]),
              ([a 0, d 1, f 1], replicate 8 v0 ++ [v0,v0,v0,v1]),
              ([a 0, e 1, g 1], [v2]),
              ([a 0, d 1, f 1], [v3])]

sawLine :: Music.T MyNote
sawLine = makeSawLine sawPattern

song :: Music.T MyNote
song = bassLine =:= sawLine


----------- Configuration of the player -----------


noteToSignal ::
   Time -> Volume -> Pitch.Relative -> MyNote -> Note.T Volume Volume
noteToSignal detune dyn trans note =
   let freq p = detune * Note.pitchFromStd trans p
   in  Note.Cons (\sampleRate ->
          case note of
             Bass index depth p ->
                Syn.amplify (dyn * 0.3)
                    (fmBell sampleRate depth (fromIntegral index) (freq p))
             Saw vel vib p ->
                Syn.amplify (dyn * vel*0.4)
                    (saw sampleRate vib 10 (freq p)))

saw :: (Module.C a a, Trans.C a, RealFrac a) =>
             a -> a -> a -> a -> [a]
saw sampleRate modDepth modFreq freq =
   Osci.freqModSaw 0
      (map (\y -> freq/sampleRate * (1+modDepth*y))
           (Osci.staticSine 0.25 (modFreq/sampleRate)))

-- Volume type arises from Haskore
songToSignalMono :: Time -> Time -> Music.T MyNote -> [Volume]
songToSignalMono sampleRate dif music =
   MusicSignal.fromMusic
      sampleRate (noteToSignal dif)
      Player.fancyMap
      (MusicSignal.contextMetro 240 qn)
      music

stereoSignal :: Time -> [(Volume, Volume)]
stereoSignal sampleRate =
   zip (songToSignalMono sampleRate 1.003 song)
       (songToSignalMono sampleRate 0.997 song)

main :: IO ExitCode
main =
   Sox.File.renderStereo "FMBassLine" 44100
      (\sampleRate -> take (round (sampleRate*16)) (stereoSignal sampleRate))