-- | Non-realtime score generation.
module Sound.SC3.Server.NRT where

import Data.Maybe {- base -}
import System.FilePath {- filepath -}
import System.IO {- base -}
import System.Process {- process -}

import qualified Data.ByteString.Lazy as B {- bytestring -}

import Sound.OSC.Core {- hosc -}
import qualified Sound.OSC.Coding.Byte as Byte {- hosc -}

import Sound.SC3.Common.Base
import Sound.SC3.Server.Enum

-- | Encode and prefix with encoded length.
oscWithSize :: Bundle -> B.ByteString
oscWithSize :: Bundle -> ByteString
oscWithSize Bundle
o =
    let b :: ByteString
b = Bundle -> ByteString
encodeBundle Bundle
o
        l :: ByteString
l = Int -> ByteString
Byte.encode_i32 (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
B.length ByteString
b))
    in ByteString -> ByteString -> ByteString
B.append ByteString
l ByteString
b

-- | An 'NRT' score is a sequence of 'Bundle's.
newtype NRT = NRT {NRT -> [Bundle]
nrt_bundles :: [Bundle]} deriving (Int -> NRT -> ShowS
[NRT] -> ShowS
NRT -> String
(Int -> NRT -> ShowS)
-> (NRT -> String) -> ([NRT] -> ShowS) -> Show NRT
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NRT] -> ShowS
$cshowList :: [NRT] -> ShowS
show :: NRT -> String
$cshow :: NRT -> String
showsPrec :: Int -> NRT -> ShowS
$cshowsPrec :: Int -> NRT -> ShowS
Show)

-- | Trivial NRT statistics.
type NRT_STAT =
    ((String, Time)
    ,(String, Int)
    ,(String, Int)
    ,(String, [(String,Int)]))

-- | NRT_STAT names.
nrt_stat_param :: (String, String, String, String)
nrt_stat_param :: (String, String, String, String)
nrt_stat_param = (String
"duration",String
"# bundles",String
"# messages",String
"command set")

-- | Trivial NRT statistics.
nrt_stat :: NRT -> NRT_STAT
nrt_stat :: NRT -> NRT_STAT
nrt_stat (NRT [Bundle]
b_seq) =
    let b_msg :: [[Message]]
b_msg = (Bundle -> [Message]) -> [Bundle] -> [[Message]]
forall a b. (a -> b) -> [a] -> [b]
map Bundle -> [Message]
bundleMessages [Bundle]
b_seq
    in (String, String, String, String)
-> (Time, Int, Int, [(String, Int)]) -> NRT_STAT
forall a b c d e f g h.
(a, b, c, d) -> (e, f, g, h) -> ((a, e), (b, f), (c, g), (d, h))
p4_zip
       (String, String, String, String)
nrt_stat_param
       (Bundle -> Time
bundleTime ([Bundle] -> Bundle
forall a. [a] -> a
last [Bundle]
b_seq)
       ,[Bundle] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bundle]
b_seq
       ,[Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (([Message] -> Int) -> [[Message]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Message] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Message]]
b_msg)
       ,[String] -> [(String, Int)]
forall a. Ord a => [a] -> [(a, Int)]
histogram (([Message] -> [String]) -> [[Message]] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Message -> String) -> [Message] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Message -> String
messageAddress) [[Message]]
b_msg))

-- | 'span' of 'f' of 'bundleTime'.  Can be used to separate the
-- /initialisation/ and /remainder/ parts of a score.
nrt_span :: (Time -> Bool) -> NRT -> ([Bundle],[Bundle])
nrt_span :: (Time -> Bool) -> NRT -> ([Bundle], [Bundle])
nrt_span Time -> Bool
f = (Bundle -> Bool) -> [Bundle] -> ([Bundle], [Bundle])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Time -> Bool
f (Time -> Bool) -> (Bundle -> Time) -> Bundle -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bundle -> Time
bundleTime) ([Bundle] -> ([Bundle], [Bundle]))
-> (NRT -> [Bundle]) -> NRT -> ([Bundle], [Bundle])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NRT -> [Bundle]
nrt_bundles

-- | Encode an 'NRT' score.
encodeNRT :: NRT -> B.ByteString
encodeNRT :: NRT -> ByteString
encodeNRT = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> (NRT -> [ByteString]) -> NRT -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bundle -> ByteString) -> [Bundle] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Bundle -> ByteString
oscWithSize ([Bundle] -> [ByteString])
-> (NRT -> [Bundle]) -> NRT -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NRT -> [Bundle]
nrt_bundles

{- | Write an 'NRT' score.

import Sound.OSC
import Sound.SC3
m1 = g_new [(1, AddToTail, 0)]
m2 = d_recv (synthdef "sin" (out 0 (sinOsc AR 660 0 * 0.15)))
m3 = s_new "sin" 100 AddToTail 1 []
m4 = n_free [100]
m5 = nrt_end
sc = NRT [bundle 0 [m1,m2],bundle 1 [m3],bundle 10 [m4],bundle 15 [m5]]
writeNRT "/tmp/t.osc" sc

-}
writeNRT :: FilePath -> NRT -> IO ()
writeNRT :: String -> NRT -> IO ()
writeNRT String
fn = String -> ByteString -> IO ()
B.writeFile String
fn (ByteString -> IO ()) -> (NRT -> ByteString) -> NRT -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NRT -> ByteString
encodeNRT

-- | Write an 'NRT' score to a file handle.
putNRT :: Handle -> NRT -> IO ()
putNRT :: Handle -> NRT -> IO ()
putNRT Handle
h = Handle -> ByteString -> IO ()
B.hPut Handle
h (ByteString -> IO ()) -> (NRT -> ByteString) -> NRT -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NRT -> ByteString
encodeNRT

-- | Decode an 'NRT' 'B.ByteString' to a list of 'Bundle's.
decode_nrt_bundles :: B.ByteString -> [Bundle]
decode_nrt_bundles :: ByteString -> [Bundle]
decode_nrt_bundles ByteString
s =
    let (ByteString
p,ByteString
q) = Int64 -> ByteString -> (ByteString, ByteString)
B.splitAt Int64
4 ByteString
s
        n :: Int64
n = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
Byte.decode_i32 ByteString
p)
        (ByteString
r,ByteString
s') = Int64 -> ByteString -> (ByteString, ByteString)
B.splitAt Int64
n ByteString
q
        r' :: Bundle
r' = ByteString -> Bundle
decodeBundle ByteString
r
    in if ByteString -> Bool
B.null ByteString
s'
       then [Bundle
r']
       else Bundle
r' Bundle -> [Bundle] -> [Bundle]
forall a. a -> [a] -> [a]
: ByteString -> [Bundle]
decode_nrt_bundles ByteString
s'

-- | Decode an 'NRT' 'B.ByteString'.
decodeNRT :: B.ByteString -> NRT
decodeNRT :: ByteString -> NRT
decodeNRT = [Bundle] -> NRT
NRT ([Bundle] -> NRT) -> (ByteString -> [Bundle]) -> ByteString -> NRT
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Bundle]
decode_nrt_bundles

-- | 'decodeNRT' of 'B.readFile'.
readNRT :: FilePath -> IO NRT
readNRT :: String -> IO NRT
readNRT = (ByteString -> NRT) -> IO ByteString -> IO NRT
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> NRT
decodeNRT (IO ByteString -> IO NRT)
-> (String -> IO ByteString) -> String -> IO NRT
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ByteString
B.readFile

-- * Render

{- | 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,
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,[])
> let r = ["-i","0","-o","1","-N","/tmp/t.osc","_","/tmp/t.wav","48000","wav","int16"]
> nrt_param_plain_to_arg opt == r

-}
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 ShowS
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

-- * QUERY

-- | Find any non-ascending sequences.
nrt_non_ascending :: NRT -> [(Bundle, Bundle)]
nrt_non_ascending :: NRT -> [(Bundle, Bundle)]
nrt_non_ascending (NRT [Bundle]
b) =
  let p :: [(Bundle, Bundle)]
p = [Bundle] -> [Bundle] -> [(Bundle, Bundle)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Bundle]
b ([Bundle] -> [Bundle]
forall a. [a] -> [a]
tail [Bundle]
b)
      f :: (Bundle, Bundle) -> Maybe (Bundle, Bundle)
f (Bundle
i,Bundle
j) = if Bundle -> Time
bundleTime Bundle
i Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
> Bundle -> Time
bundleTime Bundle
j then (Bundle, Bundle) -> Maybe (Bundle, Bundle)
forall a. a -> Maybe a
Just (Bundle
i,Bundle
j) else Maybe (Bundle, Bundle)
forall a. Maybe a
Nothing
  in ((Bundle, Bundle) -> Maybe (Bundle, Bundle))
-> [(Bundle, Bundle)] -> [(Bundle, Bundle)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Bundle, Bundle) -> Maybe (Bundle, Bundle)
f [(Bundle, Bundle)]
p