diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. + + + Copyright (C) + + 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. + + , 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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,4 @@ +#!/usr/bin/env runhaskell + +import Distribution.Simple +main = defaultMain diff --git a/Sound/SC3/Server/Allocator.hs b/Sound/SC3/Server/Allocator.hs new file mode 100644 --- /dev/null +++ b/Sound/SC3/Server/Allocator.hs @@ -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 diff --git a/Sound/SC3/Server/Allocator/Range.hs b/Sound/SC3/Server/Allocator/Range.hs new file mode 100644 --- /dev/null +++ b/Sound/SC3/Server/Allocator/Range.hs @@ -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)) diff --git a/Sound/SC3/Server/Allocator/SetAllocator.hs b/Sound/SC3/Server/Allocator/SetAllocator.hs new file mode 100644 --- /dev/null +++ b/Sound/SC3/Server/Allocator/SetAllocator.hs @@ -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 diff --git a/Sound/SC3/Server/Allocator/SimpleAllocator.hs b/Sound/SC3/Server/Allocator/SimpleAllocator.hs new file mode 100644 --- /dev/null +++ b/Sound/SC3/Server/Allocator/SimpleAllocator.hs @@ -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 diff --git a/Sound/SC3/Server/Connection.hs b/Sound/SC3/Server/Connection.hs new file mode 100644 --- /dev/null +++ b/Sound/SC3/Server/Connection.hs @@ -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 []) diff --git a/Sound/SC3/Server/Monad.hs b/Sound/SC3/Server/Monad.hs new file mode 100644 --- /dev/null +++ b/Sound/SC3/Server/Monad.hs @@ -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 diff --git a/Sound/SC3/Server/Notification.hs b/Sound/SC3/Server/Notification.hs new file mode 100644 --- /dev/null +++ b/Sound/SC3/Server/Notification.hs @@ -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" diff --git a/Sound/SC3/Server/Process/Monad.hs b/Sound/SC3/Server/Process/Monad.hs new file mode 100644 --- /dev/null +++ b/Sound/SC3/Server/Process/Monad.hs @@ -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 diff --git a/Sound/SC3/Server/State.hs b/Sound/SC3/Server/State.hs new file mode 100644 --- /dev/null +++ b/Sound/SC3/Server/State.hs @@ -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 diff --git a/Sound/SC3/Server/State/Concurrent.hs b/Sound/SC3/Server/State/Concurrent.hs new file mode 100644 --- /dev/null +++ b/Sound/SC3/Server/State/Concurrent.hs @@ -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 diff --git a/hsc3-server.cabal b/hsc3-server.cabal new file mode 100644 --- /dev/null +++ b/hsc3-server.cabal @@ -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 diff --git a/include/Accessor.h b/include/Accessor.h new file mode 100644 --- /dev/null +++ b/include/Accessor.h @@ -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 */