-- | Base-level encode function for OSC packets (slow).
--   For ordinary use see 'Sound.OSC.Coding.Encode.Builder'.
module Sound.OSC.Coding.Encode.Base where

import Data.Binary {- base -}
import qualified Data.ByteString.Char8 as C {- bytestring -}
import qualified Data.ByteString.Lazy as B {- bytestring -}

import Sound.OSC.Coding.Byte {- hosc -}
import Sound.OSC.Datum {- hosc -}
import Sound.OSC.Packet {- hosc -}
import Sound.OSC.Time {- hosc -}

-- | Align byte string, if required.
extend :: Word8 -> B.ByteString -> B.ByteString
extend :: Word8 -> ByteString -> ByteString
extend p :: Word8
p s :: ByteString
s = ByteString -> ByteString -> ByteString
B.append ByteString
s (Int64 -> Word8 -> ByteString
B.replicate (Int64 -> Int64
forall i. (Num i, Bits i) => i -> i
align (ByteString -> Int64
B.length ByteString
s)) Word8
p)

-- | Encode OSC 'Datum'.
encode_datum :: Datum -> B.ByteString
encode_datum :: Datum -> ByteString
encode_datum dt :: Datum
dt =
    case Datum
dt of
      Int32 i :: Int32
i -> Int32 -> ByteString
forall a. Binary a => a -> ByteString
encode Int32
i
      Int64 i :: Int64
i -> Int64 -> ByteString
forall a. Binary a => a -> ByteString
encode Int64
i
      Float f :: Float
f -> Float -> ByteString
encode_f32 Float
f
      Double d :: Double
d -> Double -> ByteString
encode_f64 Double
d
      TimeStamp t :: Double
t -> Word64 -> ByteString
encode_u64 (Word64 -> ByteString) -> Word64 -> ByteString
forall a b. (a -> b) -> a -> b
$ Double -> Word64
forall n. RealFrac n => n -> Word64
ntpr_to_ntpi Double
t
      ASCII_String s :: ASCII
s -> Word8 -> ByteString -> ByteString
extend 0 (ByteString -> Word8 -> ByteString
B.snoc (ASCII -> ByteString
encode_str ASCII
s) 0)
      Midi (MIDI b0 :: Word8
b0 b1 :: Word8
b1 b2 :: Word8
b2 b3 :: Word8
b3) -> [Word8] -> ByteString
B.pack [Word8
b0,Word8
b1,Word8
b2,Word8
b3]
      Blob b :: ByteString
b -> let n :: ByteString
n = Int -> ByteString
encode_i32 (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
B.length ByteString
b))
                in ByteString -> ByteString -> ByteString
B.append ByteString
n (Word8 -> ByteString -> ByteString
extend 0 ByteString
b)

-- | Encode OSC 'Message'.
encodeMessage :: Message -> B.ByteString
encodeMessage :: Message -> ByteString
encodeMessage (Message c :: Address_Pattern
c l :: [Datum]
l) =
    [ByteString] -> ByteString
B.concat [Datum -> ByteString
encode_datum (ASCII -> Datum
ASCII_String (Address_Pattern -> ASCII
C.pack Address_Pattern
c))
             ,Datum -> ByteString
encode_datum (ASCII -> Datum
ASCII_String ([Datum] -> ASCII
descriptor [Datum]
l))
             ,[ByteString] -> ByteString
B.concat ((Datum -> ByteString) -> [Datum] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Datum -> ByteString
encode_datum [Datum]
l) ]

-- | Encode OSC 'Message' as an OSC blob.
encode_message_blob :: Message -> Datum
encode_message_blob :: Message -> Datum
encode_message_blob = ByteString -> Datum
Blob (ByteString -> Datum)
-> (Message -> ByteString) -> Message -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> ByteString
encodeMessage

-- | Encode OSC 'Bundle'.
encodeBundle :: Bundle -> B.ByteString
encodeBundle :: Bundle -> ByteString
encodeBundle (Bundle t :: Double
t m :: [Message]
m) =
    [ByteString] -> ByteString
B.concat [ByteString
bundleHeader
             ,Word64 -> ByteString
encode_u64 (Double -> Word64
forall n. RealFrac n => n -> Word64
ntpr_to_ntpi Double
t)
             ,[ByteString] -> ByteString
B.concat ((Message -> ByteString) -> [Message] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (Datum -> ByteString
encode_datum (Datum -> ByteString)
-> (Message -> Datum) -> Message -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> Datum
encode_message_blob) [Message]
m)]

-- | Encode OSC 'Packet'.
encodePacket :: Packet -> B.ByteString
encodePacket :: Packet -> ByteString
encodePacket o :: Packet
o =
    case Packet
o of
      Packet_Message m :: Message
m -> Message -> ByteString
encodeMessage Message
m
      Packet_Bundle b :: Bundle
b -> Bundle -> ByteString
encodeBundle Bundle
b