Using new Rect with v2.2.2.11. Had to change getClipRect paramters.
Kartik Thakore [Tue, 8 Sep 2009 16:19:34 +0000 (12:19 -0400)]
Build.PL
lib/SDL/Config.pm
lib/SDL/Rect.pm
src/SDL.xs
t/rectpm.t
typemap

index 5ccc4e3..e452cf3 100755 (executable)
--- a/Build.PL
+++ b/Build.PL
@@ -41,6 +41,14 @@ my %subsystems =
                libraries => [qw( SDL SDL_image SDL_mixer SDL_net SDL_ttf SDL_gfx
                                  png jpeg smpeg )],
        },
+       Rect => {
+               file      => {
+                       from  => 'src/Rect.xs',
+                       to    => 'lib/SDL/Rect.xs',
+               },
+               libraries => [qw( SDL  )],
+       },
+       
        OpenGL => {
                file      => {
                        from => 'src/OpenGL.xs',
index 8ca726b..354975c 100644 (file)
@@ -2,6 +2,12 @@ package SDL::Config;
 
 my $sdl_config; 
 $sdl_config = {
+                'Rect' => {
+                            'SDL' => [
+                                       '/usr/include/SDL',
+                                       '/usr/lib'
+                                     ]
+                          },
                 'OpenGL' => {
                               'GL' => [
                                         '/usr/include/GL',
index d31055e..d8aedf5 100644 (file)
-#!/usr/bin/env perl
-#
-# Rect.pm
-#
-# Copyright (C) 2005 David J. Goehrig <dgoehrig@cpan.org>
-#
-# ------------------------------------------------------------------------------
-#
-# This library is free software; you can redistribute it and/or
-# modify it under the terms of the GNU Lesser General Public
-# License as published by the Free Software Foundation; either
-# version 2.1 of the License, or (at your option) any later version.
-# 
-# This library is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-# Lesser General Public License for more details.
-# 
-# You should have received a copy of the GNU Lesser General Public
-# License along with this library; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
-#
-# ------------------------------------------------------------------------------
-#
-# Please feel free to send questions, suggestions or improvements to:
-#
-#      David J. Goehrig
-#      dgoehrig@cpan.org
-#
-
 package SDL::Rect;
+#use strict;
 
-use strict;
-use warnings;
-use SDL;
-
-sub new {
-       my $proto = shift;
-       my $class = ref($proto) || $proto;
-       my %options = @_;
 
-       verify (%options, qw/ -x -y -top -left -width -height -w -h / ) if $SDL::DEBUG;
+require Exporter;
+require DynaLoader;
 
-       my $x = $options{-x}            || $options{-left}  || 0;
-       my $y = $options{-y}            || $options{-top}   || 0;
-       my $w = $options{-width}        || $options{-w}         || 0;
-       my $h = $options{-height}       || $options{-h}         || 0;
+@ISA = qw(Exporter DynaLoader);
+# Items to export into callers namespace by default. Note: do not export
+# names by default without a very good reason. Use EXPORT_OK instead.
+# Do not simply export all your public functions/methods/constants.
+@EXPORT = qw(
        
-       my $self = \SDL::NewRect($x,$y,$w,$h);
-       unless ($$self) {
-           require Carp;
-           Carp::croak SDL::GetError();
-       }
-       bless $self,$class;
-       return $self;
-}
+);
+#$VERSION = '0.01';
 
-sub DESTROY {
-       SDL::FreeRect(${$_[0]});
-}
+bootstrap SDL::Rect;
+
+# Preloaded methods go here.
 
 # TODO: mangle with the symbol table to create an alias
 # to sub x. We could call x from inside the sub but that
 # would be another call and rects are a time-critical object.
 sub left {
        my $self = shift;
-       SDL::RectX($$self,@_);
+       RectX($self,@_);
 }
 
 sub x {
        my $self = shift;
-       SDL::RectX($$self,@_);
+       RectX($self,@_);
 }
 
 ### TODO: see 'left' above (this is an 'alias' to sub y)
 sub top {
        my $self = shift;
-       SDL::RectY($$self,@_);
+       RectY($self,@_);
 }
 
 sub y {
        my $self = shift;
-       SDL::RectY($$self,@_);
+       RectY($self,@_);
 }
 
 ### TODO: see 'left' above (this is an 'alias' to sub width)
 sub w {
        my $self = shift;
-       SDL::RectW($$self,@_);
+       RectW($self,@_);
 }
 
 sub width {
        my $self = shift;
-       SDL::RectW($$self,@_);
+       RectW($self,@_);
 }
 
 ### TODO: see 'left' above (this is an 'alias' to sub height)
 sub h {
        my $self = shift;
-       SDL::RectH($$self,@_);
+       RectH($self,@_);
 }
 
 sub height {
        my $self = shift;
-       SDL::RectH($$self,@_);
+       RectH($self,@_);
 }
 
-1;
-
-__END__;
-
-=head1 NAME
-
-SDL::Rect - raw object for storing rectangular coordinates
-
-=head1 SYNOPSIS
-
-  my $rect = SDL::Rect->new( -height => 4, -width => 40 );
-  
-  $rect->x(12);  # same as $rect->left(12)
-  $rect->y(9);   # same as $rect->top(9)
-
-=head1 DESCRIPTION
-
-C<SDL::Rect::new> creates a SDL_Rect structure which is
-used for specifying regions of pixels for filling, blitting, and updating.
-These objects make it easy to cut and backfill.
-
-By default, x, y, height and width are all set to 0.
-
-=head2 METHODS 
-
-The four fields of a rectangle can be set simply
-by passing a value to the applicable method.  These are:
 
-=head3 x
+# Autoload methods go after __END__, and are processed by the autosplit program.
 
-=head3 left
-
-sets and fetches the x (lefmost) position of the rectangle.
-
-=head3 y
-
-=head3 top
-
-sets and fetches the y (topmost) position.
-
-=head3 w
-
-=head3 width
-
-sets and fetches the width of the rectangle (in pixels).
-
-=head3 h
-
-=head3 height 
-
-sets and fetches the height of the rectangle (in pixels).
-
-=head1 AUTHOR
-
-David J. Goehrig
-
-=head1 SEE ALSO
-
-perl(1) SDL::Surface(3)
+1;
+__END__
index 07b3d0b..09c2dbd 100644 (file)
@@ -1205,63 +1205,6 @@ VideoInfo ()
        OUTPUT:
                RETVAL
 
-SDL_Rect *
-NewRect ( x, y, w, h )
-       Sint16 x
-       Sint16 y
-       Uint16 w
-       Uint16 h
-       CODE:
-               RETVAL = (SDL_Rect *) safemalloc (sizeof(SDL_Rect));
-               RETVAL->x = x;
-               RETVAL->y = y;
-               RETVAL->w = w;
-               RETVAL->h = h;
-       OUTPUT:
-               RETVAL
-
-void
-FreeRect ( rect )
-       SDL_Rect *rect
-       CODE:
-               safefree(rect);
-
-Sint16
-RectX ( rect, ... )
-       SDL_Rect *rect
-       CODE:
-               if (items > 1 ) rect->x = SvIV(ST(1)); 
-               RETVAL = rect->x;
-       OUTPUT:
-               RETVAL
-
-Sint16
-RectY ( rect, ... )
-       SDL_Rect *rect
-       CODE:
-               if (items > 1 ) rect->y = SvIV(ST(1)); 
-               RETVAL = rect->y;
-       OUTPUT:
-               RETVAL
-
-Uint16
-RectW ( rect, ... )
-       SDL_Rect *rect
-       CODE:
-               if (items > 1 ) rect->w = SvIV(ST(1)); 
-               RETVAL = rect->w;
-       OUTPUT:
-               RETVAL
-
-Uint16
-RectH ( rect, ... )
-       SDL_Rect *rect
-       CODE:
-               if (items > 1 ) rect->h = SvIV(ST(1)); 
-               RETVAL = rect->h;
-       OUTPUT:
-               RETVAL
-
 AV*
 ListModes ( format, flags )
        Uint32 flags
@@ -2543,14 +2486,12 @@ SetClipRect ( surface, rect )
        CODE:
                SDL_SetClipRect(surface,rect);
        
-SDL_Rect*
-GetClipRect ( surface )
+void
+GetClipRect ( surface, rect )
        SDL_Surface *surface
+       SDL_Rect *rect;
        CODE:
-               RETVAL = (SDL_Rect*) safemalloc(sizeof(SDL_Rect));
-               SDL_GetClipRect(surface,RETVAL);
-       OUTPUT:
-               RETVAL
+               SDL_GetClipRect(surface, rect);
 
 
 #ifdef HAVE_SDL_NET
index 58a183e..2414ec2 100644 (file)
@@ -58,7 +58,7 @@ can_ok ('SDL::Rect', qw/
 my $rect = SDL::Rect->new();
 
 # creating with defaults
-is (ref($rect),'SDL::Rect','new went ok');
+isa_ok ($rect,'SDL::Rect');
 is ($rect->x(), 0, 'x is 0');
 is ($rect->y(), 0, 'y is 0');
 is ($rect->top(), 0, 'top is 0');
diff --git a/typemap b/typemap
index 572311b..12a35fa 100644 (file)
--- a/typemap
+++ b/typemap
@@ -19,7 +19,7 @@ SDL_SysWMmsg *                T_PTR
 SDL_CD *               T_PTR
 SDL_CDtrack *          T_PTR
 SDL_TimerCallback      T_PTR
-SDL_Rect *             T_PTR
+SDL_Rect *             O_OBJECT
 SDL_Color *            T_PTR
 SDL_Palette *          T_PTR
 SDL_PixelFormat *      T_PTR
@@ -69,3 +69,23 @@ Sound_Sample *               T_PTR
 Sound_AudioInfo *      T_PTR
 SDL_RWops*             T_PTR
 SDL_svg_context*       T_PTR
+
+OUTPUT
+
+# The Perl object is blessed into 'CLASS', which should be a
+# char* having the name of the package for the blessing.
+O_OBJECT
+       sv_setref_pv( $arg, CLASS, (void*)$var );
+
+
+INPUT
+
+O_OBJECT
+       if( sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVMG) )
+               $var = ($type)SvIV((SV*)SvRV( $arg ));
+       else{
+               warn( \"${Package}::$func_name() -- $var is not a blessed SV reference\" );
+               XSRETURN_UNDEF;
+       }
+
+