new script and library for setting desktop wallpaper

1 files changed, 146 insertions, 0 deletions

diff --git a/perl5/Local/Desktop.pm b/perl5/Local/Desktop.pm
new file mode 100644
index 00000000..1b2fcc3e
--- /dev/null
+++ b/perl5/Local/Desktop.pm
@@ -0,0 +1,146 @@
+package Local::Desktop;
+
+# graphical desktop management functions
+#
+# Copyright (C) 2020 Sean Whitton
+#
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or (at
+# your option) any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+use 5.028;
+use strict;
+use warnings;
+
+use Carp;
+use File::Find;
+use File::LibMagic;
+use File::Spec::Functions "rel2abs";
+use Exporter "import";
+
+our @EXPORT = qw(
+  select_wallpaper_files
+  ensure_resize_for_current_outputs
+  resize_for_current_outputs
+  pick_random_wallpapers );
+
+my $output_re = qr/ ([0-9]+)x([0-9]+)\+([0-9]+)\+([0-9]+) /;
+
+=head select_wallpaper_files(@files)
+
+Select the first entry of @files as the wallpaper for the first output, the
+second entry of @files as the wallpaper for the second output, etc.
+
+This function works by creating symlinks to those wallpapers in ~/local.
+
+=cut
+
+sub select_wallpaper_files {
+    my $i;
+    unlink <"$ENV{HOME}/local/wallpaper??.*">;
+    for (@_) {
+        -r or croak "$_ could not be read!";
+        symlink rel2abs($_),
+          sprintf "$ENV{HOME}/local/wallpaper%02d." . (/\.([^.]+)\z/)[0], $i++;
+    }
+}
+
+=head resize_for_current_outputs()
+
+Based on the output of xrandr(1), create ~/local/wallpaper.png from
+~/local/wallpaperNN.*, such that executing `feh --bg-scale --no-xinerama
+~/local/wallpaper.png` will put wallpaper00.* on the first output,
+wallpaper01.* on the second, etc.  There should not be more than one file
+matching ~/local/wallpaperNN.* for each NN.
+
+Returns the value of $? right after executing convert(1).
+
+=cut
+
+sub resize_for_current_outputs {
+    # note that swaybg and swaylock have per-output wallpapers built in, so
+    # hopefully someday this function will be obsolete ...
+
+    chomp(my @xrandr = `xrandr`);
+    my ($canvas_w, $canvas_h) = _get_screen_size(@xrandr);
+    # sort the displays from left to right and then from top to bottom
+    my @displays = sort {
+        my (undef, undef, $a_x, $a_y) = $a =~ $output_re;
+        my (undef, undef, $b_x, $b_y) = $b =~ $output_re;
+        $a_y <=> $b_y or $a_x <=> $b_x
+    } grep / connected /, @xrandr;
+
+    my @wallpapers = sort {
+        ($a =~ /wallpaper([0-9]+)\./)[0] <=> ($b =~ /wallpaper([0-9]+)\./)[0]
+    } <"$ENV{HOME}/local/wallpaper??.*">;
+
+    my @args = ("-page", "${canvas_w}x${canvas_h}", qw(-background none));
+    for (@displays) {
+        /$output_re/;
+        push @args, '(', (shift @wallpapers || "canvas:#FFFFF6"),
+          "-resize", "${1}x${2}^",
+          qw(-gravity center -extent), "${1}x${2}",
+          "-repage", "${1}x${2}+${3}+${4}", ')';
+    }
+    push @args, qw(-layers merge), "$ENV{HOME}/local/wallpaper.png";
+
+    system "convert", @args;
+    return $?;
+}
+
+=head ensure_resize_for_current_outputs()
+
+Call C<resize_for_current_outputs()> if it looks to be needed.
+
+=cut
+
+sub ensure_resize_for_current_outputs {
+    return unless <"$ENV{HOME}/local/wallpaper??.*">;
+    resize_for_current_outputs(), return
+      unless -e "$ENV{HOME}/local/wallpaper.png";
+    my ($screen_w, $screen_h) = _get_screen_size(`xrandr`);
+    my $magic = File::LibMagic->new;
+    my ($img_w, $img_h)
+      = $magic->info_from_filename("$ENV{HOME}/local/wallpaper.png")
+      ->{description} =~ / ([0-9]+) x ([0-9]+),/;
+    resize_for_current_outputs()
+      if $img_w
+      and $img_h
+      and ($screen_w != $img_w or $screen_h != $img_h);
+}
+
+=head pick_random_wallpapers($n, @dirs)
+
+Pick C<$n> random wallpapers from files in any of the directories listed in
+C<@dirs>.
+
+=cut
+
+sub pick_random_wallpapers {
+    my $n = shift;
+    my $magic = File::LibMagic->new(follow_symlinks => 1);
+    my (@images, @picks);
+    find sub {
+        push @images, $File::Find::name
+          if $magic->info_from_filename($_)->{description} =~ /^\w+ image/
+    }, @_;
+    push @picks, splice @images, int(rand @images), 1 for 1 .. $n;
+    return @picks;
+}
+
+sub _get_screen_size {
+    chomp(@_);
+    my ($canvas) = grep /^Screen 0:/, @_;
+    $canvas =~ /current ([0-9]+) x ([0-9]+)/;
+}
+
+1;