JAMADAM.COM

最近、プライベートでPerlMagickを覚えたので、長文いれたら勝手に折り返してくれるPerlスクリプトを作ってみた。こんなものを動的に作って何になるのかってところは不明です。

先日のPHP+GDとほぼ同じ出力が得られるのに加えて、ストロークとドロップシャドウっぽいことをやるという余計な機能もつけてみた。PHP+GDよりえらく重いけど、Perl+Magickのがライブラリがいろんな機能に対応していて楽しい。

ソースコードも出しちゃう。汚いですけど。

package NT::Image::Magick::AnnotateWithLineBreak;
use strict;
use warnings;
use Image::Magick;
use Encode qw(decode);
use encoding 'utf8';

###  ------------------------------------------------------------------------------
### Constractor
###  ------------------------------------------------------------------------------
sub new {
    
    my $class = shift;
    my $self = 
        bless {
            magick => Image::Magick->new(), 
            charset => 'utf8', 
            ngCharactorsForHead => 
                ',)]｝、〕〉》」』】〟’”`≫。.・:;ヽヾーァィゥェォッャュョヮヵヶぁぃぅぇぉっゃゅょゎ', 
            ngCharactorsForTail => 
                '([｛〔〈《「『【〝‘“_≪', 
            ngCharactorsForSeparation => 
                '[a-zA-Z0-9¥'".,!¥?¥-]', 
            result => {width => 0, height => 0},
            @_
        }, $class;
    
    $self->Read($self->{file});
    
    return $self;
}

###  ------------------------------------------------------------------------------
### パラメータセットアップ
###  ------------------------------------------------------------------------------
sub setParam {
    
    my $self = shift;
    %$self = (%{$self}, @_);
}

###  ------------------------------------------------------------------------------
### メンバ変数magickにメソッドを委譲
###  ------------------------------------------------------------------------------
sub AUTOLOAD {
    
    no strict;
    my $self = shift;
    my $type = ref($self);
    my $name = $AUTOLOAD; $name =~ s/.*://;
    
    return $self->{magick}->$name(@_);
}

###  ------------------------------------------------------------------------------
### 文字入れ
### 戻り値：ハッシュリファレンス/要した幅と高さ
###  ------------------------------------------------------------------------------
sub breakLineAnnotate {
    
    my $self = shift;
    my %args = (
        x                       => 0,
        y                       => 0,
        width                   => undef,
        height                  => undef,
        pointsize               => 9,
        font                    => undef,
        text                    => '',
        fill                    => '#000000',
        'line-spacing'          => 4,
        'drop-shadow-depth'     => 0,
        'drop-shadow-color' => '#000000',
        'nice-stroke-width'     => 0,
        'nice-stroke-color'     => '#111111',
        @_);
    
    $args{width} = 
        (defined $args{width}) 
            ? $args{width} 
            : ($self->Get('width') - $args{x});
    
    $args{height} = 
        (defined $args{height}) 
            ? $args{height} 
            : ($self->Get('height') - $args{y});
    
    my $in_str = 
        utf8::is_utf8($args{text}) 
            ? $args{text} 
            : decode($self->{charset}, $args{text});
    
    $self->_putMultiLine(%args, text => $in_str);
    
    return $self->{result};
}

###  ------------------------------------------------------------------------------
### プリント
### 戻り値：整数/要した高さ
###  ------------------------------------------------------------------------------
sub _putMultiLine {
    
    my $self = shift;
    my %args = (@_);
    
    my $y_pos = $args{y};
    
    foreach my $line (split(/¥n/, $args{text})) {
        
        if (! $line) {
            
            $y_pos += $args{pointsize} + $args{'line-spacing'};
            next;
        }
        
        $y_pos = 
            $self->_putLogicalLine(
                %args, 
                text => $line, 
                y => $y_pos + $args{'line-spacing'}
            );
    }
    
    $self->{result}->{height} = $y_pos if ($y_pos > $self->{result}->{height});
    
    return $y_pos;
}

###  ------------------------------------------------------------------------------
### 論理行のプリント
### 戻り値：整数/要した高さ
###  ------------------------------------------------------------------------------
sub _putLogicalLine {
($__PACKAGE__::debugcount++ > 200) and $::gERROR->die(log => 'deep:'. $__PACKAGE__::debugcount);
    
    my $self = shift;
    my %args = (@_);
    
    $args{text} =~ s/^¥s//;
    
    my $pos1 = ($args{_last_length} or 1);
    my @box = 
        $self->QueryFontMetrics(%args, text => substr($args{text}, 0, $pos1));
    
    my $increment = ($box[4] > $args{width}) ? -1 : 1;
    
    ### Search for horizontal limit
    for (my $i = $pos1; $i > 0 and $i <= length($args{text}); $i += $increment) {
        
        @box = $self->QueryFontMetrics(%args, text => substr($args{text}, 0, $i));
        
        if ($increment == 1 and $box[4] > $args{width}) {
            
            last;
        }
        
        $pos1 = $i;
        
        if ($increment == -1 and $box[4] < $args{width}) {
            
            last;
        }
    }
    
    return $args{y} if (($args{y} + $box[5]) > $args{height});
    
    ### word wrapping
    if ($pos1 < length($args{text})) {
        
        while ($pos1 > 1) {
            
            my $next = substr($args{text}, $pos1, 1);
            
            if ($next and index($self->{ngCharactorsForHead}, $next) > -1) {
                
                $pos1--;
                next;
            } 
            
            my $last = substr($args{text}, $pos1 - 1, 1);
            
            if ($last and index($self->{ngCharactorsForTail}, $last) > -1) {
                
                $pos1--;
                next;
            }
            
            if ($last =~ /$self->{'ngCharactorsForSeparation'}/ and 
                $next =~ /$self->{'ngCharactorsForSeparation'}/) {
                
                $pos1--;
                next;
            }
            
            last;
        }
    }
    
    @box = $self->QueryFontMetrics(%args, text => substr($args{text}, 0, $pos1));
    $self->{result}->{width} = $box[4];
    $args{_last_length} = $pos1;
    
    my %args_common = (
        %args, 
        text    => substr($args{text}, 0, $pos1), 
        y       => ($args{y} + $box[5]), 
        );
    
    ### drop shadow
    for (my $i = 0; $i < $args{'drop-shadow-depth'}; $i++) {
        
        my %args_shadow = %args_common;
        
        if ($args{'nice-stroke-width'}) {
            
            $args_shadow{stroke} = $args{'drop-shadow-color'};
            $args_shadow{strokewidth} = $args{'nice-stroke-width'},
        }
        
        $self->Annotate(
            %args_shadow, 
            fill        => $args{'drop-shadow-color'},
            x           => $args_common{x} + 1, 
            y           => $args_common{y} + 1,
        );
    }
    
    ### stroke
    if ($args{'nice-stroke-width'}) {
        
        $self->Annotate(
            %args_common, 
            fill        => $args{'nice-stroke-color'},
            stroke      => $args{'nice-stroke-color'},
            strokewidth => $args{'nice-stroke-width'},
        );
    }
    
    ### Put text
    $self->Annotate(%args_common);
    
    ### Evaluate tail str
    if ($pos1 < length($args{text})) {
        
        return 
            $self->_putLogicalLine(
                %args, 
                y       => ($args{y} + $box[5] + $args{'line-spacing'}), 
                text    => substr($args{text}, $pos1)
            );
    }
    
    ### Returns bottom position of written box
    return $args{y} + $args{pointsize};
}

###  ------------------------------------------------------------------------------
### 結果取得
### 戻り値:interger/要した幅または高さ/
###  ------------------------------------------------------------------------------
sub getResult {
    
    return shift->{result}->{$_[0]};
}

return 1;

使い方。

my $image = 
    NT::Image::Magick::AnnotateWithLineBreak->new(
        file => 'source/heart_jamadam.png', charset => 'euc-jp');

$image->breakLineAnnotate(
    text                => 
        '最近、仕事でGDを覚えたので、長文いれたら勝手に折り返してくれるPHPスクリプトを作ってみた。日本語禁則処理もできそうだなあ。', 
    font                => 
        './font/mika.ttf', 
    pointsize           => 10,
    fill                => '#000000',
    x                   => 10,
    y                   => 80,
    width               => 231,
    height              => 260,
    'nice-stroke-width' => 1, 
    'nice-stroke-color' => '#ffffff',
    'drop-shadow-depth' => 0, 
    'drop-shadow-color' => '#000000',
);

$image->breakLineAnnotate(
    text                => '今すぐクリック', 
    font                => 
        './font/ipa/ipagp0208_for_legacy_compatibility.ttf', 
    pointsize           => 14,
    fill                => '#000000',
    width               => 251,
    height              => 260,
    x                   => 155,
    y                   => 130,
    'nice-stroke-width' => 6, 
    'nice-stroke-color' => '#fafffa',
    'drop-shadow-depth' => 0, 
    'drop-shadow-color' => '#000000',
);

my ($format, $mime) = $image->Get('magick', 'mime');

print 'Content-type: '. $mime. "¥n¥n";
binmode(STDOUT);
$image->Write($format. ':-');

[2008-5-27追記]
分割禁則というのにも、雰囲気だけ対応してみた。これで英文も概ね良好。

DUOのCD、560の例文が45のセクションに分類されて収録されているため、扱いづらい。これは99トラックしか収録できないCDの宿命なのです。という訳で、2時間もかけて560トラックに分割してみました。これで機敏に頭出し。

URLが汚い。このエントリーへのトラックバックURLはhttp://jamadam.com/blog/?b=2811&x=cms%3a%3atb。これはcms::tbというライブラリを示してるんだけど、コロンが何となくだめかな、と思ってパーセントエンコードしてみている。これって必要あるのかな。GoogleのキャッシュページのURLにはコロン:やスラッシュが含まれているし、スラッシュなんか結構頻繁に見かける。という訳で、実際、何が正しいのか調べてみることにする。

URIの予約文字はRFC2396(日本語訳)で

2.2. 予約文字　Reserved Characters reserved = ";" | "/" | "?" | ":" | "@" | "&" | "=" | "+" | "$" | "," 上記"reserved"構文級は、URIにおいて許された文字であるが、第3項に述べる区切り子の部品として使われ、一般URI構文の特定の部品にあっては許されていないかもしれない文字を参照します。 "reserved"集合中の文字は、全ての文脈において予約されているのではありません。与えられたURI部品において実際に予約された文字集合は、その部品によって定義されます。

ということらしい。つまり、ざっくり言って、これらの文字は予約語だけど、部品毎に定義されてるってことか。そして、部品ってのは附属書Bのによれば

次に，URI参照をその構成要素に分割する正規表現を示す。 ^(([^:/?#]+):)?(//([^/?#]*))?([^?#]*)(\?([^#]*))?(#(.*))? scheme = $2 authority = $4 path = $5 query = $7 fragment = $9

のように分離するのが正しいらしい。クエリー文字列には#さえ使わなければ問題なさそうだけど、そうなのか？

で、クエリーコンポーネントの節をみると

3.4. クエリー成分 (Query Component)

クエリー成分は資源によって解釈される情報文字列である。

query = *uric

クエリー成分中では、文字";"、"/"、"?"、":"、"@"、"&"、"="、"+"、","、及び"$"は予約されている。

とのこと。クエリーに関しては、たったこれだけ。そしてやっぱり予約語たくさん。

と、ここまで調べてみて、ふとRFC2396の冒頭を眺めﾄると、気になる一文が。

URIスキーム (Section 3.1)はURIの名前空間を定義し、それゆえにそのスキームを用いる識別子の構文と意味はさらに制限されることがある。この仕様書では、すべてのURIスキームで必要な、又は多くのURIスキームで共通なURI構文の要素を定義する。よって、この仕様書で定義する構文と意味論は、URI参照をスキーム独立に構文解析する機構を実装する上で必要なものとし、スキームに依存する処理は、スキーム依存の意味解釈が必要になるまで後回しにできるようにする。

しまった。間違った。見るべきはHTTPに関する文書だった・・。つづく。

今日はお盆休みを取ったので、ずっと家でベースの練習。

昨日、お友達にMoonの5弦ベースを借りたのでレコーディングに使おうかと企んでいる。彼はこのベースの音が気に入らなくて売りに出しているのだが、弾いてみたらとてもよい音だ。買い取ろうか迷っている。でも弦は4本で沢山だ。5弦目は指置き以上の働きはしないだろう。

最近、「To Do」が増える一方だ。ベース録りが溜まっているのに加え、父親の経営する英会話教室の英語教材CDを作る仕事が割り込んでしまった。ちょっと面白そうと思って軽く引き受けてしまったが、正味1時間半、1300にのぼる英文を録音し、加工する作業はかなり骨が折れる。

という訳で、先日、録音してきた音の一部。

録音場所となった教室は環状通りに面しており、時折、爆音のハーレーが走り去ったり、路駐に警告する警察の騒音など、録音にはかなり劣悪な環境だったが、それにしてはなかなかよく録れたと思う。この機会にコンデンサマイクの一つでも買ってみようかと思ったが、SM58にしてよかった。コンデンサだったらオフマイクの騒音もしっかり拾っていたことだろう。

これから、ぶっ通しで録った音を文章単位に分割し、99のグループ(CDのトラック用)にし、1.5秒程度の無音を挟んで再連結する。バッチ処理のできる波形編集ソフトとファイラ、リネームソフトを駆使し、なんとか一括処理したい。一括処理は楽しい。一括処理する手段を考えるのに一日かける本末転倒さが好きだ。

1:03PM。もう今日が終わって、明日が今日になってしまった。今日もお仕事を頑張ろう。