PerlでGUIプログラミング(4)

PerlでGUIプログラミング(4)
2024/03/17

[Prev] [Next] [Top] , Perl GUI [Prev] ~~[Next]~~ , [Perl Top]

GUIツールで必要になること

CUIツールのパラメータ設定をGUIで入れるといった目的で、ちょっとしたGUIを作る場合、Buttonウィジェットのcommandオプションに関数を設定すれば事足りますが
- 動作の経過や結果をGUIに反映させたい
- キー入力などで動作開始させたい
といった場合には、少し役不足です。

ある意味、GUIツールそのものを作成したい場合、上記は必須になるでしょう。そこで今回は、ストップウォッチやタイマーをモチーフにしつつ、その方法を説明したいと思います。

after()で遅延設定後、update()で表示更新する
repeat()でcallback関数を繰り返し実行する
bind()でキーやマウス入力イベントへのcallback関数を指定する

after()で遅延設定後、update()で表示更新する

モチーフとしてストップウォッチを作ります。ソースコード全体は [こちら:stopwatch_a.pl] です。下記のようにstartボタンを押すと計測開始、stopで計測停止、clearで最初に戻ります。

原則TkのGUIは何らかのcallback関数終了時に表示更新及び他のwidgetのイベント待ちが再開されます。

しかし、ストップウォッチという機能の都合上、計測のcallback関数実行中に、指定のタイミングで更新したいですよね。そんな時にはupdate()メソッドを使います。

あとはタイミング指定ですが、Perlのsleep()は1秒単位なのでms単位の指定には使えません。これに対しTkはms単位の待ち時間指定メソッドを持っています。それがafter()メソッドです。

下記はソースコード90～103行の抜粋です。$mw はMainWindowのオブジェクトです。$mw->after(1) で1ms待ちした後、時間を算出し、$mw->update() で更新しています。

090:    while(1) { # infinite loop
091:        last if ($share->{status} ne 'count');
092:        
093:        $mw->after(1); # sampling time 1ms
094:        
095:        my @t_cur = Time::HiRes::gettimeofday; # get current time
096:        
097:        $share->{meas} = Time::HiRes::tv_interval(\@t_ini, \@t_cur); # get elapsed time
098:        
099:        # format diaplay time
100:        $share->{disp} = sprintf("%.2f sec", ($share->{store} + $share->{meas}));
101:        
102:        $mw->update(); # update gui and callback
103:    }

repeat()でcallback関数を繰り返し実行する

GUIツールでは短い間隔での表示更新は「ほぼ必須」ですが、先のように無限ループを自分で作り、after()とupdate()で制御するという野暮ったい記述は毎回必要なのでしょうか? ...実は違います。

msオーダの指定間隔で、指定callback関数を繰り返し実行するメソッドがあります。それがrepeat()メソッドです。

このrepeat()メソッドを使ってストップウォッチ(b)を作りました。動きや見た目は全く変わりません。ソースコード全体は [こちら:stopwatch_b.pl] です。そして下記は76～116行の抜粋です。

076: sub start_meas {
077:     my ($mw, $wd, $share) = @_;
078:     
079:     $wd->{cont}->configure(
080:                      -command=>sub{stop_meas($mw, $wd, $share)}, # change callback
081:                      -text=>'stop' # change button label to stop
082:                  );
083:     
084:     $wd->{cls}->configure(-state=>'disabled'); # disable clear button in measuring
085:     
086:     my @t_ini = Time::HiRes::gettimeofday; # initial/start time
087:     
088:     $share->{id} = $mw->repeat(
089:                             1, # repeat/sampling 1ms
090:                             sub{repeat_meas($mw, $wd, $share, \@t_ini)} # callback
091:                         );
092: }
 :
 :   ... omitted ...
 : 
105: sub stop_meas {
106:     my ($mw, $wd, $share) = @_;
107:     
108:     $share->{id}->cancel() if (defined($share->{id})); # cancel repeat callback
109:     
110:     $share->{store} += $share->{meas}; # update stored time
111:     
112:     $wd->{cont}->configure(-command=>sub{start_meas($mw, $wd, $share)}, # change callback
113:                            -text=>'start'); # revert button label to start
114:     
115:     $wd->{cls}->configure(-state=>'normal');
116: }

88～91行がrepeat()メソッドによって、1ms間隔でcallback関数repeat_meas()を繰り返し実行させる記述です。$mwは先と同じようにMainWindowのオブジェクトです。

ポイントは、repeat()メソッド実行時に、その戻り値(Tk::afterオブジェクト)を保持することです。サンプルコードでは $share->{id} に入れてオブジェクト参照先を保持しています。

repeatの停止は、repeat()メソッドで取得したTk::afterオブジェクトでcancel()メソッドを実行します。上記サンプルコード108行目が該当記述です。$share->{id}に保持させたTk::afterオブジェクトでcancel()メソッドを実行しています。

そして、$mw->update()記述が無くなったことにお気付きでしょうか。先にTkの画面及びWidget待ち受け更新はcallback関数終了時に行われると書きましたが、repeat()メソッドで指定したcallback関数終了時に更新が行われるからです。

bind()でキーやマウス入力イベントへのcallback関数を指定する

次はモチーフとしてカウントダウンタイマーを作ってみましょう。この場合カウント秒数を入力する必要があるので、入力兼表示にEntry Widgetを使います。ソースコード全体は [こちら:timer.pl] です。

ストップウォッチでは、計測の開始/中段をButtonで行っていましたが、カウントダウンタイマーではEntryに値を入力するので、入力Entry上でEnter(Return)キーを押した場合でも計測開始させたいとしましょう。

このように何らかのイベントとcallback関数を関係づけるメソッドにbind()があります。下記はbind()メソッド使用部の42～51行を抜粋したものです。

042:    $wd->{disp}->bind(
043:                     '<Return>', # event
044:                     sub{        # callback
045:                         if (defined($share->{id})) {
046:                             stop_meas($mw, $wd, $share);
047:                         } else {
048:                             start_meas($mw, $wd, $share);
049:                         }
050:                     }
051:                 );

$wd->{disp}はEntry Widgetです。そのメソッドとしてbind()を実行しています。第1引数の<Return>が「Returnキーが押された」ことを表すイベント記述です。このイベントが発生すると第2引数で指定したcallback関数が実行されます。

このイベント記述がちょっとわかりにくいです。普通キーボード文字、例えば「aキーが押された」は <a> になります。

Button Widgetで「マウスでButtonを押してから離す」と-commandオプションで指定したcallback関数を実行しますが、これをbind()メソッドで記述すると下記になります。
$button_obj->bind('<ButtonRelease-1>', \&callback_func);

「ん? イベント記述中の '-' は何?」と思いますよね。実は先程の「aキーが押された」も本当は <Key-a> です。bind()メソッドで使用するイベント記述は多機能かつ省略可能なため、慣れないと非常にややこしいのです。

そこで今回は、単純なキー入力は'<キーの文字>'、マウスボタン入力は'<ButtonRelease-1>'であることだけ頭に入れていただいて一旦終了とします。

次回、イベント記述をまとめて説明します。modifierやら、sequenceやら、overwriteやら盛りだくさんです...。

Appendix: stopwatch_a.pl

001:
002:
003:
004:
005:
006:
007:
008:
009:
010:
011:
012:
013:
014:
015:
016:
017:
018:
019:
020:
021:
022:
023:
024:
025:
026:
027:
028:
029:
030:
031:
032:
033:
034:
035:
036:
037:
038:
039:
040:
041:
042:
043:
044:
045:
046:
047:
048:
049:
050:
051:
052:
053:
054:
055:
056:
057:
058:
059:
060:
061:
062:
063:
064:
065:
066:
067:
068:
069:
070:
071:
072:
073:
074:
075:
076:
077:
078:
079:
080:
081:
082:
083:
084:
085:
086:
087:
088:
089:
090:
091:
092:
093:
094:
095:
096:
097:
098:
099:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:

#!perl -w
use Time::HiRes;
use Tk;
use strict;

# main closure
{
    my $mw = get_main_window();        # main window
    
    my $share = init_share_vals();     # initialize shared values
    
    my $wd = set_widgets($mw, $share); # set widgets
    
    layout_widgets($wd);               # layout widgets
    
    Tk::MainLoop();                    # start main loop
}

sub layout_widgets {
    my ($wd) = @_;
    
    $wd->{cont}->pack(-padx=>4, -pady=>4, -side=>'left'); # pack from left
    $wd->{disp}->pack(-padx=>4, -pady=>4, -side=>'left');
    $wd->{cls} ->pack(-padx=>4, -pady=>4, -side=>'left');
}

sub set_widgets {
    my ($mw, $share) = @_;
    
    my $wd = {}; # widgets
    
    # disp: Label: display measured time
    $wd->{disp} = $mw->Label(
                          -width=>16,
                          -textvariable=>\$share->{disp},
                          -relief=>'ridge',
                          -font=>['Meiryo UI',12]
                      );
    # cont: Button: start or stop time measuring
    $wd->{cont} = $mw->Button(
                          -width=>5,
                          -text=>'start',
                          -command=>sub{start_meas($mw, $wd, $share)}
                      );
    # cls: Button: clear stored time
    $wd->{cls}  = $mw->Button(
                          -width=>5,
                          -text=>'clear',
                          -command=>sub{clear_meas($mw, $wd, $share)}
                      );
    
    return $wd;
}

sub get_main_window {
    my $mw = Tk::MainWindow->new();            # create main window object
    
    $mw->title('stopwatch');                   # window title
    $mw->optionAdd('*font'=>['Meiryo UI',10]); # default font setting
    $mw->resizable(0,0);                       # disable resize
    
    return $mw;
}

sub init_share_vals {
    my $share = {};
    
    $share->{status} = 'stop';      # status of stop_watch
    $share->{disp}   = '0.00 sec';  # display
    $share->{meas}   = 0.00;        # measured time
    $share->{store}  = 0.00;        # stored time
    
    return $share;
}

sub start_meas {
    my ($mw, $wd, $share) = @_;
    
    $share->{status}='count'; # set stop watch status 'count'
    
    $wd->{cont}->configure(
                     -command=>sub{stop_meas($mw, $wd, $share)}, # change callback
                     -text=>'stop' # change button label to stop
                 );
    
    $wd->{cls}->configure(-state=>'disabled'); # disable clear button in measuring
    
    my @t_ini = Time::HiRes::gettimeofday; # initial/start time
    
    while(1) { # infinite loop
        last if ($share->{status} ne 'count');
        
        $mw->after(1); # sampling time 1ms
        
        my @t_cur = Time::HiRes::gettimeofday; # get current time
        
        $share->{meas} = Time::HiRes::tv_interval(\@t_ini, \@t_cur); # get elapsed time
        
        # format diaplay time
        $share->{disp} = sprintf("%.2f sec", ($share->{store} + $share->{meas}));
        
        $mw->update(); # update gui and callback
    }
}

sub stop_meas {
    my ($mw, $wd, $share) = @_;
    
    $share->{status} = 'stop'; # set stop watch status 'stop'
    
    $share->{store} += $share->{meas}; # update stored time
    
    $wd->{cont}->configure(-command=>sub{start_meas($mw, $wd, $share)}, # change callback
                           -text=>'start'); # revert button label to start
    
    $wd->{cls}->configure(-state=>'normal');
}

sub clear_meas {
    my ($mw, $wd, $share) = @_;
    
    $share->{disp} = '0.00 sec'; # clear display
    $share->{store} = 0.00;      # clear stored time
}

Appendix: stopwatch_b.pl

001:
002:
003:
004:
005:
006:
007:
008:
009:
010:
011:
012:
013:
014:
015:
016:
017:
018:
019:
020:
021:
022:
023:
024:
025:
026:
027:
028:
029:
030:
031:
032:
033:
034:
035:
036:
037:
038:
039:
040:
041:
042:
043:
044:
045:
046:
047:
048:
049:
050:
051:
052:
053:
054:
055:
056:
057:
058:
059:
060:
061:
062:
063:
064:
065:
066:
067:
068:
069:
070:
071:
072:
073:
074:
075:
076:
077:
078:
079:
080:
081:
082:
083:
084:
085:
086:
087:
088:
089:
090:
091:
092:
093:
094:
095:
096:
097:
098:
099:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:

#!perl -w
use Time::HiRes;
use Tk;
use strict;

# main closure
{
    my $mw = get_main_window();        # main window
    
    my $share = init_share_vals();     # initialize shared values
    
    my $wd = set_widgets($mw, $share); # set widgets
    
    layout_widgets($wd);               # layout widgets
    
    Tk::MainLoop();                    # start main loop
}

sub layout_widgets {
    my ($wd) = @_;
    
    $wd->{cont}->pack(-padx=>4, -pady=>4, -side=>'left'); # pack from left
    $wd->{disp}->pack(-padx=>4, -pady=>4, -side=>'left');
    $wd->{cls} ->pack(-padx=>4, -pady=>4, -side=>'left');
}

sub set_widgets {
    my ($mw, $share) = @_;
    
    my $wd = {}; # widgets
    
    # disp: Label: display measured time
    $wd->{disp} = $mw->Label(
                          -width=>16,
                          -textvariable=>\$share->{disp},
                          -relief=>'ridge',
                          -font=>['Meiryo UI',12]
                      );
    # cont: Button: start or stop time measuring
    $wd->{cont} = $mw->Button(
                          -width=>5,
                          -text=>'start',
                          -command=>sub{start_meas($mw, $wd, $share)}
                      );
    # cls: Button: clear stored time
    $wd->{cls}  = $mw->Button(
                          -width=>5,
                          -text=>'clear',
                          -command=>sub{clear_meas($mw, $wd, $share)}
                      );
    
    return $wd;
}

sub get_main_window {
    my $mw = Tk::MainWindow->new();            # create main window object
    
    $mw->title('stopwatch');                   # window title
    $mw->optionAdd('*font'=>['Meiryo UI',10]); # default font setting
    $mw->resizable(0,0);                       # disable resize
    
    return $mw;
}

sub init_share_vals {
    my $share = {};
    
    $share->{id}     = undef;       # id of repeated callback
    $share->{disp}   = '0.00 sec';  # display
    $share->{meas}   = 0.00;        # measured time
    $share->{store}  = 0.00;        # stored time
    
    return $share;
}

sub start_meas {
    my ($mw, $wd, $share) = @_;
    
    $wd->{cont}->configure(
                     -command=>sub{stop_meas($mw, $wd, $share)}, # change callback
                     -text=>'stop' # change button label to stop
                 );
    
    $wd->{cls}->configure(-state=>'disabled'); # disable clear button in measuring
    
    my @t_ini = Time::HiRes::gettimeofday; # initial/start time
    
    $share->{id} = $mw->repeat(
                            1, # repeat/sampling 1ms
                            sub{repeat_meas($mw, $wd, $share, \@t_ini)} # callback
                        );
}

sub repeat_meas {
    my ($mw, $wd, $share, $t_ini) = @_;
    
    my @t_cur = Time::HiRes::gettimeofday; # get current time
    
    $share->{meas} = Time::HiRes::tv_interval($t_ini, \@t_cur); # get elapsed time
    
    # format diaplay time
    $share->{disp} = sprintf("%.2f sec", ($share->{store} + $share->{meas}));
}

sub stop_meas {
    my ($mw, $wd, $share) = @_;
    
    $share->{id}->cancel() if (defined($share->{id})); # cancel repeat callback
    
    $share->{store} += $share->{meas}; # update stored time
    
    $wd->{cont}->configure(-command=>sub{start_meas($mw, $wd, $share)}, # change callback
                           -text=>'start'); # revert button label to start
    
    $wd->{cls}->configure(-state=>'normal');
}

sub clear_meas {
    my ($mw, $wd, $share) = @_;
    
    $share->{disp} = '0.00 sec'; # clear display
    $share->{store} = 0.00;      # clear stored time
}

Appendix: timer.pl

001:
002:
003:
004:
005:
006:
007:
008:
009:
010:
011:
012:
013:
014:
015:
016:
017:
018:
019:
020:
021:
022:
023:
024:
025:
026:
027:
028:
029:
030:
031:
032:
033:
034:
035:
036:
037:
038:
039:
040:
041:
042:
043:
044:
045:
046:
047:
048:
049:
050:
051:
052:
053:
054:
055:
056:
057:
058:
059:
060:
061:
062:
063:
064:
065:
066:
067:
068:
069:
070:
071:
072:
073:
074:
075:
076:
077:
078:
079:
080:
081:
082:
083:
084:
085:
086:
087:
088:
089:
090:
091:
092:
093:
094:
095:
096:
097:
098:
099:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:

#!perl -w
use Time::HiRes;
use Tk;
use strict;

# main closure
{
    my $mw = get_main_window();        # main window
    
    my $share = init_share_vals();     # initialize shared values
    
    my $wd = set_widgets($mw, $share); # set widgets
    
    layout_widgets($wd);               # layout widgets
    
    Tk::MainLoop();                    # start main loop
}

sub layout_widgets {
    my ($wd) = @_;
    
    $wd->{cont}->pack(-padx=>4, -pady=>4, -side=>'left'); # pack from left
    $wd->{disp}->pack(-padx=>4, -pady=>4, -side=>'left');
    $wd->{unit}->pack(-padx=>0, -pady=>4, -side=>'left');
    $wd->{cls} ->pack(-padx=>2, -pady=>4, -side=>'left');
}

sub set_widgets {
    my ($mw, $share) = @_;
    
    my $wd = {}; # widgets
    
    # disp: Entry: set and display remaining time
    $wd->{disp} = $mw->Entry(
                          -width=>12,
                          -textvariable=>\$share->{disp},
                          -justify=>'center',
                          -font=>['Meiryo UI',12],
                          -state=>'normal'
                      );
                      
    $wd->{disp}->bind(
                     '<Return>',
                     sub{
                         if (defined($share->{id})) {
                             stop_meas($mw, $wd, $share);
                         } else {
                             start_meas($mw, $wd, $share);
                         }
                     }
                 );
    
    # unit: Label: put [sec] as string
    $wd->{unit} = $mw->Label(
                          -width=>4,
                          -text=>'[sec]',
                          -justify=>'left',
                          -font=>['Meiryo UI',11]
                      );
                      
    # cont: Button: stop time measuring
    $wd->{cont} = $mw->Button(
                          -width=>5,
                          -text=>'start',
                          -command=>sub{start_meas($mw, $wd, $share)}
                      );
                      
    # cls: Button: clear stored time
    $wd->{cls}  = $mw->Button(
                          -width=>5,
                          -text=>'clear',
                          -command=>sub{clear_meas($mw, $wd, $share)}
                      );
    
    return $wd;
}

sub get_main_window {
    my $mw = Tk::MainWindow->new();            # create main window object
    
    $mw->title('timer');                       # window title
    $mw->optionAdd('*font'=>['Meiryo UI',10]); # default font setting
    $mw->resizable(0,0);                       # disable resize
    
    return $mw;
}

sub init_share_vals {
    my $share = {};
    
    $share->{id}    = undef;  # id of repeated callback
    $share->{disp}  = '0.00'; # display
    $share->{meas}  = 0.00;   # measured time
    $share->{store} = 0.00;
    
    return $share;
}

sub start_meas {
    my ($mw, $wd, $share) = @_;
    
    $share->{store}=sprintf("%.2f",$share->{disp}); # store start time
    
    $wd->{cont}->configure(
                     -command=>sub{stop_meas($mw, $wd, $share)}, # change callback
                     -text=>'stop' # change button label to stop
                 );
    
    $wd->{disp}->configure(-state=>'readonly'); # disable edit entry during the timer running
    $wd->{cls}->configure(-state=>'disabled');  # disable clear button in measuring
    
    my @t_ini = Time::HiRes::gettimeofday; # initial/start time
    
    $share->{id} = $mw->repeat(
                            1, # repeat/sampling 1ms
                            sub{repeat_meas($mw, $wd, $share, \@t_ini)} # callback
                        );
}

sub repeat_meas {
    my ($mw, $wd, $share, $t_ini) = @_;
    
    my @t_cur = Time::HiRes::gettimeofday;                    # get current time
    $share->{meas}=Time::HiRes::tv_interval($t_ini, \@t_cur); # get elapsed time
    
    # total elapsed time
    if ($share->{store} > $share->{meas}) {
        $share->{disp} = sprintf("%.2f", ($share->{store}-$share->{meas}));
    } else {
        $share->{disp} = '0.00';
        stop_meas($mw, $wd, $share) unless ($share->{disp} > 0);
    }
}

sub stop_meas {
    my ($mw, $wd, $share) = @_;
    
    if (defined($share->{id})) {
        $share->{id}->cancel(); # stop repeat
        $share->{id} = undef;   # set undef to set callback for Enter binding
    }
    
    $wd->{cont}->configure(-command=>sub{start_meas($mw, $wd, $share)}, # change callback
                           -text=>'start'); # revert button label to start
    
    $wd->{disp}->configure(-state=>'normal'); # enable edit display entry
    $wd->{cls}->configure(-state=>'normal');  # enable clear button
}

sub clear_meas {
    my ($mw, $wd, $share) = @_;
    
    $share->{disp}='0.00'; # clear display
}

[Prev] [Next] [Top] , Perl GUI [Prev] ~~[Next]~~ , [Perl Top]