From ce2cb6ed48e52e64fbc3ac031edfb996e87755f9 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 10 Aug 2020 16:21:59 -0700 Subject: new script and library for setting desktop wallpaper --- perl5/Local/Desktop.pm | 146 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 146 insertions(+) create mode 100644 perl5/Local/Desktop.pm (limited to 'perl5') 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 . + +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 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; -- cgit v1.2.3