module HarmTrace.Audio.ChromaKey ( beatSyncKeyStrength, keyMap ) where
import HarmTrace.Audio.ChromaChord ( Vector, fromList, correlation
, beatSync, meanBeatSyncVectors
)
import HarmTrace.Base.MusicTime
import HarmTrace.Base.MusicRep
beatSyncKeyStrength :: BarTimeTrackData -> ChordinoData -> [TimedData [NumData]]
beatSyncKeyStrength bts key =
map matchKeyProfiles . meanBeatSyncVectors $ beatSync bts key where
nanToZero :: Double -> NumData
nanToZero n = if isNaN n then 0 else n
matchKeyProfiles :: TimedData (Vector NumData) -> TimedData [NumData]
matchKeyProfiles = fmap (\x -> map (nanToZero . correlation x) allKeyProfiles)
allKeyProfiles :: [Vector Double]
allKeyProfiles = map (fromList . keyToProfile) keyMap
keyToProfile :: Key -> [Double]
keyToProfile (Key root m) = reverseShift (toSemitone root) (selectProfile m)
where reverseShift :: Int -> [a] -> [a]
reverseShift p l = b ++ a where (a,b) = splitAt (length l p) l
selectProfile :: Mode -> [Double]
selectProfile MajMode = temperleyProfCMaj
selectProfile MinMode = temperleyProfCMin
temperleyProfCMaj, temperleyProfCMin :: [Double]
temperleyProfCMaj =
[5.0, 2.0, 3.5, 2.0, 4.5, 4.0, 2.0, 4.5, 2.0, 3.5, 1.5, 4.0 ]
temperleyProfCMin =
[5.0, 2.0, 3.5, 4.5, 2.0, 4.0, 2.0, 4.5, 3.5, 2.0, 1.5, 4.0 ]
keyMap :: [Key]
keyMap = [ Key (Note (Just Sh) F) MajMode
, Key (Note Nothing B) MajMode
, Key (Note Nothing E) MajMode
, Key (Note Nothing A) MajMode
, Key (Note Nothing D) MajMode
, Key (Note Nothing G) MajMode
, Key (Note Nothing C) MajMode
, Key (Note Nothing F) MajMode
, Key (Note (Just Fl) B) MajMode
, Key (Note (Just Fl) E) MajMode
, Key (Note (Just Fl) A) MajMode
, Key (Note (Just Fl) D) MajMode
, Key (Note (Just Fl) E) MinMode
, Key (Note (Just Sh) G) MinMode
, Key (Note (Just Sh) C) MinMode
, Key (Note (Just Sh) F) MinMode
, Key (Note Nothing B) MinMode
, Key (Note Nothing E) MinMode
, Key (Note Nothing A) MinMode
, Key (Note Nothing D) MinMode
, Key (Note Nothing G) MinMode
, Key (Note Nothing C) MinMode
, Key (Note Nothing F) MinMode
, Key (Note (Just Fl) B) MinMode
]