<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">use strict;
use Tk;


###  大域変数宣言
#####################

my $R;
my $sR;
my $theta;

# 時間
my $t = 0;
my $dt = 1 / 100;

# メイングラフィクスサイズ	
my $gc_size = 500; 
my ( $gc_width , $gc_height ) = ( $gc_size*1.1 , $gc_size*1.1 );

# 各グラフィックスのスケール
my $scale1;
my $scale2;
my ( $Ox1, $Oy1 ) = ( $gc_width/4, $gc_height/4 );
my ( $Ox2, $Oy2 ) = ( $gc_width/2, $gc_height/2 );

# 関数の係数
my @a0 = (1,0);
my @a1 = (1,0);
my @a2 = (1,0);
my @a3 = (1,0);
my @a4 = (1,0);

###  大域変数宣言終わり
#####################


# グラフィカルオブジェクト作成
my $top_windw = MainWindow-&gt;new();
my $start_button = $top_windw-&gt;Button( -text =&gt; 'Start/Stop', -command =&gt; [\&amp;start_animation]  )-&gt;pack();
my $graph_frame = $top_windw-&gt;Frame()-&gt;pack();
my $g1_frame = $graph_frame-&gt;Frame()-&gt;pack( -side =&gt; 'left' );
my $ctrl_frame = $g1_frame-&gt;Frame()-&gt;pack( -side =&gt; 'top' );
my $ctrl_b_frame = $ctrl_frame-&gt;Frame()-&gt;pack();
my $l1_button = $ctrl_b_frame-&gt;Button( -text =&gt; '   z^4   ', -command =&gt; [\&amp;l1_button_T]  )-&gt;pack(  -side =&gt; 'left' );
my $l1a_button = $ctrl_b_frame-&gt;Button( -text =&gt; ' ? ', -command =&gt; [\&amp;l1a_button_T]  )-&gt;pack(  -side =&gt; 'left' );
my $l2_button = $ctrl_frame-&gt;Button( -text =&gt; 'z^4 + z^3 + z^2 + z + 1', -command =&gt; [\&amp;l2_button_F]  )-&gt;pack( -side =&gt; 'top' );
$ctrl_frame -&gt; Label( -text =&gt; ' z = R ( cos t + i sin t ) ' )-&gt; pack( -side =&gt; 'top' );
my $t_text = ' t : 0 x 3.14';
$ctrl_frame -&gt; Label( -textvariable =&gt; \$t_text )-&gt; pack(-side =&gt; 'top' );
my $ctrl_e_frame = $ctrl_frame-&gt;Frame()-&gt;pack( -side =&gt; 'top' );
$ctrl_e_frame -&gt; Label( -text =&gt; ' R : ' ) -&gt; pack( -side =&gt; 'left' );
my $tmpRe = 1.5;
my $Rentry = $ctrl_e_frame -&gt; Entry( -textvariable =&gt; \$tmpRe ) -&gt; pack();
$top_windw-&gt; bind( '&lt;Return&gt;', \&amp;eRchenged );
my $tmpRs = $tmpRe*10;
my $Rscale = $ctrl_frame -&gt;Scale( -orient =&gt; 'h', -from =&gt; 1, -to =&gt; 200, -variable =&gt; \$tmpRs, -command =&gt; \&amp;sRchenged, -showvalue =&gt; '' )-&gt;pack( -side =&gt; 'top' );
my $g2_frame = $graph_frame-&gt;Frame()-&gt;pack();
my $canvas1 = $g1_frame-&gt;Canvas( 'width' =&gt; $gc_width/2, 'height' =&gt; $gc_height/2 )-&gt;pack();
my $gc1_label_text = 'z';
my $gc1_label = $g1_frame-&gt;Label( -textvariable =&gt; \$gc1_label_text )-&gt;pack();
my $canvas2 = $g2_frame-&gt;Canvas( 'width' =&gt; $gc_width, 'height' =&gt; $gc_height )-&gt;pack();
my $gc2_label_text = 'f(z)';
my $gc2_label = $g2_frame-&gt;Label( -textvariable =&gt; \$gc2_label_text )-&gt;pack();


# 基準線描画
my $r1 = $gc_size/2;
$canvas1-&gt;create( 'oval', $Ox1-$r1/2 , $Oy1-$r1/2 , $Ox1+$r1/2 , $Oy1+$r1/2 );
$canvas1-&gt;create( 'line' , 0, $Oy1, $gc_width, $Oy1 );
$canvas1-&gt;create( 'line' , $Ox1, 0, $Ox1, $gc_height );
#$canvas2-&gt;create( 'oval' , $Ox2-$r1 , $Oy2-$r1 , $Ox2+$r1 , $Oy2+$r1 );
$canvas2-&gt;create( 'line' , 0, $Oy2, $gc_width, $Oy2 );
$canvas2-&gt;create( 'line' , $Ox2, 0, $Ox2, $gc_height );


# 現在の値のグラフィカルオブジェクト用データ変数withダミーーデータ
my @cline1_data = (0,0,0,0);
my @cline2_data = (0,0,0,0);
my @ccirc2_data = (0,0,0,0);
my @cline3_data = (0,0,0,0);
my @ccirc31_data = (0,0,0,0);
my @ccirc32_data = (0,0,0,0);
my @ccircR_data = (0,0,0,0);


# 現在の値のグラフィカルオブジェクト
my $cline1 = $canvas1-&gt;create( 'line' , @cline1_data );
$canvas1-&gt;itemconfigure( $cline1, -fill =&gt; 'black', -width =&gt; 2.0 );
my $ccirc2 = $canvas2-&gt;create( 'oval' , @ccirc2_data );
$canvas2-&gt;itemconfigure( $ccirc2, -fill =&gt; 'green');
my $cline2 = $canvas2-&gt;create( 'line' , @cline2_data );
$canvas2-&gt;itemconfigure( $cline2, -fill =&gt; 'green', -width =&gt; 2.0 );
my $cline3 = $canvas2-&gt;create( 'line' , @cline3_data );
my $ccirc31 = $canvas2-&gt;create( 'oval' , @ccirc31_data );
my $ccirc32 = $canvas2-&gt;create( 'oval' , @ccirc32_data );
$canvas2-&gt;itemconfigure( $cline3, -fill =&gt; '' );
$canvas2-&gt;itemconfigure( $ccirc31, -outline =&gt; '' );
$canvas2-&gt;itemconfigure( $ccirc32, -outline =&gt; '', -fill =&gt; '' );
my $ccircR = $canvas2-&gt;create( 'oval' , @ccircR_data );



# 初期化
&amp;calc_data;
&amp;Rchenged($tmpRe);
&amp;show_data;


# メインループ
MainLoop();
##################################################################### メイン関数の終了

#####################
###  数学関係
#####################

# 複素数関係
#####################
sub abs{
	my ($x,$y) = @_;
	return sqrt( $x*$x+$y*$y );
}


sub prod{
	my (($x1,$y1),($x2,$y2)) = @_;
	return ( $x1*$x2 - $y1*$y2, $x1*$y2 + $y1*$x2 );
}

sub sum{
	my (($x1,$y1),($x2,$y2)) = @_;
	return ( $x1+$x2 , $y1+$y2 );
}


# 関数関係
#####################
sub function{
	my ($x,$y) = @_;


	my @z0 = (1,0);
	my @z1 = &amp;prod( @z0, ($x,$y) );
	my @z2 = &amp;prod( @z1, ($x,$y) );
	my @z3 = &amp;prod( @z2, ($x,$y) );
	my @z4 = &amp;prod( @z3, ($x,$y) );

	my @zz = (0,0);
	@zz = &amp;sum( @zz, &amp;prod( @a0, @z0 ) );
	@zz = &amp;sum( @zz, &amp;prod( @a1, @z1 ) );
	@zz = &amp;sum( @zz, &amp;prod( @a2, @z2 ) );
	@zz = &amp;sum( @zz, &amp;prod( @a3, @z3 ) );
	@zz = &amp;sum( @zz, &amp;prod( @a4, @z4 ) );

	return @zz;
}


sub function4{
	my ($x,$y) = @_;

	my @z0 = (1,0);
	my @z1 = &amp;prod( @z0, ($x,$y) );
	my @z2 = &amp;prod( @z1, ($x,$y) );
	my @z3 = &amp;prod( @z2, ($x,$y) );
	my @z4 = &amp;prod( @z3, ($x,$y) );

	return &amp;prod( @a4, @z4 );
}

sub get_small_R{
	my ($r) = @_;

	return 
		&amp;abs( @a0 )
		+ &amp;abs( @a1 ) * $r
		+ &amp;abs( @a2 ) * $r * $r
		+ &amp;abs( @a3 ) * $r * $r * $r ;
}

#####################


#####################
###  グラフィックス関係
#####################

# 現在のグラフィカルデータの計算
sub calc_data{
	my $point_num = 10;

	@cline1_data = ();
	@cline2_data = ();
	for( my $i=0; $i &lt;= $point_num; $i++ ){

		my $r = $R * $i / $point_num;
		my ($x,$y) = ( $r*cos($theta), $r*sin($theta) );
		push @cline1_data, $Ox1 + $x*$scale1 , $Oy1 - $y*$scale1;


		($x,$y) = &amp;function( ($x,$y) );
		push @cline2_data, $Ox2 + $x*$scale2 , $Oy2 - $y*$scale2;


	}

	my ($x,$y) = &amp;function( ( $R*cos($theta), $R*sin($theta) ) );
	@ccirc2_data = (
		$Ox2+($x)*$scale2-5, $Oy2-($y)*$scale2-5,
		$Ox2+($x)*$scale2+5, $Oy2-($y)*$scale2+5
	);

	($x,$y) = &amp;function4( ( $R*cos($theta), $R*sin($theta) ) );
	@ccirc31_data = ( 
		$Ox2+($x-$sR)*$scale2, $Oy2-($y-$sR)*$scale2,
		$Ox2+($x+$sR)*$scale2, $Oy2-($y+$sR)*$scale2
	);
	@ccirc32_data = ( 
		$Ox2+($x)*$scale2 -3, $Oy2-($y)*$scale2 -3,
		$Ox2+($x)*$scale2 +3, $Oy2-($y)*$scale2 +3
	);

	@cline3_data = (
		$Ox2, $Oy2,
		$Ox2 + $x*$scale2, $Oy2 - $y*$scale2
	);

}

# 半径変化時の処理
sub Rchenged{
	my ($tmpR) = @_;
	if( $tmpR &gt; 0 ){
		$R = $tmpR; 
	}
	else{ $tmpR=1; }


	$scale1 = $gc_size / (4*$R);
	$scale2 = $gc_size / (2*&amp;abs( &amp;function( ($R,0) ) ) );
	$sR = &amp;get_small_R( $R );

	@ccircR_data = ( 
		$Ox2 - $R*$scale2, $Oy2 - $R*$scale2,
		$Ox2 + $R*$scale2, $Oy2 + $R*$scale2
	);
	$canvas2-&gt;coords( $ccircR, @ccircR_data );

	&amp;calc_data;
	&amp;show_data;
}


#####################
###  コマンド関係
#####################

sub sRchenged{
	$tmpRe = $tmpRs / 10.0;
	&amp;Rchenged($tmpRe);
}

sub eRchenged{
	if( $tmpRe &gt; 0 ){
		$tmpRs = $tmpRe*10; 
		&amp;Rchenged($tmpRe);
	}else{
		$tmpRs = 10;
		$tmpRe = 1; 
		&amp;Rchenged($tmpRe);
	}
}

sub l1_button_T{
	$canvas2-&gt;itemconfigure( $cline3, -fill =&gt; 'red' );
	$canvas2-&gt;itemconfigure( $ccirc32, -outline =&gt; 'black', -fill =&gt; 'red' );
	$l1_button-&gt;configure(  -command =&gt; [\&amp;l1_button_F] );
}

sub l1_button_F{
	$canvas2-&gt;itemconfigure( $cline3, -fill =&gt; '' );
	$canvas2-&gt;itemconfigure( $ccirc32, -outline =&gt; '', -fill =&gt; '' );
	$l1_button-&gt;configure(  -command =&gt; [\&amp;l1_button_T] );
}


sub l1a_button_T{
	$canvas2-&gt;itemconfigure( $ccirc31, -outline =&gt; 'red' );
	$l1a_button-&gt;configure(  -command =&gt; [\&amp;l1a_button_F] );
}

sub l1a_button_F{
	$canvas2-&gt;itemconfigure( $ccirc31, -outline =&gt; '' );
	$l1a_button-&gt;configure(  -command =&gt; [\&amp;l1a_button_T] );
}


sub l2_button_T{
	$canvas2-&gt;itemconfigure( $cline2, -fill =&gt; 'green' );
	$canvas2-&gt;itemconfigure( $ccirc2, -outline =&gt; 'black', -fill =&gt; 'green' );
	$l2_button-&gt;configure(  -command =&gt; [\&amp;l2_button_F] );
}

sub l2_button_F{
	$canvas2-&gt;itemconfigure( $cline2, -fill =&gt; '' );
	$canvas2-&gt;itemconfigure( $ccirc2, -outline =&gt; '', -fill =&gt; '' );
	$l2_button-&gt;configure(  -command =&gt; [\&amp;l2_button_T] );
}


#####################
###  アニメーション関係
#####################
my $next_animation_ID;
sub next_animation{
	$top_windw-&gt;afterCancel($next_animation_ID);
	$next_animation_ID = $top_windw-&gt;after( 100, \&amp;animation_func );
}

sub start_animation{
	&amp;Rchenged;	
	&amp;next_animation;
	$start_button-&gt;configure(  -command =&gt; [\&amp;stop_animation] );
}

sub stop_animation{
	$top_windw-&gt;afterCancel( $next_animation_ID );
	$start_button-&gt;configure(  -command =&gt; [\&amp;start_animation] );
}

sub show_data{
	$canvas1-&gt;coords( $cline1, @cline1_data );
	$canvas2-&gt;coords( $cline2, @cline2_data );
	$canvas2-&gt;coords( $cline3, @cline3_data );
	$canvas2-&gt;coords( $ccirc31, @ccirc31_data );
	$canvas2-&gt;coords( $ccirc32, @ccirc32_data );
	$canvas2-&gt;coords( $ccirc2, @ccirc2_data );
}

sub animation_func{
	$t += $dt;
	$t_text = ' t : '.$t.' x 3.14';
	$theta = $t*3.14159;
	
	&amp;calc_data;
	&amp;show_data;

	if( $t&gt;2 ){
		&amp;stop_animation;
		$t = 0;
	}else{
		&amp;next_animation;
	}
}
</pre></body></html>