File Coverage

blib/lib/Image/Base/Multiplex.pm

Criterion	Covered	Total	%
statement	49	86	56.9
branch	7	20	35.0
condition	2	13	15.3
subroutine	13	18	72.2
pod	10	12	83.3
total	81	149	54.3

# Copyright 2010, 2011, 2012 Kevin Ryde

# This file is part of Image-Base-Other.
#
# Image-Base-Other 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, or (at your option) any later
# version.
#
# Image-Base-Other 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 Image-Base-Other.  If not, see .


package Image::Base::Multiplex;
use 5.004;
use strict;
use Carp;
use vars '$VERSION', '@ISA';

$VERSION = 9;

use Image::Base;
@ISA = ('Image::Base');

# uncomment this to run the ### lines
#use Smart::Comments;


sub new {
  my $class = shift;

  if (ref $class) {
    # clone by copying fields, don't think need to copy images array
    return bless { %$class }, $class;
  }

  return bless { -images => [],
                 @_ }, $class;
}

sub _get {
  my ($self, $key) = @_;
  # ### Image-Base-Multiplex _get(): $key
  if ($key eq '-images') {
    return $self->SUPER::_get($key);
  } else {
    my $image = $self->{'-images'}->[0] || return undef;
    return $image->get($key);
  }
}
sub set {
  my $self = shift;
  # ### Image-Base-Multiplex set()

  my $set_file;
  for (my $i = 0; $i < @_; ) {
    my $key = $_[$i];
    $set_file = ($key eq '-file');
    if ($key eq '-images') {
      $self->{$key} = $_[$i+1];
      splice @_, $i, 2;
    } else {
      $i += 2
    }
  }

  my $images = $self->{'-images'};
  if ($set_file && @$images > 1) {
    croak 'Refusing to set multiple images to same -file';
  }

  foreach my $image (@$images) {
    $image->set(@_);
  }
}

sub load {
  my $self = shift;
  my $images = $self->{'-images'};
  if (@_ && @$images > 1) {
    croak 'Refusing to load multiple images from one file';
  }
  foreach my $image (@$images) { $image->load; }
}
sub save {
  my $self = shift;
  my $images = $self->{'-images'};
  if (@_ && @$images > 1) {
    croak 'Refusing to save multiple images to one file';
  }
  foreach my $image (@$images) { $image->save; }
}

sub xy {
  my $self = shift;
  ### Image-Base-Multiplex xy(): @_[1..$#_]
  my $images = $self->{'-images'};
  if (@_ > 2) {
    foreach my $image (@$images) { $image->xy(@_); }
  } else {
    my ($x, $y) = @_;
    my $image = $images->[0] || return undef;
    return $image->xy($x,$y);
  }
}
sub line {
  foreach my $image (@{shift->{'-images'}}) { $image->line(@_); }
}
sub rectangle {
  foreach my $image (@{shift->{'-images'}}) { $image->rectangle(@_); }
}
sub ellipse {
  foreach my $image (@{shift->{'-images'}}) { $image->ellipse(@_); }
}
sub diamond {
  foreach my $image (@{shift->{'-images'}}) { $image->diamond(@_); }
}

sub add_colours {
  foreach my $image (@{shift->{'-images'}}) {
    if (my $coderef = $image->can('add_colours')) {
      $image->$coderef(@_);
    }
  }
}

sub Image_Base_Other_xy_points {
  ### Multiplex xy_points
  foreach my $image (@{shift->{'-images'}}) {
    if (my $coderef = $image->can('Image_Base_Other_xy_points')) {
      $image->$coderef(@_);
    } else {
      for (my $i = 1; $i < @_; $i += 2) {
        $image->xy ($_[$i], $_[$i+1],
                    $_[0]);  # colour
      }
    }
  }
}
sub Image_Base_Other_rectangles {
  ### Multiplex rectangles
  foreach my $image (@{shift->{'-images'}}) {
    if (my $coderef = $image->can('Image_Base_Other_rectangles')) {
      $image->$coderef(@_);
    } else {
      for (my $i = 2; $i < @_; $i += 4) {
        ### rect: @_[$i .. $i+3], $_[0], $_[1]
        $image->rectangle (@_[$i .. $i+3],
                           $_[0],   # colour
                           $_[1]);  # fill
      }
    }
  }
}

1;
__END__