From 0b5cd80840940d7433fab49de9a9de237444ca2b Mon Sep 17 00:00:00 2001 From: PHO Date: Thu, 21 Jul 2011 12:29:43 +0900 Subject: [PATCH] EntropyData s --- Codec/Audio/WavPack/Entropy.hs | 65 +++++++++++++--------------------- Codec/Audio/WavPack/Words.hs | 19 +++++----- 2 files changed, 34 insertions(+), 50 deletions(-) diff --git a/Codec/Audio/WavPack/Entropy.hs b/Codec/Audio/WavPack/Entropy.hs index f031d11..e746801 100644 --- a/Codec/Audio/WavPack/Entropy.hs +++ b/Codec/Audio/WavPack/Entropy.hs @@ -19,31 +19,31 @@ module Codec.Audio.WavPack.Entropy , decMedian2 ) where +import Control.Monad.ST +import Control.Monad.Unicode import Data.Bits +import Data.STRef import Data.Word import Prelude.Unicode -- | FIXME -data EntropyData +data EntropyData s = EntropyData { -- | Median log2 values for a channel. - edMedian0 ∷ !Word32 - , edMedian1 ∷ !Word32 - , edMedian2 ∷ !Word32 + edMedian0 ∷ !(STRef s Word32) + , edMedian1 ∷ !(STRef s Word32) + , edMedian2 ∷ !(STRef s Word32) -- | FIXME - , edSlowLevel ∷ !Word32 + , edSlowLevel ∷ !(STRef s Word32) -- | FIXME - , edErrorLimit ∷ !Word32 + , edErrorLimit ∷ !(STRef s Word32) } - deriving (Eq, Show) -clearMedian ∷ EntropyData → EntropyData -{-# INLINE clearMedian #-} -clearMedian e = e { - edMedian0 = 0 - , edMedian1 = 0 - , edMedian2 = 0 - } +clearMedian ∷ EntropyData s → ST s () +clearMedian e + = writeSTRef (edMedian0 e) 0 ≫ + writeSTRef (edMedian1 e) 0 ≫ + writeSTRef (edMedian2 e) 0 -- | The time constant of the 3 median level breakpoints div0, div1, div2 ∷ Word32 @@ -52,35 +52,20 @@ div1 = 64 -- 10/ 49 of samples div2 = 32 -- 20/343 of samples -- | Retrieve the specified median breakpoint (without frac; min = 1) -getMedian0, getMedian1, getMedian2 ∷ EntropyData → Word32 -{-# INLINE getMedian0 #-} -{-# INLINE getMedian1 #-} -{-# INLINE getMedian2 #-} -getMedian0 e = (edMedian0 e `shiftR` 4) + 1 -getMedian1 e = (edMedian1 e `shiftR` 4) + 1 -getMedian2 e = (edMedian2 e `shiftR` 4) + 1 +getMedian0, getMedian1, getMedian2 ∷ EntropyData s → ST s Word32 +getMedian0 = fmap ((`shiftR` 4) ∘ (+ 1)) ∘ readSTRef ∘ edMedian0 +getMedian1 = fmap ((`shiftR` 4) ∘ (+ 1)) ∘ readSTRef ∘ edMedian1 +getMedian2 = fmap ((`shiftR` 4) ∘ (+ 1)) ∘ readSTRef ∘ edMedian2 -- | Update the specified median breakpoints. Note that the median is -- incremented when the sample is higher than the median, else -- decremented. They are designed so that the median will never drop -- below 1 and the value is essentially stationary if there are 2 -- increments for every 5 decrements. -incMedian0, decMedian0, incMedian1, decMedian1, incMedian2, decMedian2 ∷ EntropyData → EntropyData -incMedian0 e - = e { edMedian0 = - edMedian0 e + ((edMedian0 e + div0 ) `div` div0) ⋅ 5 } -decMedian0 e - = e { edMedian0 = - edMedian0 e - ((edMedian0 e + (div0-2)) `div` div0) ⋅ 2 } -incMedian1 e - = e { edMedian1 = - edMedian1 e + ((edMedian1 e + div1 ) `div` div1) ⋅ 5 } -decMedian1 e - = e { edMedian1 = - edMedian1 e - ((edMedian1 e + (div1-2)) `div` div1) ⋅ 2 } -incMedian2 e - = e { edMedian2 = - edMedian2 e + ((edMedian2 e + div2 ) `div` div2) ⋅ 5 } -decMedian2 e - = e { edMedian2 = - edMedian2 e - ((edMedian2 e + (div2-2)) `div` div2) ⋅ 2 } +incMedian0, decMedian0, incMedian1, decMedian1, incMedian2, decMedian2 ∷ EntropyData s → ST s () +incMedian0 = flip modifySTRef (\x → x + ((x + div0 ) `div` div0) ⋅ 5) ∘ edMedian0 +decMedian0 = flip modifySTRef (\x → x - ((x + (div0-2)) `div` div0) ⋅ 2) ∘ edMedian0 +incMedian1 = flip modifySTRef (\x → x + ((x + div1 ) `div` div1) ⋅ 5) ∘ edMedian1 +decMedian1 = flip modifySTRef (\x → x - ((x + (div1-2)) `div` div1) ⋅ 2) ∘ edMedian1 +incMedian2 = flip modifySTRef (\x → x + ((x + div2 ) `div` div2) ⋅ 5) ∘ edMedian2 +decMedian2 = flip modifySTRef (\x → x - ((x + (div2-2)) `div` div2) ⋅ 2) ∘ edMedian2 diff --git a/Codec/Audio/WavPack/Words.hs b/Codec/Audio/WavPack/Words.hs index 6406d3e..e477505 100644 --- a/Codec/Audio/WavPack/Words.hs +++ b/Codec/Audio/WavPack/Words.hs @@ -42,18 +42,17 @@ import Data.Word import Prelude.Unicode -- | FIXME -data WordsData +data WordsData s = WordsData { - wdBitrateDelta ∷ !(Word32, Word32) - , wdBitrateAcc ∷ !(Word32, Word32) - , wdPendingData ∷ !Word32 - , wdHoldingOne ∷ !Word32 - , wdZeroesAcc ∷ !Word32 - , wdHoldingZero ∷ !Bool - , wdPendingCount ∷ !Int - , wdEntropyData ∷ !(EntropyData, EntropyData) + wdBitrateDelta ∷ !(STRef s (Word32, Word32)) + , wdBitrateAcc ∷ !(STRef s (Word32, Word32)) + , wdPendingData ∷ !(STRef s Word32) + , wdHoldingOne ∷ !(STRef s Word32) + , wdZeroesAcc ∷ !(STRef s Word32) + , wdHoldingZero ∷ !(STRef s Bool) + , wdPendingCount ∷ !(STRef s Int) + , wdEntropyData ∷ !(EntropyData s, EntropyData s) } - deriving (Eq, Show) -- | This is an optimized version of 'getWord' that is used for -- lossless only ('edErrorLimit' ≡ 0). Also, rather than obtaining a -- 2.40.0