#!/usr/bin/perl

# a Wx based GUI player for animated JPEGs
# todo: handle one-shot animations

use Wx;

package MyApp;

use strict;
use vars qw(@ISA);

@ISA = qw(Wx::App);

sub OnInit {
	my $self = @_;
	my $frame = MyFrame->new("Animated JPEG player", [-1,-1], [-1,-1]);

	unless($frame){ print "Unable to create wxFrame, exiting."; return undef }

	1;
}


package MyFrame;

use vars qw(@ISA);
use strict;
@ISA=qw(Wx::Frame);
use Data::Dumper;
use Data::HexDump;

use Wx qw(wxWidth wxHeight wxBITMAP_TYPE_JPEG wxTIMER_ONE_SHOT wxFD_OPEN wxID_CANCEL wxBOTH);
use Wx::Event;
use IO::File;
use IO::Scalar;
use Path::Tiny;
use lib 'lib';
use Image::MetaData::JPEG;
use Image::Animated::JPEG;
use Getopt::Long;
use Pod::Usage;


sub new {
	my $class = shift;
	my $self = $class->SUPER::new( undef, -1, $_[0], $_[1], $_[2] );

	Getopt::Long::Configure('no_ignore_case');
	GetOptions(
		'debug|d'		=> \$self->{debug},
		'help|h'		=> \$self->{help},
	) or pod2usage(2);
	pod2usage(1) if $self->{help};

	$self->SetIcon( Wx::Icon->newFromXPM(icon_ref()) );

	# we draw on a panel to have keyboard events
	$self->{panel} = Wx::Panel->new( $self, -1 );
	$self->{panel}->{parent} = $self;
	$self->{panel}->SetBackgroundColour(Wx::Colour->new(50, 50, 50));

	my $default = {
		delay	=> 100,
	};

	if(@ARGV > 1){
		print "Reading multiple files as frames\n";

		# this loads all frames into memory, acceptable for short animations
		# but multi-file playback is an experimental feature anyway
		for(@ARGV){
			print " loading file $_\n";
			my $fh = IO::File->new( $_, "r" ) or return undef;
			binmode $fh;

			my $image = Wx::Image->new();
			Wx::JPEGHandler->new()->LoadFile( $image, $fh ) or die $!;
			my $bmp = Wx::Bitmap->new($image);

			push(@{ $self->{frames} }, { bitmap => $bmp, delay => 700 });
		}
	}else{
		if(!@ARGV){
			print "File path collection dialog...\n";
			my $file_dialog = Wx::FileDialog->new($self, "Please select an AJPEG file", '', '', "JPEG files (*.jpg,*.jpeg,*.ajpeg,*.mjpeg)|*.jpg;*.jpeg;*.ajpeg;*.mjpeg;|All files (*.*)|*.*", wxFD_OPEN);

			if($file_dialog->ShowModal == wxID_CANCEL){ exit; }

			my $path = $file_dialog->GetPath;
			$file_dialog->Destroy;
			print " - $path \n";
			push(@ARGV,$path);
		}

		print "Opening file $ARGV[0] ...";
		open(my $io_file, '<', $ARGV[0]) or die $!;
		binmode($io_file);
		print " done.\n";

		print "Building file index..."; print "\n" if $self->{debug};
		$self->{frames} = Image::Animated::JPEG::index($io_file, { debug => $self->{debug} });
		print " done.\n";
	}

	Wx::Event::EVT_TIMER($self, -1, \&OnTimer);
	Wx::Event::EVT_CLOSE($self, \&OnClose);
	Wx::Event::EVT_MOUSEWHEEL($self, \&OnMousewheel);
	Wx::Event::EVT_KEY_DOWN($self->{panel}, \&OnKey );
	Wx::Event::EVT_LEFT_UP( $self->{panel}, sub {
		if($_[0]->{parent}->{step_mode}){
			$_[0]->{parent}->play();
		}else{
			$_[0]->{parent}->step('forward');
		}
	});

	print "Entering play mode...\n";
	Wx::InitAllImageHandlers();
	$self->{index} = 0;
	$self->{parse_next} = 1;
	$self->{'default'} = $default; # hand over
	$self->OnTimer();

		$self->Centre( wxBOTH );
		$self->Show( 1 );
		$self->SetFocus();

	$self;
}

sub index_next {
	my $self = shift;

	if($self->{index} >= scalar(@{ $self->{frames} }) - 1){
		$self->{index} = 0;
		$self->status(", index rewound to ". sprintf('%-3s',$self->{index}), 'print');
	}else{
		$self->{index}++;
		$self->status(", index forward to ". sprintf('%-3s',$self->{index}), 'print');
	}
}
sub index_prev {
	my $self = shift;

	if($self->{index} <= 0){
		$self->{index} = scalar(@{ $self->{frames} }) - 1;
		$self->status(", index rewound to ". sprintf('%-3s',$self->{index}), 'print');
	}else{
		$self->{index}--;
		$self->status(", index forward to ". sprintf('%-3s',$self->{index}), 'print');
	}
}

sub status {
	# default is to aggregate messages; flush when $_[2] == true
	if($_[2]){
		$_[0]->{status} .= $_[1];
	}else{
		$_[0]->{status} = $_[1];
		return;
	}

	local $| = 1 unless $_[0]->{debug}; # autoflush on for STDOUT

	if($_[0]->{debug}){
		print $_[0]->{status} ."\n";
	}else{
		print $_[0]->{status};
		print "\b" x length($_[0]->{status}) if defined $_[0]->{status};
	}
}

sub step {
	if($_[0]->{step_mode}){
		if($_[1] eq 'forward'){
			$_[0]->index_next();
		}else{
			$_[0]->index_prev();
		}
		$_[0]->OnTimer();
	}else{
		print "\nEntering step mode... \n";
		$_[0]->{step_mode} = 1;
	}
}

sub play {
	my $self = UNIVERSAL::isa($_[0], 'Wx::Panel') ? $_[0]->{parent} : $_[0]; # used via events attached to Frame and Panel

	if($self->{step_mode}){
		delete($self->{step_mode});

		print "Entering play mode...\n";
		$self->OnTimer();
	}
}

sub OnMousewheel {
	if( $_[1]->GetWheelRotation() > 1){
		$_[0]->step('forward');
	}else{
		$_[0]->step('backward');
	}
}

sub OnTimer {
	my ($self,$event) = @_;

	my $buffer;
	unless($self->{frames}->[$self->{index}]->{bitmap}){
		$self->status(" reading frame ". ($self->{index}+1) .": offset:". $self->{frames}->[$self->{index}]->{offset} .", length:". $self->{frames}->[$self->{index}]->{length} ." ...");
		seek($self->{frames}->[$self->{index}]->{io_file}, $self->{frames}->[$self->{index}]->{offset}, 0);
		read($self->{frames}->[$self->{index}]->{io_file}, $buffer, $self->{frames}->[$self->{index}]->{length});

		$self->status(" done. ".length($buffer)." bytes ", 1);
		my $io_frame = IO::Scalar->new(\$buffer);
		$self->{frames}->[$self->{index}]->{bitmap} = Wx::Bitmap->new( Wx::Image->new($io_frame, 'image/jpeg') );
	}

	if($self->{parse_next} == 1){
		$self->status(" parsing frame ". ($self->{index}+1) );

		# parse for AJPEG segment (with Image::MetaData)
		# requires a patched Image::MetaData::JPEG
		#	my $meta = Image::MetaData::JPEG->new(\$buffer , 'APP0', 'FASTREADONLY') or die $!; # no work, on fh...
		#	my $per_frame;
		#	for my $segment ($meta->get_segments('APP0')) {
		#		next unless $segment->search_record_value('Identifier') =~ /^AJPEG/;
		#		print " AJPEG segment $segment \n";
		#		$per_frame = Image::Animated::JPEG::decode_ajpeg_data( $segment->data(6, $segment->size()), { debug => 1});
		#		$self->{'default'} = {
		#			%{ $self->{default} },
		#			%$per_frame, # overwrite/update defaults
		#		};
		#	}

		# parse for AJPEG segment (with Image::Animated)
		my $ref = Image::Animated::JPEG::process(\$buffer);
		my $per_frame;
		if($ref && $ref->{AJPEG}){
			$per_frame = Image::Animated::JPEG::decode_ajpeg_data( substr($buffer,$ref->{AJPEG}->{data_offset},$ref->{AJPEG}->{data_length}), { debug => 1});

			$self->{'default'} = {
				%{ $self->{default} },
				%$per_frame, # overwrite/update defaults
			};
		}

		warn "This file's first frame does not contain an AJPEG APP0 marker (as required by AJPEG Specs)!" if $self->{index} == 0 && !defined($per_frame->{version});

		for(keys %{ $per_frame }){
			$self->{frames}->[$self->{index}]->{$_} = $per_frame->{$_};
		}

		# unless this frame defines something different, decrement parse_next / disable subsequent parsing / skip until ..
		if( $per_frame->{parse_next} ){
			$self->{parse_next} = $per_frame->{parse_next};
		}else{
			$self->{parse_next}--;
			print " parse_next: parse again in $self->{parse_next} \n" if $self->{parse_next} > 1;
			print " parse_next: parse disabled \n" if $self->{parse_next} == 0;
		}
	}else{
		$self->{frames}->[$self->{index}] = {
			%{ $self->{frames}->[$self->{index}] },
			%{ $self->{default} }, # overwrite/update defaults
		};
	}

	unless($self->{laid_out}){
		my $frame = ${ $self->{frames} }[ $self->{index} ]; # should be index 0 = first frame
		my $bmp = $frame->{bitmap};

		# dummy global frameset values
		$self->{frameset} = {
			width  => $bmp->GetWidth() < 100 ? 100 : $bmp->GetWidth(),
			height => $bmp->GetHeight() < 50 ? 50 : $bmp->GetHeight(),
			repeat => $frame->{repeat} || 1,
		};

		print " setting WxFrame to $self->{frameset}->{width}x$self->{frameset}->{height} (WxH)\n";
		$self->SetSize($self->{frameset}->{width}, $self->{frameset}->{height});
		$self->Show( 1 );
		$self->{panel}->SetFocus();

		$self->{laid_out} = 1;
	}

	$self->{dc} = Wx::PaintDC->new($self->{panel}) unless $self->{dc}; # can't remember if it's ok to store a DC

	my $frame = $self->{frames}->[ $self->{index} ];

	my $delay = $frame->{delay};
	if($self->{delay_modifier}){
		$delay = int($delay * (1+$self->{delay_modifier}));
	}
	$delay = 10 if $delay < 10; # hard delay (fps) floor

	if( $frame->{bitmap}->Ok() ) {
		if($self->{step_mode}){
			$self->status(" displaying frame ". sprintf('%-3s',$self->{index}) ."in step mode");
		}else{
			$self->status(" displaying frame ". sprintf('%-3s',$self->{index}) ." for ". sprintf('%3s',$delay) ."ms");
		}
		$self->{dc}->DrawBitmap($frame->{bitmap}, 0,0, 1);
	}else{
		$self->status(" Frame bitmap error!");
	}

	if(@{ $self->{frames} } > 50 && $self->{frames}->[$self->{index}]->{length} > 50000){
		$self->status(" release frame");
		$self->{frames}->[ $self->{index} ]->{bitmap} = undef;
	}

	$self->index_next() unless $self->{step_mode};

	if(@{ $self->{frames} } > 1 && $self->{index} < @{ $self->{frames} }){
		unless($self->{step_mode}){
			my $timer = Wx::Timer->new( $self );
			$timer->Start( $delay, wxTIMER_ONE_SHOT );
		}
	}
}

sub OnKey {
	my ($self, $event) = @_;

	my $keycode = $event->GetKeyCode();

	# print "OnKey: $keycode \n";

	if($keycode == 46 ){ # . (qwerty >)
		$self->{parent}->step('forward');
	}elsif($keycode == 44 ){ # , (qwerty <)
		$self->{parent}->step('backward');
	}elsif($keycode == 78 ){ # n
		print " slow down by 20% \n";
		$self->{'parent'}->{delay_modifier} += 0.2;
	}elsif($keycode == 77 ){ # m
		print " speed up by 20% \n";
		$self->{'parent'}->{delay_modifier} -= 0.2;
	}elsif($keycode == 66 ){ # b
		print " speed modifier reset \n";
		delete($self->{'parent'}->{delay_modifier});
	}elsif($keycode == 315 ){ # arrow up
		$self->{parent}->step('forward');
	}elsif($keycode == 317 ){ # arrow down
		$self->{parent}->step('backward');
	}elsif($keycode == 32 ){ # space
		if($self->{parent}->{step_mode}){
			$self->{parent}->play();
		}else{
			$self->{parent}->step('forward');
		}
	}elsif($keycode == 81 ){ # q
		$self->{parent}->Close();
	}elsif($keycode == 88 ){ # x
		$self->{parent}->Close();
	}elsif($keycode == 27 ){ # ESC
		$self->{parent}->Close();
	}

	$event->Skip(1);
}

sub OnClose {
	my ($self,$event) = @_;

	$event->Skip() if $event;
}

sub icon_ref {
	return ["16 16 3 1",
"  c #335577",
"X c #888888",
". c #cccccc",
"                ",
"                ",
" XXXXXXXXXXX    ",
" X.........X    ",
" X.........X    ",
" X.........XXX  ",
" X.........X X  ",
" XXXXXXXXXXX X  ",
"   X.........XXX",
"   X.........X.X",
"   XXXXXXXXXXX.X",
"    X..........X",
"    X..........X",
"    XXXXXXXXXXXX",
"                ",
"                "
	];
}

package main;
my $app = MyApp->new();
$app->MainLoop();

__END__

=head1 NAME

playajpeg - Play Animated JPEGs (AJPEGs)

=head1 SYNOPSIS

  playajpeg [options] ajpeg-file or frame-jpegs...

playajpeg is a L<WxPerl|Wx> based GUI application.

=head1 KEYBOARD & MOUSE

During playback, playajpeg can be controled by keyboard and by mouse:

=over

=item B<ARROW UP / MOUSE WHEEL UP / "." (dot)>

Enter step mode, step forward.

=item B<ARROW DOWN / MOUSE WHEEL DOWN / "," (comma)>

Enter step mode, step backward.

=item B<SPACE / MOUSE CLICK>

Toggle (start/stop) playback. Enter or exit step mode.

=item B<M>

Speed up animation by 20%.

=item B<N>

Slow down animation by 20%.

=item B<B>

Reset speed to normal.

=item B<X / Q / ESC>

Stop animation and exit playajpeg.

=back

=head1 OPTIONS

=over

=item B<--debug, -d>

Flag. Switch debug output on.

=item B<--help, -h>

Flag. Print usage info.

=back

=head1 SEE ALSO

More information about what this script does can be found in the documentation
of the backend module L<Image::Animated::JPEG>.

=head1 AUTHOR

Clipland GmbH L<http://www.clipland.com/>

=head1 COPYRIGHT & LICENSE

Copyright 2012-2015 Clipland GmbH. All rights reserved.

This library is free software, dual-licensed under L<GPLv3|http://www.gnu.org/licenses/gpl>/L<AL2|http://opensource.org/licenses/Artistic-2.0>.
You can redistribute it and/or modify it under the same terms as Perl itself.
