-- | Bit-level type casts and byte layout string typecasts.
module Sound.Osc.Coding.Cast where

import Data.Char {- base -}
import Data.Word {- base -}

import qualified Data.Binary.IEEE754 as Ieee {- data-binary-ieee754 -}

import Sound.Osc.Coding.Convert {- hosc -}

-- | The IEEE byte representation of a float.
f32_w32 :: Float -> Word32
f32_w32 :: Float -> Word32
f32_w32 = Float -> Word32
Ieee.floatToWord

-- | Inverse of 'f32_w32'.
w32_f32 :: Word32 -> Float
w32_f32 :: Word32 -> Float
w32_f32 = Word32 -> Float
Ieee.wordToFloat

-- | The IEEE byte representation of a double.
f64_w64 :: Double -> Word64
f64_w64 :: Double -> Word64
f64_w64 = Double -> Word64
Ieee.doubleToWord

-- | Inverse of 'f64_i64'.
w64_f64 :: Word64 -> Double
w64_f64 :: Word64 -> Double
w64_f64 = Word64 -> Double
Ieee.wordToDouble

-- | Transform a haskell string into a C string (a null suffixed byte string).
str_cstr :: String -> [Word8]
str_cstr :: String -> [Word8]
str_cstr String
s = forall a b. (a -> b) -> [a] -> [b]
map (Int -> Word8
int_to_word8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) String
s forall a. [a] -> [a] -> [a]
++ [Word8
0]

-- | Inverse of 'str_cstr'.
cstr_str :: [Word8] -> String
cstr_str :: [Word8] -> String
cstr_str = forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
chr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
word8_to_int) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Word8
0)

-- | Transform a haskell string to a pascal string (a length prefixed byte string).
str_pstr :: String -> [Word8]
str_pstr :: String -> [Word8]
str_pstr String
s = Int -> Word8
int_to_word8 (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (Int -> Word8
int_to_word8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) String
s

-- | Inverse of 'str_pstr'.
pstr_str :: [Word8] -> String
pstr_str :: [Word8] -> String
pstr_str = forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
chr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
word8_to_int) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
1