From: Ian Jackson <ian@liberator.relativity.greenend.org.uk>
Date: Sat, 24 Oct 2009 13:48:27 +0000 (+0100)
Subject: ypp-chart-memshow: new ypp-sc-tools script
X-Git-Tag: 5.0~1
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.main.git;a=commitdiff_plain;h=dc62905fe72a3547ce8164744e9428a58b1a6a29

ypp-chart-memshow: new ypp-sc-tools script
---

diff --git a/ypp-chart-memshow b/ypp-chart-memshow
new file mode 100755
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);
+}