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,
    send, sync, d_recv_synthdef,
    simpleSync, mceDegree,
   ) where

import Sound.SC3.UGen.Bindings.DB (out)
import Sound.SC3.UGen.Type (UGen(..), constant, Proxy(Proxy), MRG(..), Primitive(..), )
import Sound.SC3.UGen.MCE (MCE(..), )
import Sound.SC3.Server.Synthdef (synthdef, )
import Sound.SC3.Server.Enum (AddAction(AddToTail), )
import Sound.SC3.Server.Command
         (s_new, d_recv, g_new, g_freeAll, n_set, n_free, )

import qualified Sound.OSC.Type as OSC

import Sound.OSC.Class (OSC)
import Sound.OSC.Type (Packet(Packet_Message), )
import Sound.OSC.Transport.FD.TCP (TCP)
import Sound.OSC.Transport.FD.UDP (UDP)
import Sound.OSC.Transport.Monad
          (Transport, SendOSC, Connection, sendOSC, waitReply, withTransport, )

import qualified Sound.OSC.Transport.FD.TCP as TCP
import qualified Sound.OSC.Transport.FD.UDP as UDP
import qualified Sound.OSC.Transport.File as File

import Prelude hiding (init, )



type NodeId = Int

send :: (OSC a, SendOSC m) => a -> m ()
send = sendOSC

-- | Construct an instrument definition, send /d_recv and /s_new messages to scsynth.
play :: Transport m => UGen -> m OSC.Message
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 :: Transport m => m ()
stop = send (g_freeAll [homeId])

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

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

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

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

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

-- | withSC3 . play
audition :: UGen -> IO OSC.Message
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 :: (OSC a, Transport m) => a -> m OSC.Message
sync o = send o >> waitReply "/done"
-- sync o = send o >> recv

simpleSync :: (Transport m, OSC a) => a -> m ()
simpleSync o = sync o >> return ()

init :: Transport m => m ()
init = send (g_new [(homeId, AddToTail, rootId)])

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

set :: Transport m => String -> Double -> m ()
set = setId lastId

setMulti :: Transport m => [(String, Double)] -> m ()
setMulti = setMultiId lastId


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

stopId :: Transport m => NodeId -> m ()
stopId sid   = send (n_free [sid])

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

setMultiId :: Transport 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::Integer)) u else u

d_recv_synthdef :: String -> UGen -> OSC.Message
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_U (Primitive _ _ _ o _ _)) = not (null o)
hasOutputs (MCE_U (MCE_Vector l))            = any hasOutputs l
hasOutputs (MRG_U (MRG l r))          = hasOutputs l || hasOutputs r
hasOutputs (Proxy_U (Proxy _ _))        = True
hasOutputs _                  = False

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