view release on metacpan or  search on metacpan

lib/Game/FaceGenerator/Core.pm  view on Meta::CPAN

Thus, a mustache (as part of the C<chin>) covers a mouth; C<hair> covers the
face; C<hat> cover C<hair>, and so on.

=cut

sub all_elements {
  # face is the background, if any (mostly to support photos)
  # chin after mouth (mustache hides mouth)
  # nose after chin (mustache!)
  # hair after ears
  # ears after chin (if you're fat)
  # chin after ears (for your beard) – damn!
  return qw(face eyes brows mouth chin ears nose extra horns bangs hair hat);
}

=head2 random_components

The random components of C<$type> for C<$artist>. If C<$debug> is true,
F<empty.png> is added to the list of components.

=cut

sub random_components {
  my ($type, $artist, $debug) = @_;
  %artists = %{all_artists()} unless keys %artists;
  $type = one(@{$artists{$artist}->{types}}) if $type eq 'random';
  my @elements = all_elements();
  @elements = grep(!/^extra/, @elements) if rand(1) >= 0.1; # 10% chance
  @elements = grep(!/^hat/, @elements) if rand(1) >= 0.1; # 10% chance
  my @files = grep { /\.png$/ } read_dir("$dir/$artist");
  my @components;
  for my $element (@elements) {
    my @candidates1 = grep(/^${element}_/, @files);
    my @candidates2 = grep(/_$type/, @candidates1);
    @candidates2 = grep(/_all/, @candidates1) unless @candidates2;
    my $candidate = one(@candidates2) || '';
    unless (any { $type eq $_ } no_flip($artist)) {
      $candidate .= '_' if $candidate and rand >= 0.5; # invert it!
    }
    push(@components, $candidate) if $candidate;
  }
  unshift(@components, 'empty.png') if $debug;
  return @components;
}

=head2 render_components

Renders the components for C<$artist>. The C<@components> are probably the
result of a call to C<random_components>.

=cut

sub render_components {
  my ($artist, @components) = @_;
  my $image;
  for my $component (@components) {
    next unless $component;
    my $layer;
    if (-f "$dir/$component") {
      $layer = GD::Image->newFromPng("$dir/$component", 1);
    } elsif (substr($component, -1) eq '_') {
      $component = substr($component, 0, -1);
      $layer = GD::Image->newFromPng("$dir/$artist/$component", 1);
      $layer->flipHorizontal();
    } else {
      $layer = GD::Image->newFromPng("$dir/$artist/$component", 1);
    }
    # scanned images with a white background: make white transparent unless this
    # is the first image
    if ($layer->isTrueColor == 0 and $layer->transparent == -1 and $image) {
      my $white = $layer->colorClosest(255,255,255);
      $layer->transparent($white);
    }
    # if we already have an image, combine them
    if ($image) {
      $image->copy($layer, 0, 0, 0, 0, $layer->getBounds());
    } else {
      $image = $layer;
      $image->alphaBlending(1);
      $image->saveAlpha(1);
    }
  }
  return $image->png();
}

=head2 move

This is the subroutine called to edit the images.

=cut

sub move {
  my ($artist, $element, $direction, $step) = @_;
  my $file = "$dir/$artist/$element";
  my $original = GD::Image->new($file);
  my $image = GD::Image->new(450, 600);
  my $white = $image->colorAllocate(255,255,255); # find white
  $image->rectangle(0, 0, $image->getBounds(), $white);
  if ($direction eq 'up') {
    $image->copy($original, 0, 0, 0, $step, $image->width, $image->height - $step);
  } elsif ($direction eq 'down') {
    $image->copy($original, 0, $step, 0, 0, $image->width, $image->height - $step);
  } elsif ($direction eq 'left') {
    $image->copy($original, 0, 0, $step, 0, $image->width - $step, $image->height);
  } elsif ($direction eq 'right') {
    $image->copy($original, $step, 0, 0, 0, $image->width - $step, $image->height);
  } elsif ($direction eq 'appart') {
    $image->copy($original, $image->width/2 + $step/2, 0, $image->width/2, 0, $image->width/2 - $step/2, $image->height);
    $image->copy($original, 0, 0, $step/2, 0, $image->width/2 - $step/2, $image->height);
  } elsif ($direction eq 'closer') {
    $image->copy($original, $step/2, 0, 0, 0, $image->width/2 - $step/2, $image->height);
    $image->copy($original, $image->width/2, 0, $image->width/2 + $step/2, 0, $image->width/2 - $step/2, $image->height);
  } else {
    die "Unknown direction: $direction\n";
  }
  write_binary($file, $image->png);
}

1;