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

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...

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