hosc 0.4 → 0.5

raw patch · 6 files changed

+96/−45 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Sound/OpenSoundControl/Cast.hs +11/−0
• Sound/OpenSoundControl/Coerce.hs +29/−0
• Sound/OpenSoundControl/OSC.hs +8/−15
• Sound/OpenSoundControl/Time.hs +30/−19
• Sound/OpenSoundControl/Transport.hs +14/−8
• hosc.cabal +4/−3

@@ -21,6 +21,17 @@ f64_i64 :: Double -> Int64 f64_i64 d = runST ((from_array =<< castSTUArray =<< unit_array d) :: ST s Int64) +{-+http://www.haskell.org/pipermail/haskell-cafe/2008-February/040000.html++{-# LANGUAGE MagicHash #-}+import Data.Int+import GHC.Exts++f64_i64 :: Double -> Int64 --ghc only+f64_i64 (D# x) = I64# (unsafeCoerce# x)+-}+ -- | Inverse of 'f64_i64'. i64_f64 :: Int64 -> Double i64_f64 d = runST ((from_array =<< castSTUArray =<< unit_array d) :: ST s Double)

@@ -0,0 +1,29 @@+module Sound.OpenSoundControl.Coerce where++import Sound.OpenSoundControl.OSC++-- | Map a normalizing function over datum at an osc packet.+coerce :: (Datum -> Datum) -> OSC -> OSC+coerce f (Message s xs) = Message s (map f xs)+coerce f (Bundle t xs) = Bundle t (map (coerce f) xs)++-- | Coerce Float to Double.+f_to_d :: Datum -> Datum+f_to_d (Float n) = Double n+f_to_d x = x++-- | Coerce Int and Float to Double.+if_to_d :: Datum -> Datum+if_to_d (Int n) = Double (fromIntegral n)+if_to_d (Float n) = Double n+if_to_d x = x++-- | Coerce Float and Double to Int.+fd_to_i :: Datum -> Datum+fd_to_i (Float n) = Int (round n)+fd_to_i (Double n) = Int (round n)+fd_to_i x = x++-- | A normalized osc packet has only Int and Double numerical values.+normalize :: OSC -> OSC+normalize = coerce f_to_d

@@ -1,6 +1,6 @@ module Sound.OpenSoundControl.OSC ( OSC(..)                                   , Datum(..)-                                  , encodeOSC, encodeOSCNTP+                                  , encodeOSC                                   , decodeOSC ) where  import qualified Data.ByteString.Lazy as B@@ -21,7 +21,7 @@  -- | An OSC packet. data OSC = Message String [Datum]-         | Bundle Double [OSC]+         | Bundle Time [OSC]            deriving (Eq, Show)  -- | OSC bundles can be ordered (time ascending).@@ -69,25 +69,18 @@ encode_osc_blob = Blob . B.unpack . encodeOSC  -- Encode an OSC bundle.-encode_bundle_ntp :: Double -> [OSC] -> B.ByteString-encode_bundle_ntp t l =+encode_bundle_ntpi :: Integer -> [OSC] -> B.ByteString+encode_bundle_ntpi t l =     B.concat [ encode_datum (String "#bundle")-             , encode_u64 (ntpr_ntp t)+             , encode_u64 t              , B.concat (map (encode_datum . encode_osc_blob) l) ] --- | Encode an OSC packet (NTP epoch).-encodeOSCNTP :: OSC -> B.ByteString-encodeOSCNTP (Message c l) = encode_message c l-encodeOSCNTP (Bundle t l) = encode_bundle_ntp t l---- Offset from UTC to NTP epoch.-utc_ntp_diff :: Double-utc_ntp_diff = (70 * 365 + 17) * 24 * 60 * 60- -- | Encode an OSC packet. encodeOSC :: OSC -> B.ByteString encodeOSC (Message c l) = encode_message c l-encodeOSC (Bundle t l) = encode_bundle_ntp (t + utc_ntp_diff) l+encodeOSC (Bundle (NTPi t) l) = encode_bundle_ntpi t l+encodeOSC (Bundle (NTPr t) l) = encode_bundle_ntpi (ntpr_ntpi t) l+encodeOSC (Bundle (UTCr t) l) = encode_bundle_ntpi (utcr_ntpi t) l  -- The plain byte count of an OSC value. size :: Char -> B.ByteString -> Int

@@ -4,19 +4,30 @@ import Control.Monad import qualified Data.Time as T --- | UTC time is represented as a real number.-type UTC = Double+-- | Time is represented in either UTC or NTP form.+data Time = UTCr Double | NTPr Double | NTPi Integer+            deriving (Eq, Show) --- | NTP time is represented as an integer.-type NTP = Integer+-- | Coerce to NTPi form.+as_ntpi :: Time -> Integer+as_ntpi (UTCr t) = utcr_ntpi t+as_ntpi (NTPr t) = ntpr_ntpi t+as_ntpi (NTPi t) = t +-- | Times can be ordered, avoid coercion if not required.+instance Ord Time where+    compare (UTCr p) (UTCr q) = compare p q+    compare (NTPr p) (NTPr q) = compare p q+    compare (NTPi p) (NTPi q) = compare p q+    compare p q = compare (as_ntpi p) (as_ntpi q)+ -- | Convert a real-valued NTP timestamp to an NTP timestamp.-ntpr_ntp :: Double -> NTP-ntpr_ntp t = round (t * 2^(32::Int))+ntpr_ntpi :: Double -> Integer+ntpr_ntpi t = round (t * 2^(32::Int))  -- | Convert UTC timestamp to NTP timestamp.-utc_ntp :: UTC -> NTP-utc_ntp t = ntpr_ntp (t + secdif)+utcr_ntpi :: Double -> Integer+utcr_ntpi t = ntpr_ntpi (t + secdif)     where secdif = (70 * 365 + 17) * 24 * 60 * 60  -- | The time at 1970-01-01:00:00:00.@@ -25,19 +36,19 @@     where d = T.fromGregorian 1970 1 1           s = T.secondsToDiffTime 0 --- | Read current UTC timestamp.-utc :: IO UTC-utc = do t <- T.getCurrentTime-         return (realToFrac (T.diffUTCTime t utc_base))+-- | Read current UTCr timestamp.+utcr :: IO Double+utcr = do t <- T.getCurrentTime+          return (realToFrac (T.diffUTCTime t utc_base))  -- | Read current NTP timestamp.-ntp :: IO NTP-ntp = liftM utc_ntp utc+ntpi :: IO Integer+ntpi = liftM utcr_ntpi utcr  -- | Pause current thread for the indicated duration, given in seconds.-pause :: Double -> IO ()-pause n = when (n > 1e-4) (threadDelay (floor (n * 1e6)))+pauseThread :: Double -> IO ()+pauseThread n = when (n > 1e-4) (threadDelay (floor (n * 1e6))) --- | Pause current thread until the given utc time.-pauseUntil :: UTC -> IO ()-pauseUntil t = pause . (t -) =<< utc+-- | Pause current thread until the given utcr time.+pauseThreadUntil :: Double -> IO ()+pauseThreadUntil t = pauseThread . (t -) =<< utcr

@@ -1,6 +1,6 @@ module Sound.OpenSoundControl.Transport ( Transport(..)                                         , withTransport-                                        , wait ) where+                                        , waitFor, wait ) where  import Control.Exception import Sound.OpenSoundControl.OSC@@ -19,15 +19,21 @@ has_address x (Message y _) = x == y has_address _ _ = False --- Repeat action until predicate holds on result.-untilM :: Monad m => (a -> Bool) -> m a -> m a-untilM p act = recurse-    where recurse = act >>= (\r -> if p r then return r else recurse)+-- Repeat action until function does not give Nothing when applied to result.+untilM :: Monad m => (a -> Maybe b) -> m a -> m b+untilM f act = recurse+    where g p = let q = f p in case q of { Nothing -> recurse+                                         ; Just r -> return r }+          recurse = act >>= g --- | Wait for an OSC message with the specified address, ---   discarding intervening messages.+-- | Wait for an OSC message where the supplied function does not give+--   Nothing, discarding intervening messages.+waitFor :: Transport t => t -> (OSC -> Maybe a) -> IO a+waitFor t f = untilM f (recv t)++-- | A 'waitFor' for variant matching on address string of messages. wait :: Transport t => t -> String -> IO OSC-wait t s = untilM (has_address s) (recv t)+wait t s = waitFor t (\o -> if has_address s o then Just o else Nothing)  -- | Bracket OSC communication. withTransport :: Transport t => IO t -> (t -> IO a) -> IO a

@@ -1,5 +1,5 @@ Name:              hosc-Version:           0.4+Version:           0.5 Synopsis:          Haskell Open Sound Control Description:       hosc provides Sound.OpenSoundControl, a haskell                    module implementing a subset of the Open Sound@@ -11,17 +11,18 @@ Maintainer:        rd@slavepianos.org Stability:         Experimental Homepage:          http://slavepianos.org/rd/f/269573/-Tested-With:       GHC==6.8.2+Tested-With:       GHC==6.10.1 Build-Type:        Simple Cabal-Version:     >= 1.2 Data-Files:        README  Library   Build-Depends:   array, base, bytestring, binary, network, time-  GHC-Options:     -Wall -fwarn-tabs -O2+  GHC-Options:     -Wall -fwarn-tabs   Exposed-modules: Sound.OpenSoundControl                    Sound.OpenSoundControl.Byte                    Sound.OpenSoundControl.Cast+                   Sound.OpenSoundControl.Coerce                    Sound.OpenSoundControl.OSC                    Sound.OpenSoundControl.Time                    Sound.OpenSoundControl.Transport