-- | Recording @scsynth@.
module Sound.SC3.Server.Recorder where

import Sound.OSC {- hosc -}

import Sound.SC3.Common.Rate
import Sound.SC3.Server.Command
import Sound.SC3.Server.Enum
import Sound.SC3.Server.NRT
import Sound.SC3.Server.Synthdef
import Sound.SC3.UGen.Bindings
import Sound.SC3.UGen.UGen

-- | Parameters for recording @scsynth@.
data SC3_Recorder =
    SC3_Recorder {SC3_Recorder -> SoundFileFormat
rec_sftype :: SoundFileFormat -- ^ Sound file format.
                 ,SC3_Recorder -> SampleFormat
rec_coding :: SampleFormat -- ^ Sample format.
                 ,SC3_Recorder -> FilePath
rec_fname :: FilePath -- ^ File name.
                 ,SC3_Recorder -> Int
rec_nc :: Int -- ^ Number of channels.
                 ,SC3_Recorder -> Int
rec_bus :: Int -- ^ Bus number.
                 ,SC3_Recorder -> Int
rec_buf_id :: Int -- ^ ID of buffer to allocate.
                 ,SC3_Recorder -> Int
rec_buf_frames :: Int -- ^ Number of frames at buffer.
                 ,SC3_Recorder -> Int
rec_node_id :: Int -- ^ ID to allocate for node.
                 ,SC3_Recorder -> Int
rec_group_id :: Int -- ^ Group to allocate node within.
                 ,SC3_Recorder -> Maybe Time
rec_dur :: Maybe Time -- ^ Recoring duration if fixed.
                 }

-- | Default recording structure.
default_SC3_Recorder :: SC3_Recorder
default_SC3_Recorder :: SC3_Recorder
default_SC3_Recorder =
    SC3_Recorder :: SoundFileFormat
-> SampleFormat
-> FilePath
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Maybe Time
-> SC3_Recorder
SC3_Recorder {rec_sftype :: SoundFileFormat
rec_sftype = SoundFileFormat
Wave
                 ,rec_coding :: SampleFormat
rec_coding = SampleFormat
PcmFloat
                 ,rec_fname :: FilePath
rec_fname = FilePath
"/tmp/sc3-recorder.wav"
                 ,rec_nc :: Int
rec_nc = Int
2
                 ,rec_bus :: Int
rec_bus = Int
0
                 ,rec_buf_id :: Int
rec_buf_id = Int
10
                 ,rec_buf_frames :: Int
rec_buf_frames = Int
65536
                 ,rec_node_id :: Int
rec_node_id = Int
2001
                 ,rec_group_id :: Int
rec_group_id = Int
0
                 ,rec_dur :: Maybe Time
rec_dur = Time -> Maybe Time
forall a. a -> Maybe a
Just Time
60}

-- | The name indicates the number of channels.
rec_synthdef_nm :: Int -> String
rec_synthdef_nm :: Int -> FilePath
rec_synthdef_nm Int
nc = FilePath
"sc3-recorder-" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
nc

-- | Generate 'Synthdef' with required number of channels.
--
-- > Sound.SC3.UGen.Dot.draw (rec_synthdef 2)
rec_synthdef :: Int -> Synthdef
rec_synthdef :: Int -> Synthdef
rec_synthdef Int
nc =
    let bufnum :: UGen
bufnum = Rate -> FilePath -> Time -> UGen
control Rate
KR FilePath
"bufnum" Time
0
        bus :: UGen
bus = Rate -> FilePath -> Time -> UGen
control Rate
KR FilePath
"bus" Time
0
    in FilePath -> UGen -> Synthdef
synthdef (Int -> FilePath
rec_synthdef_nm Int
nc) (UGen -> UGen -> UGen
diskOut UGen
bufnum (Int -> Rate -> UGen -> UGen
in' Int
nc Rate
AR UGen
bus))

-- | Asyncronous initialisation 'Message's ('d_recv', 'b_alloc' and
-- 'b_write').
--
-- > withSC3 (sendBundle (bundle immediately (rec_init_m def)))
rec_init_m :: SC3_Recorder -> [Message]
rec_init_m :: SC3_Recorder -> [Message]
rec_init_m SC3_Recorder
r =
    let buf :: Int
buf = SC3_Recorder -> Int
rec_buf_id SC3_Recorder
r
    in [Synthdef -> Message
d_recv (Int -> Synthdef
rec_synthdef (SC3_Recorder -> Int
rec_nc SC3_Recorder
r))
       ,Int -> Int -> Int -> Message
b_alloc Int
buf (SC3_Recorder -> Int
rec_buf_frames SC3_Recorder
r) (SC3_Recorder -> Int
rec_nc SC3_Recorder
r)
       ,Int
-> FilePath
-> SoundFileFormat
-> SampleFormat
-> Int
-> Int
-> Buffer_Leave_File_Open
-> Message
b_write Int
buf (SC3_Recorder -> FilePath
rec_fname SC3_Recorder
r) (SC3_Recorder -> SoundFileFormat
rec_sftype SC3_Recorder
r) (SC3_Recorder -> SampleFormat
rec_coding SC3_Recorder
r) (-Int
1) Int
0 Buffer_Leave_File_Open
True]

-- | Begin recording 'Message' ('s_new').
--
-- > withSC3 (sendMessage (rec_begin_m def))
rec_begin_m :: SC3_Recorder -> Message
rec_begin_m :: SC3_Recorder -> Message
rec_begin_m SC3_Recorder
r =
    FilePath
-> Int -> AddAction -> Int -> [(FilePath, Time)] -> Message
s_new (Int -> FilePath
rec_synthdef_nm (SC3_Recorder -> Int
rec_nc SC3_Recorder
r))
          (SC3_Recorder -> Int
rec_node_id SC3_Recorder
r)
          AddAction
AddToTail
          (SC3_Recorder -> Int
rec_group_id SC3_Recorder
r)
          [(FilePath
"bus",Int -> Time
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SC3_Recorder -> Int
rec_bus SC3_Recorder
r))
          ,(FilePath
"bufnum",Int -> Time
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SC3_Recorder -> Int
rec_buf_id SC3_Recorder
r))]

-- | End recording 'Message's ('n_free', 'b_close' and 'b_free').
--
-- > withSC3 (sendBundle (bundle immediately (rec_end_m def)))
rec_end_m :: SC3_Recorder -> [Message]
rec_end_m :: SC3_Recorder -> [Message]
rec_end_m SC3_Recorder
r =
    [[Int] -> Message
n_free [SC3_Recorder -> Int
rec_node_id SC3_Recorder
r]
    ,Int -> Message
b_close (SC3_Recorder -> Int
rec_buf_id SC3_Recorder
r)
    ,Int -> Message
b_free (SC3_Recorder -> Int
rec_buf_id SC3_Recorder
r)]

{- | 'NRT' score for recorder, if 'rec_dur' is given schedule 'rec_end_m'.

> import Sound.SC3
> withSC3 (Sound.OSC.sendMessage (dumpOSC TextPrinter))
> audition (out 0 (sinOsc AR (mce2 440 441) 0 * 0.1))
> let rc = default_SC3_Recorder {rec_dur = Just 5.0}
> nrt_audition (sc3_recorder rc)

-}
sc3_recorder :: SC3_Recorder -> NRT
sc3_recorder :: SC3_Recorder -> NRT
sc3_recorder SC3_Recorder
r =
    let b0 :: Bundle
b0 = Time -> [Message] -> Bundle
bundle Time
0 (SC3_Recorder -> [Message]
rec_init_m SC3_Recorder
r [Message] -> [Message] -> [Message]
forall a. [a] -> [a] -> [a]
++ [SC3_Recorder -> Message
rec_begin_m SC3_Recorder
r])
    in case SC3_Recorder -> Maybe Time
rec_dur SC3_Recorder
r of
         Maybe Time
Nothing -> [Bundle] -> NRT
NRT [Bundle
b0]
         Just Time
d -> [Bundle] -> NRT
NRT [Bundle
b0,Time -> [Message] -> Bundle
bundle Time
d (SC3_Recorder -> [Message]
rec_end_m SC3_Recorder
r)]