window-utils 0.2.0.0 → 0.2.1.0

raw patch · 3 files changed

+46/−27 lines, 3 files

Files

• CHANGELOG.md +2/−2
• src/OS/Window/X11.hs +41/−22
• window-utils.cabal +3/−3

@@ -1,5 +1,5 @@ # Revision history for window-utils -## 0.1.0.0 -- 12-03-2023+## 0.2.1.0 -- 03-04-2023 -* First version. Released on an unsuspecting world.+* Handle PNGs with no alpha channel.

@@ -7,6 +7,7 @@  import Codec.Picture import Control.Applicative+import Control.Arrow import Data.Bits import Data.ByteString (ByteString) import Data.ByteString qualified as BS@@ -51,25 +52,43 @@     -- | PNG image     ByteString ->     IO ()-setIcon (Window w d) img = do-    case decodePng img of-        Left e -> error e-        Right (ImageRGBA8 Image{..}) -> do-            nET_WM_ICON <- internAtom d "_NET_WM_ICON" True-            changeProperty32 d w nET_WM_ICON cARDINAL propModeReplace $-                map fromIntegral [imageWidth, imageHeight]-                    ++ map fromIntegral (groupPixels $ Vec.toList imageData)-            flush d-          where-            groupPixels :: [Word8] -> [Word64]-            groupPixels = \case-                r : g : b : a : ps ->-                    ( shift (fromIntegral a) 24-                        .|. shift (fromIntegral r) 16-                        .|. shift (fromIntegral g) 8-                        .|. shift (fromIntegral b) 0-                    )-                        : groupPixels ps-                [] -> []-                _ -> error "vector length not a multiple of 4"-        _ -> error "wrong pixel type"+setIcon (Window w d) =+    decodePng >>> either error \case+        ImageRGBA8 Image{..} -> rgb imageWidth imageHeight imageData \case+            r : g : b : a : ps -> Just ((r, g, b, a), ps)+            [] -> Nothing+            _ -> error "vector length not a multiple of 4"+        ImageRGB8 Image{..} -> rgb imageWidth imageHeight imageData \case+            r : g : b : ps -> Just ((r, g, b, maxBound), ps)+            [] -> Nothing+            _ -> error "vector length not a multiple of 3"+        ImageY8{} -> error "unexpected pixel type: ImageY8"+        ImageY16{} -> error "unexpected pixel type: ImageY16"+        ImageY32{} -> error "unexpected pixel type: ImageY32"+        ImageYF{} -> error "unexpected pixel type: ImageYF"+        ImageYA8{} -> error "unexpected pixel type: ImageYA8"+        ImageYA16{} -> error "unexpected pixel type: ImageYA16"+        ImageRGB16{} -> error "unexpected pixel type: ImageRGB16"+        ImageRGBF{} -> error "unexpected pixel type: ImageRGBF"+        ImageRGBA16{} -> error "unexpected pixel type: ImageRGBA16"+        ImageYCbCr8{} -> error "unexpected pixel type: ImageYCbCr8"+        ImageCMYK8{} -> error "unexpected pixel type: ImageCMYK8"+        ImageCMYK16{} -> error "unexpected pixel type: ImageCMYK16"+  where+    rgb :: Int -> Int -> Vec.Vector Word8 -> ([Word8] -> Maybe ((Word8, Word8, Word8, Word8), [Word8])) -> IO ()+    rgb imageWidth imageHeight imageData unconsPixels = do+        nET_WM_ICON <- internAtom d "_NET_WM_ICON" True+        changeProperty32 d w nET_WM_ICON cARDINAL propModeReplace $+            map fromIntegral [imageWidth, imageHeight]+                ++ map fromIntegral (groupPixels $ Vec.toList imageData)+        flush d+      where+        groupPixels :: [Word8] -> [Word64]+        groupPixels =+            unconsPixels >>> maybe [] \((r, g, b, a), ps) ->+                ( shift (fromIntegral a) 24+                    .|. shift (fromIntegral r) 16+                    .|. shift (fromIntegral g) 8+                    .|. shift (fromIntegral b) 0+                )+                    : groupPixels ps

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               window-utils-version:            0.2.0.0+version:            0.2.1.0 license:            BSD-3-Clause author:             George Thomas maintainer:         georgefsthomas@gmail.com@@ -34,10 +34,10 @@         cpp-options:             -DWIN=Unsupported     build-depends:-        base ^>= 4.16,+        base ^>= {4.16, 4.17, 4.18},         bytestring ^>= 0.11,         JuicyPixels ^>= 3.3.6,-        text ^>= 1.2.3,+        text ^>= {1.2.3, 2.0},         vector ^>= 0.12.3.1,     default-language: GHC2021     default-extensions: