ぽち＊ろぐ

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.