お気楽 Perl/Tkx 超入門

●スピンボックス

スピンボックス (spinbox) はエントリー (entry) ウィジェットを拡張したウィジェット
スピンボックスはエントリーの右側に上下のボタンが付いている
エントリーで値を直接入力するだけではなく、上下のボタンを押すことで値を選択することができる
スピンボックスは new_spinbox で生成する
主なオプションを以下に示す

-from => n, -to => m, -increment => i
選択できる数値の範囲を n から m までに設定する。ボタンを押したときの増分値は i になる。
i が浮動小数点数の場合、表示も浮動小数点数になる。
-format => 書式文字列
選択する数値が浮動小数点数の場合、表示方法を書式文字列で指定する。
書式は書式文字列の変換指示子 %f と同じ。
-values => タプル
選択する項目を配列で設定する。
-state => 状態
スピンボックスの状態 (normal, readonly, disabled) を設定する。

数値はオプション -from, -to, -increment で簡単に設定することができる
数値が浮動小数点数の場合、オプション -format で表示方法を設定することができる
数値以外の場合はオプション -values を使う
-state を readonly にすると、エントリーによる入力が禁止され、ボタンだけで値を選択することになる

簡単な使用例

リスト : スピンボックス

use strict;
use warnings;
use Tkx;

my $top = Tkx::widget->new('.');
Tkx::option_add('*font', ['', 12]);

my $s1 = $top->new_spinbox(-from => 1, -to => 10, -increment => 1, -width => 10);
my $s2 = $top->new_spinbox(-from => 1, -to => 5, -increment => 0.5, -format => '%05.2f', -width => 10);
my $s3 = $top->new_spinbox(-values => ['apple', 'banana', 'cherry', 'grape', 'orange'], -state => 'readonly', -width => 10);

$s1->g_pack(-padx => 5, -pady => 5);
$s2->g_pack(-padx => 5, -pady => 5);
$s3->g_pack(-padx => 5, -pady => 5);

Tkx::MainLoop();

スピンボックスを 3 つ作る
$s1 は 1 から 10 までの数値で、-increment は 1 にする
$s2 は 1 から 5 までの数値だが、-increment は 0.5 なので浮動小数点数で表示される
-format の指定が %05.2f なので、表示は 01.50 のようになる
$s3 は apple, banana, cherry, grape, orange から選択する
-state に readonly を指定したので、エントリーから入力することはできない

1. 2. 3.

実行した直後の状態
アップボタンを 1 回押した状態
もう一回アップボタンを押した状態

●テキストウィジェット

テキスト (text) ウィジェットはスクリーンエディタに相当する
テキストウィジェットには標準動作が用意されていて、それだけでテキスト編集が可能
マウスの操作は、左クリックでカーソル位置の変更、ドラッグで範囲の選択、ダブルクリックで単語の選択が行える
また、トリプルクリックで行の選択ができる

テキストウィジェットは new_text で生成する
テキストウィジェットの場合、オプション -width と -height は桁数と行数を表す
使用するフォントによってウィンドウのサイズが変わることに注意
オプション -state に disabled を設定すると、テキストの変更を禁止することができる
これはキーボートからの入力だけでなく、プログラムによる挿入や削除も禁止される
必要なテキストデータをウィジェットに挿入してから、-state を disabled に設定すること
オプション -wrap で行の折り畳みを設定することができる
none を指定すると折り畳みは行われない
char は文字の切れ目で、word は単語の切れ目で折り畳む

テキストウィジェットはスクロールバーと組み合わせて表示範囲を変更することができる
文字列の挿入、削除、検索といった、テキストエディタとして必要なメソッドが多数用意されている
詳細は Tcl/Tk のマニュアルを参照
また、多くのメソッドで位置の指定が必要になる
位置の基本的な指定方法を下表に示す

表 : 位置の基本指定
N.M	N 行の M 文字目
@x,y	テキスト内の (x,y) の位置にある文字
end	テキスト末尾
マーク名	その名前のマークをつけた位置
タグ名.first	その名前のタグの最初の位置
タグ名.last	その名前のタグの最後の位置

テキストウィジェットでは、行は 1 から数えるが、文字は 0 から数える
この基本指定に加えて、次に示す相対指定を組み合わせることができる

表 : 位置の相対指定
+Nchars, -Nchars	そこから N 文字先、手前
+Nlines, -Nlines	そこから N 行先、手前
linestart, lineend	その行の先頭、末尾
wordstart, wordend	その単語の先頭、末尾

簡単な使用例 (1)

リスト : テキストファイルを表示する

use strict;
use warnings;
use utf8;
use File::Basename;
use Tkx;

# メインウィンドウ
my $top = Tkx::widget->new('.');
Tkx::option_add('*font', ['Terminal', 10]);
Tkx::option_add('*tearOff', 0);
$top->g_wm_title('Text Viewer');

# テキストウィジェット
my $t0 = $top->new_text(-wrap => 'word');
$t0->g_pack(-side => 'left', -expand => 1, -fill => 'both');

# スクロールバー
my $sb = $top->new_scrollbar(-command => [$t0, 'yview']);
$sb->g_pack(-side => 'left', -fill => 'y');
$t0->configure(-yscrollcommand => [$sb, 'set']);

# ファイルの読み込み
my $path_name = '.';

sub load_file {
    my $filename = Tkx::tk___getOpenFile(-filetypes => "{Perl {.pl}} {Text {.txt}} {ALL {*}}",
                                         -initialdir => $path_name );
    if ($filename) {
        $path_name = dirname($filename) . '/';
        # 前のドキュメントを消去
        $t0->delete('1.0', 'end');
        # ファイルのリード
        open my $in, "<:utf8", "$filename" or die "Can't open $filename\n";
        while (<$in>) {
            $t0->insert('end', $_);
        }
        close($in);
        $t0->g_focus();
    }
}

# メニューの設定
my $m = $top->new_menu(-type => 'menubar');
$top->configure(-menu => $m);

my $m1 = $m->new_menu;
$m->add_cascade(-menu => $m1, -label => 'File', -under => 0);
$m1->add_command(-label => 'Open', -under => 0, -command => \&load_file);
$m1->add_separator;
$m1->add_command(-label => 'Exit', -under => 0, -command => sub { exit; });

Tkx::MainLoop();

メニューの設定とファイルの選択はファイルの選択で作成した画像ローダーと同じ
ファイルの読み込みは関数 load_file で行う
tk___getOpenFile でファイル選択ダイアログを表示してファイル名を取得する
テキストウィジェットにデータを挿入するメソッドが insert
削除するメソッドが delete
最初に表示しているテキストを delete で削除する
1.0 は 1 行目の 0 文字、つまりテキストの先頭を表す
insert の位置指定は end なので、データはテキストウィジェットの最後に追加される
メソッド mark_set() でカーソルを先頭に移動し、g_focus でフォーカスを設定する
マークはあとで説明する

テキストウィジェット

ファイルの表示

簡単な使用例 (2)

リスト : 行番号の挿入と削除

use strict;
use warnings;
use utf8;
use File::Basename;
use Tkx;

# メインウィンドウ
my $top = Tkx::widget->new('.');
Tkx::option_add('*font', ['Terminal', 10]);
Tkx::option_add('*tearOff', 0);
$top->g_wm_title('Text Viewer');

# テキストウィジェット
my $t0 = $top->new_text(-wrap => 'word');
$t0->g_pack(-side => 'left', -expand => 1, -fill => 'both');

# スクロールバー
my $sb = $top->new_scrollbar(-command => [$t0, 'yview']);
$sb->g_pack(-side => 'left', -fill => 'y');
$t0->configure(-yscrollcommand => [$sb, 'set']);

# 行番号の処理
my $number_flag = 0;

sub change_number {
    my $line = $t0->index('end');
    my $i;
    if ($number_flag) {
        for ($i = 1; $i < $line; $i++) {
            $t0->insert("$i.0", sprintf("%6d:", $i));
        }
    } else {
        for ($i = 1; $i < $line; $i++) {
            $t0->delete("$i.0", "$i.7");
        }
    }
}

# ファイルの読み込み
my $path_name = '.';

sub load_file {
    my $filename = Tkx::tk___getOpenFile(-filetypes => "{Perl {.pl}} {Text {.txt}} {ALL {*}}",
                                         -initialdir => $path_name );
    if ($filename) {
        $path_name = dirname($filename) . '/';
        # 前のドキュメントを消去
        $t0->delete('1.0', 'end');
        # ファイルのリード
        open my $in, "<:utf8", "$filename" or die "Can't open $filename\n";
        while (<$in>) {
            $t0->insert('end', $_);
        }
        close($in);
        $t0->g_focus();
        &change_number if $number_flag;
    }
}

# メニューの設定
my $m = $top->new_menu(-type => 'menubar');
$top->configure(-menu => $m);

my $m1 = $m->new_menu;
$m->add_cascade(-menu => $m1, -label => 'File', -under => 0);
$m1->add_command(-label => 'Open', -under => 0, -command => \&load_file);
$m1->add_separator;
$m1->add_checkbutton(-label => 'Number', -under => 0,
                     -variable => \$number_flag, -command => \&change_number);
$m1->add_separator;
$m1->add_command(-label => 'Exit', -under => 0, -command => sub { exit; });

Tkx::MainLoop();

メニューに次の項目を追加する

$m1->add_checkbutton(-label => 'Number', -under => 0,
                     -variable => \$number_flag, -command => \&change_number);

Number がチェックされていれば行番号を表示し、そうでなければ行番号を表示しない
チェックボタンの値は変数 $number_flag に格納し、行番号の処理は関数 change_number で行う
最初に行数を index メソッドで求める
index はテキストの位置を line.char の形式の文字列で返す
end を指定することで最終行の次の行を求めることができる

たとえば、ファイルの行数が 55 行であれば、index('end') は '56.0' を返す

行番号は行の先頭に挿入することで表示する
変数 x は行番号を表し、挿入する文字列を sprintf("%6d:", $i) で作成する
この場合、先頭に空白を含めて 7 文字挿入することになる
行番号の削除は行の先頭から 7 文字削除するだけ
テキストウィジェットのメソッドで範囲指定を指定する場合、終了位置の文字は範囲に含まれないことに注意
ファイルを読み込んだあとで $number_flag が真であれば、change_number を呼び出して行番号を挿入する

行番号の表示

●テキストウィジェット : マークとタグ

マークはテキストの位置を表す名前のこと
マークは文字自体につけられるのではなく、文字と文字の間に設定される
マークで指定した位置に文字列を挿入する場合はとても便利
テキストを操作するメソッドで、位置の指定にマークを使うこともできる
マークを操作するおもなメソッドを下表に示す

表 : マーク操作用のおもなメソッド
mark_set(markname, index);	マークの設定
mark_unset(*markname);	マークの削除
mark_names();	定義されているすべてのマークを返す
mark_gravity(markname, left_or_right);	マークのつき方を left と right で指定
mark_next(index);	index より後ろにあるマークを返す
mark_previous(index);	index より前にあるマークを返す

マークの設定は mark_set メソッドで行う
マークは指定した位置の文字とその前の文字の間に設定される

たとえば '1.3' と指定すると、1 行目の 2 文字目と 3 文字目の間にマークが設定される
文字は 0 から数えることに注意
テキストウィジェットの 1 行目に abcdefg が書き込まれている状態で、first という名前のマークを設定する

$t0->mark_set('first', '1.3');

マーク first は 1 行目の 2 文字目 (c) と 3 文字目 (d) の間に設定される

文字 d が移動すれば、その文字とともにマークも移動する

この状態で 1 行目の先頭文字 a を削除すると文字 d は 2 文字目になる
first の位置は 1.3 ではなく 1.2 に変わる
また、行頭に文字 A を挿入すれば d は 4 文字目になる
first は 1.3 から 1.4 に変わる

マークの位置に文字列を挿入する場合、マークは挿入した文字列の左右どちらかにつく
mark_gravity メソッドは、文字列を挿入したときのマークのつき方を指定する
left であれば挿入した文字列の左側に、right であれば右側にマークが設定される

デフォルトの設定は right
たとえば、first の位置に文字列 1234 を挿入するには、次のように行う

$t0->insert('first', '1234');

first の位置が c と d の間であれば、文字列は abc1234defg になる
このとき、マークが挿入した文字列の左側につく場合は c と 1 の間にマークが設定される
逆に、右側につく場合は 4 と d の間に設定される
ここでもう一度 first に文字列 5678 を挿入すると、文字列は abc12345678defg となる

特別なマークとしてカーソル位置を表す 'insert' と、マウスカーソルが指す文字位置を表す 'current' がある
たとえば、カーソルの位置に文字列を挿入したい場合は、次のように行う

$t0->insert('insert', 'string');

これで指定した string がカーソル位置に挿入される
また、mark_set('insert', index) でカーソルを指定した index に移動することができる

テキストウィジェットのタグは指定した文字列に名前 (タグ名) をつける機能
タグごとにフォントや色などの表示属性やバインディングを設定することができる
たとえば、ある単語をクリックしたら別のテキストを表示する、といったハイパーテキストを構成するも可能
タグを操作するおもなメソッドを下表に示す

表 : タグ操作用のおもなメソッド
tag_add(tagname, index1, index2);	指定した範囲に対して、タグ tagname を設定
tag_delete(*tagname);	タグの削除
tag_names(index);	index の位置にある文字と関連するすべてのタグを返す
tag_cget(tagname, option);	タグ tagname のオプションの値を返す
tag_configure(tagname, option, value);	タグ tagname のオプションを設定する
tag_bind(tagname, event, callback);	タグ tagname にバインドを設定する

簡単な使用例

リスト : 行番号に色をつける

sub change_number {
    my $line = $t0->index('end');
    my $i;
    if ($number_flag) {
        for ($i = 1; $i < $line; $i++) {
            $t0->insert("$i.0", sprintf("%6d:", $i), 'LINENUM');
        }
    } else {
        for ($i = 1; $i < $line; $i++) {
            $t0->delete("$i.0", "$i.7");
        }
    }
}

テキストを表示するプログラムで、行番号を赤く表示する
行番号を表す文字列にタグ LINENUM を指定し、色をオプションで設定する
オプションの設定はメソッド tag_configure で行う

$t0->tag_configure('LINENUM', -foreground => 'red');

文字の色はオプション foreground で指定する
また、オプション background で背景色も指定することができる
このオプションが指定されていると、borderwidth でふちの幅を、relief で形状を指定することができる
行番号のタグは insert メソッドで指定する

$t0->insert(index, string, tagname, ...);

これで行番号が赤く表示される

行番号を赤く表示する

●テキストウィジェット : ウィジェットの表示

テキストウィジェットはテキストだけではなく他のウィジェットも表示することができる
これを「埋め込みウィンドウ」という
埋め込みウィンドウ用のメソッドを以下に示す

window_create(index, -option => value, ...);
オプション window で指定したウィジェットを表示する。
window_names();
テキストウィジェットに表示されているほかのウィジェットをリストで返す。
window_configure(index, -option => value);
window_cget(index, -option);
位置 index にあるウィジェットのオプションの設定 (window_configure()) と値の取得 (window_cget()) を行う。

window_create メソッドで使用するオプションを下表に示す

表 : window_create メソッドのオプション
-window	ウィジェット名
-create	ウィジェットを生成するコマンドを指定（window を指定しない場合のみ有効）
-align	上下方向の揃え指定 (baseline, top, bottom, center)
-stretch	上下方向の引き延ばし
-padx, -pady	スペースの指定

簡単な使用例

リスト : ラベル (画像) の挿入

use strict;
use warnings;
use utf8;
use File::Basename;
use Tkx;

# メインウィンドウ
my $top = Tkx::widget->new('.');
Tkx::option_add('*font', ['Terminal', 10]);
Tkx::option_add('*tearOff', 0);
$top->g_wm_title('Text Viewer');

# テキストウィジェット
my $t0 = $top->new_text(-wrap => 'word');
$t0->g_pack(-side => 'left', -expand => 1, -fill => 'both');
$t0->tag_configure('LINENUM', -foreground => 'red');

# スクロールバー
my $sb = $top->new_scrollbar(-command => [$t0, 'yview']);
$sb->g_pack(-side => 'left', -fill => 'y');
$t0->configure(-yscrollcommand => [$sb, 'set']);

# 行番号の処理
my $number_flag = 0;

sub change_number {
    my $line = $t0->index('end');
    my $i;
    if ($number_flag) {
        for ($i = 1; $i < $line; $i++) {
            $t0->insert("$i.0", sprintf("%6d:", $i), 'LINENUM');
        }
    } else {
        for ($i = 1; $i < $line; $i++) {
            $t0->delete("$i.0", "$i.7");
        }
    }
}

# ファイルの読み込み
my $path_name = '.';

sub load_file {
    my $filename = Tkx::tk___getOpenFile(-filetypes => "{Perl {.pl}} {Text {.txt}} {ALL {*}}",
                                         -initialdir => $path_name );
    if ($filename) {
        $path_name = dirname($filename) . '/';
        # 前のドキュメントを消去
        $t0->delete('1.0', 'end');
        # ファイルのリード
        open my $in, "<:utf8", "$filename" or die "Can't open $filename\n";
        while (<$in>) {
            $t0->insert('end', $_);
        }
        close($in);
        $t0->g_focus();
        &change_number if $number_flag;
    }
}

# 画像を選んで挿入する
my $image_path = '.';

sub insert_image {
    my $image_name = Tkx::tk___getOpenFile(-filetypes => "{GIF {.gif}} {PPM {.ppm}} {ALL {*}}",
                                           -initialdir => $image_path);
    if ($image_name) {
        my $image = Tkx::image_create_photo(-file => $image_name);
        my $label = $top->new_label(-image => $image, -relief => 'raised', -borderwidth => 4);
        $t0->window_create('insert', -window => $label, -align => 'baseline');
        $image_path = dirname($image_name) . '/';
    }
}

# メニューの設定
my $m = $top->new_menu(-type => 'menubar');
$top->configure(-menu => $m);

my $m1 = $m->new_menu;
$m->add_cascade(-menu => $m1, -label => 'File', -under => 0);
$m1->add_command(-label => 'Open', -under => 0, -command => \&load_file);
$m1->add_separator;
$m1->add_checkbutton(-label => 'Number', -under => 0,
                     -variable => \$number_flag, -command => \&change_number);
$m1->add_separator;
$m1->add_command(-label => 'Image', -under => 0, -command => \&insert_image);
$m1->add_separator;
$m1->add_command(-label => 'Exit', -under => 0, -command => sub { exit; });

Tkx::MainLoop();

ラベルにイメージを貼り付けて、そのラベルをテキストウィジェットに埋め込む
画像ファイルはメニュー Image で選択し、カーソル位置にその画像を挿入する
メニュー Image の設定は次の 1 行を追加するだけ

$m1->add_command(-label => 'Image', -under => 0, -command => \&insert_image);

ラベル (画像) の挿入は関数 insert_image で行う
tk___getOpenFile でファイル選択ダイアログを表示し、画像ファイル名を取得する
image_create_photo でイメージ $image を生成する
あとは、$image を new_label でラベルに貼り付け、そのラベルを window_create でテキストウィジェットに表示する
表示位置はマーク insert で指定できる

画像挿入 Tcl/Tk Logo を挿入

テキスト編集テキストの編集

テキストウィジェットに画像を表示するだけならば、画像専用のメソッドを使った方が簡単
これを「埋め込み画像」という
埋め込み画像用のメソッドを以下に示す

image_create(index, -option => value, ... );
オプション image で指定した画像を表示する。
image_names();
テキストウィジェットに表示されている画像をリストで返す。
image_configure(index, -option => value);
image_cget(index, -option);
位置 index にある画像のオプションの設定 (image_configure) と値の取得 (image_cget) を行う。

image_create メソッドで使用するオプションを下表に示す

表 : image_create メソッドのオプション
-image	表示する画像
-name	画像を参照するための名前を付ける
-align	上下方向の揃え指定(baseline, top, bottom, center)
-padx, -pady	スペースの指定

画像を挿入する関数 insert_image の修正

リスト : 画像の挿入

sub insert_image {
    my $image_name = Tkx::tk___getOpenFile(-filetypes => "{GIF {.gif}} {PPM {.ppm}} {ALL {*}}",
                                           -initialdir => $image_path);
    if ($image_name) {
        my $image = Tkx::image_create_photo(-file => $image_name);
        $t0->image_create('insert', -image => $image, -align => 'baseline');
        $image_path = dirname($image_name) . '/';
    }
}

image_create_photo で生成したイメージを image_create メソッドでテキストウィジェットに直接表示する
ラベルウィジェットを生成しない分だけプログラムは簡単になる

画像挿入 Tcl/Tk Logo を挿入

Perl/Tk memo

お気楽 Perl/Tkx 超入門

●スピンボックス

●テキストウィジェット

●テキストウィジェット : マークとタグ

●テキストウィジェット : ウィジェットの表示