Fixed up new_from. It is usable but it cause wierd XS behaviour so we don't recommend...
Kartik Thakore [Wed, 4 Nov 2009 16:36:18 +0000 (11:36 -0500)]
lib/pods/SDL/Surface.pod
src/Core/objects/Surface.xs
t/core_surface.t

index ff53dd5..8b9a8e8 100644 (file)
@@ -17,7 +17,7 @@ The main surface (display) is provided by L<SDL::Video::set_video_mode>.
 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
 
@@ -27,11 +27,22 @@ An C<SDL_Surface> defines a surfaceangular area of pixels.
 
 =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. 
index 640791f..f8ae399 100644 (file)
@@ -47,8 +47,7 @@ surface_new (CLASS, flags, width, height, depth, Rmask, Gmask, Bmask, Amask )
 
 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
@@ -57,18 +56,18 @@ surface_new_from (CLASS, pixels, width, height, depth, pitch, Rmask, Gmask, Bmas
        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
index 6224818..ca0e2f9 100644 (file)
@@ -17,11 +17,10 @@ use SDL::Rect;
 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' );
@@ -98,7 +97,20 @@ SDL::Video::update_rects( $app, $small_rect );
 
 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);
+
+