Ecchi.pm

package Acme::Ecchi;

use strict;
use warnings;
use utf8;
use Mouse;
use Imager;
use Imager::Color;

has width => (
    is      => 'rw',
    isa     => 'Int',
    default => 1024,
);

has height => (
    is      => 'rw',
    isa     => 'Int',
    default => 1024,
);

has longer_side => (
    is         => 'ro',
    isa        => 'Int',
    lazy_build => 1,
);

has base => (
    is         => 'ro',
    isa        => 'Imager',
    lazy_build => 1,
);

has max_size => (
    is         => 'ro',
    isa        => 'Int',
    lazy_build => 1,
);

has object_count => (
    is         => 'rw',
    isa        => 'Int',
    lazy_build => 1,
);

sub _build_base {
    my $self = shift;
    my $im = Imager->new(xsize => $self->width, ysize => $self->height);
    $im->box(filled => 1, color => Imager::Color->new(255, 255, 255));
    return $im;
}

sub _build_longer_side {
    my $self = shift;
    my $base = $self->base;
    my $x = $base->getwidth;
    my $y = $base->getheight;
    return $x > $y ? $x : $y;
}

sub _build_max_size {
    return shift->longer_side * 0.1;
}

sub _build_object_count {
    my $self = shift;
    return int($self->width * $self->height * 0.01);
}

sub ecchi {
    my($self, $name) = @_;
    $name //= 'ecchi.jpg'; # default filename

    my $base = $self->base;
    for (1 .. $self->object_count) {
        # 30% of objects are ovals, others are rectangles
        my $object =
            rand() < 0.3 ? $self->random_oval : $self->random_rectangle;
        my $tx = rand($self->width  + $self->max_size * 2) - $self->max_size;
        my $ty = rand($self->height + $self->max_size * 2) - $self->max_size;
        $base->compose(
            tx      => $tx,
            ty      => $ty,
            src     => $object,
            opacity => rand(),
        );
    }

    $base->write(file => $name);
}

sub random_oval {
    my $self = shift;
    my $r = rand($self->max_size); # radius
    my $object = Imager->new(
        xsize    => ($r * 2) + 4,
        ysize    => ($r * 2) + 4,
        channels => 4,
    );

    # draws a circle
    $object->circle(
        color => $self->random_color(),
        r     => $r,
        x     => $r + 2,
        y     => $r + 2
    );

    # make the circle an oval
    return $object->scale(
        xpixels => $object->getwidth  * rand(),
        ypixels => $object->getheight * rand(),
        type    => 'nonprop',
    );
}

sub random_rectangle {
    my $self = shift;
    # draws a rectangle
    my $object = Imager->new(
        xsize    => rand($self->max_size) + 1,
        ysize    => rand($self->max_size) + 1,
        channels => 4,
    );

    $object->box(filled => 1, color => $self->random_color());

    return $object;
}

sub random_color {
    my $self = shift;
    return Imager::Color->new(rand(256), rand(256), rand(256));
}

__PACKAGE__->meta->make_immutable;

1;
__END__

=head1 NAME
 
Acme::Ecchi - 最高にエッチな画像っぽい何かを作る
 
=head1 SYNOPSIS
 
 use Acme::Ecchi;  
 Acme::Ecchi->new->ecchi; # write to ecchi.jpg
 
or

 use Acme::Ecchi;
 
 my $ecchi = Acme::Ecchi->new;
 
 $ecchi->width(400);
 $ecchi->height(500);
 $ecchi->object_count(5000);

 $ecchi->ecchi('ecchi.png');
 
=head1 DESCRIPTION
 
最高にエッチな画像は作れません。
所詮「0世代目」みたいなものです。

=head1 AUTHOR
 
Koichi Taniguchi (a.k.a. nipotan) E<lt>[email protected]<gt>
 
=head1 LICENSE
 
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
 
=head1 SEE ALSO
 
L<https://gamingchahan.com/ecchi/>
 
=cut