Skip to content

Instantly share code, notes, and snippets.

@dru8274
Created January 3, 2016 23:53
Show Gist options
  • Save dru8274/48bc6bb21c1a4145f8a3 to your computer and use it in GitHub Desktop.
Save dru8274/48bc6bb21c1a4145f8a3 to your computer and use it in GitHub Desktop.
Fvwm Thumbnail Icons
#### My Iconificate module
This is how I did the thumbnail icons here : http://i.imgur.com/ryWrztC.png
Thumbnail icons are common enough in FVWM. Most times, it is done with xwd and/or
imagemagick in a PipeRead command. I merely decided that it would be better done in
an fvwmperl module. There I could ensure the thumnail is cropped to the right
geometry, and extra imagemagick steps to add in the miniicon. And I hate the
ugly syntax used in a large PipeRead command.
Note that the Iconificate module first gathers info from the fvwm configuration
database before starting the iconificate process with the iconic_mode()
subroutine. This way, any config info for this module can come from my ~/.fvwm/config
I believe there was at one time an FvwmThumbnail module, although I haven't looked at it.
## On Debian, tells you which perl lib to install to provide a certain perl module
http://deb.perl.it/debian/cpan-deb/
#### MORE INFO ABOUT FVWMPERL MODULES
## Read the hidden fvwmperl manpages
$ fvwm-perllib man index
## A folder full of simple fvwmperl examples
ftp://ftp.fvwm.org/pub/fvwm/devel/sources/tests/perl/
## An excellent fvwmperl module example
http://www.fvwmforums.org/phpBB3/viewtopic.php?f=38&t=3069&hilit=fvwmsleep
#### Relevant lines from within my ~/.fvwm/config
##==============================##
## ICONS + MINI-ICONS ##
##==============================##
#-----------------------#
# THUMBNAIL ICONS #
#-----------------------#
## An fvwmperl module to do pretty thumbnailing.
## Used later in the Iconify function.
## For the thumbnail icon, the blue border around the outside is from FVWM
## but the small blue border around the inset miniicon is thanks to
## imagemagick and the iconificate fvwmperl module.
DestroyModuleConfig Iconificate: *
*Iconificate: ThumbIconWidth 205
*Iconificate: ThumbIconHeight 120
*Iconificate: MiniIconPadding 5
*Iconificate: MiniIconBorderWidth 4
## *Iconificate: MiniIconBorderColor rgb(54,100,139)
## *Iconificate: MiniIconBackgroundColor rgb(38,38,38)
## rgb(r,g,b) where each value is 0-255 with no spaces.
Style * !IconTitle
Style * IconOverride
Style * !UseIconPosition
Style * IconSize -1 -1
Style * IconBackgroundColorset 25
Style * IconBackgroundRelief 5
Style * IconBackgroundPadding 0
Style * IconBox 990x150-20-36, IconGrid 234 134, IconFill right bottom
#-------------------#
# MINI-ICONS #
#-------------------#
## Additional windows styles for mini-icons.
Style WithMiniIcon EWMHMiniIconOverride, EWMHDonateMiniIcon
## Currently, only windows with defined miniicons will get a miniicon inset into their thumbnail icon
Style Iceweasel MiniIcon mi_iceweasel.png, UseStyle WithMiniIcon
Style URxvt MiniIcon mi_urxvt.png, UseStyle WithMiniIcon
Style Geany MiniIcon mi_geany.png, UseStyle WithMiniIcon
Style Gvim MiniIcon mi_gvim.png, UseStyle WithMiniIcon
Style Thunderbird MiniIcon mi_icedove.png, UseStyle WithMiniIcon
## IconBackgroundColorset # TESTME PLZ #
Colorset 25 sh #2A5E8B, hi #2A5E8B
## For the border color around the mini-icon inset into the thumbnail.
*Iconificate: MiniIconBorderColor rgb(54,100,139)
## For the bg color for behind the mini-icon inset into the thumbnail.
*Iconificate: MiniIconBackgroundColor rgb(38,38,38)
## Alt + F9 : Iconify the window.
Key F9 A M Iconificate
## Iconify the current window, if possible.
## Uses the Iconificate fvwmperl module to create the thumbnail icon.
## Relates to the Alt + F9 key binding.
DestroyFunc Iconificate
AddToFunc Iconificate
+ I ThisWindow (Iconifiable, !Iconic) \
ModuleSynchronous Iconificate $[w.id] $[w.miniiconfile]
#!/usr/bin/perl
use strict ;
use warnings ;
use v5.18 ;
use lib `fvwm-perllib dir`;
use FVWM::Module;
use Data::Dump qw( dump ) ;
use Image::Magick ; ## libimage-magick-perl
use Path::Tiny ;
use Try::Tiny ;
use IPC::Run qw( run timeout ) ;
my $module = new FVWM::Module(
Name => 'Iconificate',
Debug => 0,
);
my $modname = $module->name ;
my @cmds ;
my ($wid, $miniicon_file) = @ARGV ;
$wid = hex($wid) if $wid =~ /^0x/ ;
## Logfile
my $logfile = path("$ENV{FVWM_USERDIR}/log/Iconificate.log") ;
unlink $logfile ;
#my $logger = "yes" ;
my $logger = "" ;
## These vars gain their values from the module config.
my $thumb_w ;
my $thumb_h ;
my $miniicon_padding ;
my $miniicon_backcolor ;
my $miniicon_borderwidth ;
my $miniicon_bordercolor ;
$module->add_handler(M_CONFIG_INFO, \&read_config) ;
$module->add_handler(M_END_CONFIG_INFO, sub {
debug("[$modname] read config finished", 0) ;
iconic_mode() ;
$module->terminate ;
});
$module->send("Send_ConfigInfo");
$module->event_loop ;
#### SUBROUTINES
sub iconic_mode {
## Useful webpages :-
## http://www.imagemagick.org/script/command-line-processing.php
## http://www.imagemagick.org/script/perl-magick.php
logger("debug", "iconic_mode : start") ;
logger("debug", "wid : $wid, mini: $miniicon_file") ;
my $aspect = $thumb_w / $thumb_h ;
my $thumbfile = path("$ENV{FVWM_USERDIR}/tmp/$wid.png") ;
#my $thumbfile = path("/home/nostromo/.fvwm") ;
my $thumb = Image::Magick->New() ;
my $err = 1 ;
## 3 tries to grab an image of the current window.
## The retvar for IMagick is always undef except when in error.
foreach (1, 2, 3) {
logger("debug", "iconic_mode : begin screenshot") ;
## A 3 second timeout on the screenshot.
my $t = timeout(3) ;
my $out = my $in = my $stderr = "" ;
my @cmd = ("xwd", "-silent", "-nobdrs", "-id",
$wid, "-out", "/tmp/thumbicon.xwd" ) ;
#logger("debug", "@cmd") ;
my $excp = try {
run \@cmd, \$in, \$out, \$stderr, $t ;
} catch { "" } ;
## If import cmnd produced error, then repeat again.
if ($stderr or not -r "/tmp/thumbicon.xwd") {
logger("debug", "iconic_mode : import failed \n$stderr") ;
next ;
}
## If png file cannot be opened, then repeat again.
if (not open(IMAGE, '/tmp/thumbicon.xwd')) {
logger("debug", "iconic_mode : can't open thumbicon.xwd") ;
next ;
}
## If PerlMagic successfully read the png, then continue.
$err = $thumb->Read(file=>\*IMAGE);
close(IMAGE);
last if not $err ;
}
## Return early if the screenshot operation failed.
if ($err) {
logger("debug", "iconic_mode : screenshot FAILED") ;
return 0 ;
}
my $xwd_w = $thumb->Get('columns') ;
my $xwd_h = $thumb->Get('rows') ;
## Crop the window such that it can still be recognized.
if ( $xwd_w/$xwd_h < $aspect ) {
my $hh = int($xwd_w / $aspect) ;
return 0 if $thumb->Crop(
geometry => "${xwd_w}x${hh}+0+0"
) ;
$xwd_h = $thumb->Get('rows') ;
} elsif ( $xwd_w/$xwd_h > $aspect ) {
my $ww = int($xwd_h * $aspect) ;
return 0 if $thumb->Crop(
geometry => "${ww}x${xwd_h}+0+0"
) ;
$xwd_w = $thumb->Get('columns') ;
}
## Convert large image into a thumbnail.
$err = $thumb->Thumbnail(geometry => "${thumb_w}x${thumb_h}!") ;
return 0 if $err ;
logger("debug", "iconic_mode : create small thumbnail [pass]") ;
## Add a mini-icon-to thumbnail, if avail.
my $mini = get_mini_icon() ;
if ($mini) {
logger("debug", "iconic_mode : get_mini_icon [pass]") ;
$err = $thumb->Composite(image => $mini, gravity => "SouthEast") ;
return 0 if $err ;
logger("debug", "iconic_mode : miniicon composite into thumbnail [pass]") ;
} else {
logger("debug", "iconic_mode : get_mini_icon [fail]") ;
} ;
## Save the finished thumbnail.
open(IMAGE, ">$thumbfile") ;
$err = $thumb->Write(
file=>\*IMAGE,
filename=>$thumbfile,
quality => 1
) ;
return 0 if $err ;
logger("debug", "iconic_mode : IM writes finished thumb [pass] ") ;
close IMAGE ;
## Tell fvwm to iconify the window.
addcmd("WindowStyle Icon $thumbfile ") ;
addcmd("Iconify True") ;
addcmd("All (CurrentDesk, Iconic) PlaceAgain Icon") ;
sendcmds($wid) ;
## Cleanup.
undef $mini ;
undef $thumb ;
unlink "/tmp/thumbicon.xwd" ;
logger("debug", "iconic_mode : Finished with success ") ;
return 1 ;
}
sub get_mini_icon {
logger("debug", "get_mini_icon : start") ;
return 0 if not defined $miniicon_file ;
return 0 if not -r $miniicon_file ;
logger("debug", "get_mini_icon : miniicon file exits [pass] ") ;
## Read in the miniicon image
my $miniicon = Image::Magick->new ;
return 0 if not open(IMAGE, $miniicon_file) ;
logger("debug", "get_mini_icon : open the miniicon_file [pass] ") ;
my $err = $miniicon->Read(file=>\*IMAGE) ;
return 0 if $err ;
logger("debug", "get_mini_icon : IM reads the open miniicon [pass] ") ;
close IMAGE ;
## Create an empty canvas that is slightly larger.
my $mini_h = $miniicon->Get('rows') + $miniicon_padding ;
my $mini_w = $miniicon->Get('columns') + $miniicon_padding ;
my $mini_geom = "${mini_w}x${mini_h}" ;
my $mini = Image::Magick->New() ;
$mini->Set(size => $mini_geom) ;
$err = $mini->ReadImage("canvas:$miniicon_backcolor") ;
return 0 if $err ;
logger("debug", "get_mini_icon : IM makes an empty canvas [pass] ") ;
## Place the miniicon atop the canvas.
$mini->Composite( image => $miniicon, gravity => "Center") ;
return 0 if $err ;
logger("debug", "get_mini_icon : Miniicon put atop canvas [pass] ") ;
## Add a border to miniicons north and west sides.
$err = $mini->Splice(
gravity => "northwest",
geometry => "${miniicon_borderwidth}x$miniicon_borderwidth",
background => $miniicon_bordercolor,
) ;
return 0 if $err ;
logger("debug", "get_mini_icon : Partial border added [pass] ") ;
## Return okay if above steps all completed correctly.
undef $miniicon ;
logger("debug", "get_mini_icon : Returns with success [pass] ") ;
return $mini ;
}
sub read_config {
my ($module, $event) = @_;
return unless $event->_text =~ /^\*$modname(.*)$/;
process_config($1);
}
sub process_config {
my ($s) = @_;
my ($option, $args)= $s =~/\s*(\w+)\s*(.*)/;
my %opts = (
ThumbIconWidth => sub { $thumb_w = $args },
ThumbIconHeight => sub { $thumb_h = $args },
MiniIconPadding => sub { $miniicon_padding = $args },
MiniIconBackgroundColor => sub { $miniicon_backcolor = $args },
MiniIconBorderWidth => sub { $miniicon_borderwidth = $args },
MiniIconBorderColor => sub { $miniicon_bordercolor = $args },
) ;
if (defined $opts{$option}) {
debug("[$modname] [Config] $option : $args", 0) ;
$opts{$option}() ;
} else {
$module->showMessage("Unknown option \"$option\"");
}
}
sub addcmd { push @cmds, @_ } ;
sub sendcmds {
foreach (@cmds) { $module->send($_, $wid) } ;
@cmds = () ;
}
sub debug {
my ($msg, $level) = @_ ;
$level = 0 if not defined $level ;
$module->debug($msg, $level) ;
}
sub logger {
return 0 unless $logger ;
my ($level, $msg) = @_;
$msg = "[$level] $msg\n" ;
$logfile->append_utf8($msg) ;
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment