PlayEasy.hs

module Sound.SC3.Server.PlayEasy (
    play, stop, reset, audition,
    withSC3, withSC3UDP, withSC3TCP, withSC3File,
    NodeId, noId, autoId, lastId, rootId, homeId,
    set, setMulti, setId,
    playIdCustomOut, playId, stopId,
    sync, d_recv_synthdef,
    simpleSync, mceDegree,
   ) where

import Sound.SC3.UGen.IO (out)
import Sound.SC3.UGen.UGen (UGen(..))
import Sound.SC3.Server.Synthdef (synthdef, )
import Sound.SC3.Server.Command
         (AddAction(AddToTail), s_new, d_recv, g_new, g_freeAll,
          n_set, n_free)
import Sound.OpenSoundControl (OSC(Message))
import Sound.OpenSoundControl.Transport.TCP (TCP)
import Sound.OpenSoundControl.Transport.UDP (UDP)
import Sound.OpenSoundControl.Transport.Monad (send, wait, )

import qualified Sound.OpenSoundControl.Transport.TCP   as TCP
import qualified Sound.OpenSoundControl.Transport.UDP   as UDP
import qualified Sound.OpenSoundControl.Transport.File  as File
import qualified Sound.OpenSoundControl.Transport.Monad as Trans
import qualified Sound.OpenSoundControl.Transport.Monad.IO as TIO



type NodeId = Int

-- | Construct an instrument definition, send /d_recv and /s_new messages to scsynth.
play :: Trans.C m => UGen -> m OSC
play u =
   do r <- sync (d_recv_synthdef "Anonymous" (addOut u))
      send (s_new "Anonymous" autoId AddToTail homeId [])
      return r

-- | Free all nodes at the group with node id 'homeId'.
stop :: Trans.C m => m ()
stop = send (g_freeAll [homeId])

-- | Free all nodes and re-create group node with id 'homeId'.
reset :: Trans.C m => m ()
reset = send (g_freeAll [rootId]) >> init_

-- | Bracket SC3 communication.
withSC3 :: TIO.T UDP a -> IO a
withSC3 = withSC3UDP

-- | Bracket SC3 communication via UDP.
withSC3UDP :: TIO.T UDP a -> IO a
withSC3UDP = TIO.with (UDP.openUDP "127.0.0.1" 57110)

-- | Bracket SC3 communication via TCP.
withSC3TCP :: TIO.T TCP a -> IO a
withSC3TCP = TIO.with (TCP.openTCP "127.0.0.1" 57110)

-- | Write SC3 communication to a command file.
withSC3File :: FilePath -> TIO.T File.T a -> IO a
withSC3File fn = TIO.with (File.open (Message "/done" []) fn)

-- | withSC3 . play
audition :: UGen -> IO OSC
audition = withSC3 . play


{- * Lemming's extensions -}

{- ** Special identifiers -}

{-# DEPRECATED noId "use autoId instead" #-}
noId :: NodeId
noId = -1

-- for new: choose an arbitrary id
autoId :: NodeId
autoId = -1

-- for set: the last created node
lastId :: NodeId
lastId = -1

rootId :: NodeId
rootId = 0

homeId :: NodeId
homeId = 1


{- ** Functions for custom node identifiers -}

sync :: Trans.C m => OSC -> m OSC
sync o = send o >> wait "/done"
-- sync o = send o >> recv

simpleSync :: Trans.C m => OSC -> m ()
simpleSync o = sync o >> return ()

init_ :: Trans.C m => m ()
init_ = send (g_new [(homeId, AddToTail, rootId)])

playIdCustomOut :: Trans.C m => NodeId -> UGen -> m OSC
playIdCustomOut sid u =
   do r <- sync (d_recv_synthdef "Anonymous" u)
      send (s_new "Anonymous" sid AddToTail homeId [])
      return r

set :: Trans.C m => String -> Double -> m ()
set = setId lastId

setMulti :: Trans.C m => [(String, Double)] -> m ()
setMulti = setMultiId lastId


playId :: Trans.C m => NodeId -> UGen -> m OSC
playId sid u = playIdCustomOut sid (addOut u)

stopId :: Trans.C m => NodeId -> m ()
stopId sid   = send (n_free [sid])

setId :: Trans.C m => NodeId -> String -> Double -> m ()
setId  sid name value = send (n_set sid [(name, value)])

setMultiId :: Trans.C m => NodeId -> [(String, Double)] -> m ()
setMultiId sid attrs = send (n_set sid attrs)



-- | If the UGen has output ports connect it to an 'out' UGen.
addOut :: UGen -> UGen
addOut u = if hasOutputs u then out (Constant 0) u else u

d_recv_synthdef :: String -> UGen -> OSC
d_recv_synthdef n = d_recv . synthdef n

-- | True if the 'UGen' has output ports (ie. is not a sink UGen).
hasOutputs :: UGen -> Bool
hasOutputs (Primitive _ _ _ o _ _) = not (null o)
hasOutputs (MCE l)            = any hasOutputs l
hasOutputs (MRG l r)          = hasOutputs l || hasOutputs r
hasOutputs (Proxy _ _)        = True
hasOutputs _                  = False

-- | Returns 1 for mono signals.
mceDegree :: UGen -> Int
mceDegree (Primitive _ _ _ _ _ _) = 1
mceDegree (MCE l) = length l
mceDegree _       = error "mceDegree: illegal ugen"