synthesizer-llvm 0.5.0.1 → 0.5.0.2
raw patch · 3 files changed
+266/−8 lines, 3 filesdep ~tfp
Dependency ranges changed: tfp
Files
- jack/Synthesizer/LLVM/Server/Option.hs +110/−0
- render/Synthesizer/LLVM/Server/Option.hs +144/−0
- synthesizer-llvm.cabal +12/−8
+ jack/Synthesizer/LLVM/Server/Option.hs view
@@ -0,0 +1,110 @@+-- the options defined here overlap with the ALSA options+module Synthesizer.LLVM.Server.Option (+ T(..),+ ClientName(ClientName),+ get,+ defaultChannel,+ ) where++import qualified Sound.MIDI.Message.Channel as ChannelMsg++import System.Console.GetOpt+ (getOpt, ArgOrder(..), OptDescr(..), ArgDescr(..), usageInfo, )+import System.Environment (getArgs, getProgName, )+import System.Exit (exitSuccess, exitFailure, )+import qualified System.IO as IO++import Control.Monad (when, )++import Prelude hiding (Real, )+++data T =+ Cons {+ clientName :: ClientName,+ channel, extraChannel :: ChannelMsg.Channel,+ sampleDirectory :: FilePath+ }+ deriving (Show)+++deflt :: T+deflt =+ Cons {+ clientName = defaultClientName,+ channel = defaultChannel,+ extraChannel = ChannelMsg.toChannel 1,+ sampleDirectory = "speech"+ }+++newtype ClientName = ClientName String+ deriving (Show)++defaultClientName :: ClientName+defaultClientName =+ ClientName "Haskell-LLVM-Synthesizer"++defaultChannel :: ChannelMsg.Channel+defaultChannel = ChannelMsg.toChannel 0++++exitFailureMsg :: String -> IO a+exitFailureMsg msg =+ IO.hPutStrLn IO.stderr msg >> exitFailure++parseChannel :: String -> IO ChannelMsg.Channel+parseChannel str =+ case reads str of+ [(chan, "")] ->+ if 0<=chan && chan<16+ then return $ ChannelMsg.toChannel chan+ else exitFailureMsg "MIDI channel must a number from 0..15"+ _ ->+ exitFailureMsg $ "channel must be a number, but is '" ++ str ++ "'"++{-+Guide for common Linux/Unix command-line options:+ http://www.faqs.org/docs/artu/ch10s05.html+-}+description :: [OptDescr (T -> IO T)]+description =+ Option ['h'] ["help"]+ (NoArg $ \ _flags -> do+ programName <- getProgName+ putStrLn+ (usageInfo ("Usage: " ++ programName ++ " [OPTIONS]") description)+ exitSuccess)+ "show options" :+ Option [] ["clientname"]+ (flip ReqArg "NAME" $ \str flags ->+ return $ flags{clientName = ClientName str})+ "name of the JACK client" :+ Option ['c'] ["channel"]+ (flip ReqArg "CHANNEL" $ \str flags ->+ fmap (\chan -> flags{channel = chan}) $+ parseChannel str)+ "select MIDI input channel (0-based)" :+ Option [] ["extra-channel"]+ (flip ReqArg "CHANNEL" $ \str flags ->+ fmap (\chan -> flags{extraChannel = chan}) $+ parseChannel str)+ "select MIDI channel with effects" :+ Option ['I'] ["sample-directory"]+ (flip ReqArg "DIR" $ \str flags ->+ return $ flags{sampleDirectory = str})+ "directory for sound samples" :+ []+++get :: IO T+get = do+ argv <- getArgs+ let (opts, files, errors) = getOpt RequireOrder description argv+ when (not $ null errors) $+ exitFailureMsg (init (concat errors))+ when (not $ null files) $+ exitFailureMsg $+ "Do not know what to do with arguments " ++ show files+ foldl (>>=) (return deflt) opts
+ render/Synthesizer/LLVM/Server/Option.hs view
@@ -0,0 +1,144 @@+-- the options defined here overlap with the ALSA options+module Synthesizer.LLVM.Server.Option (+ T(..),+ get,+ defaultChannel,+ defaultSampleRate,+ ) where++import Synthesizer.LLVM.Server.Common (SampleRate(SampleRate), )+import qualified Data.StorableVector.Lazy as SVL++import qualified Sound.MIDI.Message.Channel as ChannelMsg++import System.Console.GetOpt+ (getOpt, ArgOrder(..), OptDescr(..), ArgDescr(..), usageInfo, )+import System.Environment (getArgs, getProgName, )+import System.Exit (exitSuccess, exitFailure, )+import qualified System.IO as IO++import Control.Monad (when, )++import Prelude hiding (Real, )+++data T =+ Cons {+ channel, extraChannel :: ChannelMsg.Channel,+ sampleDirectory :: FilePath,+ sampleRate :: SampleRate Int,+ chunkSize :: SVL.ChunkSize,+ volume :: Float+ }+ deriving (Show)+++deflt :: T+deflt =+ Cons {+ channel = defaultChannel,+ extraChannel = ChannelMsg.toChannel 1,+ sampleDirectory = "speech",+ sampleRate = SampleRate defaultSampleRate,+ chunkSize = SVL.chunkSize (128*1024),+ volume = 0.2+ }+++defaultChannel :: ChannelMsg.Channel+defaultChannel = ChannelMsg.toChannel 0++defaultSampleRate :: Num a => a+defaultSampleRate = 44100++++exitFailureMsg :: String -> IO a+exitFailureMsg msg =+ IO.hPutStrLn IO.stderr msg >> exitFailure++parseChannel :: String -> IO ChannelMsg.Channel+parseChannel str =+ case reads str of+ [(chan, "")] ->+ if 0<=chan && chan<16+ then return $ ChannelMsg.toChannel chan+ else exitFailureMsg "MIDI channel must a number from 0..15"+ _ ->+ exitFailureMsg $ "channel must be a number, but is '" ++ str ++ "'"++parseNumber ::+ (Read a) =>+ String -> (a -> Bool) -> String -> String -> IO a+parseNumber name constraint constraintName str =+ case reads str of+ [(n, "")] ->+ if constraint n+ then return n+ else exitFailureMsg $ name ++ " must be a " ++ constraintName ++ " number"+ _ ->+ exitFailureMsg $ name ++ " must be a number, but is '" ++ str ++ "'"++maxInt :: Integer+maxInt =+ fromIntegral (maxBound :: Int)++{-+Guide for common Linux/Unix command-line options:+ http://www.faqs.org/docs/artu/ch10s05.html+-}+description :: [OptDescr (T -> IO T)]+description =+ Option ['h'] ["help"]+ (NoArg $ \ _flags -> do+ programName <- getProgName+ putStrLn+ (usageInfo ("Usage: " ++ programName ++ " [OPTIONS] infile.mid [outfile.wav]") description)+ exitSuccess)+ "show options" :+ Option ['r'] ["samplerate"]+ (flip ReqArg "RATE" $ \str flags ->+ fmap (\rate -> flags{sampleRate = SampleRate $ fromInteger rate}) $+ parseNumber "sample-rate" (\n -> 0<n && n<=maxInt) "positive" str)+ "sample-rate in samples per second" :+ Option ['b'] ["blocksize"]+ (flip ReqArg "SIZE" $ \str flags ->+ fmap (\size -> flags{chunkSize = SVL.ChunkSize $ fromInteger size}) $+ parseNumber "blocksize" (\n -> 0<n && n<=maxInt) "positive" str)+ "block size as number of sample-frames" :+{-+ Option ['v'] ["volume"]+ (flip ReqArg "FACTOR" $ \str flags ->+ fmap (\x -> flags{volume = x}) $+ parseNumber "volume" (const True) "any" str)+ "block size as number of sample-frames" :+-}+ Option ['c'] ["channel"]+ (flip ReqArg "CHANNEL" $ \str flags ->+ fmap (\chan -> flags{channel = chan}) $+ parseChannel str)+ "select MIDI input channel (0-based)" :+ Option [] ["extra-channel"]+ (flip ReqArg "CHANNEL" $ \str flags ->+ fmap (\chan -> flags{extraChannel = chan}) $+ parseChannel str)+ "select MIDI channel with effects" :+ Option ['I'] ["sample-directory"]+ (flip ReqArg "DIR" $ \str flags ->+ return $ flags{sampleDirectory = str})+ "directory for sound samples" :+ []+++get :: IO (T, String, Maybe String)+get = do+ argv <- getArgs+ let (opts, files, errors) = getOpt RequireOrder description argv+ when (not $ null errors) $+ exitFailureMsg (init (concat errors))+ opt <- foldl (>>=) (return deflt) opts+ case files of+ [] -> exitFailureMsg "need MIDI input file"+ [midiPath] -> return (opt, midiPath, Nothing)+ [midiPath, wavePath] -> return (opt, midiPath, Just wavePath)+ _ -> exitFailureMsg "too many file names given"
synthesizer-llvm.cabal view
@@ -1,5 +1,5 @@ Name: synthesizer-llvm-Version: 0.5.0.1+Version: 0.5.0.2 License: GPL License-File: LICENSE Author: Henning Thielemann <haskell@henning-thielemann.de>@@ -58,7 +58,7 @@ default: True Source-Repository this- Tag: 0.5.0.1+ Tag: 0.5.0.2 Type: darcs Location: http://code.haskell.org/synthesizer/llvm/ @@ -73,7 +73,7 @@ -- llvm must be imported with restrictive version bounds, -- because we import implicitly and unqualified llvm-tf >=3.0 && <3.0.1,- tfp >=0.7 && <0.8,+ tfp >=0.7 && <0.9, vault >=0.1 && <0.3, synthesizer-core >=0.6 && <0.7, synthesizer-midi >=0.6 && <0.7,@@ -180,7 +180,7 @@ llvm-extra >=0.4.1 && <0.5, llvm-tf,- tfp >=0.7 && <0.8,+ tfp, synthesizer-core >=0.6 && <0.7, synthesizer-midi >=0.6 && <0.7, midi >=0.2.1 && <0.3,@@ -223,7 +223,7 @@ llvm-extra >=0.4.1 && <0.5, llvm-tf,- tfp >=0.7 && <0.8,+ tfp, synthesizer-core >=0.6 && <0.7, synthesizer-midi >=0.6 && <0.7, midi >=0.2.1 && <0.3,@@ -277,7 +277,7 @@ llvm-extra >=0.4.1 && <0.5, llvm-tf,- tfp >=0.7 && <0.8,+ tfp, synthesizer-core >=0.6 && <0.7, synthesizer-midi >=0.6 && <0.7, midi >=0.2.1 && <0.3,@@ -310,6 +310,8 @@ Default-Extensions: CPP Hs-Source-Dirs: jack Main-Is: Synthesizer/LLVM/Server/JACK.hs+ Other-Modules:+ Synthesizer.LLVM.Server.Option Executable synthi-llvm-render If flag(buildExamples)@@ -318,7 +320,7 @@ llvm-extra >=0.4.1 && <0.5, llvm-tf,- tfp >=0.7 && <0.8,+ tfp, sox >=0.2.1 && <0.3, synthesizer-core >=0.6 && <0.7, synthesizer-midi >=0.6 && <0.7,@@ -352,6 +354,8 @@ Default-Extensions: CPP Hs-Source-Dirs: render Main-Is: Synthesizer/LLVM/Server/Render.hs+ Other-Modules:+ Synthesizer.LLVM.Server.Option Executable synthi-llvm-test If flag(buildTests)@@ -360,7 +364,7 @@ llvm-extra >=0.4.1 && <0.5, llvm-tf,- tfp >=0.7 && <0.8,+ tfp, synthesizer-core >=0.6 && <0.7, storablevector >=0.2.6 && <0.3, numeric-prelude >=0.3 && <0.5,