module Sound.Jammit.Export
( Library
, fuzzySearchBy
, exactSearchBy
, loadLibrary
, getAudioParts
, getSheetParts
, audioSource
, runAudio
, runSheet
) where
import Control.Applicative (liftA2)
import Control.Monad (forM)
import Data.Char (toLower)
import Data.Int (Int16, Int32)
import Data.List (isInfixOf, sort, isPrefixOf)
import Data.Maybe (catMaybes)
import System.Directory (getDirectoryContents)
import System.FilePath ((</>), splitFileName, takeFileName)
import Sound.Jammit.Internal.Image
import Sound.Jammit.Base
import Sound.Jammit.Internal.Audio
import Sound.Jammit.Internal.TempIO
import qualified Data.Conduit.Audio as A
import Control.Monad.Trans.Resource (MonadResource, runResourceT)
type Library = [(FilePath, Info, [Track])]
fuzzySearchBy :: (Info -> String) -> String -> Library -> Library
fuzzySearchBy f str = let str' = map toLower str in
filter $ \(_, info, _) -> str' `isInfixOf` map toLower (f info)
exactSearchBy :: (Info -> String) -> String -> Library -> Library
exactSearchBy f str = filter $ \(_, info, _) -> f info == str
loadLibrary :: FilePath -> IO Library
loadLibrary jmt = do
dirs <- songSubdirs jmt
fmap catMaybes $ forM dirs $ \d -> do
maybeInfo <- loadInfo d
maybeTrks <- loadTracks d
return $ liftA2 (\i t -> (d, i, t)) maybeInfo maybeTrks
getAudioParts :: Library -> [(AudioPart, FilePath)]
getAudioParts lib = do
(dir, info, trks) <- lib
trk <- trks
case trackTitle trk >>= \t -> titleToAudioPart t (instrument info) of
Nothing -> []
Just ap -> [(ap, dir </> (identifier trk ++ "_jcfx"))]
getSheetParts :: Library -> [(SheetPart, (FilePath, Integer))]
getSheetParts lib = do
(dir, _info, trks) <- lib
trk <- trks
case (trackTitle trk >>= \t -> titleToPart t, scoreSystemInterval trk) of
(Just p, Just ht) -> let
sheet = (Notation p, (dir </> (identifier trk ++ "_jcfn"), ht))
tab = (Tab p, (dir </> (identifier trk ++ "_jcft"), ht))
in if elem (partToInstrument p) [Guitar, Bass]
then [sheet, tab]
else [sheet]
_ -> []
audioSource :: (MonadResource m) => FilePath -> IO (A.AudioSource m Int16)
audioSource fp = if takeFileName fp `elem` [tttDrums, tttDrumsBack]
then fmap (A.padStart $ A.Frames 38) $ readIMA fp
else readIMA fp
where tttDrums = "793EAAE0-6761-44D7-9A9A-1FB451A2A438_jcfx"
tttDrumsBack = "37EE5AA5-4049-4CED-844A-D34F6B165F67_jcfx"
runAudio
:: [FilePath]
-> [FilePath]
-> FilePath
-> IO ()
runAudio pos neg fp = do
pos' <- mapM audioSource pos
neg' <- mapM audioSource neg
let src = case (pos', neg') of
([] , [] ) -> A.silent (A.Frames 0) 44100 2
([p] , [] ) -> p
([] , [n] ) -> A.mapSamples negate16 n
(p : ps, [] ) -> i32To16 $ mix16To32 p ps
([] , n : ns) -> i32To16 $ A.mapSamples negate $ mix16To32 n ns
(p : ps, n : ns) -> i32To16 $ A.mix (mix16To32 p ps) $ A.mapSamples negate $ mix16To32 n ns
i16To32 = A.mapSamples (fromIntegral :: Int16 -> Int32)
i32To16 = A.mapSamples (fromIntegral . clamp (32768, 32767) :: Int32 -> Int16)
negate16 :: Int16 -> Int16
negate16 x = if x == minBound then maxBound else negate x
mix16To32 x xs = foldr A.mix (i16To32 x) (map i16To32 xs)
runResourceT $ writeWAV fp src
runSheet
:: [(FilePath, Integer)]
-> Int
-> FilePath
-> IO ()
runSheet trks lns fout = runTempIO fout $ do
trkLns <- liftIO $ forM trks $ \(fp, ht) -> do
let (dir, file) = splitFileName fp
ls <- getDirectoryContents dir
return (map (dir </>) $ sort $ filter (file `isPrefixOf`) ls, ht)
jpegs <- partsToPages trkLns lns
pdf <- newTempFile "pages.pdf"
liftIO $ jpegsToPDF jpegs pdf
return pdf