Permalink
Browse files

Brought all packages under eye of strict, warnings and love of Carp, For

debugging help. Also removed forced die in Build of MSWin32.
  • Loading branch information...
Kartik Thakore
Kartik Thakore committed Aug 4, 2009
1 parent 686ed2c commit 084b921f85583af6a5b82572f6a561c94dd2fb5d
View
@@ -5,7 +5,8 @@
# Copyright (C) 2009 Kartik Thakore
use strict;
-
+use warnings;
+use Carp;
use lib 'make/lib';
use SDL::Build;
@@ -17,7 +18,7 @@ my $sdl_link_flags = `sdl-config --libs`;
if ($? >> 8)
{
- die "SDL doesn't appear to be installed.\n" .
+ croak "SDL doesn't appear to be installed.\n" .
"Please check that sdl-config is in your path and try again.\n";
}
View
@@ -1,10 +1,13 @@
#
# Copyright (C) 2004 David J. Goehrig
-#
+# Copyright (C) 2009 Kartik Thakore
package SDL;
use strict;
+use warnings;
+use Carp;
+
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter;
@@ -41,7 +44,7 @@ sub in {
sub verify (\%@) {
my ($options,@valid_options) = @_;
for (keys %$options) {
- die "Invalid option $_\n" unless in ($_, @valid_options);
+ croak "Invalid option $_\n" unless in ($_, @valid_options);
}
}
View
@@ -8,6 +8,8 @@
package SDL::App;
use strict;
+use warnings;
+use Carp;
use SDL;
use SDL::Event;
use SDL::Surface;
@@ -82,7 +84,7 @@ sub new {
}
my $self = \SDL::SetVideoMode($w,$h,$d,$f);
$$self
- or die SDL::GetError();
+ or croak SDL::GetError();
if ($ic and -e $ic) {
my $icon = new SDL::Surface -name => $ic;
@@ -176,7 +178,7 @@ sub attribute ($$;$) {
SDL::GLSetAttribute($mode,$value);
}
my $returns = SDL::GLGetAttribute($mode);
- die "SDL::App::attribute failed to get GL attribute" if ($$returns[0] < 0);
+ croak "SDL::App::attribute failed to get GL attribute" if ($$returns[0] < 0);
$$returns[1];
}
@@ -331,11 +333,12 @@ or OpenGL buffer if applicable. This is prefered to calling flip on the applica
C<SDL::App::attribute> allows one to set and get GL attributes. By passing a value
in addition to the attribute selector, the value will be set. C<SDL:::App::attribute>
-always returns the current value of the given attribute, or dies on failure.
+always returns the current value of the given attribute, or croaks on failure.
=head1 AUTHOR
David J. Goehrig
+Kartik Thakore
=head1 SEE ALSO
View
@@ -7,6 +7,8 @@
package SDL::Cdrom;
use strict;
+use warnings;
+use Carp;
BEGIN {
use Exporter();
@@ -21,7 +23,7 @@ sub new {
my $self;
my $number = shift;
$self = \SDL::CDOpen($number);
- die SDL::GetError() if ( SDL::CD_ERROR() eq SDL::CDStatus($$self));
+ croak SDL::GetError() if ( SDL::CD_ERROR() eq SDL::CDStatus($$self));
bless $self,$class;
return $self;
}
View
@@ -7,6 +7,8 @@
package SDL::Color;
use strict;
+use warnings;
+use Carp;
use SDL;
sub new {
@@ -24,7 +26,7 @@ sub new {
if ($options{-color}) {
$self = \$options{-color};
} elsif ($options{-pixel} && $options{-surface}) {
- die "SDL::Color::new requires an SDL::Surface"
+ croak "SDL::Color::new requires an SDL::Surface"
unless !$SDL::DEBUG || $options{-surface}->isa("SDL::Surface");
$self = \SDL::NewColor(SDL::GetRGB(${$options{-surface}}, $options{-pixel}));
} else {
@@ -34,7 +36,7 @@ sub new {
push @color, $options{-blue} || $options{-b} || 0;
$self = \SDL::NewColor(@color);
}
- die "Could not create color, ", SDL::GetError(), "\n"
+ croak "Could not create color, ", SDL::GetError(), "\n"
unless ($$self);
bless $self, $class;
}
@@ -64,7 +66,7 @@ sub rgb {
}
sub pixel {
- die "SDL::Color::pixel requires an SDL::Surface"
+ croak "SDL::Color::pixel requires an SDL::Surface"
unless !$SDL::DEBUG || $_[1]->isa("SDL::Surface");
SDL::MapRGB(${$_[1]},$_[0]->r(),$_[0]->g(),$_[0]->b());
}
View
@@ -5,6 +5,8 @@
package SDL::Cursor;
use strict;
+use warnings;
+use Carp;
sub new {
my $proto = shift;
View
@@ -9,6 +9,9 @@
package SDL::Event;
use strict;
+use warnings;
+use Carp;
+
use SDL;
sub new {
View
@@ -7,6 +7,8 @@
package SDL::Font;
use strict;
+use warnings;
+use Carp;
use SDL;
use SDL::SFont;
use SDL::Surface;
View
@@ -8,6 +8,8 @@
package SDL::MPEG;
use strict;
+use warnings;
+use Carp;
use SDL;
sub new {
@@ -19,7 +21,7 @@ sub new {
my $self;
if ( $options{-from} ) {
- die "SDL::MPEG::new -from requires a SDL::Video object\n"
+ croak "SDL::MPEG::new -from requires a SDL::Video object\n"
unless $options{-from}->isa('SDL::Video');
$self = \SDL::SMPEGGetInfo(${$options{-from}});
View
@@ -7,6 +7,9 @@
package SDL::Mixer;
use strict;
+use warnings;
+use Carp;
+
use SDL;
use SDL::Sound;
use SDL::Music;
@@ -27,7 +30,7 @@ sub new {
my $size = $options{-size} || 4096;
unless ( $SDL::Mixer::initialized ) {
SDL::MixOpenAudio($frequency,$format,$channels,$size ) &&
- die SDL::GetError();
+ croak SDL::GetError();
$SDL::Mixer::initialized = 1;
} else {
++$SDL::Mixer::initialized;
View
@@ -6,6 +6,8 @@
package SDL::Music;
use strict;
+use warnings;
+use Carp;
use SDL;
sub new {
View
@@ -7,6 +7,10 @@
package SDL::OpenGL;
+use strict;
+use warnings;
+use Carp;
+
require Exporter;
require DynaLoader;
use vars qw(
@@ -18,6 +22,7 @@ use vars qw(
use SDL;
use SDL::OpenGL::Constants;
+
bootstrap SDL::OpenGL;
for ( keys %SDL::OpenGL:: ) {
if (/^gl/) {
View
@@ -7,6 +7,8 @@
package SDL::Palette;
use strict;
+use warnings;
+use Carp;
# NB: there is no palette destructor because most of the time the
# palette will be owned by a surface, so any palettes you create
View
@@ -7,6 +7,8 @@
package SDL::Rect;
use strict;
+use warnings;
+use Carp;
use SDL;
sub new {
View
@@ -7,7 +7,8 @@
package SDL::Sound;
use strict;
-
+use warnings;
+use Carp;
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
View
@@ -8,6 +8,8 @@
package SDL::Surface;
use strict;
+use warnings;
+use Carp;
use SDL;
use SDL::SFont;
use SDL::Color;
@@ -47,7 +49,7 @@ sub new {
$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;
@@ -130,17 +132,17 @@ sub pixels {
}
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]}) :
new SDL::Color -color => SDL::SurfacePixel(${$_[0]},$_[1],$_[2]);
}
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]});
@@ -165,7 +167,7 @@ sub update {
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');
}
}
@@ -178,10 +180,10 @@ sub flip {
sub blit {
if ($SDL::DEBUG) {
- die "SDL::Surface::blit requires SDL::Rect objects"
+ 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 ? ${$_} : $_ } @_);
@@ -191,14 +193,14 @@ 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]});
}
View
@@ -8,6 +8,8 @@
package SDL::TTFont;
use strict;
+use warnings;
+use Carp;
use SDL;
use SDL::Surface;
@@ -27,15 +29,15 @@ sub new {
$self->{-fg} = $options{-foreground} || $options{-fg} || $SDL::Color::black;
$self->{-bg} = $options{-background} || $options{-bg} || $SDL::Color::white;
- die "SDL::TTFont::new requires a -name\n"
+ croak "SDL::TTFont::new requires a -name\n"
unless ($$self{-name});
- die "SDL::TTFont::new requires a -size\n"
+ croak "SDL::TTFont::new requires a -size\n"
unless ($$self{-size});
$self->{-font} = SDL::TTFOpenFont($self->{-name},$self->{-size});
- die "Could not open font $$self{-name}, ", SDL::GetError(), "\n"
+ croak "Could not open font $$self{-name}, ", SDL::GetError(), "\n"
unless ($self->{-font});
bless $self,$class;
@@ -51,15 +53,15 @@ sub DESTROY {
sub print {
my ($self,$surface,$x,$y,@text) = @_;
- die "Print requies an SDL::Surface"
+ croak "Print requies an SDL::Surface"
unless( ref($surface) && $surface->isa("SDL::Surface") );
SDL::FreeSurface($self->{-surface}) if ($$self{-surface});
$$self{-surface} = SDL::TTFPutString($$self{-font},$$self{-mode},
$$surface,$x,$y,${$$self{-fg}},${$$self{-bg}},join("",@text));
- die "Could not print \"", join("",@text), "\" to surface, ",
+ croak "Could not print \"", join("",@text), "\" to surface, ",
SDL::GetError(), "\n" unless ($$self{-surface});
}
@@ -150,7 +152,7 @@ sub unicode_blended {
$$self{-mode} = UNICODE_BLENDED();
}
-die "Could not initialize True Type Fonts\n"
+croak "Could not initialize True Type Fonts\n"
if ( SDL::TTFInit() < 0);
1;
Oops, something went wrong.

0 comments on commit 084b921

Please sign in to comment.