-- | Server notification processors. module Sound.SC3.Server.Notification ( Notification(..) , hasAddress , Status(..) , status_reply , tr , synced , done , NodeNotification(nodeId, parentGroupId, previousNodeId, nextNodeId) , headNodeId, tailNodeId , n_go , n_end , n_off , n_on , n_move , n_info , n_go_, n_end_, n_off_, n_on_ , BufferInfo(..) , b_info ) where import Sound.SC3.Server.State (BufferId, NodeId, SyncId) import Sound.OpenSoundControl (OSC(..), Datum(..)) -- | A notification transformer, extracting a value from a matching OSC packet. newtype Notification a = Notification { match :: OSC -> Maybe a } instance Functor Notification where fmap f = Notification . (.) (fmap f) . match -- | Wait for an OSC message matching a specific address. -- -- Returns the matched OSC message. hasAddress :: String -> Notification OSC hasAddress a = Notification f where f m@(Message a' _) = if a == a' then Just m else Nothing f _ = Nothing data Status = Status { numUGens :: Int , numSynths :: Int , numGroups :: Int , numSynthDefs :: Int , avgCPU :: Double , peakCPU :: Double , nominalSampleRate :: Double , actualSampleRate :: Double } deriving (Eq, Show) status_reply :: Notification Status status_reply = Notification f where f (Message "/status.reply" [Int _, Int u, Int s, Int g, Int d, Float a, Float p, Double sr, Double sr']) = Just $ Status u s g d a p sr sr' f _ = Nothing tr :: NodeId -> Maybe Int -> Notification Double tr n = Notification . f where f (Just i) (Message "/tr" [Int n', Int i', Float r]) | fromIntegral n == n' && i == i' = Just r f Nothing (Message "/tr" [Int n', Int _, Float r]) | fromIntegral n == n' = Just r f _ _ = Nothing synced :: SyncId -> Notification SyncId synced i = Notification f where f (Message "/synced" [Int j]) | fromIntegral j == i = Just i f _ = Nothing normalize :: String -> String normalize ('/':s) = s normalize s = s done :: String -> Notification [Datum] done c = Notification f where f (Message "/done" (String s:xs)) | normalize c == normalize s = Just xs f _ = Nothing data NodeNotification = SynthNotification { nodeId :: NodeId , parentGroupId :: NodeId , previousNodeId :: Maybe NodeId , nextNodeId :: Maybe NodeId } | GroupNotification { nodeId :: NodeId , parentGroupId :: NodeId , previousNodeId :: Maybe NodeId , nextNodeId :: Maybe NodeId , _headNodeId :: Maybe NodeId , _tailNodeId :: Maybe NodeId } deriving (Eq, Show) isSynthNotification :: NodeNotification -> Bool isSynthNotification (SynthNotification _ _ _ _) = True isSynthNotification _ = False headNodeId :: NodeNotification -> Maybe NodeId headNodeId n | isSynthNotification n = Nothing | otherwise = _headNodeId n tailNodeId :: NodeNotification -> Maybe NodeId tailNodeId n | isSynthNotification n = Nothing | otherwise = _tailNodeId n n_notification :: String -> NodeId -> Notification NodeNotification n_notification s nid = Notification f where nodeIdToMaybe (-1) = Nothing nodeIdToMaybe i = Just (fromIntegral i) f osc = case osc of (Message s' (Int nid':xs)) -> if s == s' && fromIntegral nid == nid' then case xs of (Int g:Int p:Int n:Int b:rest) -> let group = fromIntegral g prev = nodeIdToMaybe p next = nodeIdToMaybe n in case b of 1 -> case rest of [Int h, Int t] -> Just $ GroupNotification nid group prev next (nodeIdToMaybe h) (nodeIdToMaybe t) _ -> Nothing _ -> Just $ SynthNotification nid group prev next _ -> Nothing else Nothing _ -> Nothing n_go :: NodeId -> Notification NodeNotification n_go = n_notification "/n_go" n_end :: NodeId -> Notification NodeNotification n_end = n_notification "/n_end" n_off :: NodeId -> Notification NodeNotification n_off = n_notification "/n_off" n_on :: NodeId -> Notification NodeNotification n_on = n_notification "/n_on" n_move :: NodeId -> Notification NodeNotification n_move = n_notification "/n_move" n_info :: NodeId -> Notification NodeNotification n_info = n_notification "/n_info" n_notification_ :: String -> NodeId -> Notification () n_notification_ s nid = Notification f where f (Message s' (Int nid':_)) | s == s' && fromIntegral nid == nid' = Just () f _ = Nothing n_go_ :: NodeId -> Notification () n_go_ = n_notification_ "/n_go" n_end_ :: NodeId -> Notification () n_end_ = n_notification_ "/n_end" n_off_ :: NodeId -> Notification () n_off_ = n_notification_ "/n_off" n_on_ :: NodeId -> Notification () n_on_ = n_notification_ "/n_on" data BufferInfo = BufferInfo { numFrames :: Int , numChannels :: Int , sampleRate :: Double } deriving (Eq, Show) b_info :: BufferId -> Notification BufferInfo b_info bid = Notification f where f (Message "/b_info" [Int bid', Int f, Int c, Float r]) | fromIntegral bid == bid' = Just $ BufferInfo f c r f _ = Nothing