Gtk2-Perl で Pango を使った縦書きビューワー『ぽちたて』を作ってみた

ここには、ぽちが PerlGtk2-Perl を通して、GTK+2Pangocairo を使って作ったテキスト縦書き形式ビューワー『ぽちたて』を置いています。『ぽちたて』は UNIX/Linux環境でも、(未確認ながら)Windows環境でも動作するのが建前ですけども、実際には、Windows で『ぽちたて』の実行環境を整えるのはハードルが高いので、気軽に使うわけにはいきません。事実上は UNIX/Linux専用のアプリケーションです。

『ぽちたて』はまだまだ実用に耐えない未完成品です。より良いものにしていく為にも、確実に数多く存在する不具合の報告や、使い勝手の要望など大募集しています。

IPAフォント使用時のぽちたて画面サムネイル 【ニコニコ動画】Perl でテキスト縦書きビューワーを書いてみた

縦書き画面は出版社別文庫の1Pに入る最大文字数!を参考に、一般的な文庫本の 1ページ分を表示するように設定してあります。

機能

UTF-8Shift JISEUC-JPJIS で書かれたテキストファイル、またはそれらのテキストファイルを gzipbzip2zip形式に圧縮したファイルを受け取って縦書き表示します。

動かすのに必要ないろいろ

以上のバージョンより新しいものであれば動きます。未確認ではありますけども、もう少し古いバージョンでも大抵の場合は動くのではないでしょうか。とは言うものの、それなりに見られる縦書き表示を行う為には、縦書きのレイアウトとレンダリングに使う Pango と実際の表示に使うフォントは可能な限り新しいバージョンの物をお勧めします。

GTK+2、Pango、cairo辺りは Windows をお使いの方には導入が難しいかもしれませんが、GTK+ - Download for Windows には Windows向けのパッケージ群が置いてあります。依存している Perlモジュールについては、Windows向け Perl の ActivePerlPPM だけを使って環境を整えるのは困難なようです。PPM経由で CPAN環境を作って CPAN を利用するか、同じ Windows向け Perl ならいっそ最初から Strawberry Perl を使って CPAN を利用する方が良さそうです。

Windows よりずっと簡単に環境を整えられる debian wheezy の場合、

$ sudo apt-get install libgtk2-perl libpath-class-perl libfile-mmagic-perl libfile-homedir-perl fonts-ipafont-mincho

で依存関係によって Lingua::JA::Fold を除いたその他必要なパッケージが自動的にインストールされます。Lingua::JA::Fold は Linux をお使いの方や Windows で Strawberry Perl をお使いの方だと CPAN からインストール出来ますし、Windows で ActivePerl をお使いの方ならバイナリ形式の PPM もあります。Debian系Linux をお使いの方で CPAN は面倒だという方の為に、dh-make-perl を使って debパッケージ化した物も置いておきます。

Debian系Linux をお使いの方は上の debパッケージファイルをダウンロードして

$ sudo dpkg -i liblingua-ja-fold-perl_0.08-0+0pochi1_all.deb

とインストールすると簡単です。apt できちんとパッケージ管理をしたければ、apt-ftparchive を使って debパッケージの aptリポジトリを作るを参考にしてローカルな aptリポジトリを作ってみてもいいかもしれません。

使い方

コードに置いてある圧縮ファイルを展開して出来るファイル(これが『ぽちたて』本体です)に実行権限を与えた後でターミナルエミュレータから、

$ ./pochitate018.pl

または、コマンドプロンプトから

C:¥> perl pochitate018.pl

と実行してあげて下さい。あとはメニューバーの[ファイル]の[開く]から、読みたいファイルを選択するだけです。[←]をクリックするかキーを押すと次ページへ、[→]をクリックするかキーを押すと前ページへ移動します。[ファイル]の[栞を挟む]をクリックして表示しているページを記憶させると、次回起動時には自動的に栞を挟んだページを表示します。[ファイル]の[終了]をクリックするか qキーまたは ESCキーを押すと『ぽちたて』を終了します。

現在のリリース

コード

  • pochitate018.pl
#!/usr/bin/env perl

use strict;
use warnings;
use utf8;
use Encode;
use Encode::Guess qw/ euc-jp cp932 iso-2022-jp /;           # 文字コード判別
use Lingua::JA::Fold qw/ fold /;                            # 日本語禁則折り返し
use open IN  => ':bytes';   # 入力される文字コードが混在している可能性があるので
use Gtk2 qw/ -init /;
use Gtk2::Gdk::Keysyms;     # キーのシンボリックネームを使う
use Glib qw/ TRUE FALSE /;  # TRUE, FALSE で真偽値を扱う
use Cairo;
use Math::Trig qw/ pip2 /;  # π/2 のラジアン値を使う
use Path::Class;
use File::MMagic;           # ファイルタイプの判別
use IO::Uncompress::AnyUncompress qw/ $AnyUncompressError /;# gz/bz2/zip を展開
use File::HomeDir;          # ホームディレクトリの取得


my $window_width     = 602;               # ウィンドウの幅
my $window_height    = 717;               # ウィンドウの高さ
my $surface_width    = 598;               # テキスト表示部の幅
my $surface_height   = 664;               # テキスト表示部の高さ
my $font_and_size    = 'IPA明朝 11';      # フォント名とサイズ
my $font_color       = '#000000';         # フォント色
my $background_color = '#e0ffff';         # 背景色
my $line_spacing     = 19400;             # 行間隔(1/1024ポイント単位)
my $upper_height     = 21;                # 本文上側の余白
my $fold_length      = 42;                # 文庫本 1ページの一般的な一行の文字数
my $page_lines       = 18;                # 文庫本 1ページの一般的な行数
my $pochitate_dir    = '.pochitate';      # ぽちたてディレクトリ
my $shiori_file      = 'shiori.txt';      # 栞ファイル


my @offsets = (0);        # 既読ページのテキストデータ読み出し後のオフセット配列
my $page = 0;             # 現在表示しているページ
my $shiori_page;          # 栞を挟んだページ
my $filename;             # 読み込むテキストファイル名
my $strs;                 # 文字列仮想ファイル
my $file_handle;          # 文字列仮想ファイル用ファイルハンドル

# 栞ファイル関係の下準備
my $shiori_d = dir( File::HomeDir->my_home, $pochitate_dir );
my $shiori = file( $shiori_d, $shiori_file );
mkdir $shiori_d, 0755 unless ( -d $shiori_d );

# 16進数表記の色を cairo向けに変換する
my ( $cairo_red, $cairo_green, $cairo_blue ) = cairo_color_parse( $font_color );

# メニューバーを作る為の下準備
my $entries = [
    [ 'FileMenu', undef, 'ファイル(_F)' ],
    [ 'Open', 'gtk-open', '開く(_O)...', '<ctrl>O', 'ファイルを開く',
        \&file_chooser],
    [ '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

# メインウィンドウの準備
my $window = Gtk2::Window->new( 'toplevel' );
$window->signal_connect( 'delete_event' => sub { Gtk2->main_quit; } );
$window->signal_connect( 'key_press_event' => \&key_press_handler );
$window->set_title( 'ぽちたて 0.1.8' );
$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 );

# 引き数が無くても栞があったら自動復帰
unless ( $filename = $ARGV[0] ){
    if ( -e $shiori ){
        open my $fh, '<', $shiori
            or die "Couldn't open $shiori for reading: $!";
        my $shiori_data = <$fh>;
        close $fh;
        chomp $shiori_data;
        my @shiori_data = split "\t", $shiori_data;
        $filename = shift @shiori_data;
        $page = ( $shiori_page = @offsets = @shiori_data );
        unlink $shiori;
    }
}

open_file( \$strs, $filename );
start_tategaki( \@offsets, \$page, \$shiori_page );

$window->add( $vbox );
$window->show_all;

Gtk2->main;

# ファイルの読み込み、展開、文字コード判定、折り返し処理
sub open_file {
    my ( $strs_ref, $in_file ) = @_;
    $$strs_ref = undef;
    if ( $in_file ) {
        my $content;
        my $mm = File::MMagic->new();
        my $res = $mm->checktype_filename( $in_file );
        if ( $res eq 'text/plain' ) {
            open my $fh, '<', $in_file
                or die "Couldn't open $in_file for reading: $!";
            $content .= join '', <$fh>;
            close $fh;
        }
        elsif (    $res eq 'application/x-zip'
                or $res eq 'application/x-gzip'
                or $res eq 'application/x-bzip2'
               ) {
            my $z = IO::Uncompress::AnyUncompress->new( $in_file )
                or die "Anyuncompress failed: $AnyUncompressError";
            $content .= join '', <$z>;
            close $z;
        } else { die "Couldn't handle: $in_file"; }
        my $decoder = Encode::Guess->guess( $content );
        ref $decoder or die "Couldn't guess: $decoder";
        $$strs_ref = encode_utf8( fold('text'   => $decoder->decode( $content ),
                                       'length' => $fold_length,
                                       'mode'   => 'traditional',
                                      )
                                );
    }
    open $file_handle, '<', \$strs
        or die "Couldn't open virtual file for reading: $!";
    seek $file_handle, $offsets[-1], 0 if $shiori_page;
    undef;
}

# ファイル選択ダイアログ
sub file_chooser {
    my $dialog = Gtk2::FileChooserDialog->new(
                                              'ファイルを開く',
                                              undef,
                                              'open',
                                              'gtk-cancel' => 'cancel',
                                              'gtk-ok' => 'ok',
                                             );
    $dialog->show_all;

    my $response = $dialog->run;
    if ( $response eq 'ok' ) {
        $filename = $dialog->get_filename;
        # 選択したファイルを使った処理
        eval { open_file( \$strs, $filename ); };
        # エラーは標準エラー出力へ表示してダイアログを壊す
        if ( $@ ) {
            print STDERR $@;
            $dialog->destroy;
        }
        start_tategaki( \@offsets, \$page, \$shiori_page );
    }
    $dialog->destroy;
    undef;
}

# 最初のページを表示
sub start_tategaki {
    my ( $offsets_ref, $page_ref, $shiori_page_ref ) = @_;
    @$offsets_ref = (0) unless $shiori_page;
    write_tategaki();
    push @$offsets_ref, tell $file_handle
        or die "Couldn't tell the file offset: $!";
    $$page_ref = 1 unless $shiori_page;
    $page_count->set_label( "- $page -" );
    $$shiori_page_ref = undef;
}

# 次ページ表示
sub next_tategaki {
    my ( $offsets_ref, $page_ref ) = @_;
    return if eof $file_handle;
    write_tategaki();
    push @$offsets_ref, tell $file_handle
        or die "Couldn't tell the file offset: $!";
    $$page_ref++;
    $page_count->set_label( "- $page -" );
    undef;
}

# 前ページ表示
sub prev_tategaki {
    my ( $offsets_ref, $page_ref ) = @_;
    my $prev_offset = tell $file_handle;
    return if $prev_offset == $offsets[1]
        || defined $shiori_page && $shiori_page > $page - 1;
    pop @$offsets_ref if $#offsets > 1;
    $$offsets_ref[-2] = 0 unless $offsets[-2];
    seek $file_handle, $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( $cairo_red, $cairo_green, $cairo_blue );

    $cr->translate( $surface_width, $upper_height );
    $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( <$file_handle> ){
            $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 key_press_handler {
    my ( $widget, $event ) = @_;
    if ( $event->keyval == $Gtk2::Gdk::Keysyms{Left} ) {
        next_ward();
    }
    elsif ( $event->keyval == $Gtk2::Gdk::Keysyms{Right} ) {
        prev_ward();
    }
    elsif (
           $event->keyval == $Gtk2::Gdk::Keysyms{q}
        or $event->keyval == $Gtk2::Gdk::Keysyms{Escape}
    ) {
        Gtk2->main_quit;
    }
    undef;
}

# 栞を挟む
sub shiori {
    my @shiori_offsets = @offsets;
    pop @shiori_offsets;
    my $offsets = join "\t", @shiori_offsets;
    open my $fh, '>', $shiori
        or die "Couldn't open $shiori_file for writing: $!";
    print $fh $filename, "\t", $offsets, "\n";
    close $fh or die "Couldn't close $shiori_file: $!";
    undef;
}

# 16進数表記の色を cairo向けに変換する
sub cairo_color_parse {
    my $str = shift;
    my @cairo_colors;
    if ( $str =~ /\A#([0-9a-fA-F]{2})([0-9a-fA-F]{2})([0-9a-fA-F]{2})\z/ ) {
        $cairo_colors[0] = ( hex $1 ) / 255;
        $cairo_colors[1] = ( hex $2 ) / 255;
        $cairo_colors[2] = ( hex $3 ) / 255;
    }
    return @cairo_colors;
}

sub next_ward {
    next_tategaki( \@offsets, \$page );
    undef;
}

sub prev_ward {
    prev_tategaki( \@offsets, \$page );
    undef;
}
# Copyright (c) 2009 - 2013, 犬山ぽち丸 
# このコードは、Perl自体と同じライセンスで配布します。
# Copyright (c) 2009 - 2013, Pochimaru Inuyama. All rights reserved.
# This code is distributed under the same terms as Perl itself.

bzip2 や zip に圧縮した物も置いておきます。

  • pochitate018.pl.bz2 ( 4449 bytes sha256sum: f7aa8a34d4872433d7c67b6ce2abdee7689663e88711d2e396374c061624c203 *pochitate018.pl.bz2 )
  • pochitate018.zip ( 4639 bytes sha256sum: b32b3d160a53074ac7b2f9a0476a3cbcf8f104b3ad6938631688ffc9d351b32f *pochitate018.zip )

謝辞

うっかり『ぽちたて』を試してみてしまった奇特な方々へ。未完成な道具とはいえ、あなた方に使っていただけるというのは道具の作り手にとって最大の喜びです。感想などをお知らせいただければ励みになります。

『ぽちたて』を作るにあたって励ましの言葉や助言、力添えをいただいた全ての方々へ。『ぽちたて』がより良いものになっていくのはあなた方のお蔭です。あなた方が気にかけてくれただけの価値のある道具に、少しでも近づけていれば良いのですが…。

本当にありがとうございます。

動作確認環境 : Perl 5.14.2 on Debian GNU/Linux 7.0 wheezy

戻る


Last updated : 2013/05/20
Author : 犬山ぽち丸 / INUYAMA Pochimaru / Pochimaru Inuyama
E-mail : pochi@hoshinoumi.net
Key ID : 4A1B5E85
Key fingerprint : 4605 4D40 6154 20C1 5592 3E54 5A37 FEE9 4A1B 5E85

正当な XHTML 1.1 です 正当な CSS です