-- | Non-realtime score rendering.
module Sound.Sc3.Server.Nrt.Render where

import System.FilePath {- filepath -}
import System.Process {- process -}

import Sound.Sc3.Server.Enum
import Sound.Sc3.Server.Nrt

{- | Minimal Nrt rendering parameters.

The sound file type is inferred from the file name extension.
Structure is:
Osc file name,
input audio file name and input number of channels (use ("_",0) for no input file),
output audio file name and output number of channels,
sample rate (int),
sample format,
further parameters (ie. ["-m","32768"]) to be inserted before the Nrt -N option.
-}
type Nrt_Param_Plain = (FilePath, (FilePath, Int), (FilePath, Int), Int, SampleFormat, [String])

{- | Compile argument list from Nrt_Param_Plain.

>>> let opt = ("/tmp/t.osc",("_",0),("/tmp/t.wav",1),48000,PcmInt16,[])
>>> nrt_param_plain_to_arg opt
["-i","0","-o","1","-N","/tmp/t.osc","_","/tmp/t.wav","48000","wav","int16"]
-}
nrt_param_plain_to_arg :: Nrt_Param_Plain -> [String]
nrt_param_plain_to_arg :: Nrt_Param_Plain -> [String]
nrt_param_plain_to_arg (String
osc_nm, (String
in_sf, Int
in_nc), (String
out_sf, Int
out_nc), Int
sr, SampleFormat
sf, [String]
param) =
  let sf_ty :: SoundFileFormat
sf_ty = case String -> String
takeExtension String
out_sf of
        Char
'.' : String
ext -> String -> SoundFileFormat
soundFileFormat_from_extension_err String
ext
        String
_ -> String -> SoundFileFormat
forall a. HasCallStack => String -> a
error String
"nrt_exec_plain: invalid sf extension"
  in [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [
        [ String
"-i"
        , Int -> String
forall a. Show a => a -> String
show Int
in_nc
        , String
"-o"
        , Int -> String
forall a. Show a => a -> String
show Int
out_nc
        ]
      , [String]
param
      ,
        [ String
"-N"
        , String
osc_nm
        , String
in_sf
        , String
out_sf
        , Int -> String
forall a. Show a => a -> String
show Int
sr
        , SoundFileFormat -> String
soundFileFormatString SoundFileFormat
sf_ty
        , SampleFormat -> String
sampleFormatString SampleFormat
sf
        ]
      ]

{- | Compile argument list from Nrt_Param_Plain and run scynth.

> nrt_exec_plain opt
-}
nrt_exec_plain :: Nrt_Param_Plain -> IO ()
nrt_exec_plain :: Nrt_Param_Plain -> IO ()
nrt_exec_plain Nrt_Param_Plain
opt = String -> [String] -> IO ()
callProcess String
"scsynth" (Nrt_Param_Plain -> [String]
nrt_param_plain_to_arg Nrt_Param_Plain
opt)

{- | Minimal Nrt rendering, for more control see Stefan Kersten's
/hsc3-process/ package at:
<https://github.com/kaoskorobase/hsc3-process>.
-}
nrt_proc_plain :: Nrt_Param_Plain -> Nrt -> IO ()
nrt_proc_plain :: Nrt_Param_Plain -> Nrt -> IO ()
nrt_proc_plain Nrt_Param_Plain
opt Nrt
sc = do
  let (String
osc_nm, (String, Int)
_, (String, Int)
_, Int
_, SampleFormat
_, [String]
_) = Nrt_Param_Plain
opt
  String -> Nrt -> IO ()
writeNrt String
osc_nm Nrt
sc
  Nrt_Param_Plain -> IO ()
nrt_exec_plain Nrt_Param_Plain
opt

{- | Variant for no input case.

(osc-file-name, audio-file-name, number-of-channels, sample-rate, sample-format, param)
-}
type Nrt_Render_Plain = (FilePath, FilePath, Int, Int, SampleFormat, [String])

{- | Add ("-",0) as input parameters and run 'nrt_proc_plain'.

> nrt_render_plain opt sc
-}
nrt_render_plain :: Nrt_Render_Plain -> Nrt -> IO ()
nrt_render_plain :: Nrt_Render_Plain -> Nrt -> IO ()
nrt_render_plain (String
osc_nm, String
sf_nm, Int
nc, Int
sr, SampleFormat
sf, [String]
param) Nrt
sc =
  let opt :: Nrt_Param_Plain
opt = (String
osc_nm, (String
"_", Int
0), (String
sf_nm, Int
nc), Int
sr, SampleFormat
sf, [String]
param)
  in Nrt_Param_Plain -> Nrt -> IO ()
nrt_proc_plain Nrt_Param_Plain
opt Nrt
sc