1 files changed, 67 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/bin/tkjpeg b/Master/tlpkg/tlperl/bin/tkjpeg
new file mode 100755
index 00000000000..b2b5619726c
--- /dev/null
+++ b/Master/tlpkg/tlperl/bin/tkjpeg
@@ -0,0 +1,67 @@
+#!/usr/local/bin/perl -w
+use strict;
+use Tk;
+use Tk::JPEG;
+use Getopt::Std;
+eval { require Tk::PNG; };
+
+my $mw  = MainWindow->new();
+print "vis=",$mw->visual," d=",$mw->depth,"\n";
+my ($vis) = grep(!/\b8\b/,grep(/truecolor/,$mw->visualsavailable));
+my @args = ();
+if ($vis)
+ {
+  # print $vis,"\n";
+  $mw->destroy;
+  $mw = MainWindow->new(-visual => $vis);
+ }
+else
+ {
+  @args = (-palette => '4/4/4');
+ }
+# print "vis=",$mw->visual," d=",$mw->depth,' "',join('" "',$mw->visualsavailable),"\"\n";
+my %opt;
+getopts('f:',\%opt);
+if ($opt{'f'})
+ {
+  push(@args,'-format' => $opt{'f'});
+ }
+unless (@ARGV)
+ {
+  warn "usage $0 [-f format] <imagefile>\n";
+  exit 1;
+ }
+my $file = shift;
+my $image = $mw->Photo(-file => $file, @args);
+#print join(' ',$image->formats),"\n";
+print "w=",$image->width," h=",$image->height,"\n";
+$mw->Label(-image => $image)->pack(-expand => 1, -fill => 'both');
+$mw->Button(-text => 'Quit', -command => [destroy => $mw])->pack;
+MainLoop;
+
+__END__
+
+=head1 NAME
+
+tkjpeg - simple JPEG viewer using perl/Tk
+
+=head1 SYNOPSIS
+
+  tkjpeg imagefile.jpg
+
+=head1 DESCRIPTION
+
+Very simplistic image viewer that loads JPEG image, (well actually
+anything for which Photo has a handler) and puts it into a
+Label for display.
+
+It tries to find a fullcolour visual to use if display is deeper than
+8-bit. (On 8-bit it uses a 4/4/4 palette.)
+
+=head1 AUTHOR
+
+Nick Ing-Simmons <nick@ing-simmons.net>
+
+=cut
+
+