{- | 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.Coding.Convert {- 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 Word8
p 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'.

MidiData: Bytes from MSB to LSB are: port id, status byte, data1, data2.

>>> encode_datum (blob [1, 2, 3, 4]) == B.pack [0, 0, 0, 4, 1, 2, 3, 4]
True

>>> encode_datum (Float 1) == B.pack [63, 128, 0, 0]
True

>>> encode_datum (Float 2) == B.pack [64, 0, 0, 0]
True

>>> encode_datum (Float 3) == B.pack [64, 64, 0, 0]
True

>>> encode_datum (Float 4) == B.pack [64, 128, 0, 0]
True

>>> encode_datum (Float 5) == B.pack [64, 160, 0, 0]
True

>>> encode_datum (Int32 65536) == B.pack [0, 1, 0, 0]
True

>>> encode_datum (Int32 (-65536)) == B.pack [255, 255, 0, 0]
True
-}
encode_datum :: Datum -> B.ByteString
encode_datum :: Datum -> ByteString
encode_datum Datum
dt =
  case Datum
dt of
    Int32 Int32
i -> Int32 -> ByteString
forall a. Binary a => a -> ByteString
encode Int32
i
    Int64 Int64
i -> Int64 -> ByteString
forall a. Binary a => a -> ByteString
encode Int64
i
    Float Float
f -> Float -> ByteString
encode_f32 Float
f
    Double Double
d -> Double -> ByteString
encode_f64 Double
d
    TimeStamp Double
t -> Word64 -> ByteString
encode_word64 (Word64 -> ByteString) -> Word64 -> ByteString
forall a b. (a -> b) -> a -> b
$ Double -> Word64
ntpr_to_ntpi Double
t
    AsciiString Ascii
s -> Word8 -> ByteString -> ByteString
extend Word8
0 (ByteString -> Word8 -> ByteString
B.snoc (Ascii -> ByteString
encode_ascii Ascii
s) Word8
0)
    Midi (MidiData Word8
b0 Word8
b1 Word8
b2 Word8
b3) -> [Word8] -> ByteString
B.pack [Word8
b0, Word8
b1, Word8
b2, Word8
b3]
    Blob ByteString
b ->
      let n :: ByteString
n = Int32 -> ByteString
forall a. Binary a => a -> ByteString
encode (Int64 -> Int32
int64_to_int32 (ByteString -> Int64
B.length ByteString
b))
      in ByteString -> ByteString -> ByteString
B.append ByteString
n (Word8 -> ByteString -> ByteString
extend Word8
0 ByteString
b)

{- | Encode Osc 'Message'.

>>> blob_unpack (encodeMessage (Message "/x" []))
[47,120,0,0,44,0,0,0]

>>> blob_unpack (encodeMessage (Message "/y" [float 3.141]))
[47,121,0,0,44,102,0,0,64,73,6,37]

>>> let m = Message "/n_set" [int32 (-1), string "freq", float 440, string "amp", float 0.1]
>>> let e = blob_unpack (encodeMessage m)
>>> length e
40

>>> take 20 e
[47,110,95,115,101,116,0,0,44,105,115,102,115,102,0,0,255,255,255,255]
-}
encodeMessage :: Message -> B.ByteString
encodeMessage :: Message -> ByteString
encodeMessage (Message Address_Pattern
c [Datum]
l) =
  [ByteString] -> ByteString
B.concat
    [ Datum -> ByteString
encode_datum (Ascii -> Datum
AsciiString (Address_Pattern -> Ascii
C.pack Address_Pattern
c))
    , Datum -> ByteString
encode_datum (Ascii -> Datum
AsciiString ([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'.

>>> blob_unpack (encodeBundle (Bundle immediately [Message "/x" []]))
[35,98,117,110,100,108,101,0,0,0,0,0,0,0,0,1,0,0,0,8,47,120,0,0,44,0,0,0]

>>> let m = Message "/n_set" [int32 (-1), string "freq", float 440, string "amp", float 0.1]
>>> let b = Bundle 0.0 [m]
>>> let e = blob_unpack (encodeBundle b)
>>> length e
60

>> take 20 e
[35,98,117,110,100,108,101,0,0,0,0,0,0,0,0,0,0,0,0,40]
-}
encodeBundle :: BundleOf Message -> B.ByteString
encodeBundle :: BundleOf Message -> ByteString
encodeBundle (Bundle Double
t [Message]
m) =
  [ByteString] -> ByteString
B.concat
    [ ByteString
bundleHeader
    , Word64 -> ByteString
encode_word64 (Double -> 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 :: PacketOf Message -> B.ByteString
encodePacket :: PacketOf Message -> ByteString
encodePacket PacketOf Message
o =
  case PacketOf Message
o of
    Packet_Message Message
m -> Message -> ByteString
encodeMessage Message
m
    Packet_Bundle BundleOf Message
b -> BundleOf Message -> ByteString
encodeBundle BundleOf Message
b