All surfaces constructed from now on are attached to the $display. There are two constructors available to do this.
my $surface = SDL::Surface->new ( ... );
- my $surface2 = SDL::Surface->new_from ( ... );
+ my $surface2 = SDL::Surface->new_from ( surface, ... );
=head1 DESCRIPTION
=head2 new ( flags, width, height, depth, Rmask, Gmask, Bmask, Amask )
-The constructor creates a new surface with the specified x, y, w, h
-values:
+The constructor creates a new surface with the specified parameter values.
my $surface = SDL::Surface->new( ... );
+=head2 new_from ( surface, width, height, depth, Rmask, Gmask, Bmask, Amask )
+
+The constructor creates a new surface with the specified parameter values.
+
+ my $surface = SDL::Surface->new_from( $old_surface, ... );
+
+THIS WILL SEGFAULT!!! Read: http://sdlperl.ath.cx/projects/SDLPerl/ticket/53
+
+=head3 Construtor Parameters
+
+
+
=head2 w
SDL::Surface width are defined at construction. Thus the following is read only.
SDL_Surface *
surface_new_from (CLASS, pixels, width, height, depth, pitch, Rmask, Gmask, Bmask, Amask )
- char *CLASS
- char *pixels
+ char* CLASS
int width
int height
int depth
Uint32 Gmask
Uint32 Bmask
Uint32 Amask
+ IV pixels
CODE:
- void* pixeldata;
- int len = pitch * height;
- Newx(pixeldata,len,Uint8);
- Copy(pixels,pixeldata,len,Uint8);
- RETVAL = SDL_CreateRGBSurfaceFrom ( pixeldata, width, height,
- depth, pitch, Rmask, Gmask, Bmask, Amask );
+ warn ("USING THIS WILL CAUSE YOUR CODE TO SEGFAULT ON EXIT! \n READ: http://sdlperl.ath.cx/projects/SDLPerl/ticket/53");
+ void *p = INT2PTR(void*, pixels);
+ RETVAL = SDL_CreateRGBSurfaceFrom ( p, width, height, depth, pitch, Rmask, Gmask, Bmask, Amask );
+ if( RETVAL == NULL)
+ croak ("SDL_CreateRGBSurfaceFrom failed: %s", SDL_GetError());
+
OUTPUT:
RETVAL
-
SDL_PixelFormat *
surface_format ( surface )
SDL_Surface *surface
use SDL::Color;
use SDL::Video;
use SDL::PixelFormat;
-use Test::More tests => 37;
+use Test::More tests => 36;
my $surface
= SDL::Surface->new( SDL::SDL_ANYFORMAT(), 640, 320, 8, 0, 0, 0, 0 );
- #TODO: test SDL::Surface->new_from
isa_ok( $surface, 'SDL::Surface' );
is( $surface->w, 640, 'surface has width' );
is( $surface->h, 320, 'surface has height' );
diag( 'This is in surface : ' . SDL::Surface::get_pixels($app) );
+SKIP:
+{
+ skip('new_form is segfaulting on DESTROY of created surface. Read: http://sdlperl.ath.cx/projects/SDLPerl/ticket/53', 1);
-pass 'did this pass';
+my $other_surface = SDL::Surface->new_from( $surface->get_pixels, 640, 320, 8, $surface->pitch, 0, 0, 0, 0 );
+
+isa_ok( $other_surface, 'SDL::Surface' );
+
+$surface->DESTROY();
+$other_surface->DESTROY();
+
+}
+pass 'Final SegFault test';
SDL::delay(100);
+
+