module Vivid.OSC (
OSC(..)
, OSCDatum(..)
, encodeOSC
, decodeOSC
, Timestamp(..)
, OSCBundle(..)
, encodeOSCBundle
, decodeOSCBundle
, encodeTimestamp
, utcToTimestamp
, addSecs
, diffTimestamps
, encodeOSCDatum
, putOSC
, putOSCString
, putOSCDatum
, getOSCString
, getOSC
, putOSCBlob
, getOSCBlob
, getOSCTimestamp
, putOSCTimestamp
, putOSCBundle
, getOSCBundle
, runGetWithNoLeftover
, toTypeChar
, alignTo4'
) where
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 qualified Data.Serialize.Get as Get
import Data.Time (UTCTime(..), fromGregorian, secondsToDiffTime, diffUTCTime)
data OSC
= OSC ByteString [OSCDatum]
deriving (Show, Read, Eq, Ord)
data OSCDatum
= OSC_I Int32
| OSC_S ByteString
| OSC_F Float
| OSC_D Double
| OSC_B ByteString
| OSC_T Timestamp
deriving (Show, Read, Eq, Ord)
newtype Timestamp = Timestamp Double
deriving (Show, Read, Eq, Ord)
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"
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
putByteString $ padTo4Bytes (s<>"\NUL")
getOSCString :: Get ByteString
getOSCString = do
first <- BS.takeWhile (/= 0) <$> getByteString 4
case BS.length first of
4 -> do
(first <>) <$> getOSCString
_ -> pure first
padTo4Bytes :: ByteString -> ByteString
padTo4Bytes b = b <> BS.replicate (alignTo4' (BS.length b)) 0
putOSCBlob :: ByteString -> Put
putOSCBlob bs = do
putInt32be $ toEnum $ BS.length bs
putByteString $ padTo4Bytes bs
getOSCBlob :: Get ByteString
getOSCBlob = do
size <- fromEnum <$> getInt32be
b <- getByteString size
_ <- getByteString (alignTo4' size)
pure b
decodeOSC :: ByteString -> Either String OSC
decodeOSC = runGet getOSC
getOSC :: Get OSC
getOSC = do
path <- getOSCString
(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
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
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 <- fromIntegral <$> getWord64be
pure $ Timestamp $ w / 2 ** 32
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
runGet :: Get a -> ByteString -> Either String a
runGet g = Get.runGet $ do
x <- g
isEmpty >>= \case
True -> pure x
False -> fail $ "Leftover bytes #2"
runGetWithNoLeftover :: Get a -> ByteString -> Either String a
runGetWithNoLeftover = runGet
alignTo4' :: Integral i => i -> i
alignTo4' n = (4 (n `rem` 4)) `mod` 4