Kanako's Programming

正５角形を描くプログラム(perlのソース)

#!/usr/bin/perl

use Tk;
use strict;
use Math::Trig;
use Image::Magick;

&main_nonagon;

sub main_nonagon {
    
##座標が格納してあるディレクトリ名;
    my $dir = "/home/username/perl/";

##座標データ;
    open(POINTDATA, "$dir/pentagondata.txt");
    my $x0;
    my $y0;
    my %nonagon;
    while(my $points = <POINTDATA>) {
	chomp($points);
	my @new_points = ();
	@new_points = &data_split($points);
	my @trcal = ();
	@trcal = &trig_calc(@new_points);
	my $point_x = eval $trcal[1];
	my $x = int($point_x + 0.5);
	my $point_y = eval $trcal[2];
	my $y = int($point_y + 0.5);
	$nonagon{$trcal[0]} = [$x,$y];
    }
    close(POINTDATA);

    my %daub;
##折り紙の裏側の領域のデータ;
    open(POINTDATADAUB, "$dir/pentagondata-daub.txt");
    while(my $daub = <POINTDATADAUB>) {
	chomp($daub);
	my @p_daub = ();
	@p_daub = split(/,/,$daub);
	if ($p_daub[1] !~ /[N]/) {
	    my $firstd = $p_daub[0];
	    shift(@p_daub);
	    $daub{$firstd} = join(",",@p_daub);
	}
    }
    close(POINTDATADAUB);

    my %broken;
##破線データ;
    open(POINTDATABROKEN, "$dir/pentagondata-broken.txt");
    while(my $broken = <POINTDATABROKEN>) {
	chomp($broken);
	my @p_broken = ();
	@p_broken = split(/,/,$broken);
	if ($p_broken[1] !~ /[N]/) {
	    my $firstb = $p_broken[0];
	    shift(@p_broken);
	    $broken{$firstb} = join(",",@p_broken);
	}
    }
    close(POINTDATABROKEN);

    my %sold;
##実線データ;
    open(POINTDATASOLD, "$dir/pentagondata-sold.txt");
    while(my $sold = <POINTDATASOLD>) {
	chomp($sold);
	my @p_sold = ();
	@p_sold = split(/,/,$sold);
	if ($p_sold[1] !~ /[N]/) {
	    my $firsts = $p_sold[0];
	    shift(@p_sold);
	    $sold{$firsts} = join(",",@p_sold);
	}
    }
    close(POINTDATASOLD);
 
    my $top =MainWindow->new();
    my $canvas = $top->Canvas(width=>500,height=>500,-background=>'white');
    $canvas->pack();
    &nonagon_plot($top,$canvas,scalar(keys(%sold)),\%nonagon,\%sold,\%broken,\%daub);  

}

sub nonagon_plot {
    my($top,$canvas,$maxnum,$nonagon,$sold,$broken,$daub) = @_;
    my $callback;
    my $number = -1;

    $callback = sub {
	$canvas->delete('all');
	&nonagon_canvas(++$number,$canvas,$nonagon,$sold,$broken,$daub);
	if ($number< $maxnum) {
	    $top->after(200,$callback);
	}else {
	    $canvas->Button(-command=>&exit);
	}
    };
    $callback->();
    MainLoop();
 
}

sub nonagon_canvas {
    my($number,$canvas,$nonagon,$sold,$broken,$daub) = @_;

    if (exists($daub->{$number})) {
	my $ndaub = $daub->{$number};
	my @ndaub = ();
	@ndaub = split(/,/,$daub->{$number});
	my @ndaubxy = ();
	for(my $j=0; $j<@ndaub; ++$j) {
	    push(@ndaubxy,$nonagon->{$ndaub[$j]}->[0],$nonagon->{$ndaub[$j]}[1]);
	}
	$canvas->create('polygon',@ndaubxy,-fill=>'yellow');
    }
    if (exists($broken->{$number})) {
	my $nbroken = $broken->{$number};
	my @nbroken = ();
	@nbroken = split(/,/,$broken->{$number});
	my @nbrokenxy = ();
	for(my $j=0; $j<@nbroken-1; $j=$j+2) {
	    $canvas->create('line',$nonagon->{$nbroken[$j]}->[0],$nonagon->{$nbroken[$j]}->[1],$nonagon->{$nbroken[$j+1]}->[0],$nonagon->{$nbroken[$j+1]}->[1],-width=>3.0, -dash=>'-..', -fill=>'red');
	}
    }
    if (exists($sold->{$number})) {
	my $nsold = $sold->{$number};
	my @nsold = ();
	@nsold = split(/,/,$sold->{$number});
	my @nsoldxy = ();
	for(my $j=0; $j<@nsold-1; $j=$j+2) {
	    $canvas->create('line',$nonagon->{$nsold[$j]}->[0],$nonagon->{$nsold[$j]}->[1],$nonagon->{$nsold[$j+1]}->[0],$nonagon->{$nsold[$j+1]}->[1],-fill=>'black',-width=>3.0);
	}
    }
   
}

##Math.Sqrt->sqrt;
sub data_split {
    my($line) = @_;
    
    my @line = ();
    @line = split(/\,/,$line);
 
    for (my $i=1; $i<3; ++$i) {
	if ($line[$i] =~ m<Math\.Sqrt\((\d+)\)>) {
	    my $sq = eval sqrt($1);
	    $line[$i] =~ s/Math\.Sqrt\(\d+\)/$sq/g;
	}
    }
    @line;
}

sub trig_calc {
    my(@line) = @_;

    my $pai = 3.14159;

    for (my $i=1; $i<3; ++$i) {
	if ($line[$i] =~ /(sin|cos|tan)\((\d+)\)/) {
	    my $angle = $2*$pai/180;
	    my $sct;
	    if ($1 eq "sin") {
		$sct = sin($angle);
	    }elsif($1 eq "cos") {
		$sct = cos($angle);
	    }else {
		$sct = tan($angle);
	    }
	    $line[$i] =~ s/(sin|cos|tan)\(\d+\)/\($sct\)/g;
	}
    }
    @line;
}

1;