module Exercise06 where

import Data.List
import Effects
import Types

sinPeriod :: Signal
sinPeriod x = sin (x * 2 * pi)

sqwPeriod :: Signal
sqwPeriod x = if x <= 0.5 then -1 else 1

sawPeriod :: Signal
sawPeriod x = (x * 2) -1

triPeriod :: Signal
triPeriod x
  | x < 0.5 = x * 4 -1
  | otherwise = 1 - ((x - 0.5) * 4)

silence :: Signal
silence _ = 0

-- NOTE: the formula is taken from https://pages.mtu.edu/~suits/NoteFreqCalcs.html
f :: Semitone -> Hz
f n = 440.0 * (2 ** (fromInteger n / 12.0))

osc :: Signal -> ADSR -> Oscillator
osc signal adsrParams semitone duration t =
  let plainSignal = signalTone signal semitone
   in adsr adsrParams duration plainSignal t

signalTone :: Signal -> Semitone -> Signal
signalTone signal semitone t = signal (time - fromInteger (floor time))
  where
    time = f semitone * t

adsr :: ADSR -> Seconds -> Signal -> Signal
adsr (attack, decay, sustain, release) duration signal t
  | t <= attack = signal t * t / attack
  | t <= (attack + decay) = signal t * (1 - (((t - attack) / decay) * (1 - sustain)))
  | t <= (duration - release) = signal t * sustain
  | otherwise = signal t * sustain - (((signal t * sustain) / release) * (t - (duration - release)))

mix :: [SampledSignal] -> SampledSignal
mix xss = mixHelper xss (length xss)

mixHelper :: [SampledSignal] -> Int -> SampledSignal
mixHelper xss l
  | all null xss = []
  | otherwise = getFirstSample emptyListsRemoved l : mixHelper (map tail emptyListsRemoved) l
  where
    emptyListsRemoved = filter (/= []) xss

getFirstSample :: [SampledSignal] -> Int -> Sample
getFirstSample xss l = sum [head xs | xs <- xss] / ll
  where
    ll = fromIntegral l

{-WETT-}
whiteNoise :: Signal
whiteNoise x = (n - fromIntegral (floor n)) * signum
  where
    n = x * 17
    signum = if even (round (n * 100)) then 1 else -1

-- you can add new oscillators here
piano :: Oscillator
piano = osc sawPeriod (0.01, 0.1, 0.7, 0.2)

lead :: Oscillator
lead = osc sqwPeriod (0.01, 0.2, 0.3, 0.1)

bass :: Oscillator
bass = osc sinPeriod (0.001, 0.2, 0.9, 0.1)

sinLead :: Oscillator
sinLead = osc sinPeriod (0.01, 0.1, 0.6, 0.2)

sawLead :: Oscillator
sawLead = osc sawPeriod (0.01, 0.1, 0.6, 0.2)

chords :: Oscillator
chords = osc triPeriod (0.2, 0.1, 1, 0.2)

hihat :: Oscillator
hihat = osc whiteNoise (0.01, 0.04, 0, 0.1)

-- you can add more effects here

{- DELAY
  tempo: time in between each repetition in seconds
  feedback: how many times a note should be repeated
  amount: 1 -> only delayed signal, 0 -> only dry signal
-}
delay :: Seconds -> Int -> Double -> DSPEffect
delay tempo feedback amount track = mixTracks [track, wetSignal] [1 - amount, amount]
  where
    wetSignal = mixTracks (delayTracks tempo feedback track) (delayMix feedback)

delayTracks :: Seconds -> Int -> SampledSignal -> [SampledSignal]
delayTracks t n track = [concat (replicate x silence) ++ track | x <- [1 .. n]]
  where
    silence = replicate (samplesPerSecond t) 0.0

delayMix :: Int -> [Double]
delayMix n = reverse $ map (`div'` (n + 1)) [1 .. n]

div' :: Int -> Int -> Double
div' a b = fromIntegral a / fromIntegral b

{- VOLUME MODULATION
  time: the time of one repetition of the modulation in seconds
  amount: 1 -> 100 % 0 -> 0%
  signal: the signal that should be used as an envelope for the modulation

  Note: This effect takes a waveform (signal) as an input and uses it to modify the volume
    of the given track over time
-}
volumeModulation :: Seconds -> Double -> Signal -> DSPEffect
volumeModulation time amount signal track = zipWith (\sample modulation -> sample * (1 - (1 - modulation) * amount)) track envelope
  where
    envelope = volumeModulationEnvelope time (fromIntegral (length track) / sampleRate) signal

volumeModulationEnvelope :: Seconds -> Seconds -> Signal -> [Double]
volumeModulationEnvelope time length signal = concat . replicate (round (length / time)) $ repetition
  where
    samplesPerRepetition = samplesPerSecond time
    repetition = [(signal (div' t samplesPerRepetition) + 1) / 2 | t <- [0 .. (samplesPerRepetition -1)]]

{- TREMOLO
  time: the time of one repetition of the modulation in seconds
  amount: 1 -> big change in pitch, 0 -> small change in pitch

  Note: This Tremolo effect is implemented by first dividing the given track in chunks of
    the length of each repetition of the effect, then each of these chunks is split in 2 parts again,
    the first part will be shortened by deleting every nth sample (increasing the frequency).
    the second part is lengthened by duplicating every nth sample (decreasing the frequency)
-}
tremolo :: Seconds -> Double -> DSPEffect
tremolo time amount track = concatMap (addTremolo sampleCount) (splitEvery (samplesPerSecond time) track)
  where
    sampleCount = round ((1 - amount) * 10) ^ 4

addTremolo :: Int -> SampledSignal -> SampledSignal
addTremolo amount track = deleteEvery amount (fst parts) ++ duplicateEvery amount (snd parts)
  where
    parts = splitAt (div (length track) 2 + amount) track

splitEvery :: Int -> [a] -> [[a]]
splitEvery _ [] = []
splitEvery n list = next : splitEvery n rest
  where
    (next, rest) = splitAt n list

duplicateEvery :: Int -> SampledSignal -> SampledSignal
duplicateEvery _ [] = []
duplicateEvery n xs = head xs : take n xs ++ duplicateEvery n next
  where
    next = drop n xs

deleteEvery :: Int -> SampledSignal -> SampledSignal
deleteEvery _ [] = []
deleteEvery n xs = take (n -1) xs ++ deleteEvery n (drop n xs)

{- CHORUS
  tempo: how much the added track is delayed (see note)
  amount: 1 -> only wet signal, 0 -> only dry signal

  Note: This chorus is implemented by mixing the original signal with a track that
  has been slightly delayed and has a slight tremolo effect applied to it.
-}
chorus :: Seconds -> Double -> DSPEffect
chorus tempo amount track = mixTracks [track, wetSignal] [1 - amount, amount]
  where
    silence = replicate (samplesPerSecond tempo) 0.0
    wetSignal = tremolo 0.3 0.5 (silence ++ track)

-- mix the signals with some volume
mixTracks :: [SampledSignal] -> [Double] -> SampledSignal
mixTracks trks vols = mix $ zipWith (\trk vol -> map (* vol) trk) trks vols

{-MCCOMMENT ...
  To compile the track run "stack run synth mid/HaskellSong.mid HaskellSong.wav"
  (Can take up to a minute!)
-}

-- here we mix it all together and apply the effects
notesToSignal :: (Oscillator -> [Note] -> SampledSignal) -> [[Note]] -> SampledSignal
notesToSignal playNotes tracks = audio
  where
    instrs = cycle [sinLead, sawLead, chords, bass, hihat]
    audioTracks = zipWith playNotes instrs tracks

    sixteenthNote = noteLength songBPM 1 / 16
    sixthNote = noteLength songBPM 1 / 6

    sinLeadEffects = [addGain 4, delay sixthNote 10 0.7]
    sawLeadEffects = [tremolo sixteenthNote 0.65, chorus 0.05 0.2]
    chordsEffect = [volumeModulation sixthNote 0.3 sinPeriod, chorus 0.05 0.2]
    bassEffects = [clip 0.9, addGain 1.5]
    hihatEffects = [delay sixteenthNote 2 0.2]

    tracksWithEffects = zipWith addEffects [sinLeadEffects, sawLeadEffects, chordsEffect, bassEffects, hihatEffects] audioTracks
    audio = mixTracks tracksWithEffects [1, 0.18, 0.5, 0.8, 0.3]

songBPM :: Int
songBPM = 120

noteLength :: Int -> Double -> Seconds
noteLength bpm note = note * (240 / fromIntegral bpm)

{-TTEW-}