module Vivid.OSC (
OSC(..)
, OSCDatum(..)
, encodeOSC
, decodeOSC
) where
import Vivid.OSC.Util
import Control.DeepSeq
import Data.Binary (encode, decode)
import qualified Data.ByteString as BS
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy as BSL
import Data.Int (Int32)
import Data.Monoid
data OSC
= OSC ByteString [OSCDatum]
deriving (Show, Read, Eq)
data OSCDatum
= OSC_I Int32
| OSC_S ByteString
| OSC_F Float
| OSC_B ByteString
deriving (Show, Read, Eq)
encodeOSC :: OSC -> ByteString
encodeOSC (OSC url args) = BSL.toStrict $ BSL.concat $ [
encodeDatum (OSC_S url)
,encodeDatum (OSC_S ("," <> BS.concat (map toTypeChar args)))
] <> map encodeDatum args
where
toTypeChar (OSC_I _) = "i"
toTypeChar (OSC_S _) = "s"
toTypeChar (OSC_F _) = "f"
toTypeChar (OSC_B _) = "b"
encodeDatum :: OSCDatum -> BSL.ByteString
encodeDatum (OSC_I i) = encode i
encodeDatum (OSC_S s) = BSL.fromStrict $
s <> BS.replicate (align (BS.length s + 1) + 1) 0
encodeDatum (OSC_F f) = (encode . floatToWord) f
encodeDatum (OSC_B b) = mconcat [
encode (fromIntegral (BS.length b) :: Int32)
, BSL.fromStrict b
, BSL.fromStrict (BS8.pack (replicate (align (BS.length b)) '\NUL'))
]
decodeDatumWithPadding :: Char -> ByteString -> OSCDatum
decodeDatumWithPadding 'i' b =
OSC_I (decode $ BSL.fromStrict b)
decodeDatumWithPadding 'f' b =
OSC_F (wordToFloat . decode $ BSL.fromStrict b)
decodeDatumWithPadding 's' b =
OSC_S $ BS.take (numBytesWithoutPadding 's' b) b
decodeDatumWithPadding 'b' b =
OSC_B $ BS.take (numBytesWithoutPadding 'b' b) $ BS.drop 4 b
decodeDatumWithPadding c b =
error $ "unknown character " <> show c <> ": " <> show b
numBytesWithoutPadding :: Char -> ByteString -> Int
numBytesWithoutPadding 'i' _ = 4
numBytesWithoutPadding 'f' _ = 4
numBytesWithoutPadding 's' b = case BS.elemIndex 0 $ b of
Just x -> fromIntegral x
Nothing -> error $ "weirdness on " <> show b
numBytesWithoutPadding 'b' b = fromIntegral $
(decode $ BSL.fromStrict $ BS.take 4 b :: Int32)
numBytesWithoutPadding c b =
error $ "unknown character " <> show c <> ": " <> show b
numBytesWithPadding :: Char -> ByteString -> Int
numBytesWithPadding 'i' _ = 4
numBytesWithPadding 'f' _ = 4
numBytesWithPadding 's' b =
let n = (numBytesWithoutPadding 's' b) + 1
in n + (align n)
numBytesWithPadding 'b' b =
let n = numBytesWithoutPadding 'b' b
in n + align n + 4
numBytesWithPadding c b =
error $ "unknown character " <> show c <> ": " <> show b
decodeOSCData :: [Char] -> ByteString -> [OSCDatum]
decodeOSCData [] "" = []
decodeOSCData [] leftover = error $ "leftover bytes: " <> show leftover
decodeOSCData (t:ypes) blob =
(:) datum
(decodeOSCData ypes (BS.drop (numBytesWithPadding t blob) blob))
where
datum = decodeDatumWithPadding t thisBlob
thisBlob = BS.take (numBytesWithPadding t blob) blob
decodeOSC :: ByteString -> OSC
decodeOSC b =
let sizeOfURL = numBytesWithoutPadding 's' b
storageOfURL = numBytesWithPadding 's' b
url = BS.take sizeOfURL b
sizeOfTypeDesc = numBytesWithoutPadding 's' $ BS.drop storageOfURL b
storageOfTypeDesc = numBytesWithPadding 's' $ BS.drop storageOfURL b
(',':typeDesc) = BS8.unpack $ BS.take sizeOfTypeDesc $
BS.drop storageOfURL b
rest = BS.drop (storageOfURL + storageOfTypeDesc) $ b
in OSC url $ decodeOSCData typeDesc rest
instance NFData OSCDatum where
rnf (OSC_I x) = rnf x
rnf (OSC_F x) = rnf x
rnf (OSC_S x) = rnf x
rnf (OSC_B x) = rnf x