Thread Image::Magick -> SDL::Surface: Übertragung eines Bildes klappt nicht (1 answers)
Opened by topeg at 2006-12-18 23:10

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);

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