From: Kartik Thakore Date: Tue, 8 Sep 2009 16:19:34 +0000 (-0400) Subject: Using new Rect with v2.2.2.11. Had to change getClipRect paramters. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e4ab5b2e8635df41fd14c9e92e2c3ec7277bda0a;p=sdlgit%2FSDL_perl.git Using new Rect with v2.2.2.11. Had to change getClipRect paramters. --- diff --git a/Build.PL b/Build.PL index 5ccc4e3..e452cf3 100755 --- 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', diff --git a/lib/SDL/Config.pm b/lib/SDL/Config.pm index 8ca726b..354975c 100644 --- a/lib/SDL/Config.pm +++ b/lib/SDL/Config.pm @@ -2,6 +2,12 @@ package SDL::Config; my $sdl_config; $sdl_config = { + 'Rect' => { + 'SDL' => [ + '/usr/include/SDL', + '/usr/lib' + ] + }, 'OpenGL' => { 'GL' => [ '/usr/include/GL', diff --git a/lib/SDL/Rect.pm b/lib/SDL/Rect.pm index d31055e..d8aedf5 100644 --- a/lib/SDL/Rect.pm +++ b/lib/SDL/Rect.pm @@ -1,166 +1,71 @@ -#!/usr/bin/env perl -# -# Rect.pm -# -# Copyright (C) 2005 David J. Goehrig -# -# ------------------------------------------------------------------------------ -# -# 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 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__ diff --git a/src/SDL.xs b/src/SDL.xs index 07b3d0b..09c2dbd 100644 --- a/src/SDL.xs +++ b/src/SDL.xs @@ -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 diff --git a/t/rectpm.t b/t/rectpm.t index 58a183e..2414ec2 100644 --- a/t/rectpm.t +++ b/t/rectpm.t @@ -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 --- 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; + } + +