module Sound.OpenSoundControl.OSC ( OSC(..)
, Datum(..)
, encodeOSC
, decodeOSC ) where
import qualified Data.ByteString.Lazy as B
import Data.List
import Data.Maybe
import Data.Word
import Sound.OpenSoundControl.Time
import Sound.OpenSoundControl.Byte
import Sound.OpenSoundControl.Cast
data Datum = Int Int
| Float Double
| Double Double
| String String
| Blob [Word8]
deriving (Eq, Show)
data OSC = Message String [Datum]
| Bundle Time [OSC]
deriving (Eq, Show)
instance Ord OSC where
compare (Bundle a _) (Bundle b _) = compare a b
compare _ _ = EQ
tag :: Datum -> Char
tag (Int _) = 'i'
tag (Float _) = 'f'
tag (Double _) = 'd'
tag (String _) = 's'
tag (Blob _) = 'b'
descriptor :: [Datum] -> Datum
descriptor l = String (',' : map tag l)
align :: Int -> Int
align n = (n) `mod` 4
extend :: a -> [a] -> [a]
extend p s = s ++ replicate (align (length s)) p
encode_datum :: Datum -> B.ByteString
encode_datum (Int i) = encode_i32 i
encode_datum (Float f) = encode_f32 f
encode_datum (Double d) = encode_f64 d
encode_datum (String s) = B.pack (extend 0 (str_cstr s))
encode_datum (Blob b) = B.concat [encode_i32 (length b), B.pack (extend 0 b)]
encode_message :: String -> [Datum] -> B.ByteString
encode_message c l =
B.concat [ encode_datum (String c)
, encode_datum (descriptor l)
, B.concat (map encode_datum l) ]
encode_osc_blob :: OSC -> Datum
encode_osc_blob = Blob . B.unpack . encodeOSC
encode_bundle_ntpi :: Integer -> [OSC] -> B.ByteString
encode_bundle_ntpi t l =
B.concat [ encode_datum (String "#bundle")
, encode_u64 t
, B.concat (map (encode_datum . encode_osc_blob) l) ]
encodeOSC :: OSC -> B.ByteString
encodeOSC (Message c l) = encode_message c 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
size :: Char -> B.ByteString -> Int
size 'i' _ = 4
size 'f' _ = 4
size 'd' _ = 8
size 's' b = fromIntegral (fromMaybe
(error ("size: no terminating zero: " ++ show b))
(B.elemIndex 0 b))
size 'b' b = decode_i32 (B.take 4 b)
size _ _ = error "size: illegal type"
storage :: Char -> B.ByteString -> Int
storage 's' b = n + align n where n = size 's' b + 1
storage 'b' b = n + align n + 4 where n = size 'b' b
storage c _ = size c B.empty
decode_datum :: Char -> B.ByteString -> Datum
decode_datum 'i' b = Int (decode_i32 b)
decode_datum 'f' b = Float (decode_f32 b)
decode_datum 'd' b = Double (decode_f64 b)
decode_datum 's' b = String (decode_str (b_take n b)) where n = size 's' b
decode_datum 'b' b = Blob (B.unpack (b_take n (B.drop 4 b))) where n = size 'b' b
decode_datum _ _ = error "decode_datum: illegal type"
decode_datum_seq :: [Char] -> B.ByteString -> [Datum]
decode_datum_seq cs b = zipWith decode_datum cs (snd (mapAccumL f b cs))
where swap (x,y) = (y,x)
f b' c = swap (B.splitAt (fromIntegral (storage c b')) b')
decode_message :: B.ByteString -> OSC
decode_message b = Message cmd arg
where n = storage 's' b
(String cmd) = decode_datum 's' b
m = storage 's' (b_drop n b)
(String dsc) = decode_datum 's' (b_drop n b)
arg = decode_datum_seq (drop 1 dsc) (b_drop (n + m) b)
decodeOSC :: B.ByteString -> OSC
decodeOSC = decode_message
b_take :: Int -> B.ByteString -> B.ByteString
b_take n = B.take (fromIntegral n)
b_drop :: Int -> B.ByteString -> B.ByteString
b_drop n = B.drop (fromIntegral n)