Schrift
Start · Board · Anwendungen/Programme/Skripte in Perl · Graphische Oberflächen
[thread]5271[/thread]

Image::Magick -> SDL::Surface: Übertragung eines Bildes klappt nicht

Leser: 2


<< >> 2 Einträge, 1 Seite
topeg
 2006-12-18 23:10
#46041 #46041
User since
2006-07-10
2611 Artikel
BenutzerIn

user image
Möglicherweise kennt sich hier jemand besser mit der SDL Bibliothek aus, und kann mir sagen wo es bei meinem Code hakt. Ich will ein mit Image::Magick erzeugtes Bild an SDL übergeben und das mit möglichst wenig Overhead (wie zwischenspeichern, oder in irgendein komplexes Bildformat konvertieren).
Hier etwas Code:
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64

#!/usr/bin/perl
use strict;
use warnings;
use SDL;
use SDL::Surface;
use SDL::App;
use SDL::Event;
use Image::Magick;

##
# Brücke von Image::Magic nach SDL
##
sub magick_to_surface($)
{
 my ($magick)=@_;
 my $depth=8;
 my $alpha=1;
 my @data=$magick->ImageToBlob(magick=>$alpha?'RGBA':'RGB', colorspace=>'RGB', depth=>$depth);
 my $b=$magick->Get('width');
 my $h=$magick->Get('height');
 return data_to_surface($data[0],$h,$b,$alpha,$depth)
}

##
# BiteString nach SDL
##
sub data_to_surface($$$$$)
{
 my ($data,$h,$b,$alpha,$colors)=@_;
 my $c=($colors*($alpha?4:3))/8;
 return SDL::Surface->new(-from =>$data, -width=>$b, -height=>$h, -depth=>$colors, -pitch=>$b*$c);
}

##
# Defaultbild erzeugen
##
sub create_image($)
{
 my ($img) = @_;
 $img->Set(size=>'100x100');
 $img->Read('xc:none');
 $img->Draw(fill=>'black', stroke=>"black", primitive=>'circle', points=>'50,50 2,50');
 $img->Draw(fill=>'white', stroke=>"black", primitive=>'circle', points=>'50,50 5,50');
 $img->Annotate(text=> '!', stroke=>"red", fill=>"red", x=>35, y=>85, pointsize=>100, font=>"arial");
}

###################################################################

my $app = new SDL::App(-title    => "Test",
               -width    => 100,
               -height    => 100,
               -depth    => 8,
               -fullscreen => 0);

my $images = Image::Magick->new;
create_image($images);

my $test=magick_to_surface($images);

my $test_rect = new SDL::Rect( -x=>0, -y=>0, -width=>$test->width, -height=>$test->height );
$test->blit($test_rect, $app, $test_rect);

$app->sync();
$app->loop({ SDL_QUIT() => sub { exit(0); } });

Es kommt aber nur "murx" raus, Das bild wird verzerrt und nicht mit den richtigen Farben, dargestellt, ich vermute mal, daß das Bildformat des Speichrdumps der beiden Bibiotheken nicht gleich ist. Aber genauere Informationen konnte ich bisher nicht finden.
Wenn ich das selbe mit Image::Magick -> GTK versuche, dann klappt es problemlos.
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57

#!/usr/bin/perl -w
use strict;
use warnings;
use Gtk2 '-init';
use Image::Magick;

##
# Brücke von Image::Magic nach GTK2
##
sub magick_to_pixbuf($)
{
 my ($magick)=@_;
 my $depth=8;
 my $alpha=1;
 my @data=$magick->ImageToBlob(magick=>$alpha?'RGBA':'RGB', colorspace=>'RGB', depth=>$depth);
 my $b=$magick->Get('columns');
 my $h=$magick->Get('rows');
 return data_to_pixbuf($data[0],$h,$b,$alpha,$depth)
}

##
# BiteString nach GTK2
##
sub data_to_pixbuf($$$$$)
{
 my ($data,$h,$b,$alpha,$colors)=@_;
 my $c=($colors*($alpha?4:3))/8;
 return Gtk2::Gdk::Pixbuf->new_from_data ($data,'GDK_COLORSPACE_RGB',$alpha,$colors,$b,$h,$b*$c);
}

##
# Defaultbild erzeugen
##
sub create_image($)
{
 my ($img) = @_;
 $img->Set(size=>'100x100');
 $img->Read('xc:none');
 $img->Draw(fill=>'black', stroke=>"black", primitive=>'circle', points=>'50,50 2,50');
 $img->Draw(fill=>'white', stroke=>"black", primitive=>'circle', points=>'50,50 5,50');
 $img->Annotate(text=> '!', stroke=>"red", fill=>"red", x=>35, y=>85, pointsize=>100, font=>"arial");
}

###################################################################

my $images = Image::Magick->new;
create_image($images);
my $pixbuf = magick_to_pixbuf($images);

my $window = Gtk2::Window->new;
my $image = Gtk2::Image->new_from_pixbuf ($pixbuf);
$window->add($image);
$window->set_title("Test");
$window->show_all;
$window->signal_connect (delete_event => sub {Gtk2->main_quit;});
Gtk2->main;
exit(0);
topeg
 2006-12-25 00:19
#46042 #46042
User since
2006-07-10
2611 Artikel
BenutzerIn

user image
Habe den Fehler gefunden.
Anders als GTK oder ImageMagick will die SDL als "depth" (farbtiefe) nicht die Anzahl der Bits pro Farbe, sondern die Anzahl der Bits aller Farben (Alphakanal als vierte Farbe gezählt) pro Pixel. Der funktionierende Code sieht allso so aus:
Code: (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
#!/usr/bin/perl
use strict;
use warnings;
use SDL;
use SDL::Surface;
use SDL::App;
use SDL::Event;
use Image::Magick;


##
# Defaultbild erzeugen
##
sub create_image($)
{
  my ($img) = @_;
  $img->Set(size=>'100x100');
  $img->Read('xc:none');
  $img->Draw(fill=>'black', stroke=>"black", primitive=>'circle', points=>'50,50 2,50');
  $img->Draw(fill=>'white', stroke=>"black", primitive=>'circle', points=>'50,50 5,50');
  $img->Annotate(text=> '!', stroke=>"red", fill=>"red", x=>35, y=>85, pointsize=>100, font=>"arial");
}

##
# BiteString nach SDL
##
sub data_to_surface($$$$$)
{
  my ($data,$h,$b,$bit_per_color,$bytes_per_pixel)=@_;
  my $pitch=$b*$bytes_per_pixel;
  my $depth=$bit_per_color*($bytes_per_pixel/($bit_per_color/8));
  return SDL::Surface->new(-from =>$data, -width=>$b, -height=>$h, -depth=>$depth, -pitch=>$pitch);
}

##
# Brücke von Image::Magic nach SDL
##
sub magick_to_surface($)
{
  my ($magick)=@_;
  my $depth=8;
  my $alpha=1;
  my @data=$magick->ImageToBlob(magick=>$alpha?'RGBA':'RGB', colorspace=>'RGB', depth=>$depth);
  my $b=$magick->Get('width');
  my $h=$magick->Get('height');
  my $bit_per_color=$depth;
  my $bytes_per_pixel=$alpha?4:3;
  return data_to_surface($data[0],$h,$b,$bit_per_color,$bytes_per_pixel);
}

###################################################################

my $app = new SDL::App(-title    => "Test",
               -width    => 100,
               -height    => 100,
               -depth    => 8,
               -fullscreen => 0);

my $images = Image::Magick->new;
create_image($images);

my $test=magick_to_surface($images);

my $test_rect = new SDL::Rect( -x=>0, -y=>0, -width=>$test->width, -height=>$test->height );
$test->blit($test_rect, $app, $test_rect);

#$app->sync();
$app->flip();
$app->loop({ SDL_QUIT() => sub { print "EXIT\n"; exit(0); } });


Sowas können die einem doch auch sagen...
<< >> 2 Einträge, 1 Seite



View all threads created 2006-12-18 23:10.