+#!/usr/bin/env perl
+#
+# Surface.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.
#
-# Surface.pm
+# 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:
#
-# A package for manipulating SDL_Surface *
+# David J. Goehrig
+# dgoehrig@cpan.org
#
-# Copyright (C) 2003 David J. Goehrig
package SDL::Surface;
use strict;
+use warnings;
+use Carp;
use SDL;
use SDL::SFont;
use SDL::Color;
$self = \SDL::CreateRGBSurface($f,$w,$h,$d,$r,$g,$b,$a);
}
}
- die "SDL::Surface::new failed. ", SDL::GetError()
+ croak "SDL::Surface::new failed. ", SDL::GetError()
unless ( $$self);
bless $self,$class;
return $self;
}
sub pixel {
- die "SDL::Surface::pixel requires a SDL::Color"
+ croak "SDL::Surface::pixel requires a SDL::Color"
if $_[3] && $SDL::DEBUG && !$_[3]->isa("SDL::Color");
$_[3] ?
new SDL::Color -color => SDL::SurfacePixel(${$_[0]},$_[1],$_[2],${$_[3]}) :
}
sub fill {
- die "SDL::Surface::fill requires a SDL::Rect object"
+ croak "SDL::Surface::fill requires a SDL::Rect object"
unless !$SDL::DEBUG || $_[1] == 0 || $_[1]->isa('SDL::Rect');
- die "SDL::Surface::fill requires a SDL::Color object"
+ croak "SDL::Surface::fill requires a SDL::Color object"
unless !$SDL::DEBUG || $_[2]->isa('SDL::Color');
if ($_[1] == 0 ) {
SDL::FillRect(${$_[0]},0,${$_[2]});
my $self = shift;;
if ($SDL::DEBUG) {
for (@_) {
- die "SDL::Surface::update requires SDL::Rect objects"
+ croak "SDL::Surface::update requires SDL::Rect objects"
unless $_->isa('SDL::Rect');
}
}
sub blit {
if ($SDL::DEBUG) {
- die "SDL::Surface::blit requires SDL::Rect objects"
+ carp "/n SDL::Surface::blit accepting undef is depreceated use SDL::NULL" if ( !defined($_[1]) || !defined($_[3]) );
+ croak "SDL::Surface::blit requires SDL::Rect objects"
unless ($_[1] == 0 || $_[1]->isa('SDL::Rect'))
&& ($_[3] == 0 || $_[3]->isa('SDL::Rect'));
- die "SDL::Surface::blit requires SDL::Surface objects"
+ croak "SDL::Surface::blit requires SDL::Surface objects"
unless $_[2]->isa('SDL::Surface');
}
- SDL::BlitSurface(map { $_ != 0 ? ${$_} : $_ } @_);
+
+ $_[1] = 0 unless defined $_[1];
+ $_[3] = 0 unless defined $_[3];
+ SDL::BlitSurface(map { (defined($_) && $_ != 0)? ${$_} : $_ } @_) if defined(@_);
}
sub set_colors {
my $self = shift;
my $start = shift;
for (@_) {
- die "SDL::Surface::set_colors requires SDL::Color objects"
+ croak "SDL::Surface::set_colors requires SDL::Color objects"
unless !$SDL::DEBUG || $_->isa('SDL::Color');
}
return SDL::SetColors($$self, $start, map { ${$_} } @_);
}
sub set_color_key {
- die "SDL::Surface::set_color_key requires a SDL::Color object"
+ croak "SDL::Surface::set_color_key requires a SDL::Color object"
unless !$SDL::DEBUG || (ref($_[2]) && $_[2]->isa('SDL::Color'));
SDL::SetColorKey(${$_[0]},$_[1],${$_[2]});
}