:set -XOverloadedStrings
:set prompt ""

import Sound.Tidal.Context
import System.IO (hSetEncoding, stdout, utf8)
import Data.Char (toLower)

hSetEncoding stdout utf8

-- Metadata & Visualization OSC setup
:{
-- Target for visualizer metadata OSC messages
metadataTarget = Target { oName = "ParVaguesViz", 
                          oAddress = "127.0.0.1", 
                          oPort = 57120, 
                          oBusPort = Nothing,
                          oLatency = 0.1, 
                          oWindow = Nothing, 
                          oSchedule = Live,
                          oHandshake = False }

-- DPV visualization target
targetdpv = Target {oName = "didacticpatternvisualizer",
                   oAddress = "127.0.0.1",
                   oPort = 1818,
                   oLatency = 0.2,
                   oWindow = Nothing,
                   oSchedule = Live,
                   oBusPort = Nothing,
                   oHandshake = False
                  }
formatsdpv = [OSC "/delivery" Named {requiredArgs = []} ]

-- Pulsar Editor Highlighting Target (NEW)
editorTarget = Target { oName = "editor", 
                        oAddress = "127.0.0.1", 
                        oPort = 6013, 
                        oLatency = 0.02, 
                        oSchedule = Pre BundleStamp, 
                        oWindow = Nothing, 
                        oHandshake = False, 
                        oBusPort = Nothing }

-- Editor highlighting shape (NEW)
editorShape = OSCContext "/editor/highlights"

-- SuperDirt target
superdirtTarget' = superdirtTarget {oLatency = 0.1, oAddress = "127.0.0.1", oPort = 57120}

-- Set up targets for SuperDirt, DPV, metadata, AND editor highlighting
oscmapdpv = [(targetdpv, formatsdpv),
            (superdirtTarget', [superdirtShape]),
            (metadataTarget, []),
            (editorTarget, [editorShape])  -- Added editor highlighting
            ]
:}

-- Initialize TidalCycles with all targets (increased frame rate for smoother highlighting)
tidal <- startStream defaultConfig {cFrameTimespan = 1/25} oscmapdpv

:{
-- Simpler metadata system using parameters that get sent through normal patterns
let trackName = pS "trackName"    -- Custom parameter for track name
    trackType = pS "trackType"    -- Custom parameter for track type
    trackSubtype = pS "trackSubtype"  -- For variants like bass2, fx2, etc.
    
    -- Simple shorthands - add these to ANY pattern
    labelKick n = (# trackName n) . (# trackType "kick")
    labelSnare n = (# trackName n) . (# trackType "snare")
    labelHihat n = (# trackName n) . (# trackType "hihat")
    labelBreak n = (# trackName n) . (# trackType "breaks")
    
    -- ParVagues specific shorthands
    labelBass n = (# trackName n) . (# trackType "bass")
    labelBass2 n = (# trackName n) . (# trackType "bass") . (# trackSubtype "bass2")
    labelMelody n = (# trackName n) . (# trackType "melodic")
    labelMelody2 n = (# trackName n) . (# trackType "melodic") . (# trackSubtype "melody2")
    labelFX n = (# trackName n) . (# trackType "fx")
    labelFX2 n = (# trackName n) . (# trackType "fx") . (# trackSubtype "fx2")
    labelFX3 n = (# trackName n) . (# trackType "fx") . (# trackSubtype "fx3")
    labelVocal n = (# trackName n) . (# trackType "vocals")
    labelVocal2 n = (# trackName n) . (# trackType "vocals") . (# trackSubtype "vocal2")
:}

:{
let p = streamReplace tidal
    hush = streamHush tidal
    list = streamList tidal
    mute = streamMute tidal
    unmute = streamUnmute tidal
    solo = streamSolo tidal
    unsolo = streamUnsolo tidal
    once = streamOnce tidal
    first = streamFirst tidal
    asap = once
    nudgeAll = streamNudgeAll tidal
    all = streamAll tidal
    resetCycles = streamResetCycles tidal
    setcps = asap . cps
    xfade i = transition tidal True (Sound.Tidal.Transition.xfadeIn 4) i
    xfadeIn i t = transition tidal True (Sound.Tidal.Transition.xfadeIn t) i
    histpan i t = transition tidal True (Sound.Tidal.Transition.histpan t) i
    wait i t = transition tidal True (Sound.Tidal.Transition.wait t) i
    waitT i f t = transition tidal True (Sound.Tidal.Transition.waitT f t) i
    jump i = transition tidal True (Sound.Tidal.Transition.jump) i
    jumpIn i t = transition tidal True (Sound.Tidal.Transition.jumpIn t) i
    jumpIn' i t = transition tidal True (Sound.Tidal.Transition.jumpIn' t) i
    jumpMod i t = transition tidal True (Sound.Tidal.Transition.jumpMod t) i
    mortal i lifespan release = transition tidal True (Sound.Tidal.Transition.mortal lifespan release) i
    interpolate i = transition tidal True (Sound.Tidal.Transition.interpolate) i
    interpolateIn i t = transition tidal True (Sound.Tidal.Transition.interpolateIn t) i
    clutch i = transition tidal True (Sound.Tidal.Transition.clutch) i
    clutchIn i t = transition tidal True (Sound.Tidal.Transition.clutchIn t) i
    anticipate i = transition tidal True (Sound.Tidal.Transition.anticipate) i
    anticipateIn i t = transition tidal True (Sound.Tidal.Transition.anticipateIn t) i
    forId i t = transition tidal False (Sound.Tidal.Transition.mortalOverlay t) i
    d1 = p 1 . (|< orbit 0)
    d2 = p 2 . (|< orbit 1)
    d3 = p 3 . (|< orbit 2)
    d4 = p 4 . (|< orbit 3)
    d5 = p 5 . (|< orbit 4)
    d6 = p 6 . (|< orbit 5)
    d7 = p 7 . (|< orbit 6)
    d8 = p 8 . (|< orbit 7)
    d9 = p 9 . (|< orbit 8)
    d10 = p 10 . (|< orbit 9)
    d11 = p 11 . (|< orbit 10)
    d12 = p 12 . (|< orbit 11)
    d13 = p 13
    d14 = p 14
    d15 = p 15
    d16 = p 16
:}

:{
let setI = streamSetI tidal
    setF = streamSetF tidal
    setS = streamSetS tidal
    setR = streamSetR tidal
    setB = streamSetB tidal
:}

:{
let -- DPV specific parameters
    grid = pS "grid"
    connectionN = pI "connectionN"
    connectionMax = pI "connectionMax"
    speedSequenser = pF "speedSequenser"
    clear = pI "clear"
    sizeMin = pF "sizeMin"
    sizeMax = pF "sizeMax"
    figure = pS "figure"
    color = pS "color"
    -- =============================================
    -- Mutable Instruments synth parameters
    -- =============================================
    -- MiPlaits (macro oscillator)
    engine = pI "engine"        -- 0-15: oscillator model
    harm = pF "harm"            -- harmonics
    timbre = pF "timbre"
    morph = pF "morph"
    plaitslevel = pF "plaitslevel"  -- internal LPG level
    plaitsdecay = pF "plaitsdecay"  -- "decay" is built into Tidal, so renamed
    fm_mod = pF "fm_mod"
    timb_mod = pF "timb_mod"
    morph_mod = pF "morph_mod"
    lpg_colour = pF "lpg_colour"
    -- MiRings (resonator)
    rstruct = pF "struct"       -- "struct" is a Tidal function, so aliased
    bright = pF "bright"        -- brightness
    damp = pF "damp"            -- damping
    pos = pF "pos"              -- position
    model = pI "model"          -- resonator model
    poly = pI "poly"            -- polyphony
    intern_exciter = pI "intern_exciter"
    easteregg = pI "easteregg"
    -- MiElements (physical modeling)
    strength = pF "strength"
    contour = pF "contour"
    bow_level = pF "bow_level"
    blow_level = pF "blow_level"
    strike_level = pF "strike_level"
    flow = pF "flow"
    mallet = pF "mallet"
    bow_timb = pF "bow_timb"
    blow_timb = pF "blow_timb"
    strike_timb = pF "strike_timb"
    geom = pF "geom"
    eldamp = pF "eldamp"
    elpos = pF "elpos"
    elmodel = pI "elmodel"
    space = pF "space"
    -- MiOmi (dual osc FM synth)
    detune = pF "detune"
    level1 = pF "level1"
    level2 = pF "level2"
    ratio1 = pF "ratio1"
    ratio2 = pF "ratio2"
    fm1 = pF "fm1"
    fm2 = pF "fm2"
    fb = pF "fb"
    xfb = pF "xfb"
    filter_mode = pI "filter_mode"
    omicutoff = pF "omicutoff"
    reson = pF "reson"
    rotate = pF "rotate"
    omispace = pF "omispace"
    -- MiWarps (wave folder / ring mod)
    algo = pI "algo"
    timb = pF "timb"
    osc = pI "osc"
    lev1 = pF "lev1"
    lev2 = pF "lev2"
    vgain = pF "vgain"
    -- MiTides (complex envelope / osc)
    slope = pF "slope"
    tsmooth = pF "smooth"       -- "smooth" is a Tidal function, so aliased
    shift = pF "shift"
    output_mode = pI "output_mode"
    ramp_mode = pI "ramp_mode"
    ratio = pI "ratio"
    tiderate = pF "tiderate"
    -- MiVerb global effect
    verbwet = pF "verbwet"
    verbtime = pF "verbtime"
    verbdamp = pF "verbdamp"
    verbhp = pF "verbhp"
    verbfreeze = pI "verbfreeze"
    verbdiff = pF "verbdiff"
    verbgain = pF "verbgain"
    -- MiClouds global effect
    cloudspitch = pF "cloudspitch"
    cloudspos = pF "cloudspos"
    cloudssize = pF "cloudssize"
    cloudsdens = pF "cloudsdens"
    cloudstex = pF "cloudstex"
    cloudswet = pF "cloudswet"
    cloudsgain = pF "cloudsgain"
    cloudsspread = pF "cloudsspread"
    cloudsrvb = pF "cloudsrvb"
    cloudsfb = pF "cloudsfb"
    cloudsfreeze = pI "cloudsfreeze"
    cloudsmode = pI "cloudsmode"
    cloudslofi = pI "cloudslofi"
    -- MiRipples global effect
    ripplescf = pF "ripplescf"
    ripplesreson = pF "ripplesreson"
    ripplesdrive = pF "ripplesdrive"
    ripplesgain = pF "ripplesgain"
    -- =============================================
    -- Other parameters
    modIndex = pF "modIndex"
    mix =       pF "mix"
    vibrato =   pF "vibrato"
    chorus = pF "chorus"
    lagamount = pF "lagamount"
    dec = pF "dec"
    sus = pF "sus"
    cutoff = pF "cutoff"
    drumMachine name ps = stack
                    (map (\ x ->
                        (# s (name ++| (extractS "s" (x)))) $ x
                        ) ps)
    drumFrom name drum = s (name ++| drum)
    drumM = drumMachine
    drumF = drumFrom
    -- Midi boolean buttons
    -- midiOn
    midiOn    ch    pat = someCyclesBy ch             pat
    midiOff   ch    pat = someCyclesBy (1 - ch)       pat
    midiNo    c1 c2 pat = someCyclesBy (1 - c1 - c2)  pat
    midiBoth  c1 c2 pat = someCyclesBy (c1 + c2 - 1)  pat
    -- Parameterized DJF
    _LPF lMin lMax ch = (# lpf (min lMax ((range lMin ((lMax*2) - lMin) ch))))
    _HPF hMin hMax ch = (# hpf (max hMin (min hMax (range (hMin - hMax) (hMax - hMin) ch))))
    midiDJF   ch lMin lMax hMin hMax = (_LPF lMin lMax ch) . (_HPF hMin hMax ch)
    -- FIXME: Seems to cut some lows when lMin != 0
    -- Midi gain control (faders)
    midiGGlobal = "^77" * 1.3
    _gainG ch     = (gain (midiGGlobal * ch)) -- gain Global
    midiG' ch l h = _gainG (range l h ch)     -- midiGain   control
    midiGdef      = midiG' 1 0 1             -- midiGain   default
    midiG  ch     = midiG' ch 0 1             -- midiGain   default
    -- Global filters
    gF1 = (# djfbus 1 (range 0.05 0.95 "^49"))
    gF2 = (# djfbus 2 (range 0.05 0.95 "^50"))
    gF3 = (# djfbus 3 (range 0.05 0.95 "^51"))  
    -- Global masks (defaults)
    gMask = (midiOn "^41" (mask "t!7 f"))
    gMute1 = (midiOn "^73" (mask "f*16"))
    gMute2 = (midiOn "^74" (mask "f*16"))
    gMute3 = (midiOn "^75" (mask "f*16"))
    gM1 = gMask . gMute1
    gM2 = gMask . gMute2
    gM3 = gMask . gMute3

    -- Launchpad S controls
    -- Launchpad S pad controls
    pad00 = pF "pad00"
    pad01 = pF "pad01"
    pad02 = pF "pad02"
    pad03 = pF "pad03"
    pad04 = pF "pad04"
    pad05 = pF "pad05"
    pad06 = pF "pad06"
    pad07 = pF "pad07"
    pad08 = pF "pad08"
    pad10 = pF "pad10"
    pad11 = pF "pad11"
    pad12 = pF "pad12"
    pad13 = pF "pad13"
    pad14 = pF "pad14"
    pad15 = pF "pad15"
    pad16 = pF "pad16"
    pad17 = pF "pad17"
    pad18 = pF "pad18"
    pad20 = pF "pad20"
    pad21 = pF "pad21"
    pad22 = pF "pad22"
    pad23 = pF "pad23"
    pad24 = pF "pad24"
    pad25 = pF "pad25"
    pad26 = pF "pad26"
    pad27 = pF "pad27"
    pad28 = pF "pad28"
    pad30 = pF "pad30"
    pad31 = pF "pad31"
    pad32 = pF "pad32"
    pad33 = pF "pad33"
    pad34 = pF "pad34"
    pad35 = pF "pad35"
    pad36 = pF "pad36"
    pad37 = pF "pad37"
    pad38 = pF "pad38"
    pad40 = pF "pad40"
    pad41 = pF "pad41"
    pad42 = pF "pad42"
    pad43 = pF "pad43"
    pad44 = pF "pad44"
    pad45 = pF "pad45"
    pad46 = pF "pad46"
    pad47 = pF "pad47"
    pad48 = pF "pad48"
    pad50 = pF "pad50"
    pad51 = pF "pad51"
    pad52 = pF "pad52"
    pad53 = pF "pad53"
    pad54 = pF "pad54"
    pad55 = pF "pad55"
    pad56 = pF "pad56"
    pad57 = pF "pad57"
    pad58 = pF "pad58"
    pad60 = pF "pad60"
    pad61 = pF "pad61"
    pad62 = pF "pad62"
    pad63 = pF "pad63"
    pad64 = pF "pad64"
    pad65 = pF "pad65"
    pad66 = pF "pad66"
    pad67 = pF "pad67"
    pad68 = pF "pad68"
    pad70 = pF "pad70"
    pad71 = pF "pad71"
    pad72 = pF "pad72"
    pad73 = pF "pad73"
    pad74 = pF "pad74"
    pad75 = pF "pad75"
    pad76 = pF "pad76"
    pad77 = pF "pad77"
    pad78 = pF "pad78"
    pad80 = pF "pad80"
    pad81 = pF "pad81"
    pad82 = pF "pad82"
    pad83 = pF "pad83"
    pad84 = pF "pad84"
    pad85 = pF "pad85"
    pad86 = pF "pad86"
    pad87 = pF "pad87"
    pad88 = pF "pad88"
:}

-- FIXME: STALE EXAMPLES
-- :{
-- -- Example metadata setup for common tracks
-- -- Run these at the start of your session
-- setupMetadata = do
--   labelKick 0 "Kick"            -- d1: Kick
--   labelSnare 1 "Snare"          -- d2: Snare
--   labelHihat 2 "Drums"          -- d3: Drums
--   labelBass 3 "Bass"            -- d4: Bass
--   labelMelody 4 "Synth"         -- d5: Synth
--   labelFX 5 "FX"                -- d6: FX
--   labelVocal 8 "Vocals"         -- d9: Vocals
--   labelBreak 7 "Breakbeats"     -- d8: Breaks
-- 
-- -- For BLUE GOLD tracks
-- setupBlueGold = do
--   labelKick 0 "Kick"
--   labelSnare 1 "Snare" 
--   labelHihat 2 "Hihats"
--   labelBass 3 "Bass"
--   labelMelody 4 "Suns Keys"
--   labelFX2 5 "Guitars 1"
--   labelFX3 6 "Guitars 2"
--   labelBreak 7 "Breakbeats"
--   labelVocal 8 "Father Voice"
--   labelFX 9 "Cues & Noise"
-- :}

-- Jazz chord symbol converter (Am → a'min, C7 → c'dom7, etc.)
-- Use it in patterns with parseBP like: d1 $ n (jchord "<Am C D F>") # s "superpiano"
:{
jchord :: String -> ControlPattern
jchord input = n (parseBP_E $ convertChordSymbols input)
  where
    convertChordSymbols :: String -> String
    convertChordSymbols str = unwords $ map parseChordSymbol (words str)

    parseChordSymbol :: String -> String
    parseChordSymbol symbol =
      -- Handle pattern syntax chars at beginning/end
      case symbol of
        ('<':rest) -> '<' : parseChordSymbol rest
        ('>':rest) -> '>' : parseChordSymbol rest
        ('[':rest) -> '[' : parseChordSymbol rest
        (']':rest) -> ']' : parseChordSymbol rest
        ('{':rest) -> '{' : parseChordSymbol rest
        ('}':rest) -> '}' : parseChordSymbol rest
        ('|':rest) -> '|' : parseChordSymbol rest
        ('~':rest) -> '~' : parseChordSymbol rest
        _ -> case reverse symbol of
          ('>':tser) -> parseChordSymbol (reverse tser) ++ ">"
          (']':tser) -> parseChordSymbol (reverse tser) ++ "]"
          ('}':tser) -> parseChordSymbol (reverse tser) ++ "}"
          ('|':tser) -> parseChordSymbol (reverse tser) ++ "|"
          _ -> if null symbol || not (any (`elem` "ABCDEFG") symbol)
               then symbol  -- no note names, pass through
               else
                 let (root, quality) = splitChordSymbol symbol
                     tidalRoot = convertRoot root
                     tidalQuality = convertQuality quality
                 in tidalRoot ++ "'" ++ tidalQuality

    -- NEW: Convert root note to Tidal notation
    convertRoot :: String -> String
    convertRoot root = map toLower $ replace '#' 's' $ replace 'b' 'f' root
      where
        replace :: Char -> Char -> String -> String
        replace from to = map (\c -> if c == from then to else c)

    splitChordSymbol :: String -> (String, String)
    splitChordSymbol (c:rest)
      | c `elem` "ABCDEFG" =
          case rest of
            ('#':q) -> ([c, '#'], q)
            ('b':q) -> ([c, 'b'], q)
            ('s':q) -> ([c, 's'], q)  -- also accept 's' directly
            ('f':q) -> ([c, 'f'], q)  -- also accept 'f' directly
            _ -> ([c], rest)
      | otherwise = ([c], rest)
    splitChordSymbol [] = ("C", "maj")  -- default

    convertQuality :: String -> String
    convertQuality "" = "maj"
    convertQuality "M" = "maj"
    convertQuality "maj" = "maj"
    convertQuality "m" = "min"
    convertQuality "min" = "min"
    convertQuality "-" = "min"
    convertQuality "7" = "dom7"
    convertQuality "maj7" = "maj7"
    convertQuality "M7" = "maj7"
    convertQuality "^7" = "maj7"
    convertQuality "m7" = "min7"
    convertQuality "min7" = "min7"
    convertQuality "-7" = "min7"
    convertQuality "mM7" = "minmaj7"
    convertQuality "-M7" = "minmaj7"
    convertQuality "dim" = "dim"
    convertQuality "o" = "dim"
    convertQuality "dim7" = "dim7"
    convertQuality "o7" = "dim7"
    convertQuality "m7b5" = "m7f5"
    convertQuality "half-dim7" = "m7f5"
    convertQuality "aug" = "aug"
    convertQuality "+" = "aug"
    convertQuality "sus2" = "sus2"
    convertQuality "sus4" = "sus4"
    convertQuality "sus" = "sus4"
    convertQuality "7sus4" = "seven"  -- closest match
    convertQuality "9" = "nine"
    convertQuality "maj9" = "maj9"
    convertQuality "M9" = "maj9"
    convertQuality "^9" = "maj9"
    convertQuality "m9" = "min9"
    convertQuality "min9" = "min9"
    convertQuality "-9" = "min9"
    convertQuality "11" = "eleven"
    convertQuality "maj11" = "maj11"
    convertQuality "M11" = "maj11"
    convertQuality "m11" = "min11"
    convertQuality "min11" = "min11"
    convertQuality "13" = "thirteen"
    convertQuality "maj13" = "maj13"
    convertQuality "M13" = "maj13"
    convertQuality "6" = "six"
    convertQuality "m6" = "min6"
    convertQuality "69" = "six"  -- closest
    convertQuality "add9" = "nine"  -- approximate
    convertQuality other = "maj"  -- fallback to major

-- Extract root notes for bass lines (Am7 -> a, C#m9 -> cs, Bb -> bf)
-- FIXED: Now properly converts # to s and b to f for Tidal notation
jroot :: String -> ControlPattern
jroot input = n (parseBP_E $ extractRoots input)
  where
    extractRoots :: String -> String
    extractRoots str = unwords $ map extractRoot (words str)

    extractRoot :: String -> String
    extractRoot symbol =
      case symbol of
        ('<':rest) -> '<' : extractRoot rest
        ('>':rest) -> '>' : extractRoot rest
        ('[':rest) -> '[' : extractRoot rest
        (']':rest) -> ']' : extractRoot rest
        ('{':rest) -> '{' : extractRoot rest
        ('}':rest) -> '}' : extractRoot rest
        ('|':rest) -> '|' : extractRoot rest
        ('~':rest) -> '~' : extractRoot rest
        _ -> case reverse symbol of
          ('>':tser) -> extractRoot (reverse tser) ++ ">"
          (']':tser) -> extractRoot (reverse tser) ++ "]"
          ('}':tser) -> extractRoot (reverse tser) ++ "}"
          ('|':tser) -> extractRoot (reverse tser) ++ "|"
          _ -> if null symbol || not (any (`elem` "ABCDEFG") symbol)
               then symbol
               else
                 let (root, _) = splitChordSymbol symbol
                 in convertRoot root

    -- NEW: Convert root note to Tidal notation
    convertRoot :: String -> String
    convertRoot root = map toLower $ replace '#' 's' $ replace 'b' 'f' root
      where
        replace :: Char -> Char -> String -> String
        replace from to = map (\c -> if c == from then to else c)

    splitChordSymbol :: String -> (String, String)
    splitChordSymbol (c:rest)
      | c `elem` "ABCDEFG" =
          case rest of
            ('#':q) -> ([c, '#'], q)
            ('b':q) -> ([c, 'b'], q)
            ('s':q) -> ([c, 's'], q)
            ('f':q) -> ([c, 'f'], q)
            _ -> ([c], rest)
      | otherwise = ([c], rest)
    splitChordSymbol [] = ("C", "")
:}

:set prompt "tidal> "
-- :set prompt-cont ""
