The Practical Programming in Script Based Graphics User Interface

Shinji Kono 河野真治

Self Introduction

http://rananim.ie.u-ryukyu.ac.jp

Associate Professor of University of the Ryukyus ('96-)

Sony Computer Science Laboratory, Inc. ('89-'95)

Phd. The university of Tokyo, Information Engineering

Research Area

	Temporal Logic, Object Oriented Programming,
	Concurrent Object, Program Verificaiton,
	Network Programming

Script Language

	Shell
	Awk
	Perl
	Ruby
	HTML/SHTML

Advantage of Script Language

	Quick
	Visible
	Network Transparent
	High Portability
	Easy to modify

Disadvantage of Script Language

	Slow
	No hidden source
	High Portability
	Easy to modify

Perl

	Unix Culture Oriented
	No adhoc limitation on data size
	String manipulation
	Dynamic Extendable Array
	Associatibe Array
	Object Orientation

Target of Perl

	CGI (WWW page generator)
	Log processing ( login record, etc. )
	Database Proprocessing of large data
	Data conversion
	GUI application

What is Unix Culture

	Flat text
	Combination of Command Tools
	File descriptor
	stdin, stdout, stderr
	pipe, redirect, socket

Programming Perl

	Similarity
		Sh, Csh, Awk, C

Programming Perl (conditional)

1. if ($i++ <10 ) { print $i; }2. print $i if ($i++ <10 );3. print $i unless ($i++ > 9 );4. open(FD,"<test") || die("error $@\n");5. open(FD,"<test") or die("error $@\n");

Programming Perl (control)

1. while(<>) { $i++; }; print $i;2. print $_ while(<>);3. while(<>) { print $_; last if ($i++ > 10); }4. while(<>) { next if ($i++ < 10); print $_; last if ($i++ > 20); }5. while(<>) { print if (10..20); }6. do { print "$i\n"; } until($i++ < 10) ;

sub gcd0 {
    my ($a,$b) = @_;
    return ($a > $b) ? $a % $b : $b % $a;


}

Ex. complete a program which calculate GCD.

Perl Data Types

Perl Type Anotation

Character	Type
$a	scalar (0 dimention value)
@a	entire array, vector(1 dimention value)
$a[1]	value of an element of the array (scalar)
%a	entire associative array
$a{1}	value of an element of the associative array
<a>	File handle
&a	procedure
\$a	reference
$$a	value of reference
()	list
[]	anonymous array
{}	anonymous associative array
--	boolean if(), while()

Perl document

Debugging Perl

	perl -de 0

Quick and easy programming

Even if we use script language, we have to program clearly.

Perl programming (pattern)

      $var =~ /pattern/;
      $var =~ s/pattern/replace/;

      while(<>) {
         if (/pattern/) {
              print;
         }
      }

      /pattern/ && print while (<>);

Perl programming (regular expression)

      s/j980(\d\d)/& = $1/;

Perl programming (Reference)

pw071: {1} % perl5 -de 0

Loading DB routines from perl5db.pl version 1
Emacs support available.

Enter h or `h h' for help.

main::(-e:1):   0
  DB<1> @a = (1,2,3,4,5)
  DB<2> p "@a"


1 2 3 4 5
  DB<3> @b = @a
  DB<4> p "@b"


1 2 3 4 5
  DB<5> $a[2]="kono"
  DB<6> p "@a"


1 2 kono 4 5
  DB<7> p "@b"


1 2 3 4 5
  DB<8> $a = [1,2,3,4,5]
  DB<9> p $a



ARRAY(0x805b3b4)
  DB<10> p @$a



12345
  DB<11> p "@$a"


1 2 3 4 5
  DB<12> $$a[1] = "kono"
  DB<13> p "@$a"


1 kono 3 4 5
  DB<14> $b = $a
  DB<15> $$b[2] = "kakazu"
  DB<16> p "@$b"


1 kono kakazu 4 5
  DB<17> p $b



ARRAY(0x805b3b4)
  DB<18> p $b->[2] = "higa"


higa
  DB<19> p "@$b"


1 kono higa 4 5
  DB<20> $c = {}
  DB<21> $c->{'kono'} = 'teacher'
  DB<22> $c->{'higa'} = 'student'
  DB<23> p %$c



higastudentkonoteacher
  DB<24> $c{'kono'} = 1
  DB<25> $c{'higa'} = 2
  DB<26> p keys %c



higakono
  DB<27> p $c



HASH(0x8134cc0)

  DB<28> $d  = \%c
  DB<29> p $d



HASH(0x8152b00)
  DB<30> $d->{'shimabukuro'} = 'student'
  DB<31> p keys %c



higashimabukurokono
  DB<32> 

Ex. Try following examples.

     $a=[1,2,3,4];
     $a->[5]=3;
     print "@$a, $a->[2]\n";
     $b={};
     $b->{First}='Cat';
     $b->{Second}='Dog';
     $b->{Third}='Pig';
     foreach $key ( keys %$b)  { print "$key is $b->{$key}\n"  }

     @a =  ( 1,2,3,4);
     $refa = \@a;
     $refa->[5]=3;
     print "@$refa, $refa->[2]\n";

The Practice of Programming

There are good old books,

	The Elements of Programming Style, 1978
	Software Tools, Adison-Wesley, 1976

Performance of languages

  </td><td> 250MHz <br> R10000</td><td> 400MHz <br> Pentinum II</td><td> Lines of <br> source code

Perl Module

Perl Object

package Mammal;

sub new {
       my $type = shift;
       my %params = @_;
       my $self = {};
       $self->{'Name'} = $params{'Name'};
       $self->{'Sex'}  = $params{'Sex'};
       $self->{'Weight'}  = $params{'Weight'};
       $self->{'Color'}  = $params{'Color'};
       bless $self, $type;


}

package Cat;

@ISA = qw( Mammal );

sub new {
       my $type = shift;
       my %params = @_;
       my $self = Mammal->new(@_);
       $self->{'Character'}  = $params{'Character'};
       bless $self, $type;


}

# method 


  sub miyao {   my ($self,$arg) = @_;    $self->{Name} = $arg; }
  sub name_print {   my ($self) = @_;    print $self->{Name}; print "\n";}


# Usage


 $a = Cat->new(Name=> Jackey, Sex=>F);
 print $a->{Name};print "\n";
 $a->name_print;

CPAN

Perl/Tk

	Tk library
	Separation of GUI and main program
	Combination

Traffic Singal in Perl/Tk

Write a traffic signal in Perl/Tk.

    package Signal;
    sub new {
	my $type = shift;
	my %params = @_;
	my $self = {};
	    $self->{'State'}  = $params{'State'};
	$self->{'State'}  = 
	    defined($params{'State'})? $params{'State'}:'red';
	$self->{'States'}  = ['green','yellow','red'];
	bless $self;
    }
    sub next {
	my ($self) = shift;
	my $state = $self->{'State'};
	if($state eq 'red') {
	    $self->{'State'} = 'green';
	} elsif($state eq 'green') {
	    $self->{'State'} = 'yellow';
	} else {
	    $self->{'State'} = 'red';   # Red for all other cases 
	}
	# return $self->{'State'};
    }
    sub print {
	my ($self) = shift;
	my $state = $self->{'State'};
	print $state;
    }

      DB<3> $a = Signal->new(State=>Red);
      DB<4> $a->print
      DB<5> $a->next
      DB<6> $a->print
    red
      DB<7> $a->next
      DB<8> $a->print
    green

Perl/Tk (main)

	my $main = MainWindow->new();

Canvas とタグ

Canvasには以下のような図を書くことができる。

oval	楕円
rectangle	箱
line	線
polygon	多角形
bitmap	イメージ
text	テキスト

これらは、CanvasにタグやIDで指定することによって移動したり変形したりすることができる。

$canv->move($ball, $deltax, $deltay);	移動
$canvas->itemconfigure($view,-fill=>'black');	色などの変更
$canvas->delete($view);	削除

これらに関しては man canvas でもだいたいのことを知ることができる。

信号機を表示する<a > Perl/Tkのプログラム</a>は以下のようになる。

    package SignalView;
    use Tk;
    sub new {
	my $type = shift;
	my %params = @_;
	my $self = {};
	my $signal = Signal->new(%params);
	my $main = $params{-main};
	my $canvas;
	my $states = $signal->{'States'};
	my %views = ();
	if(! defined( $main)) { $main = MainWindow->new(%params); }
	$canvas = $main->Canvas(-width=>50,-height=>150);
	$x = 5; $y = 5;
	$r = 40;
	for $state ( @$states ) {
	    $views{$state} = 
		$canvas->create('oval', $x, $y, $x+$r, $y+$r, 
		    -width => 1, -outline => 'black', -fill => 'black');
	    $y += 50;
	}
	$canvas->pack();
	$self->{'MainWindow'}  = $main;
	$self->{'Canvas'}  = $canvas;
	$self->{'Views'}  = \%views;
	$self->{'Signal'}  = $signal;
	bless $self;
    }
    sub next {
	my ($self) = shift;
	my $state = $self->{'Signal'}->{'State'};
	my $view = $self->{'Views'}->{$state};
	my $canvas = $self->{'Canvas'};
	$canvas->itemconfigure($view,-fill=>'black');
	$state = $self->{'Signal'}->next();
	$view = $self->{'Views'}->{$state};
	$canvas->itemconfigure($view,-fill=>$state);
    }
    sub update {
	my ($self) = shift;
	$self->{'MainWindow'}->update();
    }
    package Main;
    $signal = SignalView->new();
    $signal->update();
    while($i++<100) {
	$signal->next();
	$signal->{'Signal'}->print(); print "\n";
	$signal->update();
	sleep(1);
    }

    package MainWindow;
    sub Signal {
	my ($self) = shift;
	return SignalView->new(-main=>$self);
    }
    package SignalView;
    sub new {
	my $type = shift;
	my %params = @_;
	my $self = {};
	my $signal = Signal->new(%params);
	my $main = $params{-main};
	my $canvas;
	my $states = $signal->{'States'};
	my %views = ();
	$self->{'Interval'} = 500;
	$canvas = $main->Canvas(-width=>50,-height=>150);
	$x = 5; $y = 5;
	$r = 40;
	for $state ( @$states ) {
	    $views{$state} = 
		$canvas->create('oval', $x, $y, $x+$r, $y+$r, 
		    -width => 1, -outline => 'black', -fill => 'black');
	    $y += 50;
	}
	$canvas->pack(-side=>left);
	$self->{'MainWindow'}  = $main;
	$self->{'Canvas'}  = $canvas;
	$self->{'Views'}  = \%views;
	$self->{'Signal'}  = $signal;
	bless $self;
    }
    sub next {
	my ($self) = shift;
	my $state = $self->{'Signal'}->{'State'};
	my $view = $self->{'Views'}->{$state};
	my $canvas = $self->{'Canvas'};
	$canvas->itemconfigure($view,-fill=>'black');
	$state = $self->{'Signal'}->next();
	$view = $self->{'Views'}->{$state};
	$canvas->itemconfigure($view,-fill=>$state);
    }
    sub update {
	my ($self) = shift;
	$self->{'MainWindow'}->update();
    }
    sub run {
	my ($self) = shift;
	my %params = @_;
	my $main=$self->{'MainWindow'};
	if(defined($params{'Interval'})) {
	    $self->{'Interval'} = $params{'Interval'};
	}
	if(! $self->{'Running'})  {
	    $self->{'Running'} = 1;
	    $main->after($self->{'Interval'},sub {$self->running()});
	}
    }
    sub running {
	my ($self) = shift;
	my $interval = $self->{'Interval'};
	if($self->{'Running'}) {
	    $self->next();
	    $self->update();
	    $self->{'MainWindow'}->after($interval,sub {$self->running()});
	} 
    }
    sub stop {
	my ($self) = shift;
	$self->{'Running'} = 0;
    }
    package Main;
    use Tk;
    $main = MainWindow->new();
    $signal = $main->Signal();
    $signal->run();
    &MainLoop();

Call Back と Controller

この信号をさらに外から制御するには、controller をViewに付加する。

ボタンからの情報を処理するにはCall Backを使う。Call Back では、Call Back する先を、my 変数により保持する。これをClosure という。オブジェクトを使っても同じことが実現できるが、Closureの方が構文的には軽い。

    package SingalView;
    sub controller {
	my ($self) = shift;
	my $main=$self->{'MainWindow'};
	# my $c= $main->Toplevel();
	my $c= $main->Frame();
	my $int= $c->Frame();
	my $int_entry = $int->Entry(-relief => 'sunken',-width=>5);
	my $int_label= $int->Label(-text=>"Interval:");
	my $quit = $c->Button( 
	    -text => 'Quit', -width => 10, -command => sub {$main->destroy});
	my $run = $c->Button( 
	    -text => 'Run', -width => 10, -command => 
		sub { $self->run(Interval=>($int_entry->get())) }
	    );
	my $stop = $c->Button( 
	    -text => 'Stop', -width => 10, -command => sub {$self->stop});
	$int->pack(-side => 'top', -fill => 'x');
	$int_entry->pack(-side => 'right');
	$int_label->pack(-side => 'left');
	$c->pack( -side => 'right', -expand => 'no', -pady => 2);
	$int->pack(-side => 'top', -expand => 'no', -pady => 2);
	$run->pack( -side => 'top', -expand => 'no', -pady => 2);
	$stop->pack(-side => 'top', -expand => 'no', -pady => 2);
	$quit->pack(-side => 'top', -expand => 'no', -pady => 2);
	# set default value
	$int_entry->insert(0,$self->{'Interval'});
	$self->{'Controller'}=$c;
	$self->update();
    }
    # end