module Codec.Goat.ValueFrame.Encode
( valueEncode
) where
import Control.Arrow
import Data.Bits
import Data.Bits.Floating
import Data.List
import Data.Word
import qualified Data.ByteString as B
import Codec.Goat.Util
import Codec.Goat.ValueFrame.Types
valueEncode :: [Float]
-> ValueFrame
valueEncode [] = ValueFrame Nothing 0 B.empty
valueEncode xs = ValueFrame (Just y) (genericLength bits) (packBits bits)
where
bits = concat $ snd $ mapAccumL encode (16, 16) xors :: [Bool]
xors = zipWith xor (y:ys) ys :: [Word32]
(y:ys) = map coerceToWord xs :: [Word32]
encode :: (Int, Int)
-> Word32
-> ((Int, Int), [Bool])
encode bounds x
| x == 0 = (bounds, [False])
| fits = (bounds, [True, False] ++ slice bounds bits)
| otherwise = (newBounds, [True, True] ++ outside newBounds bits)
where
newBounds = (countTrailingZeros &&& countLeadingZeros) x
bits = toBools x
fits = within bounds newBounds
within (a, b) (na, nb) = na >= a && nb >= b
outside :: (Int, Int)
-> [Bool]
-> [Bool]
outside bounds@(lead, trail) bits = concat
[ take 5 $ toBools lead
, take 6 $ toBools $ 32leadtrail
, slice bounds bits ]
slice :: (Int, Int)
-> [a]
-> [a]
slice (lead, trail) xs = take (32leadtrail) (drop lead xs)