Nov 28, 2009
怠けものなので
2ch の某スレを眺めてみたら、ぽちたてについて、「レベルの低いコーディング」という書き込みに対して「下手でも口だけで書かない奴よりはずっとマシ」などとやり合ってる方々がいて、ちょっとスレの雰囲気が悪くなっていました。どちらの主張にしろ、そんなことで険悪になられると困ってしまいます。実際、ぽちの Perl の書き方が拙くも低レベルなのは本人に自覚もあり、本当にもっともな指摘です。もっとスマートに洗練された書き方が出来るようになれたらなあ、なんていつも思っています。そんなぽちが、なんでまたわざわざぽちたてを書いているのかというと、他に書いてくれる人がいないからです。洗練された書き手の方が、ぽちが欲しいと思った機能を実装して縦書きビューワーを書いてくれたら、怠けもののぽちにとってはらくちんで嬉しいのですけれども…。
ぽちたては、xjp2 に対するいくつかの不満から、Linux向けの青空文庫対応縦書きビューワーを目指して作りはじめました(まだ青空文庫に対応するところまで到達していませんけども)。その不満というのは、第一に、UTF-8 での入出力に対応していない点、第二に、ぽち環境の debian lenny でビルドすると正常な動作ではないと思われる挙動があるという点です。特にフォントのアンチエイリアスを設定すると落ちてしまうのは致命的です。本来なら、xjp2 のソースコードをちゃんと読んで、改善する為のパッチを書いて貢献すべきなのでしょうけども、残念ながらぽちには C はほんのさわりしか理解出来ず、また、xjp2 の開発も止まったまま数年経っているようだったので、無謀にもぽち程度の能力しか無いのに Perl で縦書きビューワーを作ろうなんて思いついてしまいました。実は他にも Linux でも使える Javaベースのものや Adobe AIRベースのものもあるようですけども、タダで譲り受けた八年落ちの低スペックPC しか持っていないぽちは、モッサリ感を恐れて最初から利用を検討していません。もしかしたら想像するより軽快なのかなあ?しまった!そうだとしたら怠けられたかも!?
というわけで、xjp2 の開発さえ盛んだったなら、怠けもののぽちがわざわざぽちたてなんて作ろうとは思わなかったというお話でした。怠けものなので本当は怠けていたいのです。
Nov 27, 2009
Gtk2-Perl で Pango を使った縦書きビューワーを作ろう(3)
2ch Linux板の「GTK+プログラミング」というスレで、今まで躓いていた部分の解決法を教えて貰えました。事前にテキストを描画したオブジェクトが既にあるのかどうかを確かめて、あるようなら次の描画の為に destroy しちゃうという方法です。
言われてみればなぜ今まで気がつかなかったんだろうという感じのとても真っ当な方法なのですけども、独学の悲しさ、自分ではそこに気がつかないままになってしまっていました。教えてくれた方、本当にありがとうございます。まだまだ細々した部分は後回しにして放置しているのがほとんどの状態ですけども、とりあえずは複数ページに渡るテキストを読み進めたり戻ったりする事が出来るようになりました。
ぽちたて 20091127
#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use Encode;
use Encode::Guess qw/euc-jp shiftjis iso-2022-jp/; # 日本語文字コード判別
use Lingua::JA::Fold qw/fold/; # 日本語禁則折り返し
use open IN => ":bytes"; # 入力される文字コードが混在している可能性があるので
use Gtk2 qw/-init/;
use Glib qw/TRUE FALSE/; # TRUE, FALSE で真偽値を扱う
use Cairo;
use Math::Trig qw/pip2/; # π/2 のラジアン値を使う
my $window_width = 605; # ウィンドウの幅
my $window_height = 693; # ウィンドウの高さ
my $surface_width = 600; # テキスト表示部の幅
my $surface_height = 661; # テキスト表示部の高さ
my $font_and_size = 'IPA明朝 11'; # フォント名とサイズ
my $background_color = '#e0ffff'; # 背景色
my $line_spacing = 19400; # 行間隔(1/1024ポイント単位)
my $fold_length = 42; # 文庫本 1ページの一般的な一行の文字数
my $page_lines = 18; # 文庫本 1ページの一般的な行数
my $shiori_file = 'pochitate_shiori.txt'; # 栞ファイルの場所
my @offsets = (0); # 既読ページのテキストデータ読み出し後のオフセット配列
my $page = 0; # 現在表示しているページ
my $shiori_page; # 栞を挟んだページ
my $filename; # 読み込むテキストファイル名
# メニューバーを作る為の下準備
my $entries = [
[ 'FileMenu', undef, 'ファイル(_F)' ],
[ 'Open', 'gtk-open', '開く(_O)...', '<ctrl>O', 'ファイルを開く',
\&text_file_open],
[ 'Save', 'gtk-save', '栞を挟む(_S)', '<ctrl>S', '栞を挟む', \&shiori ],
[ 'Quit', 'gtk-quit', '終了(_Q)', '<ctrl>Q', '終了する',
sub { Gtk2->main_quit; } ],
];
my $menu_info = <<'EOS';
<ui>
<menubar name='MenuBar'>
<menu action='FileMenu'>
<menuitem action='Open' position='top'/>
<menuitem action='Save'/>
<separator/>
<menuitem action='Quit'/>
</menu>
</menubar>
</ui>
EOS
# GTK+ のバージョンを確認
die "This viewer requires GTK+ 2.4.0, but we're compiled for "
. join '.', Gtk2->GET_VERSION_INFO. "\n"
unless Gtk2->CHECK_VERSION(2, 4, 0);
# 引き数が無くても栞があったら自動復帰
unless ($filename = $ARGV[0]){
if (-e $shiori_file){
open my $fh, '<', $shiori_file
or die "Couldn't open $shiori_file for reading: $!\n";
my $shiori_data = <$fh>;
close $fh;
chomp $shiori_data;
($filename, $offsets[0], $shiori_page) = split ' ', $shiori_data;
($ARGV[0], $page) = ($filename, $shiori_page);
}
}
# テキストファイルからの読み込みと文字コード判定・折り返し処理
my $strs;
foreach (@ARGV){
open my $fh, '<', $_ or die "Couldn't open $filename for reading: $!\n";
my $content .= join '', <$fh>;
close $fh;
my $guess = guess_encoding($content);
ref $guess or die "Couldn't guess: $guess\n";
open $fh, '<', $_ or die "Couldn't open $filename for reading: $!\n";
while (<$fh>){
$_ = $guess->decode($_);
$strs .= fold( 'text' => $_, 'length' => $fold_length,
'mode' => 'traditional' );
}
close $fh;
}
# メインウィンドウの準備
my $window = Gtk2::Window->new('toplevel');
$window->signal_connect('delete_event' => sub { Gtk2->main_quit; });
$window->set_title('ぽちたて 20091127');
$window->set_default_size($window_width, $window_height);
# 垂直ボックスとその第一段の中に水平ボックスを配置
my $vbox = Gtk2::VBox->new(FALSE, 2);
my $hbox = Gtk2::HBox->new(FALSE, 0);
$vbox->pack_start($hbox, FALSE, FALSE, 0);
# メニューバーの作成
my $ui = Gtk2::UIManager->new;
my $accelgroup = $ui->get_accel_group;
$window->add_accel_group($accelgroup);
my $actions = Gtk2::ActionGroup->new('actions');
$actions->add_actions ($entries, undef);
$ui->insert_action_group($actions, 0);
$ui->add_ui_from_string ($menu_info);
my $menubar = $ui->get_widget('/MenuBar');
# ページ移動ボタンの作成
my $button_next = Gtk2::Button->new;
my $icon_next = Gtk2::Image->new_from_stock('gtk-go-back', 'menu');
$button_next->set_image($icon_next);
$button_next->signal_connect('clicked' => \&next_ward);
my $button_prev = Gtk2::Button->new;
my $icon_prev = Gtk2::Image->new_from_stock('gtk-go-forward', 'menu');
$button_prev->set_image($icon_prev);
$button_prev->signal_connect('clicked' => \&prev_ward);
# ページ数表示部の作成
my $page_count = Gtk2::Label->new("- $page -");
# 垂直ボックス第一段の水平ボックスへ各ウィジェットの配置
$hbox->pack_start($menubar, FALSE, FALSE, 0);
$hbox->pack_start($button_next, FALSE, FALSE, 0);
$hbox->pack_start($button_prev, FALSE, FALSE, 0);
$hbox->pack_start($page_count, TRUE, TRUE, 0);
# スクロール付きウィンドウを作成して垂直ボックスの第二段に配置
my $scrolled_window = Gtk2::ScrolledWindow->new(undef, undef);
$scrolled_window->set_policy('automatic', 'automatic');
$vbox->pack_start($scrolled_window, TRUE, TRUE, 0);
open my $fh, '<', \$strs or die "Couldn't open virtual file for reading: $!\n";
seek $fh, $offsets[0], 0;
&next_tategaki(\@offsets, \$page);
$window->add($vbox);
$window->show_all;
Gtk2->main;
sub text_file_open {
my $dialog = Gtk2::FileChooserDialog->new(
'ファイルを開く',
undef,
'open',
'gtk-cancel' => 'cancel',
'gtk-ok' => 'ok',
);
$dialog->show_all;
my $response = $dialog->run;
if ($response eq 'ok') {
my $filename = $dialog->get_filename;
# 得たファイル名のテキストファイルを読み込む。ここに色々書く予定。
}
$dialog->destroy;
undef;
}
# 次ページ表示
sub next_tategaki {
my ($offsets_ref, $page_ref) = @_;
return if eof $fh;
&write_tategaki;
push @$offsets_ref, tell $fh or die "Couldn't tell the file offset: $!\n";
$$page_ref++;
# ページ数の表示
$page_count->set_label("- $page -");
undef;
}
# 前ページ表示
sub prev_tategaki {
my ($offsets_ref, $page_ref) = @_;
return if $#offsets < 0 || defined $shiori_page && $shiori_page > $page - 3;
pop @$offsets_ref if $#offsets > 1;
seek $fh, $offsets[-2], 0;
&write_tategaki;
$$page_ref-- if $$page_ref > 1;
# ページ数の表示
$page_count->set_label("- $page -");
undef;
}
# 縦書き描画
sub write_tategaki {
# 既にテキストを表示していれば一旦クリア
my $current_object = $scrolled_window->child;
$current_object->destroy if $current_object;
# cairo を使った描画
my $surface = Cairo::ImageSurface->create('argb32',
$surface_width, $surface_height);
my $cr = Cairo::Context->create($surface);
# $cr->set_source_rgb(0,0,1); # 青
$cr->translate($surface_width, 0);
$cr->rotate(pip2);
my $layout = Gtk2::Pango::Cairo::create_layout($cr);
$layout->set_spacing($line_spacing);
my $context = $layout->get_context;
$context->set_base_gravity('east');
my $desc = Gtk2::Pango::FontDescription->from_string($font_and_size);
$layout->set_font_description($desc);
my $language = Gtk2::Pango::Language->from_string('ja');
$context->set_language($language);
if ($strs){
my $text;
my $lines;
while(<$fh>){
$text .= $_;
$lines++;
last if ($lines == $page_lines);
}
$text = decode_utf8($text);
$layout->set_text($text);
}
Gtk2::Pango::Cairo::show_layout($cr, $layout);
my $drawable = Gtk2::DrawingArea->new;
$drawable->size($surface_width, $surface_height);
$drawable->signal_connect(
'expose_event' => \&set_surface,
$surface,
);
$scrolled_window->add_with_viewport($drawable);
$drawable->show;
undef;
}
sub set_surface {
my ($widget, $event, $surface) = @_;
my $bg_cr = my $cr = Gtk2::Gdk::Cairo::Context->create($widget->window);
my $color = Gtk2::Gdk::Color->parse($background_color);
$bg_cr->set_source_color($color);
$bg_cr->paint;
$cr->set_source_surface($surface, 0, 0);
$cr->paint;
undef;
}
# 栞を挟む
sub shiori {
open my $fh, '>', $shiori_file
or die "Couldn't open $shiori_file for writing: $!\n";
print $fh $filename, ' ', $offsets[-2], ' ' , $page - 1, "\n";
close $fh or die "Couldn't close $shiori_file: $!\n";
undef;
}
sub next_ward{
&next_tategaki(\@offsets, \$page);
undef;
}
sub prev_ward{
&prev_tategaki(\@offsets, \$page);
undef;
}
# Copyright (c) 2009, 犬山ぽち丸
# このコードは、Perl自体と同じライセンスで配布します。
# Copyright (c) 2009, Pochimaru Inuyama. All rights reserved.
# This code is distributed under the same terms as Perl itself.
Nov 19, 2009
今更タッチタイピング
次期ぽちたてが行き詰まってしまったので、気分転換にタッチタイピングを覚えようなんて思い立ちました。元々ぽちは頭の回転が鈍くてタイピングが早くても思考の方が追いつかないので、チャットをしててもわざわざタッチタイピングを習得する必要に迫られませんでした。そんなぽちが今回こんな事を始めたのは、カタタタタと恰好良くタッチタイピングしてるとなんとなく賢そうに見えるかも?というお気楽な理由からです。
とは言うものの、なんとなく賢そうで恰好良いという印象意外には全くタッチタイピングについての知識が無いぽち。Web で検索してみると、両手の指に決まった担当するキーを割り当てて慣れていくのが基本のようです。

「ファイル:TouchTyping HomePosition QWERTY.png - Wikipedia」より
これを参考にしてテキトーに何かの文章でも打ち込んでみようかな?例えば、どう考えても著作権なんて切れている筈の平家物語の本文とか!なんて思いましたけども、良く考えたら世の中にはタイピング練習ツールというものが存在します。Linux向けで何か良いのはないかしら?と探してみましたが、日本語配列キーボードに対応したものはないようです。そんな中でキーボード配列をカスタマイズ出来るタイピング練習ツール、klavaro が見つかりました。公式サイトのトップを見てみると、お手軽にも debian にパッケージがあります。この klavaro は日本語の文章をタイピング練習する為のツールではありませんが、ぽちはずっとローマ字入力なのでたいして差し支えはありません。これを使ってしばらく練習してみようと思います。
あ、そうそう、この文章も練習がてらタッチタイピングで入力していますけども、まだまだとっても遅かったりします。カタタタタなんて素早く打てるようになるのはいつになることやら…。
Nov 11, 2009
Gtk2-Perl で Pango を使った縦書きビューワーを作ろう(2)
早速行き詰まってしまいました。
問題になってるのは、縦書き表示部分のページ移動による再描画です。ぽちには再描画する前にどうやって以前の表示をクリアしたら良いのかが良くわかりません。これは GTK+2 での Pango や cairo の描画の仕組みを詳しく理解出来てないせいなのですけども、Gtk2-Perl版ぽちたては、Perl/Tk版ぽちたてのように簡単に次ページには行けないようです。とほほ[犬]ω;)
ちゃんと動かないのですが、仕方なく途中経過の断片コードを載せておきます。
ぽちたて 20091110
#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use Encode;
use Encode::Guess qw/euc-jp shiftjis iso-2022-jp/; # 日本語文字コード判別
use Lingua::JA::Fold qw/fold/; # 日本語禁則折り返し
use open IN => ":bytes"; # 入力される文字コードが混在している可能性があるので
use Gtk2 qw/-init/;
use Glib qw/TRUE FALSE/; # TRUE, FALSE で真偽値を扱う
use Cairo;
use Math::Trig qw/pip2/; # π/2 のラジアン値を使う
my $window_width = 605; # ウィンドウの幅
my $window_height = 693; # ウィンドウの高さ
my $surface_width = 600; # テキスト表示部の幅
my $surface_height = 661; # テキスト表示部の高さ
my $font_and_size = 'IPA明朝 11'; # フォント名とサイズ
my $background_color = '#e0ffff'; # 背景色
my $line_spacing = 19400; # 行間隔(1/1024ポイント単位)
my $fold_length = 42; # 文庫本 1ページの一般的な一行の文字数
my $page_lines = 18; # 文庫本 1ページの一般的な行数
my @offsets = (0); # 既読ページのテキストデータ読み出し後のオフセット配列
my $page = 1; # 現在表示しているページ
my $filename; # 読み込むテキストファイル名
# メニューバーを作る為の下準備
my $entries = [
[ 'FileMenu', undef, 'ファイル(_F)' ],
[ 'Open', 'gtk-open', '開く(_O)...', '<ctrl>O', 'ファイルを開く',
\&text_file_open],
[ 'Save', 'gtk-save', '栞を挟む(_S)', '<ctrl>S', '栞を挟む', \&shiori ],
[ 'Quit', 'gtk-quit', '終了(_Q)', '<ctrl>Q', '終了する',
sub { Gtk2->main_quit; } ],
];
my $menu_info = <<'EOS';
<ui>
<menubar name='MenuBar'>
<menu action='FileMenu'>
<menuitem action='Open' position='top'/>
<menuitem action='Save'/>
<separator/>
<menuitem action='Quit'/>
</menu>
</menubar>
</ui>
EOS
# GTK+ のバージョンを確認
die "This viewer requires GTK+ 2.4.0, but we're compiled for "
. join '.', Gtk2->GET_VERSION_INFO. "\n"
unless Gtk2->CHECK_VERSION(2, 4, 0);
# テキストファイルからの読み込みと文字コード判定・折り返し処理
my $strs;
foreach (@ARGV){
open my $fh, '<', $_ or die "Couldn't open $filename for reading: $!\n";
my $content .= join '', <$fh>;
close $fh;
my $guess = guess_encoding($content);
ref $guess or die "Couldn't guess: $guess\n";
open $fh, '<', $_ or die "Couldn't open $filename for reading: $!\n";
while (<$fh>){
$_ = $guess->decode($_);
$strs .= fold( 'text' => $_, 'length' => $fold_length,
'mode' => 'traditional' );
}
close $fh;
}
# メインウィンドウの準備
my $window = Gtk2::Window->new('toplevel');
$window->signal_connect('delete_event' => sub { Gtk2->main_quit; });
$window->set_title('ぽちたて 20091110');
$window->set_default_size($window_width, $window_height);
# 垂直ボックスとその第一段の中に水平ボックスを配置
my $vbox = Gtk2::VBox->new(FALSE, 2);
my $hbox = Gtk2::HBox->new(FALSE, 0);
$vbox->pack_start($hbox, FALSE, FALSE, 0);
# メニューバーの作成
my $ui = Gtk2::UIManager->new;
my $accelgroup = $ui->get_accel_group;
$window->add_accel_group($accelgroup);
my $actions = Gtk2::ActionGroup->new('actions');
$actions->add_actions ($entries, undef);
$ui->insert_action_group($actions, 0);
$ui->add_ui_from_string ($menu_info);
my $menubar = $ui->get_widget('/MenuBar');
# ページ移動ボタンの作成
my $button_next = Gtk2::Button->new;
my $icon_next = Gtk2::Image->new_from_stock('gtk-go-back', 'menu');
$button_next->set_image($icon_next);
$button_next->signal_connect('clicked' => \&next_ward);
my $button_prev = Gtk2::Button->new;
my $icon_prev = Gtk2::Image->new_from_stock('gtk-go-forward', 'menu');
$button_prev->set_image($icon_prev);
$button_prev->signal_connect('clicked' => sub { Gtk2->main_quit; });
# ページ数表示部の作成
my $page_count = Gtk2::Label->new("- $page -");
# 垂直ボックス第一段の水平ボックスへ各ウィジェットの配置
$hbox->pack_start($menubar, FALSE, FALSE, 0);
$hbox->pack_start($button_next, FALSE, FALSE, 0);
$hbox->pack_start($button_prev, FALSE, FALSE, 0);
$hbox->pack_start($page_count, TRUE, TRUE, 0);
# スクロール付きウィンドウを作成して垂直ボックスの第二段に配置
my $scrolled_window = Gtk2::ScrolledWindow->new(undef, undef);
$scrolled_window->set_policy('automatic', 'automatic');
$vbox->pack_start($scrolled_window, TRUE, TRUE, 0);
open my $fh, '<', \$strs or die "Couldn't open virtual file for reading: $!\n";
seek $fh, $offsets[0], 0;
&next_tategaki(\@offsets, \$page);
$window->add($vbox);
$window->show_all;
Gtk2->main;
sub text_file_open {
my $dialog = Gtk2::FileChooserDialog->new(
'ファイルを開く',
undef,
'open',
'gtk-cancel' => 'cancel',
'gtk-ok' => 'ok',
);
$dialog->show_all;
my $response = $dialog->run;
if ($response eq 'ok') {
my $filename = $dialog->get_filename;
# 得たファイル名のテキストファイルを読み込む。ここに色々書く予定。
}
$dialog->destroy;
}
sub next_ward{
&next_tategaki(\@offsets, \$page);
undef;
}
# 次ページ表示
sub next_tategaki {
my ($offsets_ref, $page_ref) = @_;
return if eof $fh;
&write_tategaki;
push @$offsets_ref, tell $fh or die "Couldn't tell the file offset: $!\n";
$$page_ref++;
undef;
}
# 縦書き描画
# 次ページや前ページへ移動する時に、
# 現在表示しているページをクリアする良い方法がないかなあ?
sub write_tategaki {
# cairo を使った描画
my $surface = Cairo::ImageSurface->create('argb32',
$surface_width, $surface_height);
my $cr = Cairo::Context->create($surface);
# フォントカラーをここで無理矢理指定出来るけど、0-1 の範囲のRGB表記という…。
# color name や hex code からの変換用関数が用意されてないか探してみようっと。
# 無いようなら自分で作る事!
# $cr->set_source_rgb(0,0,1); # 青
$cr->translate($surface_width, 0);
$cr->rotate(pip2);
my $layout = Gtk2::Pango::Cairo::create_layout($cr);
$layout->set_spacing($line_spacing);
my $context = $layout->get_context;
$context->set_base_gravity('east');
my $desc = Gtk2::Pango::FontDescription->from_string($font_and_size);
$layout->set_font_description($desc);
my $language = Gtk2::Pango::Language->from_string('ja');
$context->set_language($language);
if ($strs){
my $text;
my $lines;
while(<$fh>){
$text .= $_;
$lines++;
last if ($lines == $page_lines);
}
$text = decode_utf8($text);
$layout->set_text($text);
}
Gtk2::Pango::Cairo::show_layout($cr, $layout);
my $drawable = Gtk2::DrawingArea->new;
$drawable->size($surface_width, $surface_height);
$drawable->signal_connect(
'expose_event' => \&set_surface,
$surface,
);
$scrolled_window->add_with_viewport($drawable);
}
sub set_surface {
my ($widget, $event, $surface) = @_;
my $bg_cr = my $cr = Gtk2::Gdk::Cairo::Context->create($widget->window);
my $color = Gtk2::Gdk::Color->parse($background_color);
$bg_cr->set_source_color($color);
$bg_cr->paint;
$cr->set_source_surface($surface, 0, 0);
$cr->paint;
undef;
}
# Copyright (c) 2009, 犬山ぽち丸
# このコードは、Perl自体と同じライセンスで配布します。
# Copyright (c) 2009, Pochimaru Inuyama. All rights reserved.
# This code is distributed under the same terms as Perl itself.
Nov 09, 2009
Pango 1.26 の縦書きは良いみたい
TrueTypeフォントについて調べてた頃に、2ch の Linux板にある「Linux上でのフォント総合スレ」というスレを覗いてみた事があるのですけども、それ以来定期的にそのスレをチェックするようになりました。さっきかなり久しぶりに眺めてみると、Pango 1.26 では句読点が中心線揃えの変な表示位置から正しい表示位置になっているというお話。しかも、次期ぽちたてに向けたぽちんちの断片コードまで紹介してくれているではありませんか!さらに挙句の果てには、ぽち断片を使って最新リリースの Pango 1.26 での次期ぽちたて表示を試してみてくれた方までいらっしゃいました。

うんうん、debian lenny で Pango 1.20 のぽち環境とは違って、充分実用に耐える品質で縦書きされています。次期ぽちたては、Pango の縦書きを使う為ダケに Gtk2-Perl版にしたので、この表示結果にはぽちもひと安心というかホッとしたというか、なんだか言葉では言い尽くせない思いです。
「Linux上でのフォント総合スレ 4」の皆様、本当にありがとうございます。お蔭様で、がんばって早く縦書きビューワーとしてひと通りの機能を実装しなきゃ!と、急に元気が湧いて来ました。
Nov 07, 2009
Gtk2-Perl で Pango を使った縦書きビューワーを作ろう(1)
前回の日記では次期ぽちたての縦書き表示部分の画像だけしか置いてなかったのですけども、今回からはちゃんと Perl のコードも書いておくことにします。

GTK+2 にならとっても分かり易い入門書まで出てたりしてますが、Gtk2-Perl の日本語文書は少ないので、こんないいかげんな断片でも誰かの助けになればと思って載せています。けっして「ぽちたて作りにちっとも進展がないから、とりあえずこないだのコードを載せちゃえ!」って事じゃないんですからねっ?誰ですか?一番役に立つのは結局本家の Gtk2-Perl - Table of Contents だって言ってるのは!(その通りですけども)
当然ではありますけども、Gtk2-Perl版ぽちたてを動かすには Perl や useされる Perlモジュール群だけでなく、事前に GTK+2 や Pango、cairo のライブラリがインストールされていなければなりません。debian lenny では libgtk2-perlパッケージをインストールすると、依存関係で必要なライブラリが一緒にインストールされるのでらくちんです。
ぽちたて 20091103
#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use Encode;
use Encode::Guess qw/euc-jp shiftjis iso-2022-jp/; # 日本語文字コード判別
use Lingua::JA::Fold qw/fold/; # 日本語禁則折り返し
use open IN => ":bytes"; # 入力される文字コードが混在している可能性があるので
use Gtk2 qw/-init/;
use Glib qw/TRUE FALSE/; # TRUE, FALSE で真偽値を扱う
use Cairo;
use Math::Trig qw/pip2/; # π/2 のラジアン値を使う
my $window_width = 605; # ウィンドウの幅
my $window_height = 693; # ウィンドウの高さ
my $surface_width = 600; # テキスト表示部の幅
my $surface_height = 661; # テキスト表示部の高さ
my $font_and_size = 'IPA明朝 11'; # フォント名とサイズ
my $background_color = '#e0ffff'; # 背景色
my $line_spacing = 19400; # 行間隔(1/1024ポイント単位)
my $fold_length = 42; # 文庫本 1ページの一般的な一行の文字数
my $page_lines = 18; # 文庫本 1ページの一般的な行数
my $shiori_file = 'pochitate_shiori.txt'; # 栞ファイルの場所
my @offsets = (0); # 既読ページのテキストデータ読み出し後のオフセット配列
my $page = 1; # 現在表示しているページ
my $shiori_page; # 栞を挟んだページ
my $filename; # 読み込むテキストファイル名
# メニューバーを作る為の下準備
my $entries = [
[ 'FileMenu', undef, 'ファイル(_F)' ],
[ 'Open', 'gtk-open', '開く(_O)...', '<ctrl>O', 'ファイルを開く',
sub { Gtk2->main_quit; } ],
[ 'Save', 'gtk-save', '栞を挟む(_S)', '<ctrl>S', '栞を挟む',
sub { Gtk2->main_quit; } ],
[ 'Quit', 'gtk-quit', '終了(_Q)', '<ctrl>Q', '終了する',
sub { Gtk2->main_quit; } ],
];
my $menu_info = <<'EOS';
<ui>
<menubar name='MenuBar'>
<menu action='FileMenu'>
<menuitem action='Open' position='top'/>
<menuitem action='Save'/>
<separator/>
<menuitem action='Quit'/>
</menu>
</menubar>
</ui>
EOS
# GTK+ のバージョンを確認
die "This viewer requires GTK+ 2.4.0, but we're compiled for "
. join '.', Gtk2->GET_VERSION_INFO. "\n"
unless Gtk2->CHECK_VERSION(2, 4, 0);
# テキストファイルからの読み込みと文字コード判定・折り返し処理
my $strs;
foreach (@ARGV){
open my $fh, '<', $_ or die "Couldn't open $filename for reading: $!\n";
my $content .= join '', <$fh>;
close $fh;
my $guess = guess_encoding($content);
ref $guess or die "Couldn't guess: $guess\n";
open $fh, '<', $_ or die "Couldn't open $filename for reading: $!\n";
while (<$fh>){
$_ = $guess->decode($_);
$strs .= fold( 'text' => $_, 'length' => $fold_length,
'mode' => 'traditional' );
}
close $fh;
}
# メインウィンドウの準備
my $window = Gtk2::Window->new('toplevel');
$window->signal_connect('delete_event' => sub { Gtk2->main_quit; });
$window->set_title('ぽちたて 20091103');
$window->set_default_size($window_width, $window_height);
# 垂直ボックスとその第一段の中に水平ボックスを配置
my $vbox = Gtk2::VBox->new(FALSE, 2);
my $hbox = Gtk2::HBox->new(FALSE, 0);
$vbox->pack_start($hbox, FALSE, FALSE, 0);
# メニューバーの作成
my $ui = Gtk2::UIManager->new;
my $accelgroup = $ui->get_accel_group;
$window->add_accel_group($accelgroup);
my $actions = Gtk2::ActionGroup->new('actions');
$actions->add_actions ($entries, undef);
$ui->insert_action_group($actions, 0);
$ui->add_ui_from_string ($menu_info);
my $menubar = $ui->get_widget('/MenuBar');
# ページ移動ボタンの作成
my $button_next = Gtk2::Button->new;
my $icon_next = Gtk2::Image->new_from_stock('gtk-go-back', 'menu');
$button_next->set_image($icon_next);
$button_next->signal_connect('clicked' => sub {Gtk2->main_quit;} );
my $button_prev = Gtk2::Button->new;
my $icon_prev = Gtk2::Image->new_from_stock('gtk-go-forward', 'menu');
$button_prev->set_image($icon_prev);
$button_prev->signal_connect('clicked' => sub {Gtk2->main_quit;} );
# ページ数表示部の作成
my $page_count = Gtk2::Label->new("- $page -");
# 垂直ボックス第一段の水平ボックスへ各ウィジェットの配置
$hbox->pack_start($menubar, FALSE, FALSE, 0);
$hbox->pack_start($button_next, FALSE, FALSE, 0);
$hbox->pack_start($button_prev, FALSE, FALSE, 0);
$hbox->pack_start($page_count, TRUE, TRUE, 0);
# スクロール付きウィンドウを作成して垂直ボックスの第二段に配置
my $scrolled_window = Gtk2::ScrolledWindow->new(undef, undef);
$scrolled_window->set_policy('automatic', 'automatic');
$vbox->pack_start($scrolled_window, TRUE, TRUE, 0);
open my $fh, '<', \$strs or die "Couldn't open virtual file for reading: $!\n";
seek $fh, $offsets[0], 0;
&write_tategaki;
$window->add($vbox);
$window->show_all;
Gtk2->main;
sub text_file_open {
my $dialog = Gtk2::FileChooserDialog->new(
'ファイルを開く',
undef,
'open',
'gtk-cancel' => 'cancel',
'gtk-ok' => 'ok',
);
$dialog->show_all;
my $response = $dialog->run;
if ($response eq 'ok') {
my $filename = $dialog->get_filename;
# 得たファイル名を縦書き描画サブルーチンへ渡して実行する予定地
}
$dialog->destroy;
}
# 縦書き描画
sub write_tategaki {
# cairo を使った描画
my $surface = Cairo::ImageSurface->create('argb32',
$surface_width, $surface_height);
my $cr = Cairo::Context->create($surface);
# フォントカラーをここで無理矢理指定出来るけど、0-1 の範囲の RGB表記という…。
# color name や hex からの変換用関数が用意されてないか探してみようっと。
# $cr->set_source_rgb(0,0,1); # 青
$cr->translate($surface_width, 0);
$cr->rotate(pip2);
my $layout = Gtk2::Pango::Cairo::create_layout($cr);
$layout->set_spacing($line_spacing);
my $context = $layout->get_context;
$context->set_base_gravity('east');
my $desc = Gtk2::Pango::FontDescription->from_string($font_and_size);
$layout->set_font_description($desc);
my $language = Gtk2::Pango::Language->from_string('ja');
$context->set_language($language);
if ($strs) {
my $text;
$text .= $_ while(<$fh>);
$text = decode_utf8($text);
$layout->set_text($text);
}
Gtk2::Pango::Cairo::show_layout($cr, $layout);
my $drawable = Gtk2::DrawingArea->new;
$drawable->size($surface_width, $surface_height);
$drawable->signal_connect(
'expose_event' => \&set_surface,
$surface,
);
$scrolled_window->add_with_viewport($drawable);
}
sub set_surface {
my ($widget, $event, $surface) = @_;
my $bg_cr = my $cr = Gtk2::Gdk::Cairo::Context->create($widget->window);
my $color = Gtk2::Gdk::Color->parse($background_color);
$bg_cr->set_source_color($color);
$bg_cr->paint;
$cr->set_source_surface($surface, 0, 0);
$cr->paint;
undef;
}
# Copyright (c) 2009, 犬山ぽち丸
# このコードは、Perl自体と同じライセンスで配布します。
# Copyright (c) 2009, Pochimaru Inuyama. All rights reserved.
# This code is distributed under the same terms as Perl itself.
Nov 02, 2009
ぽちたて次期バージョンへのみちのり

Pango を使った縦書きはこんな残念な感じですけれども、Gtk2-Perl や cairo-perl を扱う勉強も兼ねて最初のページを表示するだけのものを即席で作ってみました。後は以前のバージョンで実装した機能をこっちに持って来ればなんとかなりそうかも?メニューバーにページ移動ボタンだけでなく「ファイル(F)」なんて部分があるのは、ダイアログ画面でテキストファイルを指定して読み込む機能も付ける予定だからだったりします。
早くそれなりに恰好を付けて、ぽちたて 0.1.0 として公開出来るレベルになるといいなあ…。