diff --git a/Sound/SC3/Server/Allocator.hs b/Sound/SC3/Server/Allocator.hs --- a/Sound/SC3/Server/Allocator.hs +++ b/Sound/SC3/Server/Allocator.hs @@ -74,7 +74,13 @@ -- -- Returns the list of IDs and the modified allocator. allocMany :: (IdAllocator a, Failure AllocFailure m) => Int -> a -> m ([Id a], a) -allocMany n a = go n a [] +allocMany n a + | n <= 0 = return ([], a) + | n > numAvailable (statistics a) = + error $ "allocMany: Requesting " + ++ show n ++ " ids but only " + ++ show (numAvailable (statistics a)) ++ " available" + | otherwise = go n a [] where go 0 a is = return (is, a) go !n !a is = do diff --git a/Sound/SC3/Server/Allocator/SetAllocator.hs b/Sound/SC3/Server/Allocator/SetAllocator.hs --- a/Sound/SC3/Server/Allocator/SetAllocator.hs +++ b/Sound/SC3/Server/Allocator/SetAllocator.hs @@ -15,16 +15,16 @@ data SetAllocator i = SetAllocator {-# UNPACK #-} !(Range i) - {-# UNPACK #-} !(Set.BitSet i) + !(Set.BitSet i) !i deriving (Eq, Show) -cons :: Range i -> SetAllocator i +cons :: Integral i => Range i -> SetAllocator i cons r = SetAllocator r Set.empty (Range.begin r) -- | Convert an id to a bit index. -- --- This is necessary to keep the BitSet size bounded between [0, numIds[. +-- This is necessary to keep the BitSet size bounded between [0, numIds). toBit :: Integral i => Range i -> i -> i toBit r i = i - Range.begin r diff --git a/Sound/SC3/Server/Notification.hs b/Sound/SC3/Server/Notification.hs --- a/Sound/SC3/Server/Notification.hs +++ b/Sound/SC3/Server/Notification.hs @@ -19,9 +19,12 @@ ) where import Control.Applicative (pure, (<*>)) +import qualified Data.ByteString.Char8 as C +import Data.Int +import Data.List import qualified Data.List.Zipper as Zipper import Sound.SC3.Server.State (BufferId, NodeId, SyncId) -import Sound.OpenSoundControl (Datum(..), Message(..)) +import Sound.OSC.Type import Sound.OSC.Transport.Monad (RecvOSC(..), SendOSC(..), recvMessage) -- | A notification transformer, extracting a value from a matching OSC message. @@ -77,12 +80,12 @@ Just a -> Just (a, Zipper.toList (Zipper.delete z)) data Status = Status { - numUGens :: Int - , numSynths :: Int - , numGroups :: Int - , numSynthDefs :: Int - , avgCPU :: Double - , peakCPU :: Double + numUGens :: Int32 + , numSynths :: Int32 + , numGroups :: Int32 + , numSynthDefs :: Int32 + , avgCPU :: Float + , peakCPU :: Float , nominalSampleRate :: Double , actualSampleRate :: Double } deriving (Eq, Show) @@ -90,23 +93,23 @@ 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 (Message "/status.reply" [Int32 _, Int32 u, Int32 s, Int32 g, Int32 d, Float a, Float p, Double sr, Double sr']) + = Just $ Status u s g d (realToFrac a) (realToFrac p) sr sr' f _ = Nothing -tr :: NodeId -> Maybe Int -> Notification Double +tr :: NodeId -> Maybe Int32 -> Notification Float tr n = Notification . f where - f (Just i) (Message "/tr" [Int n', Int i', Float r]) + f (Just i) (Message "/tr" [Int32 n', Int32 i', Float r]) | fromIntegral n == n' && i == i' = Just r - f Nothing (Message "/tr" [Int n', Int _, Float r]) + f Nothing (Message "/tr" [Int32 n', Int32 _, 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 (Message "/synced" [Int32 j]) | fromIntegral j == i = Just i f _ = Nothing normalize :: String -> String @@ -116,7 +119,7 @@ done :: String -> Notification [Datum] done c = Notification f where - f (Message "/done" (String s:xs)) | normalize c == normalize s = Just xs + f (Message "/done" (ASCII_String s : xs)) | normalize c == normalize (C.unpack s) = Just xs f _ = Nothing data NodeNotification = @@ -155,16 +158,16 @@ nodeIdToMaybe i = Just (fromIntegral i) f osc = case osc of - Message s' (Int nid':xs) -> + Message s' (Int32 nid':xs) -> if s == s' && fromIntegral nid == nid' then case xs of - (Int g:Int p:Int n:Int b:rest) -> + (Int32 g:Int32 p:Int32 n:Int32 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) + [Int32 h, Int32 t] -> Just $ GroupNotification nid group prev next (nodeIdToMaybe h) (nodeIdToMaybe t) _ -> Nothing _ -> Just $ SynthNotification nid group prev next _ -> Nothing @@ -192,7 +195,7 @@ n_notification_ :: String -> NodeId -> Notification () n_notification_ s nid = Notification f where - f (Message s' (Int nid':_)) + f (Message s' (Int32 nid':_)) | s == s' && fromIntegral nid == nid' = Just () f _ = Nothing @@ -208,39 +211,39 @@ n_on_ :: NodeId -> Notification () n_on_ = n_notification_ "/n_on" -n_set :: NodeId -> Notification [(Either Int String, Double)] +n_set :: NodeId -> Notification [(Either Int32 String, Float)] n_set nid = Notification f where - f (Message "/n_set" (Int nid':cs)) + f (Message "/n_set" (Int32 nid':cs)) | nid == fromIntegral nid' = mapM ctrl (pairs cs) f _ = Nothing pairs (a:a':as) = (a, a') : pairs as pairs _ = [] - ctrl (Int k, Float v) = Just (Left k, v) - ctrl (String k, Float v) = Just (Right k, v) + ctrl (Int32 k, Float v) = Just (Left k, v) + ctrl (ASCII_String k, Float v) = Just (Right (C.unpack k), v) ctrl _ = Nothing -n_setn :: NodeId -> Notification [(Either Int String, [Double])] +n_setn :: NodeId -> Notification [(Either Int32 String, [Float])] n_setn nid = Notification f where - f (Message "/n_setn" (Int nid':cs)) + f (Message "/n_setn" (Int32 nid':cs)) | nid == fromIntegral nid' = sequence (conv cs) f _ = Nothing - value (Float v) = Just v + value (Float v) = Just (realToFrac v) value _ = Nothing - conv (Int k:Int n:xs) = (pure (,) <*> pure (Left k) <*> mapM value (take n xs)) : conv (drop n xs) - conv (String k:Int n:xs) = (pure (,) <*> pure (Right k) <*> mapM value (take n xs)) : conv (drop n xs) + conv (Int32 k:Int32 n:xs) = (pure (,) <*> pure (Left k) <*> mapM value (genericTake n xs)) : conv (genericDrop n xs) + conv (ASCII_String k:Int32 n:xs) = (pure (,) <*> pure (Right (C.unpack k)) <*> mapM value (genericTake n xs)) : conv (genericDrop n xs) conv _ = [] data BufferInfo = BufferInfo { - numFrames :: Int - , numChannels :: Int - , sampleRate :: Double + numFrames :: Int32 + , numChannels :: Int32 + , sampleRate :: Float } 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]) + f (Message "/b_info" [Int32 bid', Int32 f, Int32 c, Float r]) | fromIntegral bid == bid' = Just $ BufferInfo f c r f _ = Nothing diff --git a/Sound/SC3/Server/State/Monad.hs b/Sound/SC3/Server/State/Monad.hs --- a/Sound/SC3/Server/State/Monad.hs +++ b/Sound/SC3/Server/State/Monad.hs @@ -45,10 +45,10 @@ import Control.Monad.Trans.Control (MonadBaseControl(..)) import Control.Monad.Trans.Reader (ReaderT(..)) import qualified Control.Monad.Trans.Reader as R -import Sound.OpenSoundControl (Bundle(..), Datum(Int), Message(..), Packet(..), immediately) +import Sound.OSC (Bundle(..), Datum(Int32), Message(..), Packet(..), immediately) import Sound.OSC.Transport.Monad (DuplexOSC, RecvOSC(..), SendOSC(..), Transport) import qualified Sound.SC3.Server.Allocator as A -import Sound.SC3.Server.Command (notify) +import Sound.SC3.Server.Command.Core (notify) import Sound.SC3.Server.Connection (Connection) import qualified Sound.SC3.Server.Connection as C import qualified Sound.SC3.Server.Notification as N @@ -176,7 +176,7 @@ case p of Packet_Message m -> Packet_Bundle (Bundle immediately [m, s]) Packet_Bundle (Bundle t xs) -> Packet_Bundle (Bundle t (xs ++ [s])) - where s = Message "/sync" [Int (fromIntegral i)] + where s = Message "/sync" [Int32 (fromIntegral i)] -- | Send an OSC packet and wait for the synchronization barrier. sync :: Packet -> Server () diff --git a/Sound/SC3/Server/State/Monad/Class.hs b/Sound/SC3/Server/State/Monad/Class.hs --- a/Sound/SC3/Server/State/Monad/Class.hs +++ b/Sound/SC3/Server/State/Monad/Class.hs @@ -8,7 +8,7 @@ ) where import Control.Monad (liftM) -import Sound.OpenSoundControl (OSC) +import Sound.OSC (OSC) import Sound.OSC.Transport.Monad (SendOSC) import Sound.SC3.Server.Allocator (Id, IdAllocator, RangeAllocator, Statistics) import Sound.SC3.Server.Allocator.Range (Range) diff --git a/Sound/SC3/Server/State/Monad/Command.hs b/Sound/SC3/Server/State/Monad/Command.hs --- a/Sound/SC3/Server/State/Monad/Command.hs +++ b/Sound/SC3/Server/State/Monad/Command.hs @@ -121,15 +121,18 @@ import Control.Failure (Failure, failure) import Control.Monad (liftM, unless) import Control.Monad.IO.Class (MonadIO) -import Sound.OpenSoundControl (Datum(..), OSC(..)) +import Data.Int +import Sound.OSC (Datum(..), OSC(..)) import Sound.SC3 (Rate(..), UGen) import Sound.SC3.Server.Allocator.Range (Range) import qualified Sound.SC3.Server.Allocator.Range as Range -import qualified Sound.SC3.Server.Command.Completion as C import qualified Sound.SC3.Server.Synthdef as Synthdef import Sound.SC3.Server.Allocator (AllocFailure(..)) -import Sound.SC3.Server.Command (AddAction(..), ErrorScope(..), ErrorMode(..), PrintLevel(..)) -import qualified Sound.SC3.Server.Command as C +import Sound.SC3.Server.Enum (AddAction(..), ErrorScope(..), ErrorMode(..), PrintLevel(..)) +import qualified Sound.SC3.Server.Command.Core as C +import qualified Sound.SC3.Server.Command.Completion as C +import qualified Sound.SC3.Server.Command.Double as C +import qualified Sound.SC3.Server.Command.Int as C import Sound.SC3.Server.Enum (SoundFileFormat(..), SampleFormat(..)) import qualified Sound.SC3.Server.Notification as N import Sound.SC3.Server.Process.Options (ServerOptions(..)) @@ -367,14 +370,14 @@ where nid = nodeId s -- | Get control values. -s_get :: MonadIO m => Synth -> [String] -> Request m (Result [(Either Int String, Double)]) +s_get :: MonadIO m => Synth -> [String] -> Request m (Result [(Either Int32 String, Float)]) s_get s cs = do sendOSC (C.s_get (fromIntegral nid) cs) waitFor (N.n_set nid) where nid = nodeId s -- | Get ranges of control values. -s_getn :: MonadIO m => Synth -> [(String, Int)] -> Request m (Result [(Either Int String, [Double])]) +s_getn :: MonadIO m => Synth -> [(String, Int)] -> Request m (Result [(Either Int32 String, [Float])]) s_getn s cs = do sendOSC (C.s_getn (fromIntegral nid) cs) waitFor (N.n_setn nid) diff --git a/Sound/SC3/Server/State/Monad/Request.hs b/Sound/SC3/Server/State/Monad/Request.hs --- a/Sound/SC3/Server/State/Monad/Request.hs +++ b/Sound/SC3/Server/State/Monad/Request.hs @@ -25,12 +25,12 @@ import qualified Control.Monad.Trans.State as State import Data.IORef (newIORef, readIORef, writeIORef) import Sound.OSC.Transport.Monad (SendOSC(..)) -import qualified Sound.SC3.Server.Command as C +import qualified Sound.SC3.Server.Command.Generic as C import Sound.SC3.Server.Notification (Notification) import qualified Sound.SC3.Server.Notification as N import Sound.SC3.Server.State.Monad.Class (MonadIdAllocator(..), RequestOSC, MonadServer) import qualified Sound.SC3.Server.State.Monad.Class as M -import Sound.OpenSoundControl (Bundle(..), Message(..), OSC(..), Time, immediately, packetMessages) +import Sound.OSC (Bundle(..), Message(..), OSC(..), Time, immediately, packetMessages) data Builder = BuildDone diff --git a/examples/hello.hs b/examples/hello.hs --- a/examples/hello.hs +++ b/examples/hello.hs @@ -5,7 +5,7 @@ -- You need the hsc3-server-internal package in order to use the internal server --import Sound.SC3.Server.Monad.Process.Internal (withDefaultInternal) import Sound.SC3.Server.State.Monad.Process (withDefaultSynth) -import qualified Sound.OpenSoundControl as OSC +import qualified Sound.OSC as OSC sine = out 0 $ pan2 x (sinOsc KR 1 0) 1 where x = sinOsc AR (control KR "freq" 440) 0 diff --git a/examples/sine-grains.hs b/examples/sine-grains.hs --- a/examples/sine-grains.hs +++ b/examples/sine-grains.hs @@ -7,8 +7,8 @@ -- You need the hsc3-server-internal package in order to use the internal server --import Sound.SC3.Server.Monad.Process.Internal (withDefaultInternal) import Sound.SC3.Server.State.Monad.Process (withDefaultSynth) -import Sound.OpenSoundControl (pauseThread, pauseThreadUntil) -import qualified Sound.OpenSoundControl as OSC +import Sound.OSC (pauseThread, pauseThreadUntil) +import qualified Sound.OSC as OSC import System.Posix.Signals (installHandler, keyboardSignal, Handler(Catch)) import System.Random diff --git a/hsc3-server.cabal b/hsc3-server.cabal --- a/hsc3-server.cabal +++ b/hsc3-server.cabal @@ -1,5 +1,5 @@ Name: hsc3-server -Version: 0.6.0 +Version: 0.7.0 Synopsis: SuperCollider server resource management and synchronization. Description: This library provides abstractions for managing SuperCollider server @@ -11,7 +11,7 @@ License: GPL License-File: LICENSE Category: Sound -Copyright: Copyright (c) Stefan Kersten 2008-2012 +Copyright: Copyright (c) Stefan Kersten 2008-2013 Author: Stefan Kersten Maintainer: kaoskorobase@gmail.com Homepage: https://github.com/kaoskorobase/hsc3-server @@ -44,13 +44,14 @@ Build-Depends: base >= 4.3 && < 5 , bitset >= 1.0 + , bytestring , containers >= 0.2 , data-default >= 0.5 , failure >= 0.2 , hashtables >= 1.0 - , hosc >= 0.13 - , hsc3 >= 0.13 - , hsc3-process == 0.9.* + , hosc >= 0.14 + , hsc3 >= 0.14 + , hsc3-process == 0.10.* , lifted-base >= 0.1 , ListZipper , monad-control >= 0.3 @@ -75,9 +76,9 @@ Buildable: False Build-Depends: base >= 4.3 && < 5 - , hosc >= 0.13 - , hsc3 >= 0.13 - , hsc3-server >= 0.5 + , hosc >= 0.14 + , hsc3 >= 0.14 + , hsc3-server >= 0.7 , transformers >= 0.2 Ghc-Options: -W -rtsopts -threaded @@ -93,9 +94,9 @@ Buildable: False Build-Depends: base >= 4.3 && < 5 - , hosc >= 0.13 - , hsc3 >= 0.13 - , hsc3-server >= 0.5 + , hosc >= 0.14 + , hsc3 >= 0.14 + , hsc3-server >= 0.7 , random >= 1.0 , transformers >= 0.2 , unix >= 2.5 @@ -114,7 +115,7 @@ Build-Depends: base >= 4.3 && < 5 , failure >= 0.2 - , hsc3-server >= 0.5 + , hsc3-server >= 0.7 , QuickCheck >= 2.4 , random , test-framework