3 # This is part of ypp-sc-tools, a set of third-party tools for assisting
4 # players of Yohoho Puzzle Pirates.
6 # Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
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.
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.
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/>.
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.
25 # This script helps make memmed or not memmed points visible.
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
38 use strict qw(vars refs);
39 use File::Glob qw(:glob);
46 print STDERR "bad usage: @_\n$usage\n";
52 my @glob= bsd_glob($pat, GLOB_ERR|GLOB_LIMIT|GLOB_NOSORT);
53 die "$quis: error reading directory: $!\n" if GLOB_ERROR;
57 sub synchronously ($) {
59 print "$quis: $file displaying...\n";
60 open STDIN, "<", $file or die "$quis: $file: $!\n";
61 synchronously_stdin();
64 sub synchronously_stdin () {
67 pngtopnm |ppmchange -closeness 10 "#806c60" blue |display -
69 die "$quis: bash: $!\n";
74 chdir $dir or die "chdir $dir: $!";
77 my $pat= "Puzzle Pirates *.png";
78 $already{$_}='a' foreach xglob($pat);
79 print "$quis: watching $dir...\n";
81 print "$quis: warning: no existing screenshots found\n";
85 select undef,undef,undef, 0.100;
88 while (($child= waitpid -1, WNOHANG) > 0) {
89 my $file= $children{$child};
91 die "$quis: unknown child $child failed status $?\n" if $?;
92 warn "$quis: unknown child $child, finished ok\n";
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";
103 my @extra= grep { !exists $already{$_} } xglob($pat);
105 die "$quis: multiple screenshots at once! (@extra)\n" if @extra>1;
109 print "$quis: $file found...\n";
114 die "$quis: check $file: $!\n";
116 my $size= (stat _)[7];
117 die "$quis: $file: not a plain file !\n" unless -f _;
119 last if $size==$lastsize;
121 select undef,undef,undef, 0.300;
124 $child= fork; defined $child or die $!;
126 synchronously($file);
129 $children{$child}= $file;
130 $already{$file}= $child;
135 while (@ARGV && $ARGV[0] =~ m/^\-./) {
138 badusage("unknown option \`$_'");
144 $target= $ENV{'HOME'};
145 die unless defined $target;
146 $target .= '/Desktop';
148 $target= shift @ARGV;
150 badusage("at most one non-option argument please");
153 if ($target eq '-') {
154 synchronously_stdin();
157 (stat $target) or die "$quis: cannot find $target: $!\n";
160 synchronously($target);