帰ってきたネコブログ

カオスCGやジュリア集合に着色するのにパレットを用意してるんだけど、
良い感じのパレットのバリエーションを増やすべく、
その処理を切り出して検討してみた。

use v5.14;
use strict;
use warnings;

use Imager;

sub look_up_func {
    my $params = shift;
    my $n = scalar( @{$params} );
    return sub {
        my $t = shift;
        for (my $i=0; $i<($n - 1); $i++) {
            my ( $p1, $p2 ) = @{$params}[$i, ($i + 1)];
            if ( $t <= $p2->[0] ) {
                my $dt = $p2->[0] - $p1->[0];
                my $dv = $p2->[1] - $p1->[1];
                $t -= $p1->[0];
                return $p1->[1] + ($dv * ($t / $dt));
            }
        }

        return $params->[-1]->[1];
    }
}

sub create_palette {
    my ( $n, $args ) = @_;

    my $func_hue = look_up_func( $args->{hue} );
    my $func_val = look_up_func( $args->{val} );
    my $func_sat = look_up_func( $args->{sat} );

    my @palette = map {
        my $t = $_ / ($n - 1);
        my $hue = $func_hue->( $t );
        my $val = $func_val->( $t );
        my $sat = $func_sat->( $t );

        #printf( "%3d: %5.2f, %5.2f, %5.2f\n", $_, $hue, $val, $sat );

        Imager::Color->new( hue => $hue, v => $val, s => $sat );
    } 0..($n - 1);

    return \@palette;
}

my ( $w, $h ) = ( 640, 480 );
my $img = Imager->new(
    xsize => $w, ysize => $h, channels => 1, type => 'paletted' );

my $palette = create_palette( 256, {
    hue => [
        [ 0.0,  0.0 ],
        [ 0.2,  0.0 ],
        [ 0.6, 48.0 ]
    ],
    val => [
        [ 0.0, 0.0 ],
        [ 0.1, 0.2 ],
        [ 0.4, 1.0 ]
    ],
    sat => [
        [ 0.0, 0.8 ],
        [ 0.5, 0.8 ],
        [ 1.0, 0.0 ]
    ]
} );
$img->addcolors( colors => $palette );

my @samples = map {
    my $tmp = $_ / ($w - 1);
    int( (255 * $tmp) + 0.5 );
} 0..($w - 1);

for (my $iy=0; $iy<$h; $iy++) {
    $img->setscanline(
        y => $iy,
        type => 'index',
        pixels => \@samples );
}

my $dst_file = 'test.gif';
$img->write( file => $dst_file ) or die $img->errstr;
say 'wrote: ', $dst_file;

線形補間だけど、個人的には満足の出来。
ちなみに、これを実行するとこんな感じ。

$ perl bbb.pl
wrote: test.gif

これを利用しつつ、ガンマ補正を2.0でレンダリングするとこんな感じ。

perl aaa.pl --param="0.262,0.627" --dst="test2"

ガンマ補正も実行時引数に加えた方が良いかな？
（ここで言うところの、281行目付近の数字。）

おしまい。

カテゴリー: Perl, コンピューター by ネコ on 2016年08月26日 | タグ: Imager > メモ