1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
{-# LANGUAGE RecordWildCards #-}
import Foreign.C.Types (CFloat(..))
import qualified Sound.JACK as Jack
import qualified Sound.JACK.Audio as Audio
import Options.Applicative
import Data.Maybe
import System.Directory
import System.FilePath
import System.Posix.Files
import System.Posix.IO
import System.Environment
import System.Process
import Control.Concurrent
import Control.Concurrent.MVar
import qualified Control.Monad.Trans.Class as Trans
import qualified Control.Monad.Exception.Synchronous as Sync
import Control.Exception
import System.IO.Error
import System.INotify
data Options = Options
{ input :: String
, output :: String
, client :: String
, run :: Maybe String
, initialLevel :: Float
, stateDir :: FilePath
}
optionParser :: Parser Options
optionParser = Options <$>
strOption ( long "input"
<> metavar "STRING"
)
<*> strOption ( long "output"
<> metavar "STRING"
)
<*> strOption ( long "client"
<> metavar "STRING"
)
<*> optional ( strOption ( long "run"
<> metavar "FILE"
)
)
<*> (fromMaybe 0 <$> optional (option auto ( long "level"
<> metavar "FLOAT"
)
)
)
<*> strOption ( long "dir"
<> metavar "DIRECTORY"
)
main :: IO ()
main = execParser opts >>= trivmix
where
opts = info (helper <*> optionParser)
( fullDesc
<> progDesc "Setup a JACK mixing input/output pair controlled by fifos in a state directory"
<> header "Trivmix - A trivial mixer"
)
trivmix :: Options -> IO ()
trivmix Options{..} = onDirectory stateDir $ do
level <- newMVar initialLevel
let levelFile = stateDir </> "level"
onLevelFile levelFile initialLevel $ withINotify $ \n -> do
addWatch n [Modify] levelFile (const $ handleLevel level levelFile)
Jack.handleExceptions $
Jack.withClientDefault client $ \client' ->
Jack.withPort client' input $ \input' ->
Jack.withPort client' output $ \output' -> do
Trans.lift $ do
case run of
Nothing -> return ()
Just run' -> do
(_, _, _, ph) <- createProcess $ (proc run' [client ++ ":" ++ input, client ++ ":" ++ output]) { delegate_ctlc = True }
return ()
Audio.withProcessMono client' input' (mix level) output' $
Jack.withActivation client' $ Trans.lift Jack.waitForBreak
onDirectory :: FilePath -> IO () -> IO ()
onDirectory stateDir io = do
exists <- doesDirectoryExist stateDir
createDirectoryIfMissing True stateDir
finally io $ if exists then removeDirectory stateDir else return ()
mix :: MVar Float -> CFloat -> IO CFloat
mix level input = do
level' <- readMVar level
return $ (CFloat level') * input
onLevelFile :: FilePath -> Float -> IO a -> IO a
onLevelFile file initial action = do
exists <- doesFileExist file
let acquire = case exists of
True -> return ()
False -> createFile file mode >>= closeFd >> writeFile file (show initial)
mode = foldl unionFileModes nullFileMode [ ownerReadMode
, ownerWriteMode
, groupReadMode
, groupWriteMode
]
release = case exists of
True -> return ()
False -> removeFile file
bracket_ acquire release action
handleLevel :: MVar Float -> FilePath -> IO ()
handleLevel level file = catch action handler
where
action = readFile file >>= readIO >>= swapMVar level >>= const (return ())
handler e = if isUserError e
then readMVar level >>= \l -> writeFile file (show l)
else throw e
|
