LINUX.ORG.RU

Re: Perl - как сгенерить растровое изображение?

Что именно тебе надо? Если целью является графическое представление какой-либо функции или каких-то измерений, то можешь поискать в CPAN-е модули со словом chart [1].

Я знаком с gnuplot-ом [2] и с ploticus [3], и мне легче генерировать на лету скрипты и комманды. Результаты очень даже не плохие.


[1] http://search.cpan.org/search?mode=dist&query=chart
[2] http://www.gnuplot.info/
[3] http://ploticus.sourceforge.net/

PS (ploticus более разнообразен и рисует красивее, но gnuplot более распространен)

phrm ★★
()

Re: Perl - как сгенерить растровое изображение?

При помощи GD:

#!/usr/bin/perl -w

use strict;
use Image::Size;
use GD;

my @massiv;
my $img="karta.png";
my ($w, $h) = imgsize($img);

#считали картинку
&massiv();

# определяем новое изображение
my $im = new GD::Image($w,$h);

# определяем цвета
my $black = $im->colorAllocate(0,0,0);
my $white = $im->colorAllocate(255,255,255);
# делаем заливку
$im->fill(50,50,$white);
# заменяем цвет, если в этом есть необходимость
&zamena();

# пишем новое изображение
open F, ">/var/www/html/gr/file.png"
  or die "cant write new image: $!";
binmode F;
print F $im->png;
close F;

#если необходимо заменить какой-либо цвет
sub zamena{
  foreach my $i(0 .. $w){
    foreach my $k(0 .. $h){
      $im->setPixel($i,$k,$black) if $massiv[$i][$k]==0;
    }
  }
}

# считывание цветов пикселей картинки в массив
sub massiv{
  #считываем изображение
  my $source_img = newFromPng GD::Image($img);
  foreach my $i(0 .. $w){
    foreach my $k(0 .. $h){
      my $index = $source_img->getPixel($i,$k);
      # считываем палитру цветов RGB
      # поскольку для простоты примера нас 
      # интересует только черно-белое изображение
      # считываем только один цвет
      my ($r,undef,undef) = $source_img->rgb($index);
      $r ? do{$massiv[$i][$k] = 1} : do{$massiv[$i][$k] = 0};
    }
  }
}

При помощи ImageMagick:

#!/usr/bin/perl -w

use strict;
use Image::Magick;
use Image::Size;

my $img="/var/www/html/gr/karta.png";
my ($image, $x, @massiv);
my ($w, $h) = imgsize($img);

$image = Image::Magick->new;

#считали картинку
$x = $image->Read($img);
warn "$x" if "$x";
print "Readed\n";

#занесли данные о цветах пикселей картинки в массив
&massiv();

# заменяем цвет, если в этом есть необходимость
&zamena();

# записали изменения в ту же картинку
$x = $image->Write($img);
warn "$x" if "$x";

#если необходимо заменить какой-либо цвет
sub zamena{
  foreach my $i(0 .. $w){
    foreach my $k(0 .. $h){
      $x = $image->Set("pixel[$i,$k]", '#d2691e')
        if $massiv[$i][$k]==0;
    }
  }
}

# считывание цветов пикселей картинки в массив
sub massiv{
  foreach my $i(0 .. $w){
    foreach my $k(0 .. $h){
      # опять цвет по одному параметру
      ${[split m!,! => $image->Get("pixel[$i,$k]")]}[0]
        ? do{$massiv[$i][$k] = 0} : do{$massiv[$i][$k] = 1};
    }
  }
}

Самы правильный метод - XSUB, потому как на больших картинках эти два скрипта будут нереально тормозить. 

p.s. тебе нужен массив массивов, а не массив.

vilfred ☆☆
()
Вы не можете добавлять комментарии в эту тему. Тема перемещена в архив.
Development