module Vision.Image.Transform.ScaleDCT (scale) where
import Prelude ()
import Prelude.Compat
import Data.Array.CArray.Base (CArray (..))
import qualified Data.Vector.Storable as VS
import Vision.Image hiding ((!))
import Vision.Primitive.Shape
import Data.Array.CArray (amap, array, bounds, elems, size, (!))
import Data.Ix (range)
import Math.FFT (dct2N, dct3N)
import qualified Data.Vector as V
type Array2D = CArray (Int, Int) Double
scale ::
( ImagePixel i ~ pix
, PixelChannel pix ~ pixChan
, Integral pixChan
, Pixel pix
, VS.Storable pixChan
, Image i)
=> (Int, Int)
-> i
-> Manifest (ImagePixel i)
scale dim@(w,h) img = Manifest (Z :. w :. h) res'
where
Manifest ((Z :. iw) :. ih) ivec = compute img
!ivec' = castVec img ivec
!nchans = nChannels img
fi :: (Integral pixChan) => pixChan -> Double
fi x = fromIntegral x
chanVec = V.generate nchans (\chan ->
imageToArray (Manifest ((Z :. iw) :. ih) $
VS.generate (iw*ih) $ \ix ->
fi $ VS.unsafeIndex ivec' (ix * nchans + chan)))
chanVec' :: V.Vector Array2D
chanVec' = fmap transform chanVec
truncate' :: (Image i, Integral (PixelChannel (ImagePixel i)), VS.Storable (ImagePixel i))
=> i
-> Double
-> PixelChannel (ImagePixel i)
truncate' _ = truncate
res = VS.generate (nchans * h * w) (\ix -> case quotRem ix nchans of
(i,v) -> truncate' img . limit $ V.unsafeIndex chanVec' v ! (quotRem i w)
)
res' :: (VS.Storable pix) => VS.Vector pix
res' = VS.unsafeCast res
castVec :: (ImagePixel i ~ pix', Image i, VS.Storable pix', VS.Storable (PixelChannel pix'))
=> i
-> VS.Vector pix'
-> VS.Vector (PixelChannel pix')
castVec _ = VS.unsafeCast
transform ch = amap (k*) ch'
where
ch' = dct3N [1, 0] . cut dim . dct2N [0, 1] $ ch
k = imgNorm ch / imgNorm ch'
imgNorm :: Array2D -> Double
imgNorm ch = sqrt . (/n) . sum . fmap sq . elems $ ch
where sq x = x * x
n = fromIntegral $ size ch
cut :: (Int, Int) -> Array2D -> Array2D
cut (w, h) img = array b [ (i, pick i) | i <- range b ]
where b = ((0,0), (h1, w1))
(_,(w',h')) = bounds img
pick i@(x,y) | x < h' && y < w' = img ! i
| otherwise = 0
imageToArray :: Manifest Double -> Array2D
imageToArray img = case img of
Manifest ((Z :. h) :. w) vec -> case VS.unsafeToForeignPtr0 vec of
(fptr, len) -> CArray (0,0) (h1,w1) len fptr
limit :: Double -> Double
limit x | x < 0 = 0
| x > 255 = 255
| otherwise = x