Извлечение пикселей из картинки при помощи ImageMagick и показ картинки в виждете gtk2-perl.

Gtk2-perl позволяет получить доступ к пикселям при помощи функции get_pixels, которая возвращает 16-ти битную строку пикселей длины w*h*3 для RGB изображения. Единственное неудобство в том, что функции для работы с изображениями Gtk2-perl понимают несколько форматов картинок, а ImageMagick позволяет работать с более чем 90 форматами изображений. Функция Gtk2::Gdk::Pixbuf->new_from_data может из строки в 16-тиричном формате выстраивать картинку. Значит для этого надо открыть картинку, прочитать пикселы и затем сформировать и передать в perl соответствующую строку при помощи библиотеки ImageMagick.

Для начала необходимо написать программу на c, после чего уже писать соответствующий XS-модуль. Программа выглядит как-то так:

#include <stdlib.h>
#include <stdio.h>
#include <string.h>
// подключить API ImageMagick

#include <magick/api.h>

int main(int argc,char **argv) {

//Воспользоваться внутренними типами IM
  ExceptionInfo
      exception;
  Image
      *image;
  ImageInfo

      *image_info;
  PixelPacket 
      *pixels;
  ViewInfo 
      *vinfo;

  int i,j,w,h;
// Инициализировать структуру image info и прочитать изображение
  InitializeMagick(*argv);

// установить обработку событий типа ReadError и т.п.
  GetExceptionInfo(&exception);
// сделлать копию структуры image info
  image_info=CloneImageInfo((ImageInfo *) NULL);

// скопировать в структуру имя файла
  (void)strcpy(image_info->filename,"image.gif");
// прочитать картинку, попутно отработав эксепшены &exception 
  image=ReadImage(image_info,&exception);

  if (image == (Image *) NULL) {

// в случае ошибки
    fprintf(stderr, "readFileMagick: %s: %s\n",
    exception.reason,exception.description);

// MagickError(exception.severity,exception.reason,exception.description);

    return -1;
  }
// открыть открыть просмотр кеша пикселей
  vinfo = OpenCacheView(image);

  pixels = GetCacheView(vinfo, 0,0,image->columns,image->rows);

  if(!pixels) {
    fprintf(stderr, "readFileMagick: ошибка чтения кеша пикселей.\n"); 
    return(-1);

  }
  h = image->columns; //ширина по горизонтали (число столбцов картинки)

  w = image->rows;    //высота по вертикали   (число строк картинки)
// вывести значения пикселов по трем каналам
  for (i = 0; i <= w-1; i++) {

    for (j = 0; j <= h-1; j++) {

      printf("%d ",(int)255*pixels[j+h*i].blue/65535);

      printf("%d ",(int)255*pixels[j+h*i].green/65535);

      printf("%d\n",(int)255*pixels[j+h*i].red/65535);

    }
  }
// закрыть и уничтожить все
  CloseCacheView(vinfo);
  DestroyImageInfo(image_info);

  DestroyImage(image);
  return(0);
}

    setenv LD_LIBRARY_PATH /usr/local/lib
    gcc `Magick-config --cflags --cppflags` pixels.c `Magick-config --ldflags --libs`

SV*
pixs (SV * fn, int k)
  INIT:
       unsigned char * lfn;
       STRLEN l;  /* STRLEN is a certain type of int */
       /* ... */
  CODE:
       lfn = SvPV (fn, l); 

В целом, на XS вышеприведенная программа выглядит таким образом:

#include "EXTERN.h"

#include "perl.h"
#include "XSUB.h"
// string.h нужен для функции strcpy
#include <string.h>
// на всякий случай, для матобработкию. если таковая будет, чтобы не писать при компиляции -lm
#include <math.h>
// для ImageMagick
#include <magick/api.h>

#include "ppport.h"
// определить название модуля, необходимого далее для инициализации ImageMagick
#define PackageName "Pixels"
// название модуля и пакетов
MODULE = Pixels		PACKAGE = Pixels		

// отключить прототипы, о(see perldoc perlxs)
PROTOTYPES: DISABLE
// Инициализировать ImageMagick (see perldoc perlxs)
BOOT:
  InitializeMagick(PackageName);

// скаляр (see perldoc perlguts), функции передаются на вход два параметра,
// имя файла и что-то еще. Тип передаваемых параметров определяется только десь
SV*
pixs(SV *fn, int k)

  INIT:
//Воспользоваться внутренними типами IM
        ExceptionInfo
          exception;
        Image
          *image;

        ImageInfo
          *info,
          *image_info;
        PixelPacket
          *pixels;

        ViewInfo
          *vinfo;
// определить двумерные массивы для хранения пикселов
        int **sm,**sym,i,j;

// переменные для имени  файла и возвращаемого значения пикселов
        unsigned char * lfn, * number;
// определение STRLEN находится в файле config.h (perldoc perlguts)
        STRLEN t; 

// определение типа данных для хеша и для массива *только для XSUBs* (perldoc perlguts)
        HV* hash = newHV(); 
        AV* array = newAV();

  CODE:
// присваивание имени, впрочем, это описано в perldoc perlguts
        lfn = SvPV (fn,t);

// установить обработку событий типа ReadError и т.п.
        GetExceptionInfo(&exception);
// сделлать копию структуры image info
        image_info=CloneImageInfo((ImageInfo *) NULL);

// скопировать в структуру имя файла
        strcpy(image_info->filename, lfn);
// прочитать картинку, попутно отработав эксепшены &exception 
        image=ReadImage(image_info,&exception);

// в случае ошибки
        if (image == (Image *) NULL) {     
          fprintf(stderr, "readFileMagick: %s: %s\n",
          exception.reason,exception.description);

        }
// открыть просмотр кеша пикселей
        vinfo = OpenCacheView(image);
        pixels = GetCacheView(vinfo, 0,0,image->columns,image->rows);

        int h=image->columns; //ширина по горизонтали (число столбцов)
        int w=image->rows;    //высота по вертикали   (число строк)

// занести данные о высоте и ширине картинки в массив, который будет
// сопоставлен с ключом хеша arr
        av_push(array, newSVnv(h));
        av_push(array, newSVnv(w));

        int small=w*h*3;
// выделение памяти для строки возвращаемых пикселов, длина строки должна
// быть равна определенной выше small.
        number=malloc(small*sizeof(*number));

// отработка ошибки, если возникнут проблемы с pixels
        if(!pixels) {
          fprintf(stderr, "readFileMagick: unable to get pixel cache.\n");

        }
// выделение памяти для двумерных массивово
        sm = malloc(w * sizeof(*sm));

        for (i=0; i<w; ++i){

          sm[i] = malloc ( h * sizeof(**sm));

        }
        sym = malloc(w * sizeof(*sym));

        for (i=0; i<w; ++i){

          sym[i] = malloc ( h * sizeof(**sym));

        }
// заполнение массива пикселей для дальнейшей обработки
        for (i=0; i<=w-1; i++) {

          for (j=0; j<=h-1; j++) {

            sm[i][j]=(int)255*pixels[j+h*i].blue/65535;

            sym[i][j]=sm[i][j];

          }
        }
// математическая обработка пикселей, алгоритм подробно описан здесь и  здесь немного
        for (i=k; i<=w-1-k; i++){

          for (j=k; j<=h-1-k; j++){

            int summ=0;
            int ii,jj;
            for (ii=-k; ii<=k; ii++){

              for (jj=-k; jj<=k; jj++) summ+=sm[i+ii][j+jj];

            }
            sym[i][j]=(int)summ/((2*k+1)*(2*k+1));

          }
        }
        int count=0;
// заполнение массива пикселей, которые будут возвращаться в perl-программу по ключу хеша uns
        for (i=0; i<=w-1; i++){

          for (j=0; j<=h-1; j++){

            number[count]=(unsigned char)sym[i][j];

            count++;
            number[count]=(unsigned char)sym[i][j];

            count++;
            number[count]=(unsigned char)sym[i][j];

            count++;
          }
//освободить память из под массивов 
          free (sm[i]);

          free (sym[i]);
        }
        free(sm);

        free(sym);
// закрыть и уничтожить все
        CloseCacheView(vinfo);
        DestroyImageInfo(image_info);

        DestroyImage(image);
// добавить в значение хеша массив
        hv_store(hash, "arr",3,(SV*)array, 0);

// добавить в значение хеша строку unsigned char, которая ассоциируется с ключем uns
// четвертым параметром идет выделение памяти для переменной number
        hv_store(hash, "uns",3, newSVpv ((unsigned char*) number, small*sizeof(number[0])), 0);

        free(number);
      RETVAL = newRV_noinc((SV*) hash);

// прагма (?) RETVAL возвращает ссылку на хеш (perldoc perlguts).
  OUTPUT:
      RETVAL

[vilfred@mobile100 xxx]$ h2xs -A -n Pixels
Defaulting to backwards compatibility with perl 5.8.3
If you intend this module to be compatible with earlier perl versions,
please
specify a minimum perl version with the -b option.

Writing Pixels/ppport.h
Writing Pixels/lib/Pixels.pm
Writing Pixels/Pixels.xs
Writing Pixels/Makefile.PL
Writing Pixels/README
Writing Pixels/t/Pixels.t
Writing Pixels/Changes
Writing Pixels/MANIFEST
[vilfred@mobile100 xxx]$

    LIBS              => ['-L/usr/lib -lMagick -L/usr/X11R6/lib -lfreetype -lz \
-L/usr/lib -ltiff -lfreetype -ljpeg -lXext -lSM -lICE -lX11 -lXt \
-lbz2 -lz -lpthread -lm -lpthread'], # e.g., '-lm'

После этого вносятся соответствующие правки в текст Pixels.xs и далее идут команды perl Makefile.PL, make и make test. Т.к. модуль Pixels.pm не установлен (не было команды make install), то необходимо вновь написанный модуль каким-то образом вызвать в perl-скрипте. Nick Ing-Simmons написал библиотеку blib (perldoc blib), которая находит необходимый модуль.

Соответствующий perl-код такой,(с подсвеченным синтаксисом html). Вобщем, что то в этом роде...

samolet | Предыдущая | Извлечение пикселей | to be continued...

]]>