hsc3-server (empty) → 0.0.0
raw patch · 14 files changed
+1125/−0 lines, 14 filesdep +basedep +bitsetdep +data-accessorsetup-changed
Dependencies added: base, bitset, data-accessor, deepseq, failure, hosc, hsc3, hsc3-process, mtl, strict-concurrency, transformers
Files
- LICENSE +339/−0
- Setup.hs +4/−0
- Sound/SC3/Server/Allocator.hs +43/−0
- Sound/SC3/Server/Allocator/Range.hs +65/−0
- Sound/SC3/Server/Allocator/SetAllocator.hs +54/−0
- Sound/SC3/Server/Allocator/SimpleAllocator.hs +28/−0
- Sound/SC3/Server/Connection.hs +120/−0
- Sound/SC3/Server/Monad.hs +114/−0
- Sound/SC3/Server/Notification.hs +78/−0
- Sound/SC3/Server/Process/Monad.hs +31/−0
- Sound/SC3/Server/State.hs +137/−0
- Sound/SC3/Server/State/Concurrent.hs +53/−0
- hsc3-server.cabal +51/−0
- include/Accessor.h +8/−0
+ LICENSE view
@@ -0,0 +1,339 @@+ GNU GENERAL PUBLIC LICENSE+ Version 2, June 1991++ Copyright (C) 1989, 1991 Free Software Foundation, Inc.,+ 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++ Preamble++ The licenses for most software are designed to take away your+freedom to share and change it. By contrast, the GNU General Public+License is intended to guarantee your freedom to share and change free+software--to make sure the software is free for all its users. This+General Public License applies to most of the Free Software+Foundation's software and to any other program whose authors commit to+using it. (Some other Free Software Foundation software is covered by+the GNU Lesser General Public License instead.) You can apply it to+your programs, too.++ When we speak of free software, we are referring to freedom, not+price. Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+this service if you wish), that you receive source code or can get it+if you want it, that you can change the software or use pieces of it+in new free programs; and that you know you can do these things.++ To protect your rights, we need to make restrictions that forbid+anyone to deny you these rights or to ask you to surrender the rights.+These restrictions translate to certain responsibilities for you if you+distribute copies of the software, or if you modify it.++ For example, if you distribute copies of such a program, whether+gratis or for a fee, you must give the recipients all the rights that+you have. You must make sure that they, too, receive or can get the+source code. And you must show them these terms so they know their+rights.++ We protect your rights with two steps: (1) copyright the software, and+(2) offer you this license which gives you legal permission to copy,+distribute and/or modify the software.++ Also, for each author's protection and ours, we want to make certain+that everyone understands that there is no warranty for this free+software. If the software is modified by someone else and passed on, we+want its recipients to know that what they have is not the original, so+that any problems introduced by others will not reflect on the original+authors' reputations.++ Finally, any free program is threatened constantly by software+patents. We wish to avoid the danger that redistributors of a free+program will individually obtain patent licenses, in effect making the+program proprietary. To prevent this, we have made it clear that any+patent must be licensed for everyone's free use or not licensed at all.++ The precise terms and conditions for copying, distribution and+modification follow.++ GNU GENERAL PUBLIC LICENSE+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION++ 0. This License applies to any program or other work which contains+a notice placed by the copyright holder saying it may be distributed+under the terms of this General Public License. The "Program", below,+refers to any such program or work, and a "work based on the Program"+means either the Program or any derivative work under copyright law:+that is to say, a work containing the Program or a portion of it,+either verbatim or with modifications and/or translated into another+language. (Hereinafter, translation is included without limitation in+the term "modification".) Each licensee is addressed as "you".++Activities other than copying, distribution and modification are not+covered by this License; they are outside its scope. The act of+running the Program is not restricted, and the output from the Program+is covered only if its contents constitute a work based on the+Program (independent of having been made by running the Program).+Whether that is true depends on what the Program does.++ 1. You may copy and distribute verbatim copies of the Program's+source code as you receive it, in any medium, provided that you+conspicuously and appropriately publish on each copy an appropriate+copyright notice and disclaimer of warranty; keep intact all the+notices that refer to this License and to the absence of any warranty;+and give any other recipients of the Program a copy of this License+along with the Program.++You may charge a fee for the physical act of transferring a copy, and+you may at your option offer warranty protection in exchange for a fee.++ 2. You may modify your copy or copies of the Program or any portion+of it, thus forming a work based on the Program, and copy and+distribute such modifications or work under the terms of Section 1+above, provided that you also meet all of these conditions:++ a) You must cause the modified files to carry prominent notices+ stating that you changed the files and the date of any change.++ b) You must cause any work that you distribute or publish, that in+ whole or in part contains or is derived from the Program or any+ part thereof, to be licensed as a whole at no charge to all third+ parties under the terms of this License.++ c) If the modified program normally reads commands interactively+ when run, you must cause it, when started running for such+ interactive use in the most ordinary way, to print or display an+ announcement including an appropriate copyright notice and a+ notice that there is no warranty (or else, saying that you provide+ a warranty) and that users may redistribute the program under+ these conditions, and telling the user how to view a copy of this+ License. (Exception: if the Program itself is interactive but+ does not normally print such an announcement, your work based on+ the Program is not required to print an announcement.)++These requirements apply to the modified work as a whole. If+identifiable sections of that work are not derived from the Program,+and can be reasonably considered independent and separate works in+themselves, then this License, and its terms, do not apply to those+sections when you distribute them as separate works. But when you+distribute the same sections as part of a whole which is a work based+on the Program, the distribution of the whole must be on the terms of+this License, whose permissions for other licensees extend to the+entire whole, and thus to each and every part regardless of who wrote it.++Thus, it is not the intent of this section to claim rights or contest+your rights to work written entirely by you; rather, the intent is to+exercise the right to control the distribution of derivative or+collective works based on the Program.++In addition, mere aggregation of another work not based on the Program+with the Program (or with a work based on the Program) on a volume of+a storage or distribution medium does not bring the other work under+the scope of this License.++ 3. You may copy and distribute the Program (or a work based on it,+under Section 2) in object code or executable form under the terms of+Sections 1 and 2 above provided that you also do one of the following:++ a) Accompany it with the complete corresponding machine-readable+ source code, which must be distributed under the terms of Sections+ 1 and 2 above on a medium customarily used for software interchange; or,++ b) Accompany it with a written offer, valid for at least three+ years, to give any third party, for a charge no more than your+ cost of physically performing source distribution, a complete+ machine-readable copy of the corresponding source code, to be+ distributed under the terms of Sections 1 and 2 above on a medium+ customarily used for software interchange; or,++ c) Accompany it with the information you received as to the offer+ to distribute corresponding source code. (This alternative is+ allowed only for noncommercial distribution and only if you+ received the program in object code or executable form with such+ an offer, in accord with Subsection b above.)++The source code for a work means the preferred form of the work for+making modifications to it. For an executable work, complete source+code means all the source code for all modules it contains, plus any+associated interface definition files, plus the scripts used to+control compilation and installation of the executable. However, as a+special exception, the source code distributed need not include+anything that is normally distributed (in either source or binary+form) with the major components (compiler, kernel, and so on) of the+operating system on which the executable runs, unless that component+itself accompanies the executable.++If distribution of executable or object code is made by offering+access to copy from a designated place, then offering equivalent+access to copy the source code from the same place counts as+distribution of the source code, even though third parties are not+compelled to copy the source along with the object code.++ 4. You may not copy, modify, sublicense, or distribute the Program+except as expressly provided under this License. Any attempt+otherwise to copy, modify, sublicense or distribute the Program is+void, and will automatically terminate your rights under this License.+However, parties who have received copies, or rights, from you under+this License will not have their licenses terminated so long as such+parties remain in full compliance.++ 5. You are not required to accept this License, since you have not+signed it. However, nothing else grants you permission to modify or+distribute the Program or its derivative works. These actions are+prohibited by law if you do not accept this License. Therefore, by+modifying or distributing the Program (or any work based on the+Program), you indicate your acceptance of this License to do so, and+all its terms and conditions for copying, distributing or modifying+the Program or works based on it.++ 6. Each time you redistribute the Program (or any work based on the+Program), the recipient automatically receives a license from the+original licensor to copy, distribute or modify the Program subject to+these terms and conditions. You may not impose any further+restrictions on the recipients' exercise of the rights granted herein.+You are not responsible for enforcing compliance by third parties to+this License.++ 7. If, as a consequence of a court judgment or allegation of patent+infringement or for any other reason (not limited to patent issues),+conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License. If you cannot+distribute so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you+may not distribute the Program at all. For example, if a patent+license would not permit royalty-free redistribution of the Program by+all those who receive copies directly or indirectly through you, then+the only way you could satisfy both it and this License would be to+refrain entirely from distribution of the Program.++If any portion of this section is held invalid or unenforceable under+any particular circumstance, the balance of the section is intended to+apply and the section as a whole is intended to apply in other+circumstances.++It is not the purpose of this section to induce you to infringe any+patents or other property right claims or to contest validity of any+such claims; this section has the sole purpose of protecting the+integrity of the free software distribution system, which is+implemented by public license practices. Many people have made+generous contributions to the wide range of software distributed+through that system in reliance on consistent application of that+system; it is up to the author/donor to decide if he or she is willing+to distribute software through any other system and a licensee cannot+impose that choice.++This section is intended to make thoroughly clear what is believed to+be a consequence of the rest of this License.++ 8. If the distribution and/or use of the Program is restricted in+certain countries either by patents or by copyrighted interfaces, the+original copyright holder who places the Program under this License+may add an explicit geographical distribution limitation excluding+those countries, so that distribution is permitted only in or among+countries not thus excluded. In such case, this License incorporates+the limitation as if written in the body of this License.++ 9. The Free Software Foundation may publish revised and/or new versions+of the General Public License from time to time. Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++Each version is given a distinguishing version number. If the Program+specifies a version number of this License which applies to it and "any+later version", you have the option of following the terms and conditions+either of that version or of any later version published by the Free+Software Foundation. If the Program does not specify a version number of+this License, you may choose any version ever published by the Free Software+Foundation.++ 10. If you wish to incorporate parts of the Program into other free+programs whose distribution conditions are different, write to the author+to ask for permission. For software which is copyrighted by the Free+Software Foundation, write to the Free Software Foundation; we sometimes+make exceptions for this. Our decision will be guided by the two goals+of preserving the free status of all derivatives of our free software and+of promoting the sharing and reuse of software generally.++ NO WARRANTY++ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,+REPAIR OR CORRECTION.++ 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE+POSSIBILITY OF SUCH DAMAGES.++ END OF TERMS AND CONDITIONS++ How to Apply These Terms to Your New Programs++ If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++ To do so, attach the following notices to the program. It is safest+to attach them to the start of each source file to most effectively+convey the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++ <one line to give the program's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License along+ with this program; if not, write to the Free Software Foundation, Inc.,+ 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.++Also add information on how to contact you by electronic and paper mail.++If the program is interactive, make it output a short notice like this+when it starts in an interactive mode:++ Gnomovision version 69, Copyright (C) year name of author+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+ This is free software, and you are welcome to redistribute it+ under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License. Of course, the commands you use may+be called something other than `show w' and `show c'; they could even be+mouse-clicks or menu items--whatever suits your program.++You should also get your employer (if you work as a programmer) or your+school, if any, to sign a "copyright disclaimer" for the program, if+necessary. Here is a sample; alter the names:++ Yoyodyne, Inc., hereby disclaims all copyright interest in the program+ `Gnomovision' (which makes passes at compilers) written by James Hacker.++ <signature of Ty Coon>, 1 April 1989+ Ty Coon, President of Vice++This General Public License does not permit incorporating your program into+proprietary programs. If your program is a subroutine library, you may+consider it more useful to permit linking proprietary applications with the+library. If this is what you want to do, use the GNU Lesser General+Public License instead of this License.
+ Setup.hs view
@@ -0,0 +1,4 @@+#!/usr/bin/env runhaskell++import Distribution.Simple+main = defaultMain
+ Sound/SC3/Server/Allocator.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE+ FlexibleContexts+ , FlexibleInstances+ , MultiParamTypeClasses #-}++module Sound.SC3.Server.Allocator+ ( AllocFailure(..)+ , IdAllocator(..)+ , RangeAllocator(..)+ , module Sound.SC3.Server.Allocator.Range+ ) where++import Control.Exception (Exception)+import Control.Failure (Failure)+import Control.Monad (replicateM)+import qualified Control.Monad.Trans.Class as State+import qualified Control.Monad.Trans.State.Strict as State+import Data.Typeable (Typeable)+import Sound.SC3.Server.Allocator.Range++data AllocFailure =+ NoFreeIds+ | InvalidId+ deriving (Show, Typeable)++instance Exception AllocFailure++class IdAllocator i a where+ alloc :: Failure AllocFailure m => a -> m (i, a)+ free :: Failure AllocFailure m => i -> a -> m a+ + allocMany :: Failure AllocFailure m => Int -> a -> m ([i], a)+ allocMany n = State.runStateT (replicateM n (modifyM alloc))+ where+ modifyM f = do+ (a, s') <- State.get >>= State.lift . f+ State.put $! s'+ return a++class IdAllocator i a => RangeAllocator i a where+ allocRange :: Failure AllocFailure m => Int -> a -> m (Range i, a)+ freeRange :: Failure AllocFailure m => Range i -> a -> m a
+ Sound/SC3/Server/Allocator/Range.hs view
@@ -0,0 +1,65 @@+module Sound.SC3.Server.Allocator.Range (+ Range+ , range+ , empty+ , lowerBound+ , upperBound+ , size+ , null+ , toList+ -- *Interval operations+ , within+ , adjoins+ , overlaps+ , contains+ , join+) where++import Control.DeepSeq (NFData(..))+import Prelude hiding (null)++-- |Model intervals [a, b[+data Range a = Range !a !a deriving (Eq, Show)++instance NFData a => NFData (Range a) where+ rnf (Range x1 x2) = rnf x1 `seq` rnf x2 `seq` ()++mkRange :: a -> a -> Range a+mkRange a b = Range a b++range :: Ord a => a -> a -> Range a+range a b | a <= b = mkRange a b+ | otherwise = mkRange b a++empty :: Num a => Range a+empty = mkRange 0 0++lowerBound :: Range a -> a+lowerBound (Range a _) = a++upperBound :: Range a -> a+upperBound (Range _ a) = a++size :: Num a => Range a -> a+size a = upperBound a - lowerBound a++null :: Eq a => Range a -> Bool+null a = lowerBound a == upperBound a++toList :: Enum a => Range a -> [a]+toList a = [lowerBound a..pred (upperBound a)]++within :: Ord a => a -> Range a -> Bool+x `within` a = x >= lowerBound a && x < upperBound a++adjoins :: Eq a => Range a -> Range a -> Bool+a `adjoins` b = (upperBound a == lowerBound b) || (upperBound b == lowerBound a)++overlaps :: Ord a => Range a -> Range a -> Bool+a `overlaps` b = (upperBound a > lowerBound b) || (upperBound b > lowerBound a)++contains :: Ord a => Range a -> Range a -> Bool+a `contains` b = lowerBound b >= lowerBound a && upperBound b <= upperBound a++join :: Ord a => Range a -> Range a -> Range a+join a b = mkRange (min (lowerBound a) (lowerBound b)) (max (upperBound a) (upperBound b))
+ Sound/SC3/Server/Allocator/SetAllocator.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE BangPatterns+ , FlexibleContexts+ , FlexibleInstances+ , MultiParamTypeClasses #-}+module Sound.SC3.Server.Allocator.SetAllocator (+ SetAllocator+ , cons+) where++import Control.Failure (Failure, failure)+import Control.DeepSeq (NFData(..))+import Data.BitSet as Set+import Sound.SC3.Server.Allocator++data SetAllocator i =+ SetAllocator+ {-# UNPACK #-} !(Range i)+ {-# UNPACK #-} !(Set.BitSet i)+ !i+ deriving (Eq, Show)++instance NFData i => NFData (SetAllocator i) where+ rnf (SetAllocator x1 x2 x3) =+ rnf x1 `seq`+ x2 `seq`+ rnf x3 `seq` ()++cons :: Range i -> SetAllocator i+cons r = SetAllocator r Set.empty (lowerBound r)++findNext :: (Integral i) => SetAllocator i -> Maybe i+findNext (SetAllocator r u n) = loop (succ n)+ where+ loop !i+ | i == n = Nothing+ | i == upperBound r = loop (lowerBound r)+ | Set.member (fromIntegral i) u = loop (succ i)+ | otherwise = Just i++sa_alloc :: (Integral i, Failure AllocFailure m) => SetAllocator i -> m (i, SetAllocator i)+sa_alloc s@(SetAllocator r u n)+ | Set.member (fromIntegral n) u = failure NoFreeIds+ | otherwise = case findNext s of+ Nothing -> failure NoFreeIds+ Just n' -> return (n, SetAllocator r (Set.insert (fromIntegral n) u) n')++sa_free :: (Integral i, Failure AllocFailure m) => i -> SetAllocator i -> m (SetAllocator i)+sa_free i (SetAllocator r u n) | Set.member (fromIntegral i) u = return (SetAllocator r u' n)+ | otherwise = failure InvalidId+ where u' = Set.delete (fromIntegral i) u++instance (Integral i) => IdAllocator i (SetAllocator i) where+ alloc = sa_alloc+ free = sa_free
+ Sound/SC3/Server/Allocator/SimpleAllocator.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE FlexibleContexts+ , FlexibleInstances+ , MultiParamTypeClasses #-}+module Sound.SC3.Server.Allocator.SimpleAllocator (+ SimpleAllocator+ , cons+) where++import Control.DeepSeq (NFData(..))+import Sound.SC3.Server.Allocator++newtype SimpleAllocator i = SimpleAllocator i deriving (Eq, Show)++instance NFData i => NFData (SimpleAllocator i) where+ rnf (SimpleAllocator x1) = rnf x1 `seq` ()++cons :: Num i => SimpleAllocator i+cons = SimpleAllocator 0++sa_alloc :: (Num i, Monad m) => SimpleAllocator i -> m (i, SimpleAllocator i)+sa_alloc (SimpleAllocator n) = return (n, SimpleAllocator (n+1))++sa_free :: (Monad m) => i -> SimpleAllocator i -> m (SimpleAllocator i)+sa_free _ sa = return sa++instance (Integral i) => IdAllocator i (SimpleAllocator i) where+ alloc = sa_alloc+ free = sa_free
+ Sound/SC3/Server/Connection.hs view
@@ -0,0 +1,120 @@+{-# LANGUAGE ExistentialQuantification+ , GeneralizedNewtypeDeriving #-}+module Sound.SC3.Server.Connection (+ Connection+ , state+ , new+ , close+ , fork+ , async+ , syncWith+ , syncAddress+ , sync+ , unsafeSync+) where++import Control.Concurrent (ThreadId, forkIO)+import Control.Concurrent.MVar+import qualified Data.HashTable as Hash+import Sound.OpenSoundControl (Datum(..), OSC(..), Transport, immediately)+import qualified Sound.OpenSoundControl as OSC++import Sound.SC3 (notify)+import Sound.SC3.Server.Notification (done, synced)+import Sound.SC3.Server.State (State)+import qualified Sound.SC3.Server.State as State+import qualified Sound.SC3.Server.State.Concurrent as IOState++type ListenerId = Int+type Listener = OSC -> IO ()+data ListenerMap = ListenerMap !(Hash.HashTable ListenerId Listener) !ListenerId+data Connection = forall t . Transport t => Connection t (MVar State) (MVar ListenerMap)++state :: Connection -> MVar State+state (Connection _ s _) = s++listeners :: Connection -> MVar ListenerMap+listeners (Connection _ _ l) = l++initServer :: Connection -> IO ()+initServer c = do+ Bundle immediately [notify True] `syncWith` done "notify" $ c+ return ()++recvLoop :: Connection -> IO ()+recvLoop c@(Connection t _ _) = do+ osc <- OSC.recv t+ withMVar (listeners c) (\(ListenerMap h _) -> mapM_ (\(_, l) -> l osc) =<< Hash.toList h)+ recvLoop c++new :: Transport t => State -> t -> IO Connection+new s t = do+ ios <- IOState.fromState s+ h <- Hash.new (==) Hash.hashInt+ lm <- newMVar (ListenerMap h 0)+ let c = Connection t ios lm+ _ <- forkIO $ recvLoop c+ initServer c+ return c++close :: Connection -> IO ()+close (Connection t _ _) = OSC.close t++fork :: Connection -> (Connection -> IO ()) -> IO ThreadId+fork c f = forkIO (f c)++addListener :: Listener -> Connection -> IO ListenerId+addListener l c = modifyMVar+ (listeners c) $+ \(ListenerMap h lid) -> do+ Hash.insert h lid l+ -- lc <- Hash.longestChain h+ -- putStrLn $ "addListener: longestChain=" ++ show (length lc)+ return (ListenerMap h (lid+1), lid)++removeListener :: ListenerId -> Connection -> IO ()+removeListener uid c = modifyMVar_ (listeners c) (\lm@(ListenerMap h _) -> Hash.delete h uid >> return lm)++async :: OSC -> Connection -> IO ()+async osc (Connection t _ _) = OSC.send t osc++syncWith :: OSC -> (OSC -> Maybe a) -> Connection -> IO a+syncWith s f c = do+ res <- newEmptyMVar+ uid <- addListener (action res) c+ s `async` c+ a <- takeMVar res+ removeListener uid c+ return a+ where+ action res osc = do+ case f osc of+ Nothing -> return ()+ Just a -> putMVar res a++-- | Wait for an OSC message matching a specific address.+syncAddress :: OSC -> String -> Connection -> IO OSC+syncAddress s a = s `syncWith` hasAddress+ where+ hasAddress m@(Message a' _) = if a == a' then Just m else Nothing+ hasAddress _ = Nothing++-- | Append a @\/sync@ message to an OSC packet.+appendSync :: OSC -> Int -> OSC+appendSync p i =+ case p of+ m@(Message _ _) -> Bundle immediately [m, s]+ (Bundle t xs) -> Bundle t (xs ++ [s])+ where s = Message "/sync" [Int i]++sync :: OSC -> Connection -> IO ()+sync osc c = do+ i <- IOState.alloc State.syncId (state c)+ _ <- osc `appendSync` i `syncWith` synced i $ c+ IOState.free State.syncId (state c) i+ return ()++-- NOTE: This is only guaranteed to work with a transport that preserves+-- packet order. NOTE 2: And not even then ;)+unsafeSync :: Connection -> IO ()+unsafeSync = sync (Bundle immediately [])
+ Sound/SC3/Server/Monad.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Sound.SC3.Server.Monad (+ -- *Server Monad+ ServerT+ , runServerT+ , Server+ , runServer+ , lift+ , liftIO+ , rootNode+ -- *Allocators+ , BufferId+ , BusId+ , NodeId+ , nodeId+ , bufferId+ , busId+ , alloc+ , allocMany+ , free+ , allocRange+ , freeRange+ -- *Synchronization+ , fork+ , async+ , syncWith+ , syncAddress+ , sync+ , unsafeSync+) where++import Control.Concurrent (ThreadId)+import Control.Concurrent.MVar.Strict+import Control.Monad.Reader (MonadReader, ReaderT(..), ask, asks, lift)+import Control.Monad.Trans (MonadIO, MonadTrans, liftIO)+import Data.Accessor+import Sound.SC3 (Rate(..))+import Sound.SC3.Server.Allocator (IdAllocator, RangeAllocator, Range)+import Sound.SC3.Server.Connection (Connection)+import qualified Sound.SC3.Server.Connection as C+-- import Sound.SC3.Server.Process.Options (ServerOptions, numberOfInputBusChannels, numberOfOutputBusChannels)+import Sound.SC3.Server.State (BufferId, BufferIdAllocator, BusId, BusIdAllocator, NodeId, NodeIdAllocator, State)+import qualified Sound.SC3.Server.State as State+import qualified Sound.SC3.Server.State.Concurrent as IOState++import Sound.OpenSoundControl (OSC)++newtype ServerT m a = ServerT (ReaderT Connection m a)+ deriving (Functor, Monad, MonadReader Connection, MonadIO, MonadTrans)++type Server = ServerT IO++type Allocator a = Accessor State a++liftConn :: MonadIO m => (Connection -> IO a) -> ServerT m a+liftConn f = ask >>= \c -> liftIO (f c)++liftState :: MonadIO m => (State -> a) -> ServerT m a+liftState f = asks C.state >>= liftIO . readMVar >>= return . f++runServerT :: ServerT m a -> Connection -> m a+runServerT (ServerT r) = runReaderT r++runServer :: Server a -> Connection -> IO a+runServer = runServerT++rootNode :: MonadIO m => ServerT m NodeId+rootNode = liftState State.rootNode+++nodeId :: Allocator NodeIdAllocator+nodeId = State.nodeId++bufferId :: Allocator BufferIdAllocator+bufferId = State.bufferId++busId :: Rate -> Allocator BusIdAllocator+busId AR = State.audioBusId+busId KR = State.controlBusId+busId r = error ("No bus allocator for rate " ++ show r)+++alloc :: (IdAllocator i a, MonadIO m) => Allocator a -> ServerT m i+alloc a = asks C.state >>= liftIO . IOState.alloc a++allocMany :: (IdAllocator i a, MonadIO m) => Allocator a -> Int -> ServerT m [i]+allocMany a n = asks C.state >>= liftIO . flip (IOState.allocMany a) n++free :: (IdAllocator i a, MonadIO m) => Allocator a -> i -> ServerT m ()+free a i = asks C.state >>= liftIO . flip (IOState.free a) i++allocRange :: (RangeAllocator i a, MonadIO m) => Allocator a -> Int -> ServerT m (Range i)+allocRange a n = asks C.state >>= liftIO . flip (IOState.allocRange a) n++freeRange :: (RangeAllocator i a, MonadIO m) => Allocator a -> Range i -> ServerT m ()+freeRange a r = asks C.state >>= liftIO . flip (IOState.freeRange a) r++fork :: (MonadIO m) => ServerT IO () -> ServerT m ThreadId+fork = liftConn . flip C.fork . runServerT++async :: (MonadIO m) => OSC -> ServerT m ()+async = liftConn . C.async++syncWith :: (MonadIO m) => OSC -> (OSC -> Maybe a) -> ServerT m a+syncWith s = liftConn . C.syncWith s++syncAddress :: (MonadIO m) => OSC -> String -> ServerT m OSC+syncAddress s = liftConn . C.syncAddress s++sync :: (MonadIO m) => OSC -> ServerT m ()+sync = liftConn . C.sync++unsafeSync :: (MonadIO m) => ServerT m ()+unsafeSync = liftConn C.unsafeSync
+ Sound/SC3/Server/Notification.hs view
@@ -0,0 +1,78 @@+-- | Server notification processors.+module Sound.SC3.Server.Notification (+ Status(..)+ , status_reply+ , tr+ , synced+ , done+ , NodeNotification(..)+ , n_go , n_end , n_off , n_on , n_move , n_info+) where++import Sound.SC3.Server.State (NodeId)+import Sound.OpenSoundControl (OSC(..), Datum(..))++data Status = Status {+ numUGens :: Int+ , numSynths :: Int+ , numGroups :: Int+ , numSynthDefs :: Int+ , avgCPU :: Double+ , peakCPU :: Double+ , nominalSampleRate :: Double+ , actualSampleRate :: Double+} deriving (Eq, Show)++status_reply :: OSC -> Maybe Status+status_reply (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'+status_reply _ = Nothing++tr :: NodeId -> Maybe Int -> OSC -> Maybe Double+tr n (Just i) (Message "/tr" [Int n', Int i', Float r]) | fromIntegral n == n' && i == i' = Just r+tr n Nothing (Message "/tr" [Int n', Int _, Float r]) | fromIntegral n == n' = Just r+tr _ _ _ = Nothing++synced :: Int -> OSC -> Maybe Int+synced i (Message "/synced" [Int j]) | j == i = Just i+synced _ _ = Nothing++normalize :: String -> String+normalize ('/':s) = s+normalize s = s++done :: String -> OSC -> Maybe [Datum]+done c (Message "/done" (String s:xs)) | normalize c == normalize s = Just xs+done _ _ = Nothing++data NodeNotification =+ SynthNotification NodeId NodeId NodeId NodeId+ | GroupNotification NodeId NodeId NodeId NodeId NodeId NodeId++n_notification :: String -> NodeId -> OSC -> Maybe NodeNotification+n_notification s nid (Message s' (Int nid':Int g:Int p:Int n:Int b:r))+ | s == s' && fromIntegral nid == nid' =+ case b of+ 0 -> Just $ SynthNotification nid (fromIntegral g) (fromIntegral p) (fromIntegral n)+ _ -> case r of+ [Int h, Int t] -> Just $ GroupNotification nid (fromIntegral g) (fromIntegral p) (fromIntegral n) (fromIntegral h) (fromIntegral t)+ _ -> Just $ GroupNotification nid (fromIntegral g) (fromIntegral p) (fromIntegral n) (fromIntegral (-1 :: Int)) (fromIntegral (-1 :: Int))+n_notification _ _ _ = Nothing++n_go :: NodeId -> OSC -> Maybe NodeNotification+n_go = n_notification "/n_go"++n_end :: NodeId -> OSC -> Maybe NodeNotification+n_end = n_notification "/n_end"++n_off :: NodeId -> OSC -> Maybe NodeNotification+n_off = n_notification "/n_off"++n_on :: NodeId -> OSC -> Maybe NodeNotification+n_on = n_notification "/n_on"++n_move :: NodeId -> OSC -> Maybe NodeNotification+n_move = n_notification "/n_move"++n_info :: NodeId -> OSC -> Maybe NodeNotification+n_info = n_notification "/n_info"
+ Sound/SC3/Server/Process/Monad.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE ScopedTypeVariables #-}+module Sound.SC3.Server.Process.Monad (+ withSynth+ , withInternal+) where++import Sound.SC3.Server.Process (ServerOptions, OutputHandler, RTOptions)+import qualified Sound.SC3.Server.Process as Process+import qualified Sound.SC3.Server.Connection as Conn+import qualified Sound.SC3.Server.State as State+import qualified Sound.SC3.Server.Internal as Process+import Sound.SC3.Server.Monad (Server)+import qualified Sound.SC3.Server.Monad as Server+import qualified Sound.OpenSoundControl as OSC++withSynth :: OSC.Transport t => (ServerOptions -> RTOptions -> IO t) -> ServerOptions -> RTOptions -> OutputHandler -> Server a -> IO a+withSynth openTransport serverOptions rtOptions outputHandler action =+ Process.withSynth+ openTransport+ serverOptions+ rtOptions+ outputHandler+ $ \t -> Conn.new (State.new serverOptions) t >>= Server.runServer action++withInternal :: ServerOptions -> RTOptions -> OutputHandler -> Server a -> IO a+withInternal serverOptions rtOptions outputHandler action =+ Process.withInternal+ serverOptions+ rtOptions+ outputHandler+ $ \t -> Conn.new (State.new serverOptions) t >>= Server.runServer action
+ Sound/SC3/Server/State.hs view
@@ -0,0 +1,137 @@+{-# LANGUAGE+ CPP+ , ExistentialQuantification+ , FlexibleContexts+ , GeneralizedNewtypeDeriving+ , MultiParamTypeClasses #-}++#include "Accessor.h"++module Sound.SC3.Server.State (+ State+ , options+ , IntAllocator+ , NodeIdAllocator+ , BusIdAllocator+ , BufferIdAllocator+ , NodeId+ , BusId+ , BufferId+ , syncId+ , nodeId+ , bufferId+ , controlBusId+ , audioBusId+ , rootNode+ , new+ , Alloc.alloc+ , Alloc.allocMany+ , Alloc.allocRange+ , Alloc.free+) where++import Control.Arrow (second)+import Control.DeepSeq (NFData(..))+import Control.Monad (liftM)+import Data.Accessor+import Sound.SC3.Server.Allocator (IdAllocator)+import qualified Sound.SC3.Server.Allocator as Alloc+import Sound.SC3.Server.Allocator.SetAllocator (SetAllocator)+import qualified Sound.SC3.Server.Allocator.SetAllocator as SetAlloc+import Sound.SC3.Server.Allocator.SimpleAllocator (SimpleAllocator)+import qualified Sound.SC3.Server.Allocator.SimpleAllocator as SAlloc+import Sound.SC3.Server.Options (ServerOptions(..))++-- Hide the actual allocator+data IntAllocator = forall a . (IdAllocator Int a, NFData a) => IntAllocator !a++instance IdAllocator Int IntAllocator where+ alloc (IntAllocator a) = liftM (second IntAllocator) $ Alloc.alloc a+ free i (IntAllocator a) = liftM IntAllocator $ Alloc.free i a++instance NFData IntAllocator where+ rnf (IntAllocator a) = rnf a `seq` ()++newtype NodeId = NodeId Int deriving (Bounded, Enum, Eq, Integral, NFData, Num, Ord, Real, Show)+data NodeIdAllocator = forall a . (IdAllocator NodeId a, NFData a) => NodeIdAllocator !a++instance IdAllocator NodeId NodeIdAllocator where+ alloc (NodeIdAllocator a) = liftM (second NodeIdAllocator) $ Alloc.alloc a+ free i (NodeIdAllocator a) = liftM NodeIdAllocator $ Alloc.free i a++instance NFData NodeIdAllocator where+ rnf (NodeIdAllocator a) = rnf a `seq` ()++newtype BufferId = BufferId Int deriving (Bounded, Enum, Eq, Integral, NFData, Num, Ord, Real, Show)+data BufferIdAllocator = forall a . (IdAllocator BufferId a, NFData a) => BufferIdAllocator !a++instance IdAllocator BufferId BufferIdAllocator where+ alloc (BufferIdAllocator a) = liftM (second BufferIdAllocator) $ Alloc.alloc a+ free i (BufferIdAllocator a) = liftM BufferIdAllocator $ Alloc.free i a++instance NFData BufferIdAllocator where+ rnf (BufferIdAllocator a) = rnf a `seq` ()++newtype BusId = BusId Int deriving (Bounded, Enum, Eq, Integral, NFData, Num, Ord, Real, Show)+data BusIdAllocator = forall a . (IdAllocator BusId a, NFData a) => BusIdAllocator !a++instance IdAllocator BusId BusIdAllocator where+ alloc (BusIdAllocator a) = liftM (second BusIdAllocator) $ Alloc.alloc a+ free i (BusIdAllocator a) = liftM BusIdAllocator $ Alloc.free i a++instance NFData BusIdAllocator where+ rnf (BusIdAllocator a) = rnf a `seq` ()++data State = State {+ _options :: !ServerOptions+ , _syncId :: !IntAllocator+ , _nodeId :: !NodeIdAllocator+ , _bufferId :: !BufferIdAllocator+ , _controlBusId :: !BusIdAllocator+ , _audioBusId :: !BusIdAllocator+ }++instance NFData State where+ rnf (State x1 x2 x3 x4 x5 x6) =+ x1 `seq`+ rnf x2 `seq`+ rnf x3 `seq`+ rnf x4 `seq`+ rnf x5 `seq`+ rnf x6 `seq` ()++ACCESSOR(options, _options, State, ServerOptions)+ACCESSOR(syncId, _syncId, State, IntAllocator)+ACCESSOR(nodeId, _nodeId, State, NodeIdAllocator)+ACCESSOR(bufferId, _bufferId, State, BufferIdAllocator)+ACCESSOR(controlBusId, _controlBusId, State, BusIdAllocator)+ACCESSOR(audioBusId, _audioBusId, State, BusIdAllocator)++rootNode :: State -> NodeId+rootNode = const (NodeId 0)++new :: ServerOptions -> State+new os =+ State {+ _options = os+ , _syncId = sid+ , _nodeId = nid+ , _bufferId = bid+ , _controlBusId = cid+ , _audioBusId = aid+ }+ where+ sid = IntAllocator+ (SAlloc.cons :: SimpleAllocator Int)+ nid = NodeIdAllocator+ (SetAlloc.cons $ Alloc.range 1000 (1000 + fromIntegral (maxNumberOfNodes os)) :: SetAllocator NodeId)+ bid = BufferIdAllocator+ (SetAlloc.cons $ Alloc.range 0 (fromIntegral (numberOfSampleBuffers os - 1)) :: SetAllocator BufferId)+ cid = BusIdAllocator+ (SetAlloc.cons $ Alloc.range 0 (fromIntegral (numberOfControlBusChannels os - 1)) :: SetAllocator BusId)+ aid = BusIdAllocator+ (SetAlloc.cons $ Alloc.range+ (fromIntegral numHardwareChannels)+ (fromIntegral (numHardwareChannels + numberOfAudioBusChannels os)) :: SetAllocator BusId)+ numHardwareChannels = numberOfInputBusChannels os+ + numberOfOutputBusChannels os
+ Sound/SC3/Server/State/Concurrent.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE FlexibleContexts #-}+module Sound.SC3.Server.State.Concurrent (+ fromState+ , new+ , alloc+ , allocMany+ , free+ , allocRange+ , freeRange+) where++import Control.Arrow (second)+import Control.Failure (Failure)+-- import Control.Concurrent.MVar (MVar, newMVar)+import Control.Concurrent.MVar.Strict (MVar, modifyMVar, modifyMVar_, newMVar)+import Data.Accessor+import Sound.SC3.Server.Allocator (AllocFailure, IdAllocator, RangeAllocator, Range)+import qualified Sound.SC3.Server.Allocator as Alloc+import Sound.SC3.Server.State (State)+import qualified Sound.SC3.Server.State as State+import Sound.SC3.Server.Options (ServerOptions)++type IOState = MVar State++fromState :: State -> IO (MVar State)+fromState = newMVar++new :: ServerOptions -> IO (MVar State)+new = fromState . State.new++swap :: (a, b) -> (b, a)+swap (a, b) = (b, a)++alloc :: (IdAllocator i a, Failure AllocFailure IO) => (Accessor State a) -> MVar State -> IO i+alloc f ios = modifyMVar ios (\s -> fmap (swap . second (flip (setVal f) s)) . Alloc.alloc . getVal f $ s)++allocMany :: (IdAllocator i a, Failure AllocFailure IO) => (Accessor State a) -> MVar State -> Int -> IO [i]+allocMany f m n = modifyMVar m (\s -> fmap (swap . second (flip (setVal f) s)) . Alloc.allocMany n . getVal f $ s)++free :: IdAllocator i a => (Accessor State a) -> IOState -> i -> IO ()+free f ios i = modifyMVar_ ios $ \s -> do+ let a = s ^. f+ a' <- Alloc.free i a+ return $ f ^= a' $ s++allocRange :: (RangeAllocator i a, Failure AllocFailure IO) => (Accessor State a) -> MVar State -> Int -> IO (Range i)+allocRange f ios n = modifyMVar ios (\s -> fmap (swap . second (flip (setVal f) s)) . Alloc.allocRange n . getVal f $ s)++freeRange :: (RangeAllocator i a, Failure AllocFailure IO) => (Accessor State a) -> MVar State -> Range i -> IO ()+freeRange f ios r = modifyMVar_ ios $ \s -> do+ let a = s ^. f+ a' <- Alloc.freeRange r a+ return $ f ^= a' $ s
+ hsc3-server.cabal view
@@ -0,0 +1,51 @@+Name: hsc3-server+Version: 0.0.0+Synopsis: SuperCollider server resource management and synchronization.+Description: This library provides abstractions for managing SuperCollider server resources like node, buffer and bus ids and synchronization primitives.+License: GPL+License-File: LICENSE+Category: Sound+Copyright: Copyright (c) Stefan Kersten 2008-2011+Author: Stefan Kersten+Maintainer: Stefan Kersten+Stability: experimental+Homepage: http://space.k-hornz.de/software/hsc3-server+Tested-With: GHC == 6.10.1, GHC == 6.12.3, GHC == 7.0.1+Build-Type: Simple+Cabal-Version: >= 1.6++Extra-Source-Files:+ include/Accessor.h++Library+ Exposed-Modules:+ Sound.SC3.Server.Allocator+ Sound.SC3.Server.Allocator.Range+ Sound.SC3.Server.Allocator.SetAllocator+ Sound.SC3.Server.Allocator.SimpleAllocator+ Sound.SC3.Server.Connection+ Sound.SC3.Server.Monad+ Sound.SC3.Server.Notification+ Sound.SC3.Server.Process.Monad+ Sound.SC3.Server.State+ Sound.SC3.Server.State.Concurrent+ Build-Depends:+ base >= 3 && < 5+ , bitset >= 1.0+ , data-accessor+ , deepseq+ , failure+ , hosc >= 0.8+ , hsc3 >= 0.7+ , hsc3-process >= 0.5+ , mtl >= 2+ , strict-concurrency+ , transformers+ Include-Dirs:+ include+ Ghc-Options:+ -W++Source-Repository head+ Type: git+ Location: git://github.com/kaoskorobase/hsc3-server.git
+ include/Accessor.h view
@@ -0,0 +1,8 @@+#ifndef ACCESSOR_H_INCLUDED+#define ACCESSOR_H_INCLUDED++#define ACCESSOR(N,F,T,V) \+N :: Accessor (T) (V) ; \+N = accessor F (\x a -> a { F = x })++#endif /* ACCESSOR_H_INCLUDED */