Data Selector by Polygon (Perl GUI)

Program Perl di bawah ini berguna untuk memilih data berdasarkan polygon yang di-desain oleh user. Input merupakan ASCII 2 kolom.

Hasil data yang telah diseleksi (dalam polygon di-delete), disimpan dalam file clean.txt.

  

Membuka data input, format ASCII (TXT)

  

Tampilan data Input

 

Desain polygon dengan mouse pick, data dalam polygon akan di-delete. Dianjurkan hanya mendesain 1 buah polygon untuk pekerjaan ini.

Berikut kode Perl:

#!/usr/bin/perl
use Tk;
use Tk::ProgressBar;
use constant X         => 0;
use constant Y         => 1;
use constant PI        => atan2(0,-1);
use constant TWOPI    => 2*PI;

my $mw = MainWindow->new( -title => 'Data Selector' );

$mw->withdraw();
$mw->transient();
$mw->Popup();
my $menu_bar = $mw->Menu;
my $vw = $mw->vrootwidth/2;
my $vh = $mw->vrootheight/2;

### prepare for polygon
my $titik = [];
push(@$titik, []);

### Progress Bar
my $percent_done=0;
my $Progress = $mw->ProgressBar(-width =>5,-from => 0,-to => 100,-blocks => 50,    -colors => [0, 'green', 50, 'yellow' , 80, 'red',],-variable => \$percent_done)->pack(-fill => 'x');

### canvas
$mw->configure( -menu => $menu_bar );
my $canvas = $mw->Canvas(-cursor => "crosshair", -width => $vw+100, -height => $vh+100, -background => "white");
### Menu
my $file_mb = $menu_bar->cascade( -label => '~File', -tearoff => 0 );
$file_mb->command( -label => 'Open', -underline => 0, -command => \&f_open_data);
$file_mb->separator;
$file_mb->command( -label => 'Exit', -underline => 1, -command => sub{exit} );
$canvas->Tk::bind("<Button-1>", [ \&append_point, Ev('x'), Ev('y') ]);
$canvas->Tk::bind("<Double-Button-1>", [ \&poligon ]);
my $help_mb = $menu_bar->cascade( -label => '~About', -tearoff => 0 );
$help_mb->command( -label => 'About', -underline => 0, -command => \&f_help );

### button
my $delete= $mw->Button(-width => 8, -height => 1,-text => 'Delete',-command => \&fdelete);
my $clear = $mw->Button(-width => 8, -height => 1,-text => 'Re-Pick',-command => \&fclear);
my $exit = $mw->Button(-width => 8, -height => 1,-text => 'Exit',-command => [$mw => 'destroy']);

### packing
$canvas->pack;
$clear->pack(-side=>'left');
$delete->pack(-side=>'left');
$exit->pack(-side=>'left');

MainLoop;

### help
sub f_help {
$mw-> messageBox(-title => 'About', -message => 'Data Selector Ver 1.00 contact: Agus Abdullah, agusabdullah@gmail.com for help ', -type=>'ok');
}

### read data
sub f_open_data {

### refresh canvas
$junk=$canvas->createText(10,10, -text => a,-fill=>'white');
@items = $canvas->find('enclosed', $canvas->bbox('all') );
for($i=0;$i<=$#items;$i++)
{
  $canvas->delete($items[$i]);
}

### open file

my $filename = $mw->getOpenFile( -title => 'Open File:', -defaultextension => '.txt', -initialdir => '.' );
open (FILE, $filename);
$nr=`wc -l $filename`; ### count no of row
my $i=1;
while( <FILE> ) {
chomp;
my @row = split;
push @x,$row[0];
push @y,$row[1];
$percent_done = $i/($nr/100);
$mw->update;
$i++;
}
close( FILE );

### convert x,y into canvas pixel coordinates
for my $i (0..$#x-1)
{
$x1[$i]=(($x[$i]-min(@x))*($vw/(max(@x)-min(@x))))+50;
$y1[$i]=(($y[$i]-max(@y))*($vh/(min(@y)-max(@y))))+50;

push @x2,$x1[$i];
push @y2,$y1[$i];
$canvas->createText($x1[$i],$y1[$i], -text => x,-fill=>'blue',-tags => 'plot1');
}

### grid
$canvas->createLine(40,20, $vw+80,20,$vw+80,$vh+80, 40, $vh+80, 40,20, -fill=> 'grey',-tags => 'plot2'); #plot box
### vertical grids
$dhor=(max(@x)-min(@x))/10;
for my $i (0..10)
{
$canvas->createLine((($dhor*$i-min(@x))*($vw/(max(@x)-min(@x))))+50,20,(($dhor*$i-min(@x))*($vw/(max(@x)-min(@x))))+50,$vh+80, -fill=> 'grey', -dash => '-',-tags => 'plot3'); #plot grid
$canvas->createText((($dhor*$i-min(@x))*($vw/(max(@x)-min(@x))))+50,10, -text => sprintf("%.0f", $dhor*$i),-tags => 'plot4'); #plot box grid
}

###horizontal grids
$dxy=(max(@y)-min(@y))/5;
for my $i (0..5)
{
$canvas->createLine(40, ((min(@y)+($i*$dxy)-max(@y))*($vh/(min(@y)-max(@y))))+50, $vw+80, ((min(@y)+($i*$dxy)-max(@y))*($vh/(min(@y)-max(@y))))+50, -fill=> 'grey', -dash => '-',-tags => 'plot5');
$canvas->createText(20,((min(@y)+($i*$dxy)-max(@y))*($vh/(min(@y)-max(@y))))+50 ,-text => sprintf("%.2f", min(@y)+($i*$dxy)) ,-tags => 'plot6'); #plot grid
}
print 'Data loaded...!',"\n";


}  #### end function

### pick points
sub append_point {
    my ($canvas, $x, $y) = @_;
    my $last_country = $titik->[-1];
    my ($canvx, $canvy) = ($canvas->canvasx($x), $canvas->canvasy($y));
    push(@$last_country, $canvx, $canvy);
    $canvas->createOval($canvx-3, $canvy-3, $canvx+3, $canvy+3, ,-tags => 'plot7', -fill => 'blue');
 ##########################
    my $id     = 0;
    $main::coords = $main::coords . "$x,$y,";
    my $command = "\$id = \$canvas->createLine( $main::coords -width => 1, -fill => 'blue', "; $command = $command . "-tags => \"plot10\" )";
    eval $command;
##########################
    push @xclick,$canvx;
    push @yclick,$canvy;
}



### draw polygon
sub poligon {
    my $canvas = shift;
    $canvas->createPolygon($titik->[-1], -fill => 'blue',-stipple => 'gray12',-outline=>'blue',-tags => 'plot8');
    push(@$titik, []);
}


### draw polygon
sub fdelete {
for my $i (0..$#xclick)
{
push @xclick2,$xclick[$i];
push @yclick2,$yclick[$i];
}
push @xclick2,$xclick[0];
push @yclick2,$yclick[0];

for($i=0;$i<$#xclick2;$i++)
{
push(@{$poly[$i]}, $xclick2[$i],$yclick2[$i],); 
}

sub mapAdjPairs (&@) {
    my $code = shift;
    map { local ($a, $b) = (shift, $_[0]); $code->() } 0 .. @_-2;
}

sub Angle{
    my ($x1, $y1, $x2, $y2) = @_;
    my $dtheta = atan2($y1, $x1) - atan2($y2, $x2);
    $dtheta -= TWOPI while $dtheta >   PI;
    $dtheta += TWOPI while $dtheta < - PI;
    return $dtheta;
}

sub PtInPoly{
    my ($poly, $pt) = @_;
    my $angle=0;

    mapAdjPairs{
        $angle += Angle(
            $a->[X] - $pt->[X],
            $a->[Y] - $pt->[Y],
            $b->[X] - $pt->[X],
            $b->[Y] - $pt->[Y]
        )
    } @$poly, $poly->[0];

    return !(abs($angle) < PI);
}


print 'clean.txt has been created',"\n";
open OUT," > clean.txt" or die "$!\n";
for($i=0;$i<=$#x2;$i++)
{
$xxx[$i]=PtInPoly( \@poly, [$x2[$i],$y2[$i]]);

if ( $xxx[$i] > 0)
{
$canvas->createText($x2[$i],$y2[$i], -text => x,-fill=>'red',-tags => 'plot9');
}else
{
$x3[$i]=(($x2[$i]-50)/($vw/(max(@x)-min(@x))))+min(@x);
$y3[$i]=(($y2[$i]-50)/($vh/(min(@y)-max(@y))))+max(@y);
printf OUT  "%7.2f",$x3[$i],"\t";
printf OUT  "%10.3f",$y3[$i],"\t";
print  OUT "\n";
}
}
}

### min max subroutine
sub max {
    splice(@_, ($_[0] > $_[1]) ? 1 : 0, 1);
    return ($#_ == 0) ? $_[0] : max(@_);
}
sub min {
    splice(@_, ($_[0] > $_[1]) ? 0 : 1, 1);
    return ($#_ == 0) ? $_[0] : min(@_);
}

### clear for re-pick
sub fclear {
$canvas->delete('plot7');
$canvas->delete('plot8');
$canvas->delete('plot9');
$canvas->delete('plot10');

### delete vars
@xclick=();
@yclick=();
@xclick2=();
@yclick2=();
@poly=();
$main::coords=();