ypp-chart-memshow

   1 #!/usr/bin/perl -w
   2 #
   3 # This is part of ypp-sc-tools, a set of third-party tools for assisting
   4 # players of Yohoho Puzzle Pirates.
   5 #
   6 # Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
   7 #
   8 # This program is free software: you can redistribute it and/or modify
   9 # it under the terms of the GNU General Public License as published by
  10 # the Free Software Foundation, either version 3 of the License, or
  11 # (at your option) any later version.
  12 #
  13 # This program is distributed in the hope that it will be useful,
  14 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 # GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License
  19 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  20 #
  21 # Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
  22 # are used without permission.  This program is not endorsed or
  23 # sponsored by Three Rings.
  24
  25 # This script helps make memmed or not memmed points visible.
  26
  27 my $usage= <<END;
  28 usage:
  29    ypp-chart-memshow [/home/user/path/to/Desktop]
  30    ypp-chart-memshow /path/to/screenshot/to/convert.png
  31    ypp-chart-memshow - < /path/to/screenshot/to/convert.png
  32 if given a Desktop directory will look for
  33    /home/user/path/to/Desktop/"Puzzle Pirates <Name> <number>".png
  34 and delete them after display
  35 END
  36
  37 use POSIX;
  38 use strict qw(vars refs);
  39 use File::Glob qw(:glob);
  40
  41 our $quis= $0;
  42 $quis =~ s,.*/,,;
  43
  44
  45 sub badusage ($) {
  46     print STDERR "bad usage: @_\n$usage\n";
  47     exit 8;
  48 }
  49
  50 sub xglob ($) {
  51     my ($pat) = @_;
  52     my @glob= bsd_glob($pat, GLOB_ERR|GLOB_LIMIT|GLOB_NOSORT);
  53     die "$quis: error reading directory: $!\n" if GLOB_ERROR;
  54     return @glob;
  55 }
  56
  57 sub synchronously ($) {
  58     my ($file) = @_;
  59     print "$quis: $file displaying...\n";
  60     open STDIN, "<", $file or die "$quis: $file: $!\n";
  61     synchronously_stdin();
  62 }
  63
  64 sub synchronously_stdin () {
  65     exec 'bash', '-ec', '
  66         set -o pipefail
  67         pngtopnm |ppmchange -closeness 10 "#806c60" blue |display -
  68     ';
  69     die "$quis: bash: $!\n";
  70 }
  71
  72 sub watch_dir ($) {
  73     my ($dir) = @_;
  74     chdir $dir or die "chdir $dir: $!";
  75
  76     my %already;
  77     my $pat= "Puzzle Pirates *.png";
  78     $already{$_}='a' foreach xglob($pat);
  79     print "$quis: watching $dir...\n";
  80     if (!%already) {
  81         print "$quis: warning: no existing screenshots found\n";
  82     }
  83     my %children;
  84     for (;;) {
  85         select undef,undef,undef, 0.100;
  86
  87         my $child;
  88         while (($child= waitpid -1, WNOHANG) > 0) {
  89             my $file= $children{$child};
  90             if (!defined $file) {
  91                 die "$quis: unknown child $child failed status $?\n" if $?;
  92                 warn "$quis: unknown child $child, finished ok\n";
  93             } else {
  94                 die "$quis: display of $file failed status $?\n" if $?;
  95                 delete $already{$file};
  96                 delete $children{$child};
  97                 unlink $file or $!==&ENOENT
  98                     or die "$quis: delete $file: $!\n";
  99                 print "$quis: $file deleted.\n";
 100             }
 101         }
 102
 103         my @extra= grep { !exists $already{$_} } xglob($pat);
 104         next if !@extra;
 105         die "$quis: multiple screenshots at once! (@extra)\n" if @extra>1;
 106
 107         my $file= $extra[0];
 108
 109         print "$quis: $file found...\n";
 110         my $lastsize= -1;
 111         for (;;) {
 112             if (!stat $file) {
 113                 next if $!==&ENOENT;
 114                 die "$quis: check $file: $!\n";
 115             }
 116             my $size= (stat _)[7];
 117             die "$quis: $file: not a plain file !\n" unless -f _;
 118             next unless $size;
 119             last if $size==$lastsize;
 120             $lastsize= $size;
 121             select undef,undef,undef, 0.100;
 122         }
 123
 124         $child= fork;  defined $child or die $!;
 125         if (!$child) {
 126             synchronously($file);
 127             exit(0);
 128         }
 129         $children{$child}= $file;
 130         $already{$file}= $child;
 131     }
 132 }
 133
 134
 135 while (@ARGV && $ARGV[0] =~ m/^\-./) {
 136     $_= shift @ARGV;
 137     last if $_ eq '--';
 138     badusage("unknown option \`$_'");
 139 }
 140
 141 our $target;
 142
 143 if (!@ARGV) {
 144     $target= $ENV{'HOME'};
 145     die unless defined $target;
 146     $target .= '/Desktop';
 147 } elsif (@ARGV==1) {
 148     $target= shift @ARGV;
 149 } else {
 150     badusage("at most one non-option argument please");
 151 }
 152
 153 if ($target eq '-') {
 154     synchronously_stdin();
 155 }
 156
 157 (stat $target) or die "$quis: cannot find $target: $!\n";
 158
 159 if (-f _) {
 160     synchronously($target);
 161 } else {
 162     watch_dir($target);
 163 }