{- | Bracketed Ugens.

ScSynth is controlled by sending instructions in the form of Open Sound Control (Osc) messages.
One family of messages allocate, set and free Buffers.
Ugen graphs that utilise Buffers don't contain the messages to manage them.
These messages are ordinarily written and sent outside of the graph context.

The bracketUgen function attaches a pair of Osc message sequences to a Ugen value.
The first sequence is to be sent before the graph the Ugen belongs to is started, the other after it has ended.
The messages are stored in the Ugen type, but are not written to the SynthDef file representing the Ugen graph.
The scsynthPlayAt function reads and sends Ugen bracket messages, in addition to the Ugen graph itself.

The functions defined here return Ugen values with brackets attached to them.
-}
module Sound.Sc3.Ugen.Bracketed where

import Sound.Sc3.Common.Enum {- hsc3 -}
import Sound.Sc3.Common.Rate {- hsc3 -}
import Sound.Sc3.Common.SoundFile {- hsc3 -}

import Sound.Sc3.Ugen.Bindings.Db {- hsc3 -}
import Sound.Sc3.Ugen.Ugen {- hsc3 -}
import Sound.Sc3.Ugen.Util {- hsc3 -}

import Sound.Sc3.Server.Command.Plain {- hsc3 -}
import Sound.Sc3.Server.Enum {- hsc3 -}

{- | sfNc is the number of channels at a sound file.
     readChan is a list of channels indexed to read.
     Returns a channel count, either sfNc or the length of readChan.
     If readChan in empty returns sfNc, else returns the length of readChan.
     This function checks that requested channels are in range.
-}
readChanToNc :: Int -> [Int] -> Int
readChanToNc :: Int -> [Int] -> Int
readChanToNc Int
sfNc [Int]
readChan =
  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
readChan
  then Int
sfNc
  else if forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
readChan forall a. Ord a => a -> a -> Bool
< Int
sfNc
       then forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
readChan
       else forall a. HasCallStack => [Char] -> a
error [Char]
"readChanToNc: channel error"

{- | diskIn or vDiskIn with brackets to 1. allocate and read and then 2. close and free buffer.
     If ctlName is empty the buffer is returned as a constant, else as a control with the given name.
     Ignoring the brackets, this is equivalent to writing a diskIn or vDiskIn Ugen,
     with the number of channels given by readChan or derived from the named file.
     If readChan is empty all channels are read.
-}
sndfileDiskIn :: (String, Buffer_Id, [Int]) -> FilePath -> Maybe Ugen -> Loop Ugen -> Ugen
sndfileDiskIn :: ([Char], Int, [Int]) -> [Char] -> Maybe Ugen -> Loop Ugen -> Ugen
sndfileDiskIn ([Char]
ctlName, Int
bufId, [Int]
readChan) [Char]
sndFileName Maybe Ugen
maybeRate Loop Ugen
loop =
  let fileName :: [Char]
fileName = [Char] -> [Char]
sfResolve [Char]
sndFileName
      (Int
sfNc,Int
_sr,Int
_nf) = [Char] -> (Int, Int, Int)
sfInfo [Char]
fileName
      bufSize :: Int
bufSize = Int
65536
      buf :: Ugen
buf = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ctlName then forall n. Real n => n -> Ugen
constant Int
bufId else Rate -> [Char] -> Double -> Ugen
control Rate
kr [Char]
ctlName (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bufId)
      bufNc :: Int
bufNc = Int -> [Int] -> Int
readChanToNc Int
sfNc [Int]
readChan
  in Ugen -> Brackets -> Ugen
bracketUgen
     (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int -> Ugen -> Loop Ugen -> Ugen
diskIn Int
bufNc Ugen
buf Loop Ugen
loop) (\Ugen
rate -> Int -> Ugen -> Ugen -> Loop Ugen -> Ugen -> Ugen
vDiskIn Int
bufNc Ugen
buf Ugen
rate Loop Ugen
loop Ugen
0) Maybe Ugen
maybeRate)
     ([Int -> Int -> Int -> Message
b_alloc Int
bufId Int
bufSize Int
bufNc, Int -> [Char] -> Int -> Int -> Int -> Bool -> [Int] -> Message
b_readChannel Int
bufId [Char]
fileName Int
0 (-Int
1) Int
0 Bool
True [Int]
readChan]
     ,[Int -> Message
b_close Int
bufId, Int -> Message
b_free Int
bufId])

-- | diskIn form of sndfileDiskIn
sndfileIn :: (String, Buffer_Id, [Int]) -> FilePath -> Loop Ugen -> Ugen
sndfileIn :: ([Char], Int, [Int]) -> [Char] -> Loop Ugen -> Ugen
sndfileIn ([Char], Int, [Int])
opt [Char]
sndFileName Loop Ugen
loop = ([Char], Int, [Int]) -> [Char] -> Maybe Ugen -> Loop Ugen -> Ugen
sndfileDiskIn ([Char], Int, [Int])
opt [Char]
sndFileName forall a. Maybe a
Nothing Loop Ugen
loop

-- | vDiskIn form of sndfileDiskIn
sndfileVarIn :: (String, Buffer_Id, [Int]) -> FilePath -> Ugen -> Loop Ugen -> Ugen
sndfileVarIn :: ([Char], Int, [Int]) -> [Char] -> Ugen -> Loop Ugen -> Ugen
sndfileVarIn ([Char], Int, [Int])
opt [Char]
sndFileName Ugen
rate Loop Ugen
loop = ([Char], Int, [Int]) -> [Char] -> Maybe Ugen -> Loop Ugen -> Ugen
sndfileDiskIn ([Char], Int, [Int])
opt [Char]
sndFileName (forall a. a -> Maybe a
Just Ugen
rate) Loop Ugen
loop

{- | Returns Buffer_Id as a bracketed buffer identifier Ugen,
     along with basic sound file information: numberOfChannels, sampleRate, numberOfFrames.
     If ctlName is empty the buffer is returned as a constant, else as a control with the given name.
     The brackets will 1. allocate and read and then 2. free the buffer.
     Ignoring the brackets, and the sample rate and frame count, this is equivalent to declaring a buffer identifier.
     If readChan is empty all channels are read.
-}
sndfileRead :: (String, Buffer_Id, [Int]) -> FilePath -> (Ugen, Int, Ugen, Ugen)
sndfileRead :: ([Char], Int, [Int]) -> [Char] -> (Ugen, Int, Ugen, Ugen)
sndfileRead ([Char]
ctlName, Int
bufId, [Int]
readChan) [Char]
sndFileName =
  let fileName :: [Char]
fileName = [Char] -> [Char]
sfResolve [Char]
sndFileName
      (Int
sfNc, Int
sfSr, Int
sfNf) = [Char] -> (Int, Int, Int)
sfInfo [Char]
fileName
      buf :: Ugen
buf = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ctlName then forall n. Real n => n -> Ugen
constant Int
bufId else Rate -> [Char] -> Double -> Ugen
control Rate
kr [Char]
ctlName (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bufId)
      bufNc :: Int
bufNc = Int -> [Int] -> Int
readChanToNc Int
sfNc [Int]
readChan
  in (Ugen -> Brackets -> Ugen
bracketUgen Ugen
buf ([Int -> [Char] -> Int -> Int -> [Int] -> Message
b_allocReadChannel Int
bufId [Char]
fileName Int
0 Int
0 [Int]
readChan], [Int -> Message
b_free Int
bufId]), Int
bufNc, forall n. Real n => n -> Ugen
constant Int
sfSr, forall n. Real n => n -> Ugen
constant Int
sfNf)

{- | Bracketed b_gen sine1
     If ctlName is empty the buffer is returned as a constant, else as a control with the given name.
-}
bGenSine1 :: (String, Buffer_Id, Int) -> [B_Gen] -> [Double] -> Ugen
bGenSine1 :: ([Char], Int, Int) -> [B_Gen] -> [Double] -> Ugen
bGenSine1 ([Char]
ctlName, Int
bufId, Int
numFrames) [B_Gen]
flags [Double]
param =
  let buf :: Ugen
buf = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ctlName then forall n. Real n => n -> Ugen
constant Int
bufId else Rate -> [Char] -> Double -> Ugen
control Rate
kr [Char]
ctlName (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bufId)
      bufNc :: Int
bufNc = Int
1
  in Ugen -> Brackets -> Ugen
bracketUgen Ugen
buf ([Int -> Int -> Int -> Message
b_alloc Int
bufId Int
numFrames Int
bufNc, Int -> [B_Gen] -> [Double] -> Message
b_gen_sine1 Int
bufId [B_Gen]
flags [Double]
param], [Int -> Message
b_free Int
bufId])

-- | bGenSine1 with standard wavetable flags (normalise and wavetable and clear).
bGenSine1Tbl :: (String, Buffer_Id, Int) -> [Double] -> Ugen
bGenSine1Tbl :: ([Char], Int, Int) -> [Double] -> Ugen
bGenSine1Tbl ([Char], Int, Int)
opt = ([Char], Int, Int) -> [B_Gen] -> [Double] -> Ugen
bGenSine1 ([Char], Int, Int)
opt [B_Gen
Normalise, B_Gen
Wavetable, B_Gen
Clear]

{- | Bracketed b_gen sine1
     If ctlName is empty the buffer is returned as a constant, else as a control with the given name.
-}
bGenCheby :: (String, Buffer_Id, Int) -> [B_Gen] -> [Double] -> Ugen
bGenCheby :: ([Char], Int, Int) -> [B_Gen] -> [Double] -> Ugen
bGenCheby ([Char]
ctlName, Int
bufId, Int
numFrames) [B_Gen]
flags [Double]
param =
  let buf :: Ugen
buf = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ctlName then forall n. Real n => n -> Ugen
constant Int
bufId else Rate -> [Char] -> Double -> Ugen
control Rate
kr [Char]
ctlName (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bufId)
      bufNc :: Int
bufNc = Int
1
  in Ugen -> Brackets -> Ugen
bracketUgen Ugen
buf ([Int -> Int -> Int -> Message
b_alloc Int
bufId Int
numFrames Int
bufNc, Int -> [B_Gen] -> [Double] -> Message
b_gen_cheby Int
bufId [B_Gen]
flags [Double]
param], [Int -> Message
b_free Int
bufId])

-- | bGenCheby with standard wavetable flags (normalise and wavetable and clear).
bGenChebyTbl :: (String, Buffer_Id, Int) -> [Double] -> Ugen
bGenChebyTbl :: ([Char], Int, Int) -> [Double] -> Ugen
bGenChebyTbl ([Char], Int, Int)
opt = ([Char], Int, Int) -> [B_Gen] -> [Double] -> Ugen
bGenCheby ([Char], Int, Int)
opt [B_Gen
Normalise, B_Gen
Wavetable, B_Gen
Clear]