Perlで書き初め

あけましておめでとうございます。
今年も何卒よろしくお願いします。

新年の初めなので書き初めをしたいと思います。

元ネタ

週記くらい | Common Lispで書き初め
vallog: 2012年が明けたので書き初めしました。lispで。

ソース

試行錯誤して微調整した感じですが。

#!/usr/bin/env perl
package App::Kakizome;

use strict;
use warnings;

use GD;
use Encode;
use Encode::Locale;

sub new {
    my $class = shift;
    bless {}, $class;
}

my $mainfont = $ENV{HOME} . '/.fonts/aoyagireisyosimo.ttf';
my $subfont  = '/usr/share/fonts/truetype/vlgothic/VL-PGothic-Regular.ttf';

sub draw {
    my ($self, $string, $signature) = @_;

    my $point = 72;

    $string    = Encode::decode('console_in', $string);
    $signature = Encode::decode('console_in', $signature);

    my $fontpath = $mainfont;
    if ($string =~ m/[a-z0-9]/i) {
        $fontpath = $subfont;
    }

    my ($width, $height) = (200, length($string) * 80);
    my $im = GD::Image->new($width, $height);

    my @bg = (255, 255, 255);
    my $background = $im->colorAllocate(@bg);
    $im->fill( 0, 0, $background);
    my @fg = (0, 0, 0);
    my $foreground = $im->colorAllocate(@fg);

    my $char_margin = 30;
    my $top_pos = $point;
    my $x_pos = $width / 2 - ($point / 2);
    for my $char (split //, $string) {
        $im->stringFT($foreground, $fontpath, $point, 0,
                      $x_pos, $top_pos + $char_margin,
                      $char);
        $top_pos += $point;
    }

    if ($signature =~ m/[a-z0-9]/i) {
        $fontpath = $subfont;
    } else {
        $fontpath = $mainfont;
    }

    $point = 18;
    $x_pos = 10;
    $top_pos = $height  - ((length($signature)) * $point);
    for my $char (split //, $signature) {
        $im->stringFT($foreground, $fontpath, $point, 0,
                      $x_pos, $top_pos, $char);
        $top_pos += $point;
    }

    return $im->png();
}

package main;
use strict;
use warnings;

unless (caller) {
    my $app = App::Kakizome->new();

    die "Usage: $0 string signature [output]" unless @ARGV >= 2;
    my $png = $app->draw($ARGV[0], $ARGV[1]);

    my $filename = $ARGV[2] || 'kakizome.png';
    open my $fh, '>', $filename or die "Can't open $filename: $!";
    print {$fh} $png;
    close $fh;
}

実行

こんな感じで。

  % perl kakizome.pl 'あけおめことよろ' 'よしだ しょうへい' akeome.png

結果

おわりに

Perlとか Emacsとかその他勉強したことについてなるべく継続的に
書いていきたいと思いますので、今年もよろしくお願いします。