Implement buffer creation from picture files

quasar-wayland.cabal

@@ -76,6 +76,7 @@ library
   exposed-modules:
     Quasar.Wayland.Client
     Quasar.Wayland.Client.Buffer
+    Quasar.Wayland.Client.JuicyPixels
     Quasar.Wayland.Client.Registry
     Quasar.Wayland.Client.Socket
     Quasar.Wayland.Client.Sync
@@ -96,6 +97,7 @@ library
     exceptions,
     filepath,
     inline-c,
+    JuicyPixels,
     mtl,
     network,
     quasar,

src/Quasar/Wayland/Client/JuicyPixels.hs

+module Quasar.Wayland.Client.JuicyPixels (
+  loadImageBuffer,
+  pixelRgba8ToWlARGB,
+) where
+
+import Codec.Picture
+import Data.Bits( unsafeShiftL, unsafeShiftR, (.|.), (.&.) )
+import Foreign
+import Quasar.Prelude
+import Quasar.Wayland.Client.Buffer
+import Quasar.Wayland.Protocol
+import Quasar.Wayland.Protocol.Generated
+
+loadImageBuffer :: ShmBufferManager -> FilePath -> IO (Object 'Client Interface_wl_buffer)
+loadImageBuffer shm path = do
+  image <- either fail (pure . convertRGBA8) =<< readImage path
+  (buffer, ptr) <- newShmBuffer shm (fromIntegral (imageWidth image)) (fromIntegral (imageHeight image))
+  let
+    width = imageWidth image
+    height = imageHeight image
+
+  withForeignPtr ptr \ptr' -> forM [(x, y) | x <- [0 .. width - 1], y <- [0 .. height - 1]] \(x, y) -> do
+    pokeByteOff ptr' ((x + (y * width)) * 4) (pixelRgba8ToWlARGB (pixelAt image x y))
+
+  pure buffer
+
+
+pixelRgba8ToWlARGB :: PixelRGBA8 -> Word32
+{-# INLINE pixelRgba8ToWlARGB #-}
+pixelRgba8ToWlARGB (PixelRGBA8 r g b a) =
+    (fi b `unsafeShiftL` (0 * bitCount)) .|.
+    (fi g `unsafeShiftL` (1 * bitCount)) .|.
+    (fi r `unsafeShiftL` (2 * bitCount)) .|.
+    (fi a `unsafeShiftL` (3 * bitCount))
+  where fi = fromIntegral
+        bitCount = 8