hip
hip copied to clipboard
Superimpose function does not superimpose
The superimpose
function in Graphics.Image.Processing
does not superimpose. It replaces the pixels in the target image with the overlay image. While useful, this is not the expected behavior. Especially, with superimposed images with alpha channels.
superimpose'
:: Array arr RGBA e
=> AlphaSpace RGBA e
=> Fractional e => Ord e
=> (Int, Int) -- ^ @(i, j)@ starting index from within a source image.
-> Image arr RGBA e -- ^ Image to be positioned above the source image.
-> Image arr RGBA e -- ^ Source image.
-> Image arr RGBA e
superimpose' (!i0, !j0) !imgA !imgB = traverse2 imgB imgA const newPx where
!(m, n) = dims imgA
newPx getPxB getPxA (i, j) =
let !(i', j') = (i - i0, j - j0)
new = getPxA (i', j')
old = getPxB (i, j)
in if i' >= 0 && j' >= 0 && i' < m && j' < n then overlayAlpha old new else old
overlayAlpha :: Elevator e => Ord e => Fractional e => Pixel RGBA e -> Pixel RGBA e -> Pixel RGBA e
overlayAlpha base overlay = setPxC (liftPx2 f base overlay) AlphaRGBA 1
where f b o = b + (getAlpha overlay * (o - b))
This works, but makes me wish that AlphaSpace
came with a setAlpha
so this could be more abstract.
Thanks for submitting this. I'll make sure to get it fixed in a new version of hip
, once I do get to the rewrite I have planned.
For now you could probably simulate setAlpha
with setAlpha a = addAlpha a . dropAlpha
Thanks @Fresheyeball for this workaround - it worked fine but it generates a greenish color when there are section where pixels of both image are transparent. So I checked Wikipedia, following https://en.wikipedia.org/wiki/Alpha_compositing I have an improved version of overlayAlpha
that works as expected:
overlayAlpha
:: (Elevator e, Ord e, Fractional e)
=> Pixel RGBA e
-> Pixel RGBA e
-> Pixel RGBA e
overlayAlpha bPxa oPxa =
addAlpha rAlp (liftPx2 f (dropAlpha bPxa) (dropAlpha oPxa))
where
bAlp = getAlpha bPxa
oAlp = getAlpha oPxa
rAlp = oAlp + bAlp * (1 - oAlp)
f b o =
if rAlp == 0
then 0
else (o * oAlp + b * bAlp * (1 - oAlp)) / rAlp