{-# LANGUAGE BangPatterns #-}

module Gamgine.Image.PNG.Internal.CRC (update_crc, crc) where

import Data.Word
import Data.Array.Unboxed
import Data.Bits
import qualified Gamgine.Image.PNG.Internal.LBS as LBS
import Gamgine.Image.PNG.Internal.LBS (LBS)

crc_table :: UArray Word32 Word32
crc_table :: UArray Word32 Word32
crc_table = (Word32, Word32) -> [Word32] -> UArray Word32 Word32
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Word32
0,Word32
255) ([Word32] -> UArray Word32 Word32)
-> ([Word32] -> [Word32]) -> [Word32] -> UArray Word32 Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Word32) -> [Word32] -> [Word32]
forall a b. (a -> b) -> [a] -> [b]
map Word32 -> Word32
iterate_c ([Word32] -> UArray Word32 Word32)
-> [Word32] -> UArray Word32 Word32
forall a b. (a -> b) -> a -> b
$ [Word32
0..]
 where
   iterate_c :: Word32 -> Word32
iterate_c = ([Word32] -> Int -> Word32
forall a. HasCallStack => [a] -> Int -> a
!! Int
8) ([Word32] -> Word32) -> (Word32 -> [Word32]) -> Word32 -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Word32) -> Word32 -> [Word32]
forall a. (a -> a) -> a -> [a]
iterate Word32 -> Word32
forall {a}. (Bits a, Num a) => a -> a
compute_c
   compute_c :: a -> a
compute_c a
c
       | a
c a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1   = a
0xedb88320 a -> a -> a
forall a. Bits a => a -> a -> a
`xor` (a
c a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
1)
       | Bool
otherwise      = a
c a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
1

update_crc :: Word32 -> LBS -> Word32
update_crc :: Word32 -> LBS -> Word32
update_crc !Word32
c LBS
bs
    | LBS -> Bool
LBS.null LBS
bs        = Word32
c
    | Bool
otherwise         = let w :: Word8
w      = LBS -> Word8
LBS.head LBS
bs
                              newcrc :: Word32
newcrc = (UArray Word32 Word32
crc_table UArray Word32 Word32 -> Word32 -> Word32
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! ((Word32
c Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xff)) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` (Word32
c Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
8)
                          in
                            Word32 -> LBS -> Word32
update_crc Word32
newcrc (LBS -> LBS
LBS.tail LBS
bs)

crc :: LBS -> Word32
crc :: LBS -> Word32
crc = (Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
0xffffffff) (Word32 -> Word32) -> (LBS -> Word32) -> LBS -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> LBS -> Word32
update_crc Word32
0xffffffff

--test = crc $ LB.replicate 10000000 128