From: Kartik Thakore Date: Wed, 28 Oct 2009 20:45:12 +0000 (-0400) Subject: Clean up X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=sdlgit%2FSDL_perl.git;a=commitdiff_plain;h=3b4e65f3cf6ca7563fbb7918b59ae04e0dee5203 Clean up --- diff --git a/lib/SDL/Surface.pm b/lib/SDL/Surface.pm index 0d58261..752b0ba 100644 --- a/lib/SDL/Surface.pm +++ b/lib/SDL/Surface.pm @@ -9,577 +9,5 @@ bootstrap SDL::Surface; 1; __END__ - -#!/usr/bin/env perl -# -# Surface.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::Surface; - -use strict; -use warnings; -use Carp; -use SDL; -use SDL::SFont; -use SDL::Color; -use SDL::Rect; -use Data::Dumper; -sub new { - my $proto = shift; - my $class = ref($proto) || $proto; - my %options = @_; - my $self; - - verify (%options, qw/ -name -n -flags -fl -width -w -height -h -depth -d - -pitch -p -Rmask -r -Gmask -g -Bmask -b -Amask -a - -from -f /) if $SDL::DEBUG; - - if ( defined($options{-name}) && $options{-name} ne "" && exists $SDL::{IMGLoad} ) { - $self = \SDL::IMGLoad($options{-name}); - } else { - my $f = $options{-flags} || $options{-fl} || SDL::SDL_ANYFORMAT(); - my $w = $options{-width} || $options{-w} || 1; - my $h = $options{-height} || $options{-h} || 1; - my $d = $options{-depth} || $options{-d} || 8; - my $p = $options{-pitch} || $options{-p} || $w*$d; - my $r = $options{-Rmask} || $options{-r} - || ( SDL::BigEndian() ? 0xff000000 : 0x000000ff ); - my $g = $options{-Gmask} || $options{-g} - || ( SDL::BigEndian() ? 0x00ff0000 : 0x0000ff00 ); - my $b = $options{-Bmask} || $options{-b} - || ( SDL::BigEndian() ? 0x0000ff00 : 0x00ff0000 ); - my $a = $options{-Amask} || $options{-a} - || ( SDL::BigEndian() ? 0x000000ff : 0xff000000 ); - - if ( $options{-from}|| $options{-f} ) { - my $src = $options{-from}|| $options{-f}; - $self = \SDL::CreateRGBSurfaceFrom($src,$w,$h,$d,$p,$r,$g,$b,$a); - } else { - $self = \SDL::CreateRGBSurface($f,$w,$h,$d,$r,$g,$b,$a); - } - } - croak "SDL::Surface::new failed. ", SDL::GetError() - unless ( $$self); - bless $self,$class; - return $self; -} - -sub DESTROY { - SDL::FreeSurface(${$_[0]}); -} - -sub flags { - SDL::SurfaceFlags(${$_[0]}); -} - -sub palette { - SDL::SurfacePalette(${$_[0]}); -} - -sub bpp { - SDL::SurfaceBitsPerPixel(${$_[0]}); -} - -sub bytes_per_pixel { - SDL::SurfaceBytesPerPixel(${$_[0]}); -} - -sub Rshift { - SDL::SurfaceRshift(${$_[0]}); -} - -sub Gshift { - SDL::SurfaceGshift(${$_[0]}); -} - -sub Bshift { - SDL::SurfaceBshift(${$_[0]}); -} - -sub Ashift { - SDL::SurfaceAshift(${$_[0]}); -} - -sub Rmask { - SDL::SurfaceRmask(${$_[0]}); -} - -sub Gmask { - SDL::SurfaceGmask(${$_[0]}); -} - -sub Bmask { - SDL::SurfaceBmask(${$_[0]}); -} - -sub Amask { - SDL::SurfaceAmask(${$_[0]}); -} - -sub color_key { - SDL::SurfaceColorKey(${$_[0]}); -} - -sub alpha { - SDL::SurfaceAlpha(${$_[0]}); -} - -sub width { - SDL::SurfaceW(${$_[0]}); -} - -sub height { - SDL::SurfaceH(${$_[0]}); -} - -sub pitch { - SDL::SurfacePitch(${$_[0]}); -} - -sub pixels { - SDL::SurfacePixels(${$_[0]}); -} - -sub pixel { - 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 { - if ($_[1] == 0 ) { - SDL::FillRect(${$_[0]},0,${$_[2]}); - } else { - SDL::FillRect(${$_[0]},$_[1],$_[2]); - } -} - -sub lockp { - SDL::MUSTLOCK(${$_[0]}); -} - -sub lock { - SDL::SurfaceLock(${$_[0]}); -} - -sub unlock { - SDL::SurfaceUnlock(${$_[0]}); -} - -sub update { - my $self = shift;; - if ($SDL::DEBUG) { - for (@_) { - croak "SDL::Surface::update requires SDL::Rect objects" - unless $_->isa('SDL::Rect'); - } - } - SDL::UpdateRects($$self, map { ${$_} } @_ ); -} - -sub flip { - SDL::Flip(${$_[0]}); -} - -sub blit { - $_[1] = 0 unless defined $_[1]; - $_[3] = 0 unless defined $_[3]; - - if ($SDL::DEBUG) { - croak "SDL::Surface::blit requires SDL::Rect objects" - unless ($_[1] == 0 || $_[1]->isa('SDL::Rect')) - && ($_[3] == 0 || $_[3]->isa('SDL::Rect')); - croak "SDL::Surface::blit requires SDL::Surface objects" - unless $_[2]->isa('SDL::Surface'); - } - #BlitSurface ( src, src_rect, dest, dest_rect ) - - SDL::BlitSurface( ${$_[0]}, $_[1], ${$_[2]}, $_[3]); -} - -sub set_colors { - my $self = shift; - my $start = shift; - for (@_) { - 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 { - 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]}); -} - -sub set_alpha { - SDL::SetAlpha(${$_[0]},$_[1],$_[2]); -} - -sub display_format { - my $self = shift; - my $tmp = SDL::DisplayFormat($$self); - SDL::FreeSurface ($$self); - $$self = $tmp; - $self; -} - -sub display_format_alpha { - my $self = shift; - my $tmp = SDL::DisplayFormatAlpha($$self); - SDL::FreeSurface ($$self); - $$self = $tmp; - $self; -} - -sub rgb { - my $self = shift; - my $tmp = SDL::ConvertRGB($$self); - SDL::FreeSurface($$self); - $$self = $tmp; - $self; -} - -sub rgba { - my $self = shift; - my $tmp = SDL::ConvertRGBA($$self); - SDL::FreeSurface($$self); - $$self = $tmp; - $self; -} - -sub rect { - my $self = shift; - new SDL::Rect -width => $self->width(), -height => $self->height(), - -x => $_[0] || 0, -y => $_[1] || 0; -} - -sub print { - my ($self,$x,$y,@text) = @_; - SDL::SFont::PutString( $$self, $x, $y, join('',@text)); -} - -sub save_bmp { - SDL::SaveBMP( ${$_[0]},$_[1]); -} - -sub video_info { - shift; - SDL::VideoInfo(); -} - -1; - -__END__; - -=pod - -=head1 NAME - -SDL::Surface - a SDL perl extension - -=head1 SYNOPSIS - - use SDL::Surface; - $image = new SDL::Surface(-name=>"yomama.jpg"); - -=head1 DESCRIPTION - -The C module encapsulates the SDL_Surface* structure, and -many of its ancillatory functions. Not only is it a workhorse of the -OO Layer, it is the base class for the C class. - -=head1 EXPORTS - - SDL_SWSURFACE SDL_HWSURFACE - SDL_ASYNCBLIT SDL_ANYFORMAT - SDL_HWPALETTE SDL_DOUBLEBUF - SDL_FULLSCREEN SDL_OPENGL - SDL_OPENGLBLIT SDL_RESIZEABLE - SDL_NOFRAME SDL_SRCCOLORKEY - SDL_RLEACCEL SDL_SRCALPHA - SDL_PREALLOC - -=head1 METHODS - -=head2 new (-name => 'foo.png') - -The C class can be instantiated in a number of different ways. -If support for the SDL_image library was included when SDL_perl was compiled, -the easiest way to create a new surface is to use the C -method with the C<-name> option. This will load the image from the file -and return an object encapsulating the SDL_Surface*. - -=head2 new (-from => $buffer, ... ) - -If the contents of the new Surface is already in memory, C -may be called with the C<-from> option to create an image from that section -of memory. This method takes the following additional parameters: - -=over 4 - -=item * - --width the width of the image in pixels - -=item * - --height the height of the image in pixels - -=item * - --depth the number of bits per pixel - -=item * - --pitch the number of bytes per line - -=item * - --Rmask an optional bitmask for red - -=item * - --Gmask an optional bitmask for green - -=item * - --Bmask an optional bitmask for green - -=item * - --Amask an optional bitmask for alpha - -=back - -=head2 new ( -flags => SDL_SWSURFACE, ... ) - -Finally, C may be invoked with the C<-flags> option, in a -similar fashion to the C<-from> directive. This invocation takes the same -additional options as C<-from> with the exception of C<-pitch> which is ignored. -This method returns a new, blank, SDL::Surface option with any of the following -flags turned on: - -=over 4 - -=item * - -SWSURFACE() a non-accelerated surface - -=item * - -HWSURFACE() a hardware accelerated surface - -=item * - -SRCCOLORKEY() a surface with a transperant color - -=item * - -SRCALPHA() an alpha blended, translucent surface - -=back - -=head2 flags () - -C returns the flags with which the surface was initialized. - -=head2 palette () - -C currently returns a SDL_Palette*, this may change in -future revisions. - -=head2 bpp () - -C returns the bits per pixel of the surface - -=head2 bytes_per_pixel () - -C returns the bytes per pixel of the surface - -=head2 Rshift () - -C returns the bit index of the red field for the surface's pixel format - -=head2 Gshift () - -C returns the bit index of the green field for the surface's pixel format - -=head2 Bshift () - -C returns the bit index of the blue field for the surface's pixel format - -=head2 Ashift () - -C returns the bit index of the alpha field for the surface's pixel format - -=head2 Rmask () - -C returns the bit mask for the red field for teh surface's pixel format - -=head2 Gmask () - -C returns the bit mask for the green field for teh surface's pixel format - -=head2 Bmask () - -C returns the bit mask for the blue field for teh surface's pixel format - -=head2 Amask () - -C returns the bit mask for the alpha field for teh surface's pixel format - -=head2 color_key () - -C returns the current color key for the image, which can be set with -the C method. Before calling C on -a image, you should fist call C to convert it to the same -format as the display. Failure to do so will result in failure to apply the correct color_key. - -=head2 alpha () - -C returns the current alpha value for the image, which can be set with -the C method. - -=head2 width () - -C returns the width in pixels of the surface - -=head2 height () - -C returns the height in pixels of the surface - -=head2 pitch () - -C returns the width of a surface's scanline in bytes - -=head2 pixels () - -C returns a Uint8* to the image's pixel data. This is not -inherently useful within perl, though may be used to pass image data to user provided -C functions. - -=head2 pixel (x,y,[color]) - -C will set the color value of the pixel at (x,y) to the given -color if provided. C returns a SDL::Color object for the -color value of the pixel at (x,y) after any possible modifications. - -=head2 fill (rect,color) - -C will fill the given SDL::Rect rectangle with the specified SDL::Color -This function optionally takes a SDL_Rect* and a SDL_Color* - -=head2 lockp () - -C returns true if the surface must be locked - -=head2 lock () - -C places a hardware lock if necessary, preventing access to -the surface's memory - -=head2 unlock () - -C removes any hardware locks, enabling blits - -=head2 update ( rects...) - -C takes one or more SDL::Rect's which determine which sections -of the image are to be updated. This option is only useful on the appliaction surface. - -=head2 flip () - -C updates the full surface, using a double buffer if available - -=head2 blit (srect,dest,drect) - -C blits the current surface onto the destination surface, -according to the provided rectangles. If a rectangle is 0, then the full surface is used. - -=head2 set_colors (start,colors...) - -C updates the palette starting at index C with the -supplied colors. The colors may either be SDL::Color objects or SDL_Color* from the -low level C-style API. - -=head2 set_color_key (flag,pixel) or (flag,x,y) - -C sets the blit flag, usually SDL_SRCCOLORKEY, -to the specified L object. Optional a SDL_Color* may be passed. - -=head2 set_alpha (flag,alpha) - -C sets the opacity of the image for alpha blits. -C takes a value from 0x00 to 0xff. - -=head2 display_format () - -C converts the surface to the same format as the -current screen. - -=head2 display_format_alpha () - -C converts the surface to the same format as the -current screen, plus an alpha channel. - -=head2 rgb () - -C converts the surface to a 24 bit rgb format regardless of the initial format. - -=head2 rgba () - -C converts the surface to a 32 bit rgba format regarless of the initial format. - -=head2 print (x,y,text...) - -C renders the text using the current font onto the image. -This option is only supported for with SDL_image and SFont. - -=head2 save_bmp (filename) - -C saves the surface to filename in Windows BMP format. - -=head2 video_info () - -C returns a hash describing the current state of the -video hardware. - -=head1 AUTHOR - -David J. Goehrig - -=head1 SEE ALSO - -L L L L L - -=cut +=head1 +There C