Proper fix for alpha channel mishandling

X11 only handles alpha channels in a restricted set of APIs (such as
setting `border_color`); most others throw undocumented errors and/or
produce black pixels. Document this, and mask out alpha where it
matters.

Fixes xmonad/xmonad#395, xmonad/xmonad#398.
This commit is contained in:
brandon s allbery kf8nh
2022-07-05 10:16:53 -04:00
parent ebdb079a94
commit 5557944fb6
2 changed files with 19 additions and 3 deletions

View File

@@ -39,6 +39,7 @@ import XMonad.Prelude
import Foreign
import Control.Exception as E
import Text.Printf (printf)
import Data.Bits ((.&.))
#ifdef XFT
import qualified Data.List.NonEmpty as NE
@@ -64,16 +65,23 @@ stringToPixel d s = fromMaybe fallBack <$> io getIt
fallBack = blackPixel d (defaultScreen d)
-- | Convert a @Pixel@ into a @String@.
--
-- This function removes any alpha channel from the @Pixel@, because X11
-- mishandles alpha channels and produces black.
pixelToString :: (MonadIO m) => Display -> Pixel -> m String
pixelToString d p = do
let cm = defaultColormap d (defaultScreen d)
(Color _ r g b _) <- io (queryColor d cm $ Color p 0 0 0 0)
(Color _ r g b _) <- io (queryColor d cm $ Color (p .&. 0x00FFFFFF) 0 0 0 0)
return ("#" ++ hex r ++ hex g ++ hex b)
where
-- NOTE: The @Color@ type has 16-bit values for red, green, and
-- blue, even though the actual type in X is only 8 bits wide. It
-- seems that the upper and lower 8-bit sections of the @Word16@
-- values are the same. So, we just discard the lower 8 bits.
--
-- (Strictly, X11 supports 16-bit values but no visual supported
-- by XOrg does. It is still correct to discard the lower bits, as
-- they are not guaranteed to be meaningful in such visuals.)
hex = printf "%02x" . (`shiftR` 8)
econst :: a -> IOException -> a

View File

@@ -46,16 +46,24 @@ import XMonad
import XMonad.Util.Font
import XMonad.Util.Image
import qualified XMonad.StackSet as W
import Data.Bits ((.&.))
-- $usage
-- See "XMonad.Layout.Tabbed" or "XMonad.Layout.DragPane" or
-- "XMonad.Layout.Decoration" for usage examples
-- | Compute the weighted average the colors of two given Pixel values.
-- | Compute the weighted average the colors of two given 'Pixel' values.
--
-- This function masks out any alpha channel in the passed pixels, and the
-- result has no alpha channel. X11 mishandles @Pixel@ values with alpha
-- channels and throws errors while producing black pixels.
averagePixels :: Pixel -> Pixel -> Double -> X Pixel
averagePixels p1 p2 f =
averagePixels p1' p2' f =
do d <- asks display
let cm = defaultColormap d (defaultScreen d)
mask p = p .&. 0x00FFFFFF
p1 = mask p1'
p2 = mask p2'
[Color _ r1 g1 b1 _,Color _ r2 g2 b2 _] <- io $ queryColors d cm [Color p1 0 0 0 0,Color p2 0 0 0 0]
let mn x1 x2 = round (fromIntegral x1 * f + fromIntegral x2 * (1-f))
Color p _ _ _ _ <- io $ allocColor d cm (Color 0 (mn r1 r2) (mn g1 g2) (mn b1 b2) 0)