-- 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
    ]