#!/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 # # 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 . # # 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= < ".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); }