Merge branch 'master' into stable-5.x

diff --git a/ypp-chart-memshow b/ypp-chart-memshow
new file mode 100755 (executable)
index 0000000..44b6fac
--- /dev/null
+++ b/ypp-chart-memshow
@@ -0,0 +1,163 @@
+#!/usr/bin/perl -w
+#
+# This is part of ypp-sc-tools, a set of third-party tools for assisting
+# players of Yohoho Puzzle Pirates.
+#
+# Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
+#
+# 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/>.
+#
+# Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
+# are used without permission.  This program is not endorsed or
+# sponsored by Three Rings.
+
+# This script helps make memmed or not memmed points visible.
+
+my $usage= <<END;
+usage:
+   ypp-chart-memshow [/home/user/path/to/Desktop]
+   ypp-chart-memshow /path/to/screenshot/to/convert.png
+   ypp-chart-memshow - < /path/to/screenshot/to/convert.png
+if given a Desktop directory will look for
+   /home/user/path/to/Desktop/"Puzzle Pirates <Name> <number>".png
+and delete them after display
+END
+
+use POSIX;
+use strict qw(vars refs);
+use File::Glob qw(:glob);
+
+our $quis= $0;
+$quis =~ s,.*/,,;
+
+
+sub badusage ($) {
+    print STDERR "bad usage: @_\n$usage\n";
+    exit 8;
+}
+
+sub xglob ($) {
+    my ($pat) = @_;
+    my @glob= bsd_glob($pat, GLOB_ERR|GLOB_LIMIT|GLOB_NOSORT);
+    die "$quis: error reading directory: $!\n" if GLOB_ERROR;
+    return @glob;
+}
+
+sub synchronously ($) {
+    my ($file) = @_;
+    print "$quis: $file displaying...\n";
+    open STDIN, "<", $file or die "$quis: $file: $!\n";
+    synchronously_stdin();
+}
+
+sub synchronously_stdin () {
+    exec 'bash', '-ec', '
+        set -o pipefail
+        pngtopnm |ppmchange -closeness 10 "#806c60" blue |display -
+    ';
+    die "$quis: bash: $!\n";
+}
+
+sub watch_dir ($) {
+    my ($dir) = @_;
+    chdir $dir or die "chdir $dir: $!";
+
+    my %already;
+    my $pat= "Puzzle Pirates *.png";
+    $already{$_}='a' foreach xglob($pat);
+    print "$quis: watching $dir...\n";
+    if (!%already) {
+       print "$quis: warning: no existing screenshots found\n";
+    }
+    my %children;
+    for (;;) {
+       select undef,undef,undef, 0.100;
+
+       my $child;
+       while (($child= waitpid -1, WNOHANG) > 0) {
+           my $file= $children{$child};
+           if (!defined $file) {
+               die "$quis: unknown child $child failed status $?\n" if $?;
+               warn "$quis: unknown child $child, finished ok\n";
+           } else {
+               die "$quis: display of $file failed status $?\n" if $?;
+               delete $already{$file};
+               delete $children{$child};
+               unlink $file or $!==&ENOENT
+                   or die "$quis: delete $file: $!\n";
+               print "$quis: $file deleted.\n";
+           }
+       }
+
+       my @extra= grep { !exists $already{$_} } xglob($pat);
+       next if !@extra;
+       die "$quis: multiple screenshots at once! (@extra)\n" if @extra>1;
+
+       my $file= $extra[0];
+       
+       print "$quis: $file found...\n";
+       my $lastsize= -1;
+       for (;;) {
+           if (!stat $file) {
+               next if $!==&ENOENT;
+               die "$quis: check $file: $!\n";
+           }
+           my $size= (stat _)[7];
+           die "$quis: $file: not a plain file !\n" unless -f _;
+           next unless $size;
+           last if $size==$lastsize;
+           $lastsize= $size;
+           select undef,undef,undef, 0.100;
+       }
+
+       $child= fork;  defined $child or die $!;
+       if (!$child) {
+           synchronously($file);
+           exit(0);
+       }
+       $children{$child}= $file;
+       $already{$file}= $child;
+    }
+}
+
+
+while (@ARGV && $ARGV[0] =~ m/^\-./) {
+    $_= shift @ARGV;
+    last if $_ eq '--';
+    badusage("unknown option \`$_'");
+}
+
+our $target;
+
+if (!@ARGV) {
+    $target= $ENV{'HOME'};
+    die unless defined $target;
+    $target .= '/Desktop';
+} elsif (@ARGV==1) {
+    $target= shift @ARGV;
+} else {
+    badusage("at most one non-option argument please");
+}
+
+if ($target eq '-') {
+    synchronously_stdin();
+}
+
+(stat $target) or die "$quis: cannot find $target: $!\n";
+
+if (-f _) {
+    synchronously($target);
+} else {
+    watch_dir($target);
+}