{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
module Graphics.Rasterific.BiSampleable
( BiSampleable( .. )
, bilinearInterpolation
, sampledImageShader
) where
import Data.Fixed( mod' )
import Codec.Picture
( Image( .. )
, Pixel8
, Pixel( .. )
, PixelRGBA8( .. ) )
import Graphics.Rasterific.Linear
import Graphics.Rasterific.Types
import Graphics.Rasterific.Compositor
import Graphics.Rasterific.Command
import Graphics.Rasterific.PatchTypes
import Graphics.Rasterific.Transformations
class BiSampleable sampled px | sampled -> px where
interpolate :: sampled -> Float -> Float -> px
instance (Pixel px, Modulable (PixelBaseComponent px))
=> BiSampleable (ParametricValues px) px where
{-# INLINE interpolate #-}
interpolate = bilinearPixelInterpolation
instance ( InterpolablePixel px
, Num (Holder px Float)
) => BiSampleable (CubicCoefficient px) px where
{-# INLINE interpolate #-}
interpolate = bicubicInterpolation
instance BiSampleable (ImageMesh PixelRGBA8) PixelRGBA8 where
{-# INLINE interpolate #-}
interpolate imesh xb yb = sampledImageShader (_meshImage imesh) SamplerPad x y
where (V2 x y) = applyTransformation (_meshTransform imesh) (V2 xb yb)
sampledImageShader :: forall px. RenderablePixel px
=> Image px -> SamplerRepeat -> ShaderFunction px
{-# SPECIALIZE
sampledImageShader :: Image Pixel8 -> SamplerRepeat
-> ShaderFunction Pixel8 #-}
{-# SPECIALIZE
sampledImageShader :: Image PixelRGBA8 -> SamplerRepeat
-> ShaderFunction PixelRGBA8 #-}
sampledImageShader img _ _ _
| imageWidth img == 0 || imageHeight img == 0 = emptyPx
sampledImageShader img sampling x y =
(at px py `interpX` at pxn py)
`interpY`
(at px pyn `interpX` at pxn pyn)
where
coordSampler SamplerPad maxi v = min (maxi - 1) . max 0 $ floor v
coordSampler SamplerReflect maxi v =
floor $ abs (abs (v - maxif - 1) `mod'` (2 * maxif) - maxif - 1)
where maxif = fromIntegral maxi
coordSampler SamplerRepeat maxi v = floor v `mod` maxi
w = fromIntegral $ imageWidth img
h = fromIntegral $ imageHeight img
clampedX = coordSampler sampling w
clampedY = coordSampler sampling h
px = clampedX x
pxn = clampedX $ x + 1
py = clampedY y
pyn = clampedY $ y + 1
dx, dy :: Float
!dx = x - fromIntegral (floor x :: Int)
!dy = y - fromIntegral (floor y :: Int)
at :: Int -> Int -> px
at !xx !yy =
unsafePixelAt rawData $ (yy * w + xx) * compCount
(covX, icovX) = clampCoverage dx
(covY, icovY) = clampCoverage dy
interpX = mixWith (const $ alphaOver covX icovX)
interpY = mixWith (const $ alphaOver covY icovY)
compCount = componentCount (undefined :: px)
rawData = imageData img
bilinearPixelInterpolation :: (Pixel px, Modulable (PixelBaseComponent px))
=> ParametricValues px -> Float -> Float -> px
{-# SPECIALIZE INLINE
bilinearPixelInterpolation :: ParametricValues PixelRGBA8 -> Float -> Float -> PixelRGBA8
#-}
bilinearPixelInterpolation (ParametricValues { .. }) !dx !dy =
mixWith (const $ alphaOver covY icovY)
(mixWith (const $ alphaOver covX icovX) _northValue _eastValue)
(mixWith (const $ alphaOver covX icovX) _westValue _southValue)
where
(!covX, !icovX) = clampCoverage dx
(!covY, !icovY) = clampCoverage dy
bilinearInterpolation :: InterpolablePixel px
=> ParametricValues px -> Float -> Float -> px
{-# INLINE bilinearInterpolation #-}
bilinearInterpolation ParametricValues { .. } u v = fromFloatPixel $ lerp v uBottom uTop where
!uTop = lerp u (toFloatPixel _eastValue) (toFloatPixel _northValue)
!uBottom = lerp u (toFloatPixel _southValue) (toFloatPixel _westValue)
bicubicInterpolation :: forall px . (InterpolablePixel px, Num (Holder px Float))
=> CubicCoefficient px -> Float -> Float -> px
bicubicInterpolation params x y =
fromFloatPixel . fmap clamp $ af ^+^ bf ^+^ cf ^+^ df
where
ParametricValues a b c d = getCubicCoefficients params
maxi = maxRepresentable (Proxy :: Proxy px)
clamp = max 0 . min maxi
xv, vy, vyy, vyyy :: V4 Float
xv = V4 1 x (x*x) (x*x*x)
vy = xv ^* y
vyy = vy ^* y
vyyy = vyy ^* y
v1 ^^*^ v2 = (^*) <$> v1 <*> v2
V4 af bf cf df = (a ^^*^ xv) ^+^ (b ^^*^ vy) ^+^ (c ^^*^ vyy) ^+^ (d ^^*^ vyyy)