PerlでカオスCGを描く(2)

前回に引き続き、もう少し滑らかに描画するためにいろいろ試してみました。

use v5.14;
use strict;
use warnings;

use Imager;

use constant WIDTH => 600;
use constant HEIGHT => 600;

use constant SCALE_X => 180;
use constant SCALE_Y => 180;

sub f {
    my ( $aa, $bb, $cc, $xx, $yy ) = @_;
    my $x2 = $xx * $xx;
    my $y2 = $yy * $yy;
    return ($aa * ($x2 + $y2)) + ($bb * $xx * ($x2 - (3.0 * $y2))) + $cc;
}

sub render_image {
    my ( $src, $hue0, $m, $curve ) = @_;

    my $width = WIDTH;
    my $height = HEIGHT;

    my $img = Imager->new(
        xsize => $width, ysize => $height, channels => 3 );

    my $iy = 0;
    foreach my $line ( @{$src} ) {
        my $ix = 0;
        foreach ( @{$line} ) {

            my $val = ((($m < $_) ? 1.0 : $_ / $m) ** $curve) * 2;
            my $hue = $hue0 + ($val * 40);
            if ( $val <= 1.0 ) {
                my $color = Imager::Color->new( hue => $hue, v => $val, s => 1.0 );
                $img->setpixel( x => $ix, y => $iy, color => $color );
            }
            elsif ( $val <= 2.0 ) {
                my $color = Imager::Color->new( hue => $hue, v => 1.0, s => (2.0 - $val) );
                $img->setpixel( x => $ix, y => $iy, color => $color );
            }
            else {
                my $color = Imager::Color->new( hue => $hue, v => 1.0, s => 0.0 );
                $img->setpixel( x => $ix, y => $iy, color => $color );
            }

            $ix++;
        }

        $iy++;
    }

    return $img;
}

my $n = $ARGV[0] // 100000;
say "N = $n";

my ( $u0, $v0 ) = ( WIDTH / 2, HEIGHT / 2 );
my @result = map {
    my @tmp = map {
        0;
    } 1..WIDTH;
    \@tmp;
} 1..HEIGHT;

my ( $x00, $y00 ) = ( 0.1, 0.1 );
#my ( $a0, $b0, $c0, $d0 ) = ( -1.0, 0.05, 2.275, -0.5 );
#my ( $a0, $b0, $c0, $d0 ) = ( 1.0, 0.0, -1.9, 0.4 );
#my ( $a0, $b0, $c0, $d0 ) = ( 1.0, 0.0, -2.25, 0.2 );
my ( $a0, $b0, $c0, $d0 ) = ( -1.0, 0.1, 1.6, -0.8 );

my ( $x0, $y0 ) = ( $x00, $y00 );
my ( $x, $y ) = ( 0.0, 0.0 );
my $i = 0;
foreach ( 1..$n ) {
    my $tmp = f( $a0, $b0, $c0, $x0, $y0 );
    $x = ($tmp * $x0) + ($d0 * (($x0 * $x0) - ($y0 * $y0)));
    $y = ($tmp * $y0) - (2.0 * $d0 * $x0 * $y0);

    #printf( "(x, y) = (%6.3f, %6.3f)\n", $x, $y );

    if ( 300 < (abs($x) + abs($y)) ) {
        say 'divergence!';
        ( $x0, $y0 ) = ( $x00, $y00 );
    }
    else {
        ( $x0, $y0 ) = ( $x, $y );
    }

    my ( $u, $v ) = (
        ($x * SCALE_X) + $u0,
        $v0 - ($y * SCALE_Y)
    );

    if ( 0 < $u and $u < (WIDTH - 1) and 0 < $v and $v < (HEIGHT - 1) ) {
        foreach ( -0.75, -0.25, +0.25, +0.75 ) {
            $result[int($v - 0.25)]->[int($u + $_)] += 1;
            $result[int($v + 0.25)]->[int($u + $_)] += 1;
            $result[int($v + $_)]->[int($u - 0.25)] += 1;
            $result[int($v + $_)]->[int($u + 0.25)] += 1;
        }
    }

    $i++;
}

say 'calclated!';

{
    my $hue0 = 160;
    my $m = $n / 250;
    my $img = render_image( \@result, $hue0, $m, 0.8 );

    my $dst_file = ($0 =~ s/\.pl//r) . sprintf('_%d.png', $hue0);
    $img->write( file => $dst_file ) or die $img->errstr;
    say 'wrote: ', $dst_file;
}

だいぶ、変更すべきパラメータの数を絞り込めたんだけど、
計算より描画に時間が掛かってるらしく、
もしかしたらhueによる色指定が良くないのかも知れないので、
この辺りを重点的に計測してみようと思います。

今回のポイントとしては、
少し滲んだ感じが得られるように計算結果を格納して、
粒状感(ジャギー)を抑えてみました。

$ perl aaa.pl 800000

20160202-1

おしまい。

Leave a Comment