-- Copyright 2021 Evan Laforge -- This program is distributed under the terms of the GNU General Public -- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt -- | Stream audio from the im cache. Recreates play_cache's behaviour, but -- in a standalone way, without a DAW and VST. module Synth.StreamAudio ( play , streamDir , Device(..) , getDevices ) where import qualified Control.Concurrent.MVar as MVar import qualified Control.Monad.Trans.Resource as Resource import qualified Data.List as List import qualified Data.Set as Set import qualified System.Directory as Directory import qualified System.Exit as Exit import System.FilePath ((</>)) import qualified System.IO as IO import qualified System.IO.Unsafe as Unsafe import qualified System.Process as Process import qualified Util.Audio.Audio as Audio import qualified Util.Audio.File as Audio.File import qualified Util.Audio.PortAudio as PortAudio import qualified Util.Lists as Lists import qualified Util.Thread as Thread import qualified Derive.ScoreT as ScoreT import qualified Synth.Lib.AUtil as AUtil import qualified Synth.Shared.Config as Config import qualified Ui.Id as Id import Global import Synth.Types type Muted = Set ScoreT.Instrument -- | If true, spam stdout even when run from karya. verbose :: Bool verbose :: Bool verbose = Bool True -- | Stream audio for the give score and block, until done or told to stop. -- -- The audio backend is hardcoded, but perhaps I should get one from -- StaticConfig. -- -- This is essentially a haskell version of TrackStreamer (Streamer.h) -> -- Tracks (Tracks.h) play :: Maybe Device -> Thread.Flag -> FilePath -> Id.BlockId -> Muted -> RealTime -> IO () play :: Maybe Device -> Flag -> String -> BlockId -> Muted -> RealTime -> IO () play Maybe Device mbDevice Flag quit String scorePath BlockId blockId Muted muted RealTime start = do Config config <- IO Config Config.getConfig let dir :: String dir = String -> String -> BlockId -> String Config.outputDirectory (Config -> String Config.imDir Config config) String scorePath BlockId blockId Maybe Device -> Flag -> Muted -> RealTime -> String -> IO () streamDir Maybe Device mbDevice Flag quit Muted muted RealTime start String dir streamDir :: Maybe Device -> Thread.Flag -> Muted -> RealTime -> FilePath -> IO () streamDir :: Maybe Device -> Flag -> Muted -> RealTime -> String -> IO () streamDir Maybe Device mbDevice Flag quit Muted muted RealTime start String dir = case Maybe Device mbDevice of Just Device Sox -> Bool -> IO () -> String -> Muted -> RealTime -> IO () streamToSox Bool verbose (Flag -> IO () Thread.wait Flag quit) String dir Muted muted RealTime start Just (PortAudio Device device) -> Bool -> Device -> Flag -> String -> Muted -> RealTime -> IO () streamToPortAudio Bool verbose Device device Flag quit String dir Muted muted RealTime start Maybe Device Nothing -> do Device device <- IO Device PortAudio.getDefaultOutput Bool -> Device -> Flag -> String -> Muted -> RealTime -> IO () streamToPortAudio Bool verbose Device device Flag quit String dir Muted muted RealTime start data Device = Sox | PortAudio PortAudio.Device deriving (Int -> Device -> ShowS [Device] -> ShowS Device -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Device] -> ShowS $cshowList :: [Device] -> ShowS show :: Device -> String $cshow :: Device -> String showsPrec :: Int -> Device -> ShowS $cshowsPrec :: Int -> Device -> ShowS Show) getDevices :: IO ([(String, Device)], String) getDevices :: IO ([(String, Device)], String) getDevices = do Device deflt <- IO Device PortAudio.getDefaultOutput (, Device -> String PortAudio._name Device deflt) forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a k. (a -> k) -> [a] -> [(k, a)] Lists.keyOn Device -> String name_of forall b c a. (b -> c) -> (a -> b) -> a -> c . (forall a. [a] -> [a] -> [a] ++[Device Sox]) forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (a -> b) -> [a] -> [b] map Device -> Device PortAudio forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> IO [Device] PortAudio.getOutputDevices where name_of :: Device -> String name_of Device Sox = String "sox" name_of (PortAudio Device dev) = Device -> String PortAudio._name Device dev streamToPortAudio :: Bool -> PortAudio.Device -> Thread.Flag -> FilePath -> Muted -> RealTime -> IO () streamToPortAudio :: Bool -> Device -> Flag -> String -> Muted -> RealTime -> IO () streamToPortAudio Bool verbose Device dev Flag quit String dir Muted muted RealTime start = do forall a. MVar a -> (a -> IO a) -> IO () MVar.modifyMVar_ MVar (Maybe Flag) currentlyPlaying forall a b. (a -> b) -> a -> b $ \Maybe Flag prevQuit -> do forall (m :: * -> *) a. Applicative m => Maybe a -> (a -> m ()) -> m () whenJust Maybe Flag prevQuit Flag -> IO () Thread.set forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ forall a. a -> Maybe a Just Flag quit forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a Resource.runResourceT forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (rate :: Nat) (chan :: Nat). (KnownNat rate, KnownNat chan) => IO Bool -> Device -> AudioIO rate chan -> ResourceT IO () PortAudio.play (Seconds -> Flag -> IO Bool Thread.poll Seconds 0 Flag quit) Device dev forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< Bool -> String -> Muted -> Frames -> IO (AudioIO SamplingRate Channels) streamTracks Bool verbose String dir Muted muted (RealTime -> Frames AUtil.toFrames RealTime start) -- | Stash the previous quit flag so I can turn it off when I get a new play -- request. Even though both CoreAudio and JACK seem to be ok with multiple -- streams, I don't want them anyway. -- -- The audio card is a global resource so I feel ok about making this a global -- variable. {-# NOINLINE currentlyPlaying #-} currentlyPlaying :: MVar.MVar (Maybe Thread.Flag) currentlyPlaying :: MVar (Maybe Flag) currentlyPlaying = forall a. IO a -> a Unsafe.unsafePerformIO forall a b. (a -> b) -> a -> b $ forall a. a -> IO (MVar a) MVar.newMVar forall a. Maybe a Nothing streamToSox :: Bool -> IO () -> FilePath -> Muted -> RealTime -> IO () streamToSox :: Bool -> IO () -> String -> Muted -> RealTime -> IO () streamToSox Bool verbose IO () waitQuit String dir Muted muted RealTime start = Bool -> IO () -> AudioIO SamplingRate Channels -> IO () playSox Bool verbose IO () waitQuit forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< Bool -> String -> Muted -> Frames -> IO (AudioIO SamplingRate Channels) streamTracks Bool verbose String dir Muted muted (RealTime -> Frames AUtil.toFrames RealTime start) streamTracks :: Bool -> FilePath -> Muted -> Audio.Frames -> IO AUtil.Audio streamTracks :: Bool -> String -> Muted -> Frames -> IO (AudioIO SamplingRate Channels) streamTracks Bool verbose String dir Muted muted Frames start = do [String] dirnames <- String -> Muted -> IO [String] sampleDirs String dir Muted muted forall (f :: * -> *). Applicative f => Bool -> f () -> f () when Bool verbose forall a b. (a -> b) -> a -> b $ String -> IO () putStrLn forall a b. (a -> b) -> a -> b $ String "stream " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> String show [String] dirnames forall a. Semigroup a => a -> a -> a <> String " from " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> String show Frames start forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ forall (m :: * -> *) (rate :: Nat) (chan :: Nat). Monad m => [Audio m rate chan] -> Audio m rate chan Audio.mix forall a b. (a -> b) -> a -> b $ forall a b. (a -> b) -> [a] -> [b] map (forall (rate :: Nat) (chan :: Nat). (KnownNat rate, KnownNat chan) => Frames -> (String -> IO ()) -> Frames -> [String] -> AudioIO rate chan Audio.File.readCheckpointsFrom Frames start (if Bool verbose then String -> IO () putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c . (String "open "<>) else forall a b. a -> b -> a const (forall (f :: * -> *) a. Applicative f => a -> f a pure ())) Frames Config.chunkSize forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> [String] dirChunks) [String] dirnames where dirChunks :: String -> [String] dirChunks String dir = forall a b. (a -> b) -> [a] -> [b] map (String dir</>) [String] chunks chunks :: [String] chunks = forall a b. (a -> b) -> [a] -> [b] map Int -> String Config.chunkName [Int 0..] sampleDirs :: FilePath -> Muted -> IO [FilePath] sampleDirs :: String -> Muted -> IO [String] sampleDirs String dir Muted muted = do [String] subdirs <- forall (m :: * -> *) a. Applicative m => (a -> m Bool) -> [a] -> m [a] filterM (String -> IO Bool Directory.doesDirectoryExist forall b c a. (b -> c) -> (a -> b) -> a -> c . (String dir</>)) forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. (a -> Bool) -> [a] -> [a] filter (Bool -> Bool not forall b c a. (b -> c) -> (a -> b) -> a -> c . (String "." `List.isPrefixOf`)) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< String -> IO [String] Directory.listDirectory String dir forall (f :: * -> *). Applicative f => Bool -> f () -> f () when (forall (t :: * -> *) a. Foldable t => t a -> Bool null [String] subdirs) forall a b. (a -> b) -> a -> b $ String -> IO () putStrLn forall a b. (a -> b) -> a -> b $ String "no sample dirs in " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> String show String dir forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ forall a b. (a -> b) -> [a] -> [b] map (String dir</>) forall a b. (a -> b) -> a -> b $ forall a. (a -> Bool) -> [a] -> [a] filter ((forall a. Ord a => a -> Set a -> Bool `Set.notMember` Muted muted) forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> Instrument Config.dirToInstrument) [String] subdirs -- | Use sox to stream audio to the hardware. This is easy and portable but -- high latency. playSox :: Bool -> IO () -> AUtil.Audio -> IO () playSox :: Bool -> IO () -> AudioIO SamplingRate Channels -> IO () playSox Bool verbose IO () waitQuit AudioIO SamplingRate Channels audio = do String -> IO () putStrLn forall a b. (a -> b) -> a -> b $ [String] -> String unwords forall a b. (a -> b) -> a -> b $ String "%" forall a. a -> [a] -> [a] : String "sox" forall a. a -> [a] -> [a] : [String] soxArgs (Just Handle stdin, Maybe Handle Nothing, Maybe Handle Nothing, ProcessHandle pid) <- CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) Process.createProcess forall a b. (a -> b) -> a -> b $ (String -> [String] -> CreateProcess Process.proc String "sox" [String] soxArgs) { std_in :: StdStream Process.std_in = StdStream Process.CreatePipe } IO () -> IO ThreadId Thread.start forall a b. (a -> b) -> a -> b $ IO () waitQuit forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> ProcessHandle -> IO () Process.terminateProcess ProcessHandle pid IO () -> IO ThreadId Thread.start forall a b. (a -> b) -> a -> b $ do forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a Resource.runResourceT forall a b. (a -> b) -> a -> b $ forall (m :: * -> *) (rate :: Nat) (chan :: Nat). MonadIO m => Handle -> Audio m rate chan -> m () Audio.File.writeHandle Handle stdin AudioIO SamplingRate Channels audio Handle -> IO () IO.hClose Handle stdin ExitCode code <- ProcessHandle -> IO ExitCode Process.waitForProcess ProcessHandle pid case ExitCode code of ExitCode Exit.ExitSuccess -> forall (m :: * -> *) a. Monad m => a -> m a return () Exit.ExitFailure Int code | Int code forall a. Eq a => a -> a -> Bool == -Int 15 -> forall (f :: * -> *). Applicative f => Bool -> f () -> f () when Bool verbose forall a b. (a -> b) -> a -> b $ String -> IO () putStrLn String "sox terminated" | Bool otherwise -> forall (m :: * -> *) a. (Stack, MonadIO m) => Text -> m a errorIO forall a b. (a -> b) -> a -> b $ Text "sox failed: " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> Text showt Int code soxArgs :: [String] soxArgs :: [String] soxArgs = [ String "--no-show-progress" , String "-V1" -- turn down verbosity, to avoid clipped sample warnings , String "--type=raw", String "--channels=2", String "--bits=32", String "--encoding=floating-point" , String "--rate=44100" , String "-" -- read audio from stdin , String "--default-device" -- play audio to speaker ]