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

import Synthesizer as Syn
import Synthesizer.Plain.Control(exponential2)
import Instruments
import Sox.File

import qualified Algebra.Transcendental      as Trans
import qualified Algebra.Field               as Field
import qualified Algebra.Ring                as Ring

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

import System.Exit(ExitCode)

import PreludeBase
import NumericPrelude


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


-- Comfortable creation of chords of notes of the same length
chordDur :: t -> [t -> [NoteAttribute] -> StdMelody.T] -> StdMelody.T
chordDur dr chd = chord (zipWith (\n v -> n dr [Velocity (toPRational v)])
                              chd [1,0.3,0.3,0.3])

chords :: StdMelody.T
chords = transpose 12 (line
               [chordDur  wn [a (-3), e  0, a  0, c  1],
                chordDur  wn [d (-2), f  0, a  0, d  1],
                chordDur  wn [a (-2), e  0, a  0, c  1],
                chordDur  wn [gs(-2), e  0, a  0, c  1],
                chordDur  wn [g (-2), e  0, a  0, c  1],
                chordDur  hn [d (-2), f  0, a  0, d  1],
                chordDur  hn [f (-3), f  0, a  0, c  1],
                chordDur  wn [a (-3), e  0, a  0, c  1]  ])

makeMelody :: [[a] -> StdMelody.T] -> StdMelody.T
makeMelody mel = transpose 24 (line (map ($ []) mel))

melody :: StdMelody.T
melody  = makeMelody [e 1  wn,
                      a 0  qn, b 0 qn, c 1 qn, d 1 qn,
                      e 1 dhn, c 1 qn,
                      e 1 dhn, c 1 qn,
                      e 1 dhn, a 0 qn,
                      c 1  qn, a 0 qn, f 0 qn, c 1 qn,
                      a 0  wn]

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


defltSampleRate :: Ring.C a => a
defltSampleRate = 44100

-- Volume type arises from Haskore
songToSignalMono :: Volume -> StdMelody.T -> [Volume]
songToSignalMono dif song =
    MusicSignal.fromRhyMusic
       defltSampleRate
       (MusicSignal.detuneInstrs dif
           [("string", MusicSignal.amplify (0.5::Volume) simpleSaw)])
       Player.fancyMap
       (MusicSignal.contextMetro 120 qn)
       (StdMusic.fromStdMelody "string" song)

songSignal :: Volume -> [Volume]
songSignal dif = songToSignalMono dif chords




polarisator :: Trans.C a => a -> a -> [Pole a]
polarisator sampleRate freq =
   map (flip Pole (freq/sampleRate))
       (exponential2 (0.5*sampleRate) 100)

filterSignal :: Time -> [Pole Volume]
filterSignal dif =
   -- we must remove gaps because a pole frequency 0 let most filters crash
   -- hope that the signal doesn't become too short ...
   filter (/= Pole 0 0)
       (MusicSignal.fromRhyMusic
           defltSampleRate
           (MusicSignal.detuneInstrs dif [("filter", polarisator)])
           Player.fancyMap
           (MusicSignal.contextMetro 120 qn)
           (StdMusic.fromStdMelody "filter" melody))


filteredSignal :: Volume -> [Volume]
filteredSignal dif = Syn.amplify (0.1::Volume)
    (moogFilter 10 (map (moogFilterParam 10) (filterSignal 1))
                   (songSignal (1/dif)))
{-
filteredSignal dif =
   map (\(_,_,x) -> 0.1*x)
       (uniFilter (map uniFilterParam filterSignal)
                   songSignal)
-}

stereoSignal :: [(Volume, Volume)]
stereoSignal = zip (filteredSignal 1.002)
                   (filteredSignal 0.998)

main :: IO ExitCode
main = Sox.File.writeStereo "SwanLake" defltSampleRate stereoSignal