module Muh.Examples.Songs.Grundlast
  ( example
  ) where

import Data.Foldable (traverse_)
import Data.List (mapAccumL)
import Data.Map.Strict qualified as Map
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Vector qualified as Vector
import Lens.Micro ((&), (.~))

import Muh.Examples.Example qualified as Example
import Muh.Examples.Songs.Grundlast.Cast qualified as Cast
import Muh.Examples.Songs.Grundlast.Patches qualified as Patches
import Muh.Examples.Songs.Grundlast.Score qualified as Score
import Muh.Examples.Songs.Grundlast.Timeline qualified as Timeline
import Muh.Synth.Delay qualified as Delay
import Muh.Synth.Instrument qualified as Instrument
import Muh.Synth.Labels ()
import Muh.Synth.Mixer (Mixer, ducked_, groupBus_, highPassed_)
import Muh.Synth.Mixer qualified as Mixer
import Muh.Synth.Part qualified as Part
import Muh.Synth.Reverb qualified as Reverb
import Muh.Synth.Seed qualified as Seed
import Muh.Tracker.Builder (Builder, instrument_, mixer_, section_, seed_, song_)
import Muh.Tracker.Groove (straight_)
import Muh.Tracker.Pattern (Pattern)
import Muh.Tracker.Pattern qualified as Pattern
import Muh.Tracker.Position qualified as Position
import Muh.Tracker.Song qualified as Song

example :: Example.Example
example =
  Example.Example
    { slug = "grundlast"
    , title = "Grundlast"
    , description = "Base load at the city edge on an overcast Sunday, tuned to the mains: the 50 Hz hum is the tonic, and at each tempo gear a sixteenth lasts a whole number of its cycles. The piece drives like a heavy car through a roundabout: bass, plume and lead take turns in front while an arpeggio and morse pings answer, braking down two tempo gears into a turn in 7/8 and accelerating away. On the way out the pings sing the word they spell."
    , galleryPage =
        Just
          Example.GalleryPage
            { file = "grundlast.html"
            , cover = Just "covers/grundlast.jpg"
            , videoCover = Just "covers/grundlast.jpg"
            , stems = [handle | (handle, _, _) <- voices]
            , sheet = Example.SheetWindow{start = 158.72, end = 203.44, label = "Braking into the turn"}
            }
    , cast = Just Cast.cast
    , piece = Example.built grundlast
    }

grundlast :: Builder ()
grundlast = do
  instrument_ #netz (Patches.onGrid Patches.netz)
  instrument_ #korona Patches.korona
  instrument_ #leitung (Patches.onGrid Patches.leitung)
  instrument_ #schwung (Patches.onGrid Patches.schwung)
  instrument_ #kreisverkehr (Patches.onGrid Patches.kreisverkehr)
  instrument_ #fahne (Patches.onGrid Patches.fahne)
  instrument_ #wolken Patches.wolken
  instrument_ #sonnenfeld (Patches.onGrid Patches.sonnenfeld)
  instrument_ #kick (Patches.onGrid Patches.kick)
  instrument_ #clap Patches.clap
  instrument_ #kraehe Patches.kraehe
  instrument_ #auto Patches.auto
  Example.describe voices
  mixer_ grundlastMixer
  seed_ (Seed.Seed 0x47524e44)
  traverse_ section_ sections
  song_ grundlastSong

voices :: [(Instrument.Handle, Text, Text)]
voices =
  [ (#netz, "Netz", "Layered · a sine on the 50 Hz tonic and a saw an octave up under a low-pass that follows the load: the hum, from the first row to the last.")
  , (#korona, "Korona", "Layered noise · high-passed crackle looping thirteen steps against the bar, as dense as the air is damp.")
  , (#leitung, "Leitung", "Ladder · the bass line in eight-bar phrases from one root-and-fifth cell, phase-locked to the hum.")
  , (#schwung, "Schwung", "Ladder · the bass's octave glide on a part of its own, with the stage cleared around it.")
  , (#kreisverkehr, "Kreisverkehr", "Layered · a plucked seven-step arpeggio that circles the stereo field once per lap.")
  , (#fahne, "Fahne", "Prophet · two detuned saws with a slow attack and a slow LFO on the cutoff: the plume.")
  , (#wolken, "Wolken", "Sampler · a sixty-millisecond grain of the plume, looped through a crossfade, pinging GRUNDLAST in morse over the plume's line, and on the way out singing it as a line of its own, slowly enough to read.")
  , (#sonnenfeld, "Sonnenfeld", "Prophet · a square lead with vibrato, behind a filter that opens as the clouds do.")
  , (#kick, "Kick", "Ladder · a pitch-swept, saturated sine tuned to the tonic.")
  , (#clap, "Clap", "Layered noise · band-passed with a quick filter snap.")
  , (#kraehe, "Krähe", "Layered · a saw and noise through a resonant band-pass with a falling pitch: the crow, two caws, a rest and a lower one.")
  , (#auto, "Auto", "Layered · tyre noise and a low engine passing once in the intro, with its Doppler shift, pan and distance written into the score.")
  ]

sections :: [Position.Section]
sections = do
  (marker, from, to) <- Timeline.markers
  pure (Position.Section (Text.pack (Timeline.markerName marker)) (at from) (at <$> to))
  where
    at bar = Position.Position bar 0 0

grundlastSong :: Song.Song
grundlastSong =
  Song.Song
    { name = "Grundlast"
    , initialTempo = Timeline.mainsHz / 32 * 60
    , ticksPerRow = Timeline.ticksPerRow
    , rowsPerBeat = 4
    , beatsPerBar = 4
    , groove = straight_
    , conductor = #netz
    , parts =
        Map.map (\count -> Song.Part count barOrders Song.PlayOnce (Song.channel_ 1 0)) (Part.laneCounts Score.barLanes)
          <> Map.fromList [(#korona, single koronaOrders), (#kreisverkehr, single trafficOrders)]
    , patterns = Map.fromList (barPatterns <> koronaPatterns <> trafficPatterns)
    }
  where
    barPatterns = [(barId bar, rowsPattern (barId bar) (map (Score.barRow bar) [0 .. bar.rows - 1])) | bar <- Vector.toList Timeline.bars]
    barId bar = Pattern.Id (fromIntegral bar.index)
    barOrders = Vector.fromList (map fst barPatterns)
    (koronaOrders, koronaPatterns) = deduplicated 1000 Score.koronaLaps
    (trafficOrders, trafficPatterns) = deduplicated 3000 Score.trafficLaps
    single orders = Song.Part 1 (Vector.fromList orders) Song.PlayOnce (Song.channel_ 1 0)

deduplicated :: Int -> [(Int, [Pattern.Row])] -> ([Pattern.Id], [(Pattern.Id, Pattern)])
deduplicated base laps = (orders, [(identity, rowsPattern identity rows) | (rows, identity) <- reverse known])
  where
    (known, orders) = mapAccumL assign [] (map snd laps)
    assign seen rows = case lookup rows seen of
      Just identity -> (seen, identity)
      Nothing -> ((rows, fresh) : seen, fresh)
      where
        fresh = Pattern.Id (fromIntegral (base + length seen))

rowsPattern :: Pattern.Id -> [Pattern.Row] -> Pattern
rowsPattern identity rows = Pattern.Pattern{id = identity, rows = Vector.fromList rows}

grundlastMixer :: Mixer
grundlastMixer =
  Mixer.zero_
    & #drive .~ 1.8
    & #returns .~ returns
    & #fallbackRoute .~ Mixer.Route{dry = 1, sends = Map.singleton #reverb 0.3}
    & #routes .~ routes
    & #groups .~ groups
    & #membership .~ membership
  where
    returns =
      Map.fromList
        [ (#delay, Mixer.return_ (Mixer.Delay Delay.Delay{time = Delay.Beats 0.75, feedback = 0.42}) 0.3)
        , (#reverb, Mixer.return_ (Mixer.Reverb room) 0.3)
        ]
    room = Reverb.Reverb{decay = 2.4, damping = 0.7, preDelay = 0.03, highPass = 260}
    routes =
      Map.fromList
        [ (#leitung, Mixer.Route{dry = 1, sends = Map.fromList [(#delay, 1), (#reverb, 0.15)]})
        , (#schwung, Mixer.Route{dry = 1, sends = Map.fromList [(#delay, 1), (#reverb, 0.6)]})
        , (#kreisverkehr, Mixer.Route{dry = 1, sends = Map.fromList [(#delay, 0.5), (#reverb, 0.5)]})
        , (#sonnenfeld, Mixer.Route{dry = 1, sends = Map.fromList [(#delay, 0.4), (#reverb, 0.8)]})
        , (#fahne, Mixer.Route{dry = 1, sends = Map.fromList [(#delay, 0.15), (#reverb, 0.9)]})
        , (#wolken, Mixer.Route{dry = 1, sends = Map.fromList [(#delay, 0.3), (#reverb, 1)]})
        , (#kraehe, Mixer.Route{dry = 1, sends = Map.singleton #reverb 1})
        , (#netz, Mixer.Route{dry = 1, sends = Map.empty})
        , (#kick, Mixer.Route{dry = 1, sends = Map.singleton #reverb 0.1})
        , (#auto, Mixer.Route{dry = 1, sends = Map.singleton #reverb 0.4})
        ]
    groups =
      Map.fromList
        [ (drumGroup, groupBus_ 1 & ducked_ woop)
        , (lineGroup, groupBus_ 1 & ducked_ woop)
        , (trafficGroup, groupBus_ 1 & highPassed_ 150 & ducked_ woop)
        , (musicGroup, groupBus_ 1 & highPassed_ 220 & ducked_ (woop & #depth .~ 0.35))
        , (fieldGroup, groupBus_ 1)
        ]
    membership =
      Map.fromList do
        (handles, group) <-
          [ ([#kick, #clap, #korona], drumGroup)
          , ([#leitung], lineGroup)
          , ([#kreisverkehr], trafficGroup)
          , ([#fahne, #wolken, #sonnenfeld], musicGroup)
          , ([#kraehe, #auto], fieldGroup)
          ]
        handle <- handles
        pure (handle, group)
    woop =
      Mixer.Ducking
        { key = #schwung
        , depth = 0.6
        , threshold = 0.02
        , attackSeconds = 0.01
        , releaseSeconds = 0.5
        }

drumGroup, lineGroup, trafficGroup, musicGroup, fieldGroup :: Mixer.GroupId
drumGroup = Mixer.GroupId 0
lineGroup = Mixer.GroupId 1
trafficGroup = Mixer.GroupId 2
musicGroup = Mixer.GroupId 3
fieldGroup = Mixer.GroupId 4