package SDLx::Sprite; use strict; use warnings; use SDL; use SDL::Video; use SDL::Image; use SDLx::Rect; use SDL::Surface; use SDLx::Surface; use SDLx::Validate; use Carp (); sub new { my ( $class, %options ) = @_; my $self = bless {}, $class; if ( exists $options{surface} ) { $self->{surface} = SDLx::Surface->new( surface => $options{surface} ); $self->{orig_surface} = $options{surface}; $self->_init_rects(%options); $self->handle_surface( $self->surface ); } elsif ( exists $options{image} ) { my $surf = SDLx::Surface->load( $options{image} ); $self->{surface} = SDLx::Surface->new( surface => $surf ); $self->_init_rects(%options); $self->handle_surface($surf); $self->{orig_surface} = $self->{surface}; } elsif ( exists $options{width} && $options{height} ) { $self->{surface} = SDLx::Surface->new(%options); $self->{orig_surface} = $self->surface; $self->_init_rects(%options); $self->handle_surface( $self->surface ); } else { Carp::confess "Need a surface => SDL::Surface, an image => name, or ( width => ... , height => ...)"; } # short-circuit return $self unless %options; Carp::confess 'rect cannot be instantiated together with x or y' if exists $options{rect} and ( exists $options{x} or exists $options{y} ); Carp::confess 'image and surface cannot be instantiated together' if exists $options{image} and exists $options{surface}; # note: ordering here is somewhat important. If you change anything, # please rerun the test suite to make sure everything still works :) $self->x( $options{x} ) if exists $options{x}; $self->y( $options{y} ) if exists $options{y}; $self->rotation( $options{rotation} ) if exists $options{rotation}; $self->alpha_key( $options{alpha_key} ) if exists $options{alpha_key}; $self->alpha( $options{alpha} ) if exists $options{alpha}; return $self; } sub _init_rects { my ( $self, %options ) = @_; # create our two initial rects $self->rect( exists $options{rect} ? $options{rect} : SDLx::Rect->new( 0, 0, 0, 0 ) ); $self->clip( exists $options{clip} ? $options{clip} : SDLx::Rect->new( 0, 0, 0, 0 ) ); } sub load { my ( $self, $filename ) = @_; my $surface = SDLx::Surface->load($filename); $self->{orig_surface} = $surface unless $self->{orig_surface}; $self->handle_surface($surface); return $self; } sub handle_surface { my ( $self, $surface ) = @_; # short-circuit return $self->surface unless $surface; my $old_surface = $self->surface(); $self->surface($surface); # update our source and destination rects $self->rect->w( $surface->w ); $self->rect->h( $surface->h ); $self->clip->w( $surface->w ); $self->clip->h( $surface->h ); return $old_surface; } sub rect { my ( $self, $rect ) = @_; # short-circuit return $self->{rect} unless $rect; return $self->{rect} = SDLx::Validate::rect($rect); } sub clip { my ( $self, $clip ) = @_; # short-circuit return $self->{clip} unless $clip; return $self->{clip} = SDLx::Validate::rect($clip); } sub x { my ( $self, $x ) = @_; if ( defined $x ) { $self->rect->x($x); } return $self->rect->x; } sub y { my ( $self, $y ) = @_; if ( defined $y ) { $self->rect->y($y); } return $self->rect->y; } sub draw { my ( $self, $surface ) = @_; SDLx::Validate::surface($surface); $self->{surface}->blit( $surface, $self->clip, $self->rect ); return $self; } sub draw_xy { my ( $self, $surface, $x, $y ) = @_; SDLx::Validate::surface($surface); $self->x($x); $self->y($y); return $self->draw($surface); } sub alpha_key { my ( $self, $color ) = @_; $color = SDLx::Validate::color($color); Carp::confess 'SDL::Video::set_video_mode must be called first' unless ref SDL::Video::get_video_surface(); $self->{alpha_key} = $color unless $self->{alpha_key}; # keep a copy just in case $self->surface( SDL::Video::display_format( $self->surface ) ); if ( SDL::Video::set_color_key( $self->surface, SDL_SRCCOLORKEY, $color ) < 0 ) { Carp::confess ' alpha_key died :' . SDL::get_error; } return $self; } sub alpha { my ( $self, $value ) = @_; $value = int( $value * 0xff ) if $value < 1 and $value > 0; $value = 0 if $value < 0; $value = 0xff if $value > 0xff; $self->{alpha} = $value; # keep a copy just in case $self->surface( SDL::Video::display_format( $self->surface ) ); my $flags = SDL_SRCALPHA | SDL_RLEACCEL; #this should be predictive if ( SDL::Video::set_alpha( $self->surface, $flags, $value ) < 0 ) { Carp::confess 'alpha died :' . SDL::get_error; } return $self; } sub rotation { my ( $self, $angle, $smooth ) = @_; if ( $angle && $self->{orig_surface} ) { require SDL::GFX::Rotozoom; my $rotated = SDL::GFX::Rotozoom::surface( $self->{orig_surface}, #prevents rotting of the surface $angle, 1, # zoom ( defined $smooth && $smooth != 0 ) ) or Carp::confess 'rotation error: ' . SDL::get_error; #After rotation the surface is on a undefined background. #This causes problems with alpha. So we create a surface with a fill of the src_color. #This insures less artifacts. if ( $self->{alpha_key} ) { my $background = SDLx::Surface::duplicate($rotated); $background->draw_rect( [ 0, 0, $background->w, $background->h ], $self->{alpha_key} ); SDLx::Surface->new( surface => $rotated )->blit($background); $self->handle_surface( $background->surface ); $self->alpha_key( $self->{alpha_key} ); } else { $self->handle_surface($rotated); } $self->alpha( $self->{alpha} ) if $self->{alpha}; $self->{angle} = $angle; } return $self->{angle}; } sub surface { my ( $self, $surface ) = @_; if ($surface) { $self->{surface} = SDLx::Validate::surfacex($surface); } return $self->{surface}; } sub w { return $_[0]->{surface}->w; } sub h { return $_[0]->{surface}->h; } 1;