tuning-experiments.tidal

import qualified Data.Vector as Vector
import qualified Data.Map.Strict as Map

toVector l = Vector.generate (length l) (l!!)

data Tuning a = Tuning
  { tuning_n_tones :: Int
  , tune :: (Int -> a)
  }

data Scale = Scale
  { scale_n_tones :: Int
  , index :: (Int -> Int)
  }

cyclical_tuner :: Fractional a => a -> [a] -> Tuning a
cyclical_tuner octave intervals = Tuning {tuning_n_tones=n, tune=tune} where
  intervals' = toVector intervals
  n = length intervals
  tune i =
    let i' = i `mod` n
        j = i `div` n in
    (intervals' Vector.! i') * (octave^^j)

-- TODO: does Vector actually help here?
--       partial application should let the compiler create it only once per distinct `steps`?
cyclical_scale :: [Int] -> Tuning a -> Scale
cyclical_scale steps tuning = Scale {scale_n_tones=n, index=scale_fn} where
  steps' = toVector steps
  n = length steps
  scale_fn i =
    let i' = i `mod` n
        j = i `div` n in
    (steps' Vector.! i') + (tuning_n_tones tuning * j)

k_pattern :: [(String, a)] -> Pattern String -> Pattern a
k_pattern table pat = filterJust $ (table' Map.!?) <$> pat
  where table' = Map.fromList table
        -- s k = fmap tune (table' Map.!? k)

tuning_pattern = k_pattern [
    ("just", cyclical_tuner 2 [1,  16/15,  9/8,  6/5,   5/4,  4/3,   45/32,  3/2,   8/5,   5/3,   9/5,  15/8  ])
  , ("pyth", cyclical_tuner 2 [1, 256/243, 9/8, 32/27, 81/64, 4/3, 1024/729, 3/2, 128/81, 27/16, 16/9, 243/128])
  ]

scale_pattern = k_pattern [
    ("whole", cyclical_scale [0, 2, 4, 6, 8, 10])
  , ("diatonic", cyclical_scale [0, 2, 4, 5, 7, 9, 11])
  ]

-- tuning, function returning a scale given a tuning, scale degree -> tuning value
tunescale_f :: Tuning a -> (Tuning a -> Scale) -> Int -> a
tunescale_f tuning scale_f i = tune tuning $ index (scale_f tuning) i

semitones rat_pat = (log rat_pat) |* (12 / log 2)

-- "apply over patterns with structure from right" has a weird name: *>
-- both in that it collides with something else in Applicative, and points backward compared to <|
tusc :: Pattern String -> Pattern String -> Pattern Int -> ControlPattern
tusc tpat spat ipat = note $ semitones $ tunescale_f <$> tuning_pattern tpat <*> scale_pattern spat Sound.Tidal.Context.*> ipat

let pat = tusc "just,pyth" "diatonic" ("<0 -2 -3 -1 -4@4>" +| "[[0, 3, 6, 9, 12] ~] {0 6 ~ ~ 3 9 ~ ~ 5 ~}%4") # s "supervibe" # orbit 0 # detune (-2)
  in p 0 $ stack [
    pat # legato (2) |- note 24 # nudge 0.06,
    pat # legato (1/2) |- note 12 # nudge 0.04,
    pat # legato 1 |+ note 0 # nudge 0.02,
    pat # legato 4 |+ note 12 # nudge 0.0]

hush

-- next: sharp flat up down notation?


--------------