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,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Vivid/OSC.hs b/Vivid/OSC.hs new file mode 100644 --- /dev/null +++ b/Vivid/OSC.hs @@ -0,0 +1,283 @@ +-- | Open Sound Control data + +{-# OPTIONS_HADDOCK show-extensions #-} + +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE ScopedTypeVariables #-} + +{-# LANGUAGE NoRebindableSyntax #-} +{-# LANGUAGE NoIncoherentInstances #-} +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE NoUndecidableInstances #-} + +module Vivid.OSC ( + OSC(..) + , OSCDatum(..) + + , encodeOSC + , decodeOSC + + , Timestamp(..) + , OSCBundle(..) + + , encodeOSCBundle + , decodeOSCBundle + + , encodeTimestamp + , utcToTimestamp + -- , timestampToUTC + + , addSecs + , diffTimestamps + + , encodeOSCDatum + + -- , decodeOSCDatumWithPadding + -- , decodeOSCData + + -- Testing/internals: + , putOSC + , putOSCString + , putOSCDatum + , getOSCString + , getOSC + , putOSCBlob + , getOSCBlob + , getOSCTimestamp + , putOSCTimestamp + + , putOSCBundle + , getOSCBundle + , runGetWithNoLeftover + + -- Only need for testing old<->new + , toTypeChar + , alignTo4' + ) where + +-- import Control.DeepSeq (NFData, rnf) +import Control.Monad +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BS8 (unpack) +import Data.Int (Int32) +import Data.Monoid +import Data.Serialize hiding (encode, decode, runGet) +-- import Data.Serialize.IEEE754 +import qualified Data.Serialize.Get as Get +import Data.Time (UTCTime(..), fromGregorian, secondsToDiffTime, diffUTCTime) + +-- | An OSC message, e.g. +-- +-- > OSC "/n_free" [OSC_I 42] +data OSC + = OSC ByteString [OSCDatum] + deriving (Show, Read, Eq, Ord) + +data OSCDatum + = OSC_I Int32 + | OSC_S ByteString + | OSC_F Float + | OSC_D Double -- ^ This isn't a base type in the OSC standard but the + -- scsynth response message from "/status" uses it... +{- + | OSC_I8 Int8 + | OSC_I16 Int16 +-} + | OSC_B ByteString + | OSC_T Timestamp -- ^ From the OSC 1.1 spec + deriving (Show, Read, Eq, Ord) + +-- | This is stored as the number of seconds since Jan 1 1900. You can get +-- it with 'Vivid.Actions.Class.getTime' +newtype Timestamp = Timestamp Double + deriving (Show, Read, Eq, Ord) + +-- | TODO: a Bundle can also contain other bundles, recursively +data OSCBundle + = OSCBundle Timestamp [Either ByteString OSC] + deriving (Show, Read, Eq) + +toTypeChar :: OSCDatum -> ByteString +toTypeChar = \case + OSC_I _ -> "i" + OSC_S _ -> "s" + OSC_F _ -> "f" + OSC_B _ -> "b" + OSC_D _ -> "d" + OSC_T _ -> "t" + +-- formerly known as 'someShit': +-- TODO: if sometimes encoding can fail (e.g. if a string contains a '\NUL'), we +-- should really have a (Either String) situation (and same for 'encodeOSCDatum'): +encodeOSC :: OSC -> ByteString +encodeOSC o = runPut (putOSC o) + +putOSC :: OSC -> Put +putOSC (OSC path args) = do + putOSCString path + putOSCString $ "," <> BS.concat (map toTypeChar args) + mapM_ putOSCDatum args + +encodeOSCDatum :: OSCDatum -> ByteString +encodeOSCDatum = runPut . putOSCDatum + +putOSCDatum :: OSCDatum -> Put +putOSCDatum = \case + OSC_S s -> putOSCString s + OSC_I i -> putInt32be i + OSC_F f -> putFloat32be f + OSC_D d -> putFloat64be d + OSC_T t -> putOSCTimestamp t + OSC_B b -> putOSCBlob b + +putOSCString :: ByteString -> Put +putOSCString s = do + -- There must be at least one \NUL byte: + putByteString $ padTo4Bytes (s<>"\NUL") + +getOSCString :: Get ByteString +getOSCString = do + -- There may be a more efficient way to do this: + first <- BS.takeWhile (/= 0) <$> getByteString 4 + case BS.length first of + 4 -> do + (first <>) <$> getOSCString + -- Note we've already discarded the ending '\NUL' padding: + _ -> pure first + +-- | Add '\NUL' characters to the end of a ByteString until its length is +-- a multiple of 4 +-- TODO: make this be a 'Put' and just get like the 'seek' count so we don't have to traverse it twice: +padTo4Bytes :: ByteString -> ByteString +padTo4Bytes b = b <> BS.replicate (alignTo4' (BS.length b)) 0 + +putOSCBlob :: ByteString -> Put +putOSCBlob bs = do + -- Note: should probably really be word: + putInt32be $ toEnum $ BS.length bs + -- The only reason we don't account for the prefixed length is that's + -- always 4 bytes long so it won't affect the padding: + putByteString $ padTo4Bytes bs + +getOSCBlob :: Get ByteString +getOSCBlob = do + size <- fromEnum <$> getInt32be + b <- getByteString size + _ <- getByteString (alignTo4' size) -- TODO; 'seek' instead? + pure b + +decodeOSC :: ByteString -> Either String OSC +decodeOSC = runGet getOSC + +getOSC :: Get OSC +getOSC = do + path <- getOSCString + -- For example, ",issifbt": + (comma:typeDesc) <- BS8.unpack <$> getOSCString + when (comma /= ',') $ fail "Malformed OSC!" + values <- forM typeDesc $ \case + 's' -> OSC_S <$> getOSCString + 'i' -> OSC_I <$> getInt32be + 'f' -> OSC_F <$> getFloat32be + 't' -> OSC_T <$> getOSCTimestamp + 'd' -> OSC_D <$> getFloat64be + 'b' -> OSC_B <$> getOSCBlob + c -> fail $ "Unrecognized character: " ++ show c + pure (OSC path values) + +encodeOSCBundle :: OSCBundle -> ByteString +encodeOSCBundle b = runPut (putOSCBundle b) + +putOSCBundle :: OSCBundle -> Put +putOSCBundle (OSCBundle time messages) = do + putByteString "#bundle\NUL" + putOSCTimestamp time + forM_ messages $ \message -> do + let encoded = case message of + Left b -> b + -- TODO: Doesn't feel right that i have a 'runPut' inside a 'Put': + Right osc -> runPut $ putOSC osc + putWord32be $ toEnum $ BS.length encoded + putByteString encoded + +decodeOSCBundle :: ByteString -> Either String OSCBundle +decodeOSCBundle = runGet getOSCBundle + +getOSCBundle :: Get OSCBundle +getOSCBundle = do + let prefix = "#bundle\NUL" + pre <- getByteString (BS.length prefix) + when (pre /= prefix) $ + fail "Wrong header" + ts <- getOSCTimestamp + messages <- getListTillEnd $ do + len <- fromEnum <$> getWord32be + Right <$> isolate len getOSC + pure $ OSCBundle ts messages + +-- There might be a more efficient way to write this?: +getListTillEnd :: Get x -> Get [x] +getListTillEnd getAction = isEmpty >>= \case + True -> pure [] + False -> do + r <- getAction + (r:) <$> getListTillEnd getAction + +encodeTimestamp :: Timestamp -> ByteString +encodeTimestamp t = runPut (putOSCTimestamp t) + +putOSCTimestamp :: Timestamp -> Put +putOSCTimestamp (Timestamp t) = + putWord64be $ round $ t * 2^(32::Int) + +getOSCTimestamp :: Get Timestamp +getOSCTimestamp = do + w <- {- realToFrac -} fromIntegral <$> getWord64be + pure $ Timestamp $ w / 2 ** 32 -- (2^(32::Int)) + +utcToTimestamp :: UTCTime -> Timestamp +utcToTimestamp utcTime = + let startOfTheCentury = + UTCTime (fromGregorian 1900 1 1) (secondsToDiffTime 0) + in Timestamp . realToFrac $ diffUTCTime utcTime startOfTheCentury + +_timestampToUTC :: Timestamp -> UTCTime +_timestampToUTC = undefined + +addSecs :: Timestamp -> Double -> Timestamp +addSecs (Timestamp t) secs = Timestamp (t + secs) + +diffTimestamps :: Timestamp -> Timestamp -> Double +diffTimestamps (Timestamp t1) (Timestamp t0) = t1 - t0 + +{- +instance NFData OSCDatum where + rnf (OSC_I x) = rnf x + rnf (OSC_F x) = rnf x + rnf (OSC_S x) = rnf x +{- + rnf (OSC_I8 x) = rnf x + rnf (OSC_I16 x) = rnf x +-} + rnf (OSC_B x) = rnf x +-} + +-- Makes sure we've consumed all input: +runGet :: Get a -> ByteString -> Either String a +runGet g = Get.runGet $ do + x <- g + isEmpty >>= \case + True -> pure x + False -> fail $ "Leftover bytes #2" + +-- With an exportable name: +runGetWithNoLeftover :: Get a -> ByteString -> Either String a +runGetWithNoLeftover = runGet + +-- Everything in OSC has to be a multiple of 4 bytes, so this is handy: +alignTo4' :: Integral i => i -> i +alignTo4' n = (4 - (n `rem` 4)) `mod` 4 + diff --git a/Vivid/OSC/Old.hs b/Vivid/OSC/Old.hs new file mode 100644 --- /dev/null +++ b/Vivid/OSC/Old.hs @@ -0,0 +1,178 @@ +-- | An older implementation of the spec. I provide it here, and several +-- tests, to show that the new code behaves the same. Will be removed soon. + +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +module Vivid.OSC.Old ( + encodeOSC + , encodeOSCDatum + , encodeOSCBundle + , encodeTimestamp + + , encodedOSC_addLength + + , decodeOSCData + , decodeOSC + , decodeOSCDatumWithPadding + ) where + +import Vivid.OSC (OSCDatum(..), Timestamp(..), OSC(..), OSCBundle(..), toTypeChar) +import Vivid.OSC.Old.Util + +import Data.Binary (encode, decode) +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BS8 +import qualified Data.ByteString.Lazy as BSL +import Data.Int +import Data.Monoid +import Data.Word + +encodeOSC :: OSC -> ByteString +encodeOSC (OSC url args) = BSL.toStrict $ BSL.concat $ [ + encodeOSCDatum (OSC_S url) + ,encodeOSCDatum (OSC_S ("," <> BS.concat (map toTypeChar args))) + ] <> map encodeOSCDatum args + +encodeOSCDatum :: OSCDatum -> BSL.ByteString +encodeOSCDatum = \case + OSC_I i -> encode i + OSC_S s -> BSL.fromStrict $ + s <> BS.replicate (align (BS.length s + 1) + 1) 0 + OSC_F f -> encode $ floatToWord f + OSC_D d -> encode $ doubleToWord d + OSC_T timestamp -> + BSL.fromStrict $ encodeTimestamp timestamp + OSC_B b -> mconcat [ + -- 4 bytes which describe the size of the blob: + encode (fromIntegral (BS.length b) :: Int32) + -- the blob itself: + , BSL.fromStrict b + -- padding: + , BSL.fromStrict (BS8.pack (replicate (align (BS.length b)) '\NUL')) + ] + +encodeOSCBundle :: OSCBundle -> ByteString +encodeOSCBundle (OSCBundle time messages) = mconcat [ + "#bundle\NUL" + , encodeTimestamp time + , (mconcat . map (encodedOSC_addLength . either id encodeOSC)) messages + ] + +encodeTimestamp :: Timestamp -> ByteString +encodeTimestamp (Timestamp time) = + BSL.toStrict $ encode $ (round (time * 2^(32::Int)) :: Word64) + + +encodedOSC_addLength :: ByteString -> ByteString +encodedOSC_addLength bs = + BSL.toStrict (encode (toEnum (BS.length bs) :: Word32)) <> bs + + +numBytesWithoutPadding :: Char -> ByteString -> Either String Int +numBytesWithoutPadding char b = case char of + 'i' -> Right 4 + 'f' -> Right 4 + 't' -> Right 4 + 'd' -> Right 8 + 's' -> case BS.elemIndex 0 $ b of + Just x -> Right $ fromIntegral x + Nothing -> Left $ "weirdness on " <> show b + 'b' -> Right . fromIntegral $ + (decode $ BSL.fromStrict $ BS.take 4 b :: Int32) + c -> + Left $ "vivid: unknown OSC character " <> show c <> ": " <> show b + +numBytesWithPadding :: Char -> ByteString -> Either String Int +numBytesWithPadding char b = case char of + 'i' -> Right 4 + 'f' -> Right 4 + 't' -> Right 4 + 'd' -> Right 8 + 's' -> + case numBytesWithoutPadding 's' b of + Right nb -> + let n = nb + 1 + in Right $ n + align n + Left e -> Left e + 'b' -> + case numBytesWithoutPadding 'b' b of + Right nb -> Right $ nb + align nb + 4 + Left e -> Left e + c -> + Left $ "vivid: unknown OSC character " <> show c <> ": " <> show b + +decodeOSCData :: [Char] -> ByteString -> Either String [OSCDatum] +decodeOSCData typeChars blob = case (typeChars, blob) of + ([], "") -> Right [] + ([], leftover) -> Left $ "leftover bytes: " <> show leftover + (_:_, "") -> Left $ "leftover typechars:" <> show typeChars + (t:ypes, _) -> + case (datum, rest) of + (Right a, Right b) -> Right (a:b) + (Right _, Left b) -> Left b + (Left a, Right _) -> Left a + (Left a, Left b) -> Left $ a ++ ", " ++ b + where + datum :: Either String OSCDatum + datum = case thisBlob of + Right b -> decodeOSCDatumWithPadding t b + Left e -> Left e + thisBlob :: Either String ByteString + thisBlob = case numBytesWithPadding t blob of + Right nb -> Right $ BS.take nb blob + Left e -> Left e + rest :: Either String [OSCDatum] + rest = case numBytesWithPadding t blob of + Right nb -> decodeOSCData ypes (BS.drop nb blob) + Left e -> Left e + +decodeOSC :: ByteString -> Either String OSC +decodeOSC b = case sizeAndStorage b of + Left e -> Left e + Right (sizeOfURL, storageOfURL) -> + + let (urlWithPad, allButURL) = BS.splitAt storageOfURL b + url = BS.take sizeOfURL urlWithPad + in case sizeAndStorage allButURL of + Left e -> Left e + -- typeDesc is like ",issif" + Right (sizeOfTypeDesc, storageOfTypeDesc) -> + case BS8.unpack $ BS.take sizeOfTypeDesc allButURL of + (',':typeDesc) -> + let rest = BS.drop (storageOfURL + storageOfTypeDesc) $ b + in case decodeOSCData typeDesc rest of + Right decoded -> Right $ OSC url decoded + Left e -> Left e + other -> Left $ "not understood: " ++ show other + where + sizeAndStorage :: ByteString -> Either String (Int, Int) + sizeAndStorage bs = + case (numBytesWithoutPadding 's' bs, numBytesWithPadding 's' bs) of + (Right size, Right storage) -> Right (size, storage) + (Left e0, Left e1) -> Left $ e0 ++ ", " ++ e1 + (Left e, _) -> Left e + (_, Left e) -> Left e + +decodeOSCDatumWithPadding :: Char -> ByteString -> Either String OSCDatum +decodeOSCDatumWithPadding char b = case char of + 'i' -> + Right $ OSC_I $ decode $ BSL.fromStrict b + 'f' -> + Right $ OSC_F $ wordToFloat $ decode $ BSL.fromStrict b + 's' -> + case numBytesWithoutPadding 's' b of + Right nb -> Right $ OSC_S $ BS.take nb b + Left e -> Left e + 'b' -> + case numBytesWithoutPadding 'b' b of + Right nb -> Right $ OSC_B $ BS.take nb $ BS.drop 4 b + Left e -> Left e + 'd' -> + Right $ OSC_D $ wordToDouble $ decode $ BSL.fromStrict b + 't' -> + Right $ OSC_T $ Timestamp $ (/(2^(32::Int))) $ realToFrac $ + (decode $ BSL.fromStrict b :: Word64) + c -> + Left $ "unknown character " <> show c <> ": " <> show b diff --git a/Vivid/OSC/Old/Util.hs b/Vivid/OSC/Old/Util.hs new file mode 100644 --- /dev/null +++ b/Vivid/OSC/Old/Util.hs @@ -0,0 +1,43 @@ +{-# OPTIONS_HADDOCK show-extensions #-} + +{-# LANGUAGE NoRebindableSyntax #-} +{-# LANGUAGE NoIncoherentInstances #-} +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE NoUndecidableInstances #-} + +module Vivid.OSC.Old.Util ( + align + , floatToWord + , wordToFloat + , doubleToWord + , wordToDouble + ) where + +import Data.Bits ((.&.), complement, Bits) +import qualified Foreign as F +import System.IO.Unsafe (unsafePerformIO) + +-- from hosc: +align :: (Num i,Bits i) => i -> i +{-# INLINE align #-} +align n = ((n + 3) .&. complement 3) - n + +-- from data-binary-ieee754: +floatToWord :: Float -> F.Word32 +floatToWord = coercionThing + +wordToFloat :: F.Word32 -> Float +wordToFloat = coercionThing + +doubleToWord :: Double -> F.Word64 +doubleToWord = coercionThing + +wordToDouble :: F.Word64 -> Double +wordToDouble = coercionThing + + +coercionThing :: (F.Storable a, F.Storable b) => a -> b +coercionThing x = unsafePerformIO $ F.alloca $ \buf -> do + F.poke (F.castPtr buf) x + F.peek buf + diff --git a/test/Test.hs b/test/Test.hs new file mode 100644 --- /dev/null +++ b/test/Test.hs @@ -0,0 +1,245 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ViewPatterns #-} + +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BSL +import Data.Serialize hiding (runGet) +-- import Data.Serialize.Get hiding (runGet) +-- import qualified Data.Serialize.Get as Get +-- import Data.Serialize.Put +import Data.Time +import Data.Word + +import Test.Microspec + +import Vivid.OSC +import Vivid.OSC.Old.Util +import qualified Vivid.OSC.Old as Old + +main :: IO () +main = microspec $ do + describe ".utils" $ do + describe "float->word->float" $ \f -> + wordToFloat (floatToWord f) === f + describe "word->float->word" $ \w -> + floatToWord (wordToFloat w) === w + describe "double->word->double" $ \d -> + wordToDouble (doubleToWord d) === d + describe "word->Double->word" $ \w -> + doubleToWord (wordToDouble w) === w + describe "align == align'" $ \i -> + alignTo4' (i :: Int) === align i + describe "OSC types" $ do + describe "OSC Datum" $ do + it "newPutOSCdatum == oldPutOSCdatum" $ do + \d -> BSL.toStrict (Old.encodeOSCDatum d) == encodeOSCDatum d + {- + - Problem is we don't have type tag; not high priority because + - we test it in 'getOSC/putOSC' etc: + it "getOSCDatum . putOSCDatum" $ \oldD -> + let Right newD = runGet getOSCDatum (runPut $ putOSCDatum o) + in datumEq newD oldD + -} + + it "timestamps: old encode . decode" $ + \(Positive t) -> + let ts = Timestamp t + encoded = BSL.toStrict $ Old.encodeOSCDatum $ OSC_T ts + Right (OSC_T t') = Old.decodeOSCDatumWithPadding 't' encoded + in ts `timestampEq` t' + + describe "examples from the OSC 1.0 spec" $ do + it "example 1" $ do + Old.encodeOSCDatum (OSC_S "OSC") + === BSL.pack (map (toEnum . fromEnum) ['O','S','C', '\NUL']) + it "example 1, new" $ do + encodeOSCDatum (OSC_S "OSC") + === BS.pack (map (toEnum . fromEnum) ['O','S','C', '\NUL']) + it "example 2" $ do + Old.encodeOSCDatum (OSC_S "data") + === BSL.pack (map (toEnum . fromEnum) ("data"++replicate 4 '\NUL')) + it "example 2, new" $ do + encodeOSCDatum (OSC_S "data") + === BS.pack (map (toEnum . fromEnum) ("data"++replicate 4 '\NUL')) + + + describe "the OSC type" $ do + it "olddecode . oldencode" $ \(OSC a bs) -> + -- My old decoding of timestamps was fucked up!: + let oldO = OSC a $ filter (\case { OSC_T _ -> False ; _ -> True }) bs + in Old.decodeOSC (Old.encodeOSC oldO) === Right oldO + it "new encode == old encode" $ \o -> + encodeOSC o === Old.encodeOSC o + it "decode . encode" $ \o -> + let Right new = decodeOSC (encodeOSC o) + in oscEq new o + describe "examples from the OSC 1.0 spec" $ do + it "example 1" $ + encodeOSC (OSC "/oscillator/4/frequency" [OSC_F 440.0]) + === BS.pack [ + 0x2f, 0x6f, 0x73, 0x63 + , 0x69, 0x6c, 0x6c, 0x61 + , 0x74, 0x6f, 0x72, 0x2f + , 0x34, 0x2f, 0x66, 0x72 + , 0x65, 0x71, 0x75, 0x65 + , 0x6e, 0x63, 0x79, 0x00 + , 0x2c, 0x66, 0x00, 0x00 + , 0x43, 0xdc, 0x00, 0x00 + ] + it "example 2" $ + let cmd = OSC "/foo" [OSC_I 1000, OSC_I (-1), OSC_S "hello", OSC_F 1.234, OSC_F 5.678] + out = BS.pack [ + 0x2f, 0x66, 0x6f, 0x6f + , 0x00, 0x00, 0x00, 0x00 + , 0x2c, 0x69, 0x69, 0x73 + , 0x66, 0x66, 0x00, 0x00 + , 0x00, 0x00, 0x03, 0xe8 + , 0xff, 0xff, 0xff, 0xff + , 0x68, 0x65, 0x6c, 0x6c + , 0x6f, 0x00, 0x00, 0x00 + , 0x3f, 0x9d, 0xf3, 0xb6 + , 0x40, 0xb5, 0xb2, 0x2d + ] + in encodeOSC cmd === out + describe "OSCBundle" $ do + it "newDecode . newEncode" $ \t xs -> + let oldB = OSCBundle t (map Right xs) + Right newB = decodeOSCBundle (encodeOSCBundle oldB) + in bundleEq newB oldB + it "oldEncode === newEncode" $ \b -> + Old.encodeOSCBundle b === encodeOSCBundle b + describe "bijections" $ do + it "getOSC . putOSC" $ \origOSC -> + let Right newOSC = decodeOSC (encodeOSC origOSC) + in oscEq newOSC origOSC + it "putOSCString vs old" $ \(NonNullBS s) -> + runPut (putOSCString s) === BSL.toStrict (Old.encodeOSCDatum (OSC_S s)) + describe "getString . putString" $ \(NonNullBS s) -> + runGet getOSCString (runPut (putOSCString s)) === Right s + it "decodetimestamp . encodetimestamp" $ \t -> + fromRight (runGet getOSCTimestamp (runPut (putOSCTimestamp t))) `timestampEq` t + it "oldencode timestamp == new encode" $ \t -> + runPut (putOSCTimestamp t) === Old.encodeTimestamp t + it "encodeOSC isRight (with the valid input we generate)" pending + describe "binary blobs" $ do + it "decode . encode" $ \(BS.pack -> b) -> + runGet getOSCBlob (runPut (putOSCBlob b)) === Right b + describe "decodeOSCdatumswithpadding == getOSCDatum" pending + describe "unit tests - a few examples for each function" $ do + describe "putOSCDatum" $ do + describe "OSC_S" $ do + it "pads an extra 4 when it's already a multiple of 4" $ + encodeOSCDatum (OSC_S "four") === "four\NUL\NUL\NUL\NUL" + describe "do this for every function" pending + describe "more manual test cases" pending +-- binary up to the mazimum size +-- very large and very small floats +-- NaNs and (+/-)Infinity (floats and doubles) +-- Huge numbers of variants +-- Some example times to parse +-- Some example numbers to parse + + + describe "timestamp" $ do + it "timestamp->utc" $ pending -- \t -> + -- utcToTimestamp (timestampToUTC t) === t + it "utc->timestamp" $ pending -- \u -> + -- timestampToUTC (utcToTimestamp u) === u + +fromRight :: Show e => Either e x -> x +fromRight = \case + Right x -> x + Left e -> error $ show e + +-- TODO: generic-random: +instance Arbitrary OSCDatum where + arbitrary = oneof [ + OSC_I <$> arbitrary + + -- Note no 0: OSC strings cannot contain the null character: + , OSC_S <$> nonNullBS + , OSC_F <$> arbitrary + , OSC_D <$> arbitrary + , (OSC_B . BS.pack) <$> arbitrary + , OSC_T <$> arbitrary + ] + +nonNullBS :: Gen ByteString +nonNullBS = BS.pack <$> listOf (choose (1, maxBound :: Word8)) + +newtype NonNullBS = NonNullBS ByteString + deriving (Show) + +instance Arbitrary NonNullBS where + arbitrary = NonNullBS <$> nonNullBS + +instance Arbitrary Timestamp where + -- Note cannot be negative: + arbitrary = (Timestamp . getNonNegative) <$> arbitrary + +instance Arbitrary OSC where + arbitrary = OSC + <$> nonNullBS -- Again no '\NUL' + <*> arbitrary + +instance Arbitrary OSCBundle where + arbitrary = OSCBundle + <$> arbitrary + <*> listOf (oneof [ + -- TODO: + -- (Left . BS.pack) <$> arbitrary -- todo: maybe needs to be padded? + Right <$> arbitrary -- type inference is nice! + ]) + +instance Arbitrary UTCTime where + arbitrary = undefined + +-- TODO: do we need this? is there a way to encode timestamps non-lossily?: +-- I would also love to get rid of this whole thing: +timestampEq :: Timestamp -> Timestamp -> Bool +timestampEq (Timestamp time0) (Timestamp time1) = + abs (time0 - time1) < 0.0000001 + +datumEq :: OSCDatum -> OSCDatum -> Bool +datumEq a b = case (a, b) of + (OSC_T t0, OSC_T t1) -> timestampEq t0 t1 + _ -> a == b + +oscEq :: OSC -> OSC -> Bool +oscEq (OSC p0 args0) (OSC p1 args1) = + (p0 == p1) && argsMatch args0 args1 + where + argsMatch [] [] = True + argsMatch [] (_:_) = False + argsMatch (_:_) [] = False + argsMatch (d0:rest0) (d1:rest1) = + datumEq d0 d1 && argsMatch rest0 rest1 + +bundleEq :: OSCBundle -> OSCBundle -> Bool +bundleEq (OSCBundle t0 msgs0) (OSCBundle t1 msgs1) = + timestampEq t0 t1 && msgsMatch msgs0 msgs1 + where + msgsMatch [] [] = True + msgsMatch [] (_:_) = False + msgsMatch (_:_) [] = False + msgsMatch (Right msg0:rest0) (Right msg1:rest1) = + oscEq msg0 msg1 && msgsMatch rest0 rest1 + msgsMatch (Left msg0:rest0) (Left msg1:rest1) = + (msg0 == msg1) && msgsMatch rest0 rest1 + -- This is the case where one is 'Left' and one is 'Right'. + -- We could hypothetically test if they're equal. + msgsMatch (_:_rest0) (_:_rest1) = False +{- + msgsMatch (Left l:rest0) (Right r:rest1) = + rightMatchesLeft l r + msgsMatch (Right r:rest0) (Left l:rest1) = + rightMatchesLeft l r + +-- This is not ideal, using the encoding functions to test them +rightMatchesLeft :: Left ByteString -> Right OSC -> Bool +-} +runGet :: Get a -> ByteString -> Either String a +runGet = runGetWithNoLeftover + diff --git a/vivid-osc.cabal b/vivid-osc.cabal new file mode 100644 --- /dev/null +++ b/vivid-osc.cabal @@ -0,0 +1,112 @@ +name: vivid-osc +version: 0.3.0.0 +synopsis: Open Sound Control encode/decode +description: + A small, simple, and well-tested implementation of the Open Sound Control + message format. + . + Example usage: + . + @ + {-\# LANGUAGE OverloadedStrings \#-} + @ + . + > import Network.Socket + > import Network.Socket.ByteString as SB + > + > import Vivid.OSC + > + > main = do + > -- Boring Network.Socket setup: + > (a:_) <- getAddrInfo Nothing (Just "127.0.0.1") (Just "57120") + > s <- socket (addrFamily a) Datagram defaultProtocol + > connect s (addrAddress a) + > + > -- The interesting part: + > SB.send s $ encodeOSC $ + > OSC "/play2" [OSC_S "cps", OSC_I 1, OSC_S "s", OSC_S "bd"] + +license: GPL +license-file: LICENSE +author: Tom Murphy +maintainer: Tom Murphy +category: Audio, Codec, Music, Sound + +build-type: Simple +cabal-version: >=1.10 + + +library + exposed-modules: + Vivid.OSC + , Vivid.OSC.Old + , Vivid.OSC.Old.Util + other-extensions: + LambdaCase + , OverloadedStrings + , ViewPatterns + , ScopedTypeVariables + , NoRebindableSyntax + , NoIncoherentInstances + , NoMonomorphismRestriction + , NoUndecidableInstances + build-depends: + + base >3 && <5 + + -- TODO: can remove when we remove .Old: + -- Lower bound: + -- Just a guess -- 0.5.0.2 is >5 years old + -- I don't have a reason to think it needs a lower bound + -- 0.2 is the oldest version on Hackage + -- Upper bound: + -- 0.9 doesn't exist yet + -- Try: "> 0.5.0.2 && < 0.9" + , binary + + + -- Lower bound: + -- Just a guess -- 0.9.1.8 is >5 years old + -- I don't have a reason to think it needs a lower bound + -- 0.9 is the oldest version on Hackage + -- Upper bound: + -- 0.11 doesn't exist yet + -- Try: "> 0.9.1.8 && < 0.11" + , bytestring + + -- Lower bound: + -- Guess: 0.4 is ~5 years old + -- Upper bound: + -- 0.6 doesn't exist yet + -- Try: ">= 0.4 && < 0.6" + , cereal + + -- Lower bound: + -- Just a guess -- 1.2 is >5 years old + -- I don't have a reason to think it needs a lower bound + -- (Although check out 'old-time' and those changes -- but + -- that's before 1.2) + -- 1.0 is the oldest version on Hackage + -- Upper bound: + -- 1.7 doesn't exist yet + -- Try: "&& < 1.7" + , time >= 1.2 + + default-language: Haskell2010 + ghc-options: + -O2 + +test-suite vivid-osc-tests + hs-source-dirs: test + main-is: Test.hs + type: exitcode-stdio-1.0 + build-depends: + base + , vivid-osc + + , bytestring + , cereal + -- Try: == 0.1 + , microspec + , time + default-language: Haskell2010