Sep 09, 2009

Perl/Tk で縦書きビューワーを作ろう (2)

今日も今日とてぽちたて作りです。

今日は自動折り返し機能や指定した行数を越えて縦書き描画しない機能を付けてみました。また、今はまだ機能自体は実装していませんが、将来必要になるページ画面移動ボタンも追加しています。今は押してもぽちたてが終了するだけなんですけどね。本当にまずシンプルな機能のものを作るつもりなので、当分の間、入出力の日本語文字コードは UTF-8 だけにしか対応出来ません。

IPAフォント使用時のぽちたて画面サムネイル

ぽちたて作りの最大の懸案である縦書きグリフの取得と描画もまだ完全に手付かずの状態なので、入出力での多種類の日本語文字コードへの対応や、あったら嬉しい栞機能とか、さらには青空文庫ビューワーとしての進化等々、一体実現するのがいつの事になるのか気が遠くなりそうです。

pochitate20090909.pl

#!/usr/bin/perl

use strict;
use warnings;
use utf8;
use Tk;
use Lingua::JA::Fold qw(fold);

# 設定
my $font_family            = 'IPA明朝';
my $font_size              = 12;
my $font_style             = 'normal';
my $text_width             = 450;
my $text_height            = 46;
my $line_horizontal_margin = 26;
my $chr_vertical_margin    = 16;
my $fold_length            = 30;
my $page_lines             = 17;

# メインウィンドウの準備
my $top = MainWindow->new( -title => 'ぽちたて' );

# フレームの準備
my $frame_top = $top->Frame();
my $frame_bottom = $top->Frame();

# 主画面となるキャンバスウィジェットの配置
$frame_top = $top->Canvas( width => 481, height => 561 );
$frame_top->create( 'rectangle', 1, 1, 480, 560, -fill => 'green',
                    -stipple => 'gray25' );

# ページ移動ボタンの配置(現時点ではボタンを押してもぽちたてを終了するだけ)
$frame_bottom->Button( -text => '<', -command => \&exit,
          -font => [ $font_family, 9, $font_style ] )->pack( -side => 'left' );
$frame_bottom->Button( -text => '>', -command => \&exit,
          -font => [ $font_family, 9, $font_style ] )->pack( -side => 'left' );

# フレーム内の配置
$frame_top->pack();
$frame_bottom->pack( -side => 'right' );		 

# テキストファイルからの読み込みと折り返し処理
my $strs;
while(<>){
    utf8::decode($_);
    $strs = $strs . fold( 'text' => $_, 'length' => $fold_length,
			  'mode' => 'traditional' );
}

# 各行ごとに各文字をひとつひとつ描画
open my $fh, "<", \$strs or die "Couldn't open for reading: $!\n";
my $lines = 0;
while(<$fh>){
    utf8::decode($_);
    my $chr_height = $text_height;
    my @string = split(//, $_);
    for my $chr (@string){
        $frame_top->create( 'text', $text_width, $chr_height, -text => $chr,
                          -font => [ $font_family, $font_size, $font_style ] );
        $chr_height += $chr_vertical_margin;
    }
    $text_width -= $line_horizontal_margin;
    $lines++;
    last if ($lines > $page_lines - 1); # 指定の行数に入りきれないなら描画中止
}

MainLoop();

こうしたものを作るのが初めてなので、機能の実装方法がきっと滅茶苦茶だったり無謀だったり乱暴過ぎたりどこから見てもおかしかったりするに違い無いと思うので、プログラミングの先達の皆様方がうっかりこのページを見てくれていて、なんとなく暇潰しにでも感想をコメントしてくれるのを本当に本当に心待ちにしています。

Posted at 21:26 in perl | Comments/Trackbacks ()
Comments/Trackbacks
TrackBack ping me at
http://pochi.usamimi.info/blog/perl/PerlTk_tategaki2.
Post a comment

writeback message: