VPF::альфа канал - Форум программистов

Сisa

Дата 4.9.2014, 09:11 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 179
Регистрация: 18.1.2013

Репутация: нет
Всего: нет

Код


#!/usr/bin/perl
use strict;
use warnings;
use Imager;

my $image_source = 'image/106.ico';

my $image = Imager->new;
$image->read( file => $image_source )
  or die "Cannot load $image: ", $image->errstr;

my $x = 100;
my $blue;
foreach my $y ( 20 .. 120 ) {
    my $color = $image->getpixel( x => $x, y => $y );
    my ( $r, $g, $b, $a ) = $color->rgba();
    print "$x x $y --- shade = $r, $g, $b, $a ---- ";

    $blue = Imager::Color->new( $r, $g, $b, 112 );
    $image->setpixel(x=>$x, y=>$y, color=>$blue);
    $color = $image->getpixel( x => $x, y => $y );
    ( $r, $g, $b, $a ) = $color->rgba();
    print "shade = $r, $g, $b, $a \n";
}
$image->write(file => "foo.ico")
    or die "Cannot write: ",$image->errstr;

my $format;
# Create smaller version
# documented in Imager::Transformations
my $thumb = $image->scale(scalefactor=>.3);

  # Autostretch individual channels
$thumb->filter(type=>'autolevels');

$thumb->write(file => "foo2.ico")
    or die "Cannot write: ",$thumb->errstr;

my $file = 'image6';
  # try to save in one of these formats
SAVE:
for $format ( qw( png gif jpeg tiff ppm ico ) ) {
           print "try $format\n";
    # Check if given format is supported
    if ($Imager::formats{$format}) {
      $file.="_low.$format";
      print "Storing image as: $file\n";
      # documented in Imager::Files
      $thumb->write(file=>$file) or
        die $thumb->errstr;
      last SAVE;
    }
}

Добавлено через 9 минут и 7 секунд
получаю:
...
100 x 35 --- shade = 32, 36, 45, 233 ---- shade = 32, 36, 45, 112
100 x 36 --- shade = 44, 55, 66, 213 ---- shade = 44, 55, 66, 112
100 x 37 --- shade = 83, 110, 122, 199 ---- shade = 83, 110, 122, 112
100 x 38 --- shade = 110, 129, 150, 196 ---- shade = 110, 129, 150, 112
100 x 39 --- shade = 109, 131, 155, 199 ---- shade = 109, 131, 155, 112
100 x 40 --- shade = 107, 130, 155, 202 ---- shade = 107, 130, 155, 112
...
и пару новых файлов иконок, третьего же нового файла нет.

arto

Дата 4.9.2014, 12:50 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1495
Регистрация: 31.10.2004

Репутация: 38
Всего: 40

# perl -MImager -le '$a=Imager->new;$a->read(file=>$ARGV[0])or die $a->errstr;foreach(keys%Imager::formats){$a->write(file=>$ARGV[1].".$_",type => $_) or warn $a->errstr}' 14.bmp 1
# file 1.*
1.bmp:  PC bitmap, Windows 3.x format, 591 x 789 x 24
1.ft2:  empty
1.ifs:  empty
1.jpeg: JPEG image data, JFIF standard 1.01
1.png:  PNG image data, 591 x 789, 8-bit/color RGB, non-interlaced
1.pnm:  Netpbm PPM "rawbits" image data, size = 591 x 789
1.raw:  data
1.tga:  Targa image data - RGB - RLE 591 x 789
1.tiff: TIFF image data, little-endian
#

соберите сами себе Imager.

Сisa

Дата 4.9.2014, 16:20 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 179
Регистрация: 18.1.2013

Репутация: нет
Всего: нет

Н-да, соберите сами себе...

Windows XP, perl 5.14.2, activestate free:
ppm.exe :
Imager 092 - remove
Imager-1.000 - install
а дальше в списке доступных программ ни png, ни jpg для Imager.

http://search.cpan.org/~tonyc/Imager-1.000/Imager.pm
Imager-File-JPEG-0.88.tar.gz
Imager-File-PNG-0.91.tar.gz
- эти не инсталлируются.

arto

Дата 5.9.2014, 07:50 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1495
Регистрация: 31.10.2004

Репутация: 38
Всего: 40

если так необходим windowsxp, поставте виртуалку и туда линух.
там сможете собрать себе какой надо Imager.

Сisa

Дата 5.9.2014, 11:31 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 179
Регистрация: 18.1.2013

Репутация: нет
Всего: нет

я ж только учусь! линух многовато будет для начала smile

arto, спасибо!

arto

Дата 5.9.2014, 12:22 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1495
Регистрация: 31.10.2004

Репутация: 38
Всего: 40

хвост надо рубить сразу, а не кусками, как добрый хозяин.

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Perl: Общие вопросы \| Следующая тема »