{-# OPTIONS_HADDOCK show-extensions #-}

-- {-# LANGUAGE BangPatterns #-}
-- {-# LANGUAGE FlexibleInstances #-}
-- {-# LANGUAGE InstanceSigs #-}
-- {-# LANGUAGE KindSignatures #-}
-- {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
-- {-# LANGUAGE ScopedTypeVariables #-}
-- {-# LANGUAGE TypeSynonymInstances #-}

{-# LANGUAGE NoIncoherentInstances #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE NoRebindableSyntax #-}
{-# LANGUAGE NoUndecidableInstances #-}


-- | Library for interacting with the SuperCollider server.
-- 
--   You don't need to use much of this day-to-day
-- 
--   There's a toplevel 'scServerState' that stores the current state of the SC server
module Vivid.SCServer (
     cmdPeriod
   , freeAll
   , Timestamp(..)
     
   -- * Nodes

   , NodeId(..)
   , Synth(..)
   , Group(..)
   , ParGroup(..)
   , defaultGroup

   -- * Buffers

   , BufferId(..)
   , makeBuffer
   , makeBufferFromFile
   , newBuffer
   , newBufferFromFile
   , newBufferFromFileBetween
   , saveBuffer
   , writeBuffer
   , writeBufferWith
   , WriteBufArgs(..)
   , defaultWBArgs
   , closeBuf
   , closeBuffer
   , zeroBuf

   -- * Manual management of SC server connection

   , createSCServerConnection'
   , closeSCServerConnection'
   , SCConnectConfig(..)
   , defaultConnectConfig

   , module Vivid.SCServer.State

   , shrinkSynthArgs

   ) where

import Vivid.OSC
import Vivid.OSC.Bundles (initTreeCommand)
import qualified Vivid.SC.Server.Commands as SCCmd
import Vivid.SC.Server.Types (Group(..), ParGroup(..))

import Vivid.Actions.Class
import Vivid.SCServer.Connection
import Vivid.SCServer.State
import Vivid.SCServer.Types

-- import qualified Data.ByteString.UTF8 as UTF8 (fromString)
import Data.Int (Int32)
-- BBP hack:
import Prelude


-- | Your \"emergency\" button. Run this and everything playing on the SC server
--   will be freed -- silence!
-- 
--   Corresponds to the cmd-. \/ ctrl-.  key command in the SuperCollider IDE
cmdPeriod :: (VividAction m) => m ()
cmdPeriod :: m ()
cmdPeriod = do
   OSC -> m ()
forall (m :: * -> *). VividAction m => OSC -> m ()
callOSC (OSC -> m ()) -> OSC -> m ()
forall a b. (a -> b) -> a -> b
$ [NodeId] -> OSC
SCCmd.g_freeAll [Int32 -> NodeId
NodeId Int32
1] -- 1 instead of 0 is temp! (is it? 1 is default group...)
   OSC -> m ()
forall (m :: * -> *). VividAction m => OSC -> m ()
callOSC (OSC -> m ()) -> OSC -> m ()
forall a b. (a -> b) -> a -> b
$ OSC
SCCmd.clearSched
   m ()
forall (m :: * -> *). VividAction m => m ()
initTree
   
-- | Alias of 'cmdPeriod'
freeAll :: VividAction m => m ()
freeAll :: m ()
freeAll = m ()
forall (m :: * -> *). VividAction m => m ()
cmdPeriod

initTree :: (VividAction m) => m ()
initTree :: m ()
initTree = OSC -> m ()
forall (m :: * -> *). VividAction m => OSC -> m ()
callOSC OSC
initTreeCommand

-- | Make an empty buffer
-- 
--   The Int32 is the buffer length /in samples/. Multiply seconds by
--   the default sample rate of the server (usually 48000) to get the number
--   of samples
-- 
--   Note that this is synchronous -- it doesn't return until the buffer is allocated
--   (in theory, this could hang if e.g. the UDP packet is lost)
newBuffer :: VividAction m => Int32 -> m BufferId
newBuffer :: Int32 -> m BufferId
newBuffer Int32
bufferLength = do
   BufferId
bufId <- m BufferId
forall (m :: * -> *). VividAction m => m BufferId
newBufferId
   (SyncId -> m ()) -> m ()
forall (m :: * -> *). VividAction m => (SyncId -> m ()) -> m ()
oscWSync ((SyncId -> m ()) -> m ()) -> (SyncId -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \SyncId
syncId ->
      OSC -> m ()
forall (m :: * -> *). VividAction m => OSC -> m ()
callOSC (OSC -> m ()) -> OSC -> m ()
forall a b. (a -> b) -> a -> b
$
         BufferId -> Int32 -> Int32 -> Maybe OSC -> OSC
SCCmd.b_alloc BufferId
bufId Int32
bufferLength Int32
1 (OSC -> Maybe OSC
forall a. a -> Maybe a
Just (OSC -> Maybe OSC) -> OSC -> Maybe OSC
forall a b. (a -> b) -> a -> b
$ SyncId -> OSC
SCCmd.sync SyncId
syncId)
   BufferId -> m BufferId
forall (m :: * -> *) a. Monad m => a -> m a
return BufferId
bufId

-- | Make a buffer and fill it with sound data from a file
-- 
--   The file path should be absolute (not relative), and if you're connecting
--   to a non-localhost server don't expect it to be able to read files from
--   your local hard drive!
-- 
--   Note that like 'makeBuffer' this is synchronous
newBufferFromFile :: (VividAction m) => FilePath -> m BufferId
newBufferFromFile :: FilePath -> m BufferId
newBufferFromFile = Int32 -> Maybe Int32 -> FilePath -> m BufferId
forall (m :: * -> *).
VividAction m =>
Int32 -> Maybe Int32 -> FilePath -> m BufferId
newBufferFromFileBetween Int32
0 Maybe Int32
forall a. Maybe a
Nothing

newBufferFromFileBetween :: VividAction m => Int32 -> Maybe Int32 -> FilePath -> m BufferId
newBufferFromFileBetween :: Int32 -> Maybe Int32 -> FilePath -> m BufferId
newBufferFromFileBetween Int32
startTime Maybe Int32
endTimeMay FilePath
fPath = do
   BufferId
bufId <- m BufferId
forall (m :: * -> *). VividAction m => m BufferId
newBufferId
   (SyncId -> m ()) -> m ()
forall (m :: * -> *). VividAction m => (SyncId -> m ()) -> m ()
oscWSync ((SyncId -> m ()) -> m ()) -> (SyncId -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \SyncId
syncId -> OSC -> m ()
forall (m :: * -> *). VividAction m => OSC -> m ()
callOSC (OSC -> m ()) -> OSC -> m ()
forall a b. (a -> b) -> a -> b
$
      BufferId -> FilePath -> Int32 -> Maybe Int32 -> Maybe OSC -> OSC
SCCmd.b_allocRead BufferId
bufId FilePath
fPath Int32
startTime Maybe Int32
endTimeMay (OSC -> Maybe OSC
forall a. a -> Maybe a
Just (OSC -> Maybe OSC) -> OSC -> Maybe OSC
forall a b. (a -> b) -> a -> b
$ SyncId -> OSC
SCCmd.sync SyncId
syncId)
   BufferId -> m BufferId
forall (m :: * -> *) a. Monad m => a -> m a
return BufferId
bufId

makeBufferFromFile :: (VividAction m) => FilePath -> m BufferId
makeBufferFromFile :: FilePath -> m BufferId
makeBufferFromFile = FilePath -> m BufferId
forall (m :: * -> *). VividAction m => FilePath -> m BufferId
newBufferFromFile

makeBuffer :: (VividAction m) => Int32 -> m BufferId
makeBuffer :: Int32 -> m BufferId
makeBuffer = Int32 -> m BufferId
forall (m :: * -> *). VividAction m => Int32 -> m BufferId
newBuffer

-- | Write a buffer to a file
-- 
--   Alias of 'writeBuffer'
-- 
--   Synchronous.
saveBuffer :: (VividAction m) => BufferId -> FilePath -> m ()
saveBuffer :: BufferId -> FilePath -> m ()
saveBuffer = BufferId -> FilePath -> m ()
forall (m :: * -> *). VividAction m => BufferId -> FilePath -> m ()
writeBuffer

writeBuffer :: VividAction m => BufferId -> FilePath -> m ()
writeBuffer :: BufferId -> FilePath -> m ()
writeBuffer = WriteBufArgs -> BufferId -> FilePath -> m ()
forall (m :: * -> *).
VividAction m =>
WriteBufArgs -> BufferId -> FilePath -> m ()
writeBufferWith WriteBufArgs
defaultWBArgs

writeBufferWith :: VividAction m => WriteBufArgs -> BufferId -> FilePath -> m ()
writeBufferWith :: WriteBufArgs -> BufferId -> FilePath -> m ()
writeBufferWith WriteBufArgs
args BufferId
bufId FilePath
fPath =
   (SyncId -> m ()) -> m ()
forall (m :: * -> *). VividAction m => (SyncId -> m ()) -> m ()
oscWSync ((SyncId -> m ()) -> m ()) -> (SyncId -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \SyncId
syncId -> OSC -> m ()
forall (m :: * -> *). VividAction m => OSC -> m ()
callOSC (OSC -> m ()) -> OSC -> m ()
forall a b. (a -> b) -> a -> b
$
      BufferId
-> FilePath
-> FilePath
-> FilePath
-> Maybe Int32
-> Int32
-> Bool
-> Maybe OSC
-> OSC
SCCmd.b_write
         BufferId
bufId
         FilePath
fPath
         FilePath
"wav" -- TODO!
         FilePath
"float" -- less important, but TODO
         -- Num frames:
         Maybe Int32
forall a. Maybe a
Nothing
         -- Start frame:
         Int32
0
         -- Whether to leave the file open (useful for diskOut):
         (WriteBufArgs -> Bool
_wb_keepOpen WriteBufArgs
args)
         -- We make this synchronous because what if you send a
         -- "/b_write" then a "/quit"?(!):
         (OSC -> Maybe OSC
forall a. a -> Maybe a
Just (OSC -> Maybe OSC) -> OSC -> Maybe OSC
forall a b. (a -> b) -> a -> b
$ SyncId -> OSC
SCCmd.sync SyncId
syncId)

-- | We may add arguments in the future ; to future-proof your code, just update
--   fields of 'defaultWBArgs'
data WriteBufArgs
   = WriteBufArgs {
    WriteBufArgs -> Bool
_wb_keepOpen :: Bool
   }
 deriving (Int -> WriteBufArgs -> ShowS
[WriteBufArgs] -> ShowS
WriteBufArgs -> FilePath
(Int -> WriteBufArgs -> ShowS)
-> (WriteBufArgs -> FilePath)
-> ([WriteBufArgs] -> ShowS)
-> Show WriteBufArgs
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [WriteBufArgs] -> ShowS
$cshowList :: [WriteBufArgs] -> ShowS
show :: WriteBufArgs -> FilePath
$cshow :: WriteBufArgs -> FilePath
showsPrec :: Int -> WriteBufArgs -> ShowS
$cshowsPrec :: Int -> WriteBufArgs -> ShowS
Show, ReadPrec [WriteBufArgs]
ReadPrec WriteBufArgs
Int -> ReadS WriteBufArgs
ReadS [WriteBufArgs]
(Int -> ReadS WriteBufArgs)
-> ReadS [WriteBufArgs]
-> ReadPrec WriteBufArgs
-> ReadPrec [WriteBufArgs]
-> Read WriteBufArgs
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WriteBufArgs]
$creadListPrec :: ReadPrec [WriteBufArgs]
readPrec :: ReadPrec WriteBufArgs
$creadPrec :: ReadPrec WriteBufArgs
readList :: ReadS [WriteBufArgs]
$creadList :: ReadS [WriteBufArgs]
readsPrec :: Int -> ReadS WriteBufArgs
$creadsPrec :: Int -> ReadS WriteBufArgs
Read, WriteBufArgs -> WriteBufArgs -> Bool
(WriteBufArgs -> WriteBufArgs -> Bool)
-> (WriteBufArgs -> WriteBufArgs -> Bool) -> Eq WriteBufArgs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WriteBufArgs -> WriteBufArgs -> Bool
$c/= :: WriteBufArgs -> WriteBufArgs -> Bool
== :: WriteBufArgs -> WriteBufArgs -> Bool
$c== :: WriteBufArgs -> WriteBufArgs -> Bool
Eq, Eq WriteBufArgs
Eq WriteBufArgs
-> (WriteBufArgs -> WriteBufArgs -> Ordering)
-> (WriteBufArgs -> WriteBufArgs -> Bool)
-> (WriteBufArgs -> WriteBufArgs -> Bool)
-> (WriteBufArgs -> WriteBufArgs -> Bool)
-> (WriteBufArgs -> WriteBufArgs -> Bool)
-> (WriteBufArgs -> WriteBufArgs -> WriteBufArgs)
-> (WriteBufArgs -> WriteBufArgs -> WriteBufArgs)
-> Ord WriteBufArgs
WriteBufArgs -> WriteBufArgs -> Bool
WriteBufArgs -> WriteBufArgs -> Ordering
WriteBufArgs -> WriteBufArgs -> WriteBufArgs
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WriteBufArgs -> WriteBufArgs -> WriteBufArgs
$cmin :: WriteBufArgs -> WriteBufArgs -> WriteBufArgs
max :: WriteBufArgs -> WriteBufArgs -> WriteBufArgs
$cmax :: WriteBufArgs -> WriteBufArgs -> WriteBufArgs
>= :: WriteBufArgs -> WriteBufArgs -> Bool
$c>= :: WriteBufArgs -> WriteBufArgs -> Bool
> :: WriteBufArgs -> WriteBufArgs -> Bool
$c> :: WriteBufArgs -> WriteBufArgs -> Bool
<= :: WriteBufArgs -> WriteBufArgs -> Bool
$c<= :: WriteBufArgs -> WriteBufArgs -> Bool
< :: WriteBufArgs -> WriteBufArgs -> Bool
$c< :: WriteBufArgs -> WriteBufArgs -> Bool
compare :: WriteBufArgs -> WriteBufArgs -> Ordering
$ccompare :: WriteBufArgs -> WriteBufArgs -> Ordering
$cp1Ord :: Eq WriteBufArgs
Ord)

defaultWBArgs :: WriteBufArgs
defaultWBArgs :: WriteBufArgs
defaultWBArgs = WriteBufArgs :: Bool -> WriteBufArgs
WriteBufArgs {
     _wb_keepOpen :: Bool
_wb_keepOpen = Bool
False
   }

-- | Close an open soundfile and write header information
-- 
--   Synchronous
closeBuffer :: VividAction m => BufferId -> m ()
closeBuffer :: BufferId -> m ()
closeBuffer BufferId
bufId = (SyncId -> m ()) -> m ()
forall (m :: * -> *). VividAction m => (SyncId -> m ()) -> m ()
oscWSync ((SyncId -> m ()) -> m ()) -> (SyncId -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \SyncId
syncId ->
   OSC -> m ()
forall (m :: * -> *). VividAction m => OSC -> m ()
callOSC (OSC -> m ()) -> OSC -> m ()
forall a b. (a -> b) -> a -> b
$ BufferId -> Maybe OSC -> OSC
SCCmd.b_close BufferId
bufId (OSC -> Maybe OSC
forall a. a -> Maybe a
Just (OSC -> Maybe OSC) -> OSC -> Maybe OSC
forall a b. (a -> b) -> a -> b
$ SyncId -> OSC
SCCmd.sync SyncId
syncId)

closeBuf :: VividAction m => BufferId -> m ()
closeBuf :: BufferId -> m ()
closeBuf = BufferId -> m ()
forall (m :: * -> *). VividAction m => BufferId -> m ()
closeBuffer

-- | Zero the sample data in a buffer
-- 
--   Synchronous
zeroBuf :: VividAction m => BufferId -> m ()
zeroBuf :: BufferId -> m ()
zeroBuf BufferId
bufId = (SyncId -> m ()) -> m ()
forall (m :: * -> *). VividAction m => (SyncId -> m ()) -> m ()
oscWSync ((SyncId -> m ()) -> m ()) -> (SyncId -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \SyncId
syncId ->
   OSC -> m ()
forall (m :: * -> *). VividAction m => OSC -> m ()
callOSC (OSC -> m ()) -> OSC -> m ()
forall a b. (a -> b) -> a -> b
$ BufferId -> Maybe OSC -> OSC
SCCmd.b_zero BufferId
bufId (OSC -> Maybe OSC
forall a. a -> Maybe a
Just (OSC -> Maybe OSC) -> OSC -> Maybe OSC
forall a b. (a -> b) -> a -> b
$ SyncId -> OSC
SCCmd.sync SyncId
syncId)

-- More info is available in HelpSource/Reference/default_group.schelp
defaultGroup :: Group ; defaultGroup :: Group
defaultGroup = NodeId -> Group
Group (Int32 -> NodeId
NodeId Int32
1)