Parsing 24-bit floats correctly
Getty Ritter
8 years ago
| 1 | 1 | {-# LANGUAGE RecordWildCards #-} |
| 2 | {-# LANGUAGE BinaryLiterals #-} | |
| 2 | 3 | |
| 3 | 4 | module Graphics.HVIF |
| 4 | 5 | ( |
| 305 | 306 | pMatrix :: Get Matrix |
| 306 | 307 | pMatrix = S.fromList `fmap` replicateM 6 pFloat |
| 307 | 308 | |
| 308 | -- XXX Actually parse 24-bit floats right | |
| 309 | 309 | pFloat :: Get Float |
| 310 | 310 | pFloat = do |
| 311 | _ <- getWord8 | |
| 312 | _ <- getWord8 | |
| 313 | _ <- getWord8 | |
| 314 | return 0.0 | |
| 311 | b1 <- fromIntegral <$> getWord8 | |
| 312 | b2 <- fromIntegral <$> getWord8 | |
| 313 | b3 <- fromIntegral <$> getWord8 | |
| 314 | let sVal :: Word32 = (b1 `shift` 16) .|. (b2 `shift` 8) .|. b3 | |
| 315 | sMask = 0b100000000000000000000000 -- == 0x800000 | |
| 316 | eMask = 0b011111100000000000000000 -- == 0x7e0000 | |
| 317 | mMask = 0b000000011111111111111111 -- == 0x01ffff | |
| 318 | sign = (sVal .&. sMask) `shift` (-23) | |
| 319 | expo = ((sVal .&. eMask) `shift` (-17)) - 32 | |
| 320 | mant = (sVal .&. mMask) `shift` 6 | |
| 321 | val = (sign `shift` 31) .|. ((expo + 127) `shift` 23) .|. mant | |
| 322 | if sVal == 0 | |
| 323 | then return 0.0 | |
| 324 | else castToFloat val | |
| 325 | ||
| 326 | ||
| 327 | castToFloat :: Word32 -> Get Float | |
| 328 | castToFloat w32 = | |
| 329 | let bs = encode w32 | |
| 330 | in case runGet getFloat32be bs of | |
| 331 | Left err -> fail err | |
| 332 | Right x -> return x | |