jammittools 0.3 → 0.3.2
raw patch · 7 files changed
+140/−57 lines, 7 filesdep ~jammittools
Dependency ranges changed: jammittools
Files
- Main.hs +24/−12
- README.md +5/−3
- cbits/aifc2wav-5.1.c +28/−20
- jammittools.cabal +6/−3
- src/Sound/Jammit/Base.hs +10/−3
- src/Sound/Jammit/Internal/AIFC2WAV.hs +18/−7
- src/Sound/Jammit/Internal/Sox.hs +49/−9
Main.hs view
@@ -1,13 +1,14 @@ module Main (main) where import Control.Applicative ((<$>), (<|>))-import Control.Monad ((>=>), forM_)+import Control.Monad ((>=>), forM_, unless) import Data.Char (toLower) import Data.List (sort, nub, partition) import Data.Maybe (mapMaybe, fromMaybe, listToMaybe) import Data.Version (showVersion) import qualified System.Console.GetOpt as Opt import qualified System.Environment as Env+import System.Exit (exitFailure) import System.FilePath ((</>)) import Text.PrettyPrint.Boxes@@ -17,16 +18,24 @@ import Sound.Jammit.Export import qualified Paths_jammittools as Paths +printUsage :: IO ()+printUsage = do+ prog <- Env.getProgName+ putStrLn $ "jammittools v" ++ showVersion Paths.version+ let header = "Usage: " ++ prog ++ " [options]"+ putStr $ Opt.usageInfo header argOpts+ main :: IO () main = do- (fs, _, _) <- Opt.getOpt Opt.Permute argOpts <$> Env.getArgs- let args = foldr ($) defaultArgs fs+ (opts, nonopts, errs) <- Opt.getOpt Opt.Permute argOpts <$> Env.getArgs+ unless (null $ nonopts ++ errs) $ do+ forM_ nonopts $ \nonopt -> putStrLn $ "unrecognized argument `" ++ nonopt ++ "'"+ forM_ errs putStr+ printUsage+ exitFailure+ let args = foldr ($) defaultArgs opts case function args of- PrintUsage -> do- prog <- Env.getProgName- putStrLn $ "jammittools v" ++ showVersion Paths.version- let header = "Usage: " ++ prog ++ " [options]"- putStr $ Opt.usageInfo header argOpts+ PrintUsage -> printUsage ShowDatabase -> do matches <- searchResults args putStr $ showLibrary matches@@ -125,8 +134,9 @@ Just j -> return j Nothing -> Env.lookupEnv "JAMMIT" >>= \mv -> case mv of Just j -> return j- Nothing ->- fromMaybe (error "Couldn't find Jammit directory.") <$> findJammitDir+ Nothing -> let+ err = "Couldn't find Jammit directory. Try -j or the env var JAMMIT"+ in fromMaybe (error err) <$> findJammitDir db <- loadLibrary jmt return $ filterLibrary args db @@ -164,7 +174,7 @@ , Opt.Option ['j'] ["jammit"] (Opt.ReqArg (\s a -> a { jammitDir = Just s }) "directory") "location of Jammit library"- , Opt.Option ['?'] ["help"]+ , Opt.Option ['?', 'h'] ["help"] (Opt.NoArg $ \a -> a { function = PrintUsage }) "function: print usage info" , Opt.Option ['d'] ["database"]@@ -217,11 +227,13 @@ PartGuitar1 -> 'g' PartGuitar2 -> 'r' PartBass -> 'b'- PartDrums -> 'd'+ PartDrums1 -> 'd'+ PartDrums2 -> 'm' PartKeys1 -> 'k' PartKeys2 -> 'y' PartPiano -> 'p' PartSynth -> 's'+ PartOrgan -> 'o' PartVocal -> 'v' PartBVocals -> 'x'
README.md view
@@ -11,8 +11,8 @@ This is basically a fancy shell script but written in Haskell. [ImageMagick](http://www.imagemagick.org) and [Sox](http://sox.sourceforge.net/) are used to do the actual conversion work, so install those and put them in your path.-If you're on Windows, ImageMagick `convert` infamously conflicts with a system tool of the same name,-but `jammittools` tries looking in your Program Files so you shouldn't have to do anything.+If you're on Windows, `jammittools` will look in your Program Files for both of them+so you shouldn't need to do anything after running their installers. ## Usage @@ -67,11 +67,13 @@ g - Guitar (1) r - Guitar 2 b - Bass- d - Drums+ d - Drums (1)+ m - Drums 2 k - Keyboard (1) y - Keyboard 2 p - Piano s - Synth+ o - Organ v - Vocals (Lead) x - Vocals (Backing) GRB - in sheet music, tab instead of notation
cbits/aifc2wav-5.1.c view
@@ -240,12 +240,20 @@ #define SOWT 2 #define SDX2 3 -int aifc2wav_main(int n, char **v)+#ifdef WIDE_CBITS+ #define my_char wchar_t+ #define my_perror _wperror+ #define my_remove _wremove+#else+ #define my_char char+ #define my_perror perror+ #define my_remove remove+#endif++int aifc2wav_main(my_char *input_file, my_char *output_file) { long size; int flags = 0;- char *input_file;- char *output_file; FILE *fin, *fout; int nb_chans; /* number of channels, must be 1 or 2 */ int nb_frames; /* number of sound chunks */@@ -263,23 +271,23 @@ short predictor_left = 0; short predictor_right = 0; - if (n != 3) {- fprintf(stderr, "usage: %s <input AIFC file> <output WAV file>\n", v[0]);- return 1;- }-- input_file = v[1];- output_file = v[2];-+#ifdef WIDE_CBITS+ fin = _wfopen(input_file, L"rb");+#else fin = fopen(input_file, "rb");+#endif if (!fin) {- perror(input_file);+ my_perror(input_file); return 1; } +#ifdef WIDE_CBITS+ fout = _wfopen(output_file, L"wb");+#else fout = fopen(output_file, "wb");+#endif if (!fout) {- perror(output_file);+ my_perror(output_file); fclose(fin); return 1; }@@ -650,7 +658,7 @@ nb_frames--; if (fread(in, 1, 2, fin) != 2) {- perror(input_file);+ my_perror(input_file); goto bad_file; } if (fwrite(in, 1, 2, fout) != 2)@@ -660,7 +668,7 @@ continue; if (fread(in, 1, 2, fin) != 2) {- perror(input_file);+ my_perror(input_file); goto bad_file; } if (fwrite(in, 1, 2, fout) != 2)@@ -689,7 +697,7 @@ for (i=0; i<nb_chans; i++) { if (fread(&src, 1, 1, fin) != 1) {- perror(input_file);+ my_perror(input_file); free(last); goto bad_file; }@@ -720,7 +728,7 @@ /* ima4 */ while (nb_frames) { if (fread(in, 1, 34, fin) != 34) {- perror(input_file);+ my_perror(input_file); goto bad_file; } @@ -731,7 +739,7 @@ int i; if (fread(in, 1, 34, fin) != 34) {- perror(input_file);+ my_perror(input_file); goto bad_file; } @@ -776,10 +784,10 @@ both_error: fclose(fin); fclose(fout);- remove(output_file);+ my_remove(output_file); return 1; out_error:- perror(output_file);+ my_perror(output_file); goto both_error; }
jammittools.cabal view
@@ -1,5 +1,5 @@ Name: jammittools-Version: 0.3+Version: 0.3.2 Synopsis: Export sheet music and audio from Windows/Mac app Jammit Description: @@ -44,6 +44,9 @@ , transformers >= 0.3.0.0 && < 0.5 ghc-options: -Wall c-sources: cbits/aifc2wav-5.1.c+ if os(windows)+ cpp-options: -DWIDE_CBITS+ cc-options: -DWIDE_CBITS executable jammittools main-is: Main.hs@@ -53,8 +56,8 @@ base >= 4.6.0.1 && < 5 , directory >= 1.2.0.1 && < 1.3 , filepath >= 1.3.0.1 && < 1.4- , boxes >= 0.1.3 && < 1.2- , jammittools == 0.3+ , boxes >= 0.1.3 && < 0.2+ , jammittools == 0.3.2 ghc-options: -Wall source-repository head
src/Sound/Jammit/Base.hs view
@@ -43,11 +43,13 @@ = PartGuitar1 -- ^ Used for both Guitar and Guitar 1 | PartGuitar2 | PartBass- | PartDrums+ | PartDrums1 -- ^ Used for both Drums and Drums 1+ | PartDrums2 -- ^ Rarely used. Seen in \"Space Truckin'\" | PartKeys1 -- ^ Used for both Keys and Keys 1 | PartKeys2 | PartPiano -- ^ Rarely used. Seen in \"The Answer Lies Within\" and \"Wait for Sleep\" | PartSynth -- ^ Rarely used. Seen in \"Wait for Sleep\"+ | PartOrgan -- ^ Rarely used. Seen in \"Smoke on the Water\" | PartVocal | PartBVocals deriving (Eq, Ord, Show, Read, Enum, Bounded)@@ -68,12 +70,15 @@ "Guitar 1" -> Just PartGuitar1 "Guitar 2" -> Just PartGuitar2 "Bass" -> Just PartBass- "Drums" -> Just PartDrums+ "Drums" -> Just PartDrums1+ "Drums 1" -> Just PartDrums1+ "Drums 2" -> Just PartDrums2 "Keys" -> Just PartKeys1 "Keys 1" -> Just PartKeys1 "Keys 2" -> Just PartKeys2 "Piano" -> Just PartPiano "Synth" -> Just PartSynth+ "Organ" -> Just PartOrgan "Vocal" -> Just PartVocal "B Vocals" -> Just PartBVocals _ -> Nothing@@ -87,11 +92,13 @@ PartGuitar1 -> Guitar PartGuitar2 -> Guitar PartBass -> Bass- PartDrums -> Drums+ PartDrums1 -> Drums+ PartDrums2 -> Drums PartKeys1 -> Keyboard PartKeys2 -> Keyboard PartPiano -> Keyboard PartSynth -> Keyboard+ PartOrgan -> Keyboard PartVocal -> Vocal PartBVocals -> Vocal
src/Sound/Jammit/Internal/AIFC2WAV.hs view
@@ -1,27 +1,38 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} module Sound.Jammit.Internal.AIFC2WAV ( aifcToWav ) where +#ifdef WIDE_CBITS++import Foreign.C (withCWString, CInt(..), CWchar(..))+#define My_CChar CWchar+#define my_withCString withCWString++#else+ import Foreign.C (withCString, CInt(..), CChar(..))-import Foreign.Marshal.Array (withArrayLen)+#define My_CChar CChar+#define my_withCString withCString++#endif+ import Foreign.Ptr (Ptr) import Sound.Jammit.Internal.TempFile foreign import ccall unsafe "aifc2wav_main" aifc2wav_main- :: CInt -> Ptr (Ptr CChar) -> IO CInt+ :: Ptr My_CChar -> Ptr My_CChar -> IO CInt -- | Given a (new-style) IMA4-compressed AIFC file, converts it to a WAV file. aifcToWav :: FilePath -> TempIO FilePath aifcToWav aifc = do wav <- newTempFile "aifcToWav.wav" code <- liftIO $- withCString "aifc2wav" $ \progC ->- withCString aifc $ \aifcC ->- withCString wav $ \wavC ->- withArrayLen [progC, aifcC, wavC] $ \n v ->- aifc2wav_main (fromIntegral n) v+ my_withCString aifc $ \aifcC ->+ my_withCString wav $ \wavC ->+ aifc2wav_main aifcC wavC if code == 0 then return wav else error $ "aifcToWav: returned " ++ show code
src/Sound/Jammit/Internal/Sox.hs view
@@ -6,8 +6,15 @@ ) where import Control.Arrow (first)-import Control.Monad (void, forM, guard)+import Control.Applicative ((<$>))+import Control.Monad (forM, guard, void)+import Data.List (isPrefixOf)+import Data.Maybe (listToMaybe)+import System.Environment (lookupEnv)+import qualified System.Info as Info +import System.Directory (getDirectoryContents, findExecutable)+import System.FilePath ((</>)) import System.Process (readProcess) import Sound.Jammit.Internal.TempFile@@ -33,22 +40,20 @@ renderAudio aud = case aud of Empty -> do fout <- newTempFile "render.wav"- void $ liftIO $- readProcess "sox" (["-n", fout] ++ words "trim 0 0 channels 2") ""+ liftIO $ runSox $ ["-n", fout] ++ words "trim 0 0 channels 2" return fout File f -> return f Pad t x -> do fin <- renderAudio x fout <- newTempFile "render.wav"- void $ liftIO $ readProcess "sox" [fin, fout, "pad", showTime t] ""+ liftIO $ runSox [fin, fout, "pad", showTime t] return fout Mix xs -> case xs of [] -> renderAudio Empty [(d, x)] -> do fin <- renderAudio x fout <- newTempFile "render.wav"- void $ liftIO $- readProcess "sox" ["-v", show d, fin, fout] ""+ liftIO $ runSox ["-v", show d, fin, fout] return fout _ -> do dfins <- forM xs $ \(d, x) -> do@@ -57,15 +62,14 @@ let argsin = concatMap (\(d, fin) -> ["-v", show d, fin]) dfins fout <- newTempFile "render.wav"- void $ liftIO $- readProcess "sox" (["--combine", "mix"] ++ argsin ++ [fout]) ""+ liftIO $ runSox $ ["--combine", "mix"] ++ argsin ++ [fout] return fout Concat xs -> case xs of [] -> renderAudio Empty _ -> do fins <- mapM renderAudio xs fout <- newTempFile "render.wav"- void $ liftIO $ readProcess "sox" (fins ++ [fout]) ""+ liftIO $ runSox $ fins ++ [fout] return fout optimize :: Audio -> Audio@@ -94,3 +98,39 @@ [x] -> x _ -> Concat xs' _ -> aud++runSox :: [String] -> IO ()+runSox args = do+ sox <- findSox+ case sox of+ Just prog -> void $ readProcess prog args ""+ Nothing -> error "runSox: couldn't find sox executable"++-- | Find the SoX binary on Windows in case it's not in the PATH.+findSox :: IO (Maybe String)+findSox = do+ inPath <- findExecutable "sox"+ case inPath of+ Just prog -> return $ Just prog+ Nothing -> case Info.os of+ "mingw32" -> firstJustM $+ -- env variables for different configs of (ghc arch)/(sox arch)+ -- ProgramFiles: 32/32 or 64/64+ -- ProgramFiles(x86): 64/32+ -- ProgramW6432: 32/64+ flip map ["ProgramFiles", "ProgramFiles(x86)", "ProgramW6432"] $ \env ->+ lookupEnv env >>= \var -> case var of+ Nothing -> return Nothing+ Just pf+ -> fmap (\im -> pf </> im </> "sox.exe")+ . listToMaybe+ . filter ("sox-" `isPrefixOf`)+ <$> getDirectoryContents pf+ _ -> return Nothing++-- | Only runs actions until the first that gives 'Just'.+firstJustM :: (Monad m) => [m (Maybe a)] -> m (Maybe a)+firstJustM [] = return Nothing+firstJustM (mx : xs) = mx >>= \x -> case x of+ Nothing -> firstJustM xs+ Just y -> return $ Just y