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

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

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

{- | The IEEE byte representation of a float.

>>> f32_w32 pi
1078530011

>>> f32_w32 (-7913907.5)
3404825447

>>> 23 ^ 7
3404825447
-}
f32_w32 :: Float -> Word32
f32_w32 :: Float -> Word32
f32_w32 = ByteString -> Word32
decode_word32 (ByteString -> Word32) -> (Float -> ByteString) -> Float -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> ByteString
encode_f32

{- | Inverse of 'f32_w32'.

>>> w32_f32 1078530011
3.1415927

>>> w32_f32 (23 ^ 7)
-7913907.5
-}
w32_f32 :: Word32 -> Float
w32_f32 :: Word32 -> Float
w32_f32 = ByteString -> Float
decode_f32 (ByteString -> Float) -> (Word32 -> ByteString) -> Word32 -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> ByteString
encode_word32

{- | The IEEE byte representation of a double.


>>> f64_w64 pi
4614256656552045848

>>> f64_w64 1.6822072834e-314
3404825447
-}
f64_w64 :: Double -> Word64
f64_w64 :: Double -> Word64
f64_w64 = ByteString -> Word64
decode_word64 (ByteString -> Word64)
-> (Double -> ByteString) -> Double -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> ByteString
encode_f64

{- | Inverse of 'f64_w64'.

>>> w64_f64 4614256656552045848
3.141592653589793

>>> w64_f64 (23 ^ 7)
1.6822072834e-314
-}
w64_f64 :: Word64 -> Double
w64_f64 :: Word64 -> Double
w64_f64 = ByteString -> Double
decode_f64 (ByteString -> Double)
-> (Word64 -> ByteString) -> Word64 -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> ByteString
encode_word64

-- | 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 = (Char -> Word8) -> String -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Word8
int_to_word8 (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) String
s [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ [Word8
0]

-- | Inverse of 'str_cstr'.
cstr_str :: [Word8] -> String
cstr_str :: [Word8] -> String
cstr_str = (Word8 -> Char) -> [Word8] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
chr (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
word8_to_int) ([Word8] -> String) -> ([Word8] -> [Word8]) -> [Word8] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> [Word8] -> [Word8]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Word8 -> Word8 -> Bool
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 (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: (Char -> Word8) -> String -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Word8
int_to_word8 (Int -> Word8) -> (Char -> Int) -> Char -> 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 = (Word8 -> Char) -> [Word8] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
chr (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
word8_to_int) ([Word8] -> String) -> ([Word8] -> [Word8]) -> [Word8] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
drop Int
1