ぽち＊ろぐ

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

今日は余裕が無いのでやっと最低限の機能で動き出したコードだけ…。

• ぽちたてを動かすのに必要ないろいろ
  • Perl (多分、5.8.8以上)
  • Perl/Tk
  • Lingua::JA::Fold
• 機能
  • UTF-8 のテキストファイルを UTF-8 で縦書き表示します。
• 注意点
  • 縦書きグリフが表示出来ません。
  • 前のページへ戻る機能はありません。
  • 今読んでるのが何ページ目なのか表示しません。
  • とんでもなく起動が遅いですがフリーズと間違えないで下さい。
  • Perl と CPAN を使える環境なら Windows でも動作するとは思いますけども、Linux の Perl5.10.0 でしか動作を確認していません。

pochitat20090910.pl

#!/usr/bin/perl

## 使い方 ###########################
#                                   #
# $ pochitate20090910.pl sample.txt #
#                                   #
#####################################

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

# 設定
my $font_family            = 'IPA明朝';
my $font_size              = 11;
my $font_style             = 'normal';
my $font_color             = '#000000';
my $background_color       = '#e0ffff';
my $text_width             = 523;
my $text_height            = 28;
my $line_horizontal_margin = 26;
my $chr_vertical_margin    = 15;
my $fold_length            = 42; # 文庫本１ページの標準的な一行の文字数
my $page_lines             = 18; # 文庫本１ページの標準的な行数

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

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

# 主画面となるキャンバスウィジェットの配置
$frame_top = $top->Canvas( width => 603, height => 671 );
$frame_top->create( 'rectangle', 1, 1, 602, 670, -fill => $background_color );

# ページ移動ボタンの配置（「＜」で次ページ、「×」で終了）
my @chr_ids;
$frame_bottom->Button( -text => '＜', -command => [ \&write_tategaki, \@chr_ids ],
	  -font => [ $font_family, 4, $font_style ] )->pack( -side => 'left' );
$frame_bottom->Button( -text => '×', -command => \&exit,
	  -font => [ $font_family, 4, $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";

&write_tategaki(\@chr_ids);

MainLoop();

sub write_tategaki{
    my $chr_ids = shift;
    my $lines;
    my $line_width = $text_width;
    unless (eof $fh){
	for my $c_id (@$chr_ids){
	    $frame_top->delete( $c_id );
	}
        @$chr_ids = ();
    }
    while(<$fh>){
	utf8::decode($_);
	my $chr_height = $text_height;
	my @string = split(//, $_);
	for my $chr (@string){
	    $frame_top->create( 'text', $line_width, $chr_height, 
                          -fill => $font_color, -text => $chr,
                          -font => [ $font_family, $font_size, $font_style ] );
            push @$chr_ids, $id;
	    $chr_height += $chr_vertical_margin;
	}
	$line_width -= $line_horizontal_margin;
	$lines++;
	last if ($lines > $page_lines - 1);
    }
}