package Prima::Drawable::Metafile;

use strict;
use warnings;
use vars qw(@ISA);
use Prima;
@ISA = qw(Prima::Drawable);

sub profile_default
{
	my %def = %{ shift->SUPER::profile_default };
	return {
		%def,
		size => [1,1],
		type => dbt::Pixmap,
	};
}

sub init
{
	my ($self, %profile) = @_;
	%profile = $self->SUPER::init(%profile);
	$self->{code} = [];
	$self->{explicit_cliprect} = 0;
	$self->{clipRect} = [ 0, 0, 1, 1  ];
	$self->{type} = $profile{type};
	$self-> size( @{ $profile{size} });
	return %profile;
}

my @props = qw(
	alpha antialias
	color backColor fillMode fillPattern lineEnd
	lineJoin linePattern lineWidth rop rop2 miterLimit
	textOpaque textOutBaseline 
);

for my $prop_name (@props) {
	no strict 'refs';
	*{$prop_name} = sub {
		my $self = shift;
		if ( @_ && $self->get_paint_state == ps::Enabled ) {
			push @{ $self->{code} }, [ 'set', $prop_name, @_ ];
		}
		my $prop = 'SUPER::' . $prop_name;
		return $self->$prop(@_);
	};
}

for my $prop_name (qw(
	arc bar bar_alpha bars chord ellipse fill_chord fill_ellipse
	fillpoly fill_sector flood_fill line lines polyline
	put_image_indirect rectangle sector text_out text_shape_out
)) {
	no strict 'refs';
	*{$prop_name} = sub {
		my $self = shift;
		if ( @_ && $self->get_paint_state == ps::Enabled ) {
			push @{ $self->{code} }, [ 'put', $prop_name, @_ ];
		}
	};
}

for my $prop_name (qw(
	translate set_matrix set_font
)) {
	no strict 'refs';
	*{$prop_name} = sub {
		my $self = shift;
		if ( @_ && $self->get_paint_state == ps::Enabled ) {
			push @{ $self->{code} }, [ $prop_name, @_ ];
		}
		my $prop = 'SUPER::' . $prop_name;
		return $self->$prop(@_);
	};
}

sub call
{
	my ( $self, @args ) = @_;
	push @{ $self->{code} }, [ call => @args ];
}

sub size
{
	return @{ $_[0]->{size} } unless $#_;
	my ( $self, $x, $y ) = @_;
	$x = 1 if $x < 1;
	$y = 1 if $y < 1;
	$self->{size} = [ $x, $y ];
	$self->{clipRect} = [ 0, 0, $x - 1, $y - 1 ] unless $self->{explicit_cliprect};
}

sub clipRect
{
	return @{ $_[0]-> {clipRect} } unless $#_;
	my ( $self, $x1, $y1, $x2, $y2 ) = @_;
	$self->{explicit_cliprect} = 1;
	$x1 = 0 if $x1 < 0;
	$y1 = 0 if $y1 < 0;
	$x2 = $self->{size}->[0] - 1 if $x2 > $self->{size}->[0] - 1;
	$y2 = $self->{size}->[1] - 1 if $y2 > $self->{size}->[0] - 1;
	$self-> {clipRect} = [ $x1, $y1, $x2, $y2 ];
	push @{ $self->{code} }, [ 'clipRect', $x1, $y1, $x2, $y2 ];
}

sub clear
{
	my $self = shift;
	return unless $self->get_paint_state == ps::Enabled;
	@{ $self->{code} } = () unless @_;
	push @{ $self->{code} }, [ 'put', 'clear', @_ ];
}

sub fillPatternOffset
{
	my $self = shift;
	if (@_ && $self->get_paint_state == ps::Enabled) {
		push @{ $self->{code} }, [ 'fillPatternOffset', @_[0,1] ];
	}
	return $self->SUPER::fillPatternOffset(@_);
}

sub region
{
	my $self = shift;
	if (@_ && $self->get_paint_state == ps::Enabled) {
		push @{ $self->{code} }, [ 'region', $_[0]->dup ];
	}
	return $self->SUPER::region(@_);
}

sub graphic_context_push
{
	my $self = shift;
	my $ok = $self->SUPER::graphic_context_push;
	push @{ $self->{code} }, [ 'graphic_context_push' ] if $ok;
	return $ok;
}

sub graphic_context_pop
{
	my $self = shift;
	my $ok = $self->SUPER::graphic_context_pop;
	push @{ $self->{code} }, [ 'graphic_context_pop' ] if $ok;
	return $ok;
}

sub width  { $_[0]->{size}->[0] }
sub height { $_[0]->{size}->[1] }

sub type            { $_[0]->{type} }
sub can_draw_alpha  { shift->type != dbt::Bitmap  }
sub has_alpha_layer { shift->type == dbt::Layered }
sub get_bpp         { shift->type == dbt::Bitmap ? 1 : 24 }

sub execute
{
	my ( $self, $canvas, $x, $y ) = @_;

	if ( UNIVERSAL::isa($canvas, 'Prima::Drawable::Metafile')) {
		push @{ $canvas->{code} }, [ 'translate', $x, $y ], @{ $self->{code} };
		return;
	}

	my %save = map { $_, $canvas->$_() } @props;
	my @clip = $canvas-> clipRect;
	my $rgn  = $canvas-> region;
	my $actual_rgn = $rgn;
	my @tx   = $canvas-> translate;
	my @fpo  = $canvas-> fillPatternOffset;

	return unless $canvas->graphic_context_push;
	$canvas->translate($x + $tx[0], $y + $tx[1]);

	for my $cmd ( @{ $self->{code} } ) {
		my ($cmd, @cmd) = @$cmd;
		if ( $cmd eq 'set' ) {
			my ($method, @args) = @cmd;
			$canvas->$method(@args);
		} elsif ( $cmd eq 'put' ) {
			my ($method, @args) = @cmd;
			$canvas->$method(@args);
		} elsif ( $cmd eq 'translate' ) {
			$canvas->translate($cmd[0] + $tx[0] + $x, $cmd[1] + $tx[1] + $y);
		} elsif ( $cmd eq 'set_matrix' ) {
			my @args = @{ $cmd[0] };
			$canvas->set_matrix([ @args[0..3], $args[4] + $tx[0] + $x, $args[5] + $tx[1] + $y]);
		} elsif ( $cmd eq 'set_font' ) {
			$canvas->set_font($cmd[0]);
		} elsif ( $cmd eq 'clipRect' ) {
			if ( 4 == grep { $_ == -1 } @cmd ) {
				$actual_rgn = $rgn;
				$canvas->clipRect(@clip);
			} else {
				$rgn //= Prima::Region-> new( rect => \@clip);
				my $xrgn = Prima::Region-> new( rect => \@cmd );
				$xrgn->combine($rgn, rgnop::Intersect);
				$canvas->region($xrgn);
			}
		} elsif ( $cmd eq 'region' ) {
			$rgn //= Prima::Region-> new( rect => \@clip);
			my $xrgn = $cmd[0]->dup;
			$xrgn->combine($rgn, rgnop::Intersect);
			$canvas->region($xrgn);
		} elsif ( $cmd eq 'fillPatternOffset' ) {
			$cmd[$_] += $fpo[$_] for 0,1;
			$canvas-> fillPatternOffset(@cmd);
		} elsif ( $cmd eq 'call') {
			my ($sub, @args) = @cmd;
			$sub->( $self, $canvas, @args );
		}
	}

	$canvas->graphic_context_pop;
}

1;

=pod

=head1 NAME

Prima::Drawable::Metafile - graphics recorder

=head1 DESCRIPTION

Metafiles can record graphic primitives and replay them later on another canvas

=head1 SYNOPSIS

  my $metafile = Prima::Drawable::Metafile->new( size => [30, 30] );
  $metafile->begin_paint;
  $metafile->rectangle(10,10,20,20);
  $metafile->end_paint;

  $metafile->execute( $another_drawable, 100, 100 );

=head1 API

=over

=item call $SUB::($self,$canvas,@ARGS), @ARGS

C<$SUB> will be called when the metafile is executed, with the first two parameters
the metafile and the target canvas, and C<@ARGS> thereafter.

=item clear

When called without parameters, clears the content before proceeding.
Otherwise same as C<Drawable.clear>.

=item execute CANVAS,X,Y

Draws the content on the CANVAS with X,Y offset

=item size X,Y

Sets the metafile extensions; the content is not clipped by it.

=back

=head1

=head1 AUTHOR

Dmitry Karasik, E<lt>dmitry@karasik.eu.orgE<gt>.

=head1 SEE ALSO

L<Prima>, L<Prima::Buttons>, F<examples/buttons.pl>

=cut

