swww service

1 files changed, 96 insertions, 1 deletions

diff --git a/sigils/home/services/wayland.scm b/sigils/home/services/wayland.scm
index 6c2dc9d..53b69a0 100644
--- a/sigils/home/services/wayland.scm
+++ b/sigils/home/services/wayland.scm
@@ -13,9 +13,14 @@
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-43)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 receive)
 
   #:export (home-kanshi-service-type
-            home-kanshi-configuration))
+            home-kanshi-configuration
+
+            home-swww-service-type
+            home-swww-configuration
+            swww-wallpaper))
 
 ;;;
 ;;; kanshi.
@@ -132,3 +137,93 @@ profile portable {
                 (default-value (home-kanshi-configuration))
                 (description "\
 Install and configure kanshi, output profile manager.")))
+
+;;;
+;;; swww.
+;;;
+
+(define (string-or-false? x)
+  (or (string? x) (not x)))
+
+(define-configuration/no-serialization swww-wallpaper
+  (img
+   file-like
+   "Wallpaper to apply.")
+  (output
+   (string-or-false #f)
+   "Output to apply the wallpaper to."))
+
+(define list-of-swww-wallpaper?
+  (list-of swww-wallpaper?))
+
+(define-configuration/no-serialization home-swww-configuration
+  (swww
+   (file-like swww)
+   "swww package to use.")
+  (wallpapers
+   (list-of-swww-wallpaper '())
+   "List of wallpapers to apply."))
+
+(define (swww-img-gexp config)
+  (receive (with-outputs without-outputs)
+      (partition
+       swww-wallpaper-output
+       (home-swww-configuration-wallpapers config))
+    (let ((swww (home-swww-configuration-swww config))
+          (sorted-imgs
+           (map
+            swww-wallpaper-img
+            (append with-outputs without-outputs)))
+          (sorted-outputs
+           (map
+            swww-wallpaper-output
+            (append with-outputs without-outputs))))
+      #~(begin
+          (use-modules (ice-9 threads))
+          (par-for-each
+           (lambda (img output)
+             (apply system* (string-append #+swww "/bin/swww") "img" img
+                    (if output `("-o" ,output) '())))
+           '#$sorted-imgs '#$sorted-outputs)))))
+
+(define (home-swww-shepherd-service config)
+  (let ((swww (home-swww-configuration-swww config)))
+    (list
+     (shepherd-service
+      (provision '(swww))
+      (requirement '(wayland-display))
+      (modules '((srfi srfi-1)
+                 (srfi srfi-26)))
+      (start #~(lambda _
+                 ;; This is not optimal.
+                 (fork+exec-command
+                  (list #$(file-append swww "/bin/swww-daemon"))
+                  #:log-file (string-append
+                              (getenv "XDG_STATE_HOME") "/log"
+                              "/swww.log")
+                  #:environment-variables
+                  (cons (string-append "WAYLAND_DISPLAY=" (getenv "WAYLAND_DISPLAY"))
+                        (remove (cut string-prefix? "WAYLAND_DISPLAY=" <>)
+                                (default-environment-variables))))))
+      (stop #~(make-kill-destructor))
+      (documentation "Run the Swww daemon.")))))
+
+(define home-swww-service-type
+  (service-type
+   (name 'home-swww)
+   (extensions
+    (list
+     (service-extension
+      home-profile-service-type
+      (lambda (config)
+        (list
+         (home-swww-configuration-swww config))))
+     (service-extension
+      home-shepherd-service-type
+      home-swww-shepherd-service)
+     (service-extension
+      home-activation-service-type
+      swww-img-gexp)))
+   (compose identity)
+   (default-value (home-swww-configuration))
+   (description "Install and configure swww, animated wallpaper daemon.")))