Skip to content

Commit

Permalink
intermediate step, is broken
Browse files Browse the repository at this point in the history
  • Loading branch information
dod38fr committed May 13, 2012
1 parent 6194806 commit cd05ec4
Show file tree
Hide file tree
Showing 4 changed files with 64 additions and 161 deletions.
55 changes: 16 additions & 39 deletions lib/SDLx/SlideShow/FadeInOut.pm
@@ -1,21 +1,19 @@
package SDLx::Fader ;
package SDLx::SlideShow::FadeInOut ;

use 5.10.1;

use strict;
use warnings;

use Carp ;

use SDL;
use SDLx::App;
use SDLx::Sprite;
use SDLx::Surface;
use SDL::Color ;

use Any::Moose;
use Any::Moose '::Util::TypeConstraints' ;

extends 'SDLx::SlideShow::Any' ;

subtype 'My::Types::SDLx::Sprite' => as class_type('SDLx::Sprite');
class_type('SDLx::Surface');

Expand All @@ -28,8 +26,6 @@ coerce 'My::Types::SDLx::Sprite'
return $s ;
} ;

has max_steps => ( is => 'rw', isa => 'Int', default => 26 );

# holds old image
has _bg_frame => (
is => 'ro',
Expand All @@ -41,14 +37,11 @@ has _bg_frame => (
sub _build_bg_frame {
my $self = shift ;
my $s = SDLx::Surface->new( width => $self->width, height => $self->height);
$self->image->draw($s) ;
my $spr = SDLx::Sprite->new (
surface => $s,
alpha => 0xff,
) ;
# disable alpha color key stuff to avoid messing up photos
# SDL::Video::set_color_key( $s, 0, 0 );
# SDL::Video::set_alpha($s, SDL_SRCALPHA | SDL_RLEACCEL, 0xff);
# $s->draw_rect( undef , [ 0x80, 0x80, 0x80 ] );
return $spr ;
}

Expand All @@ -58,41 +51,26 @@ has image => (
handles => { qw/width w height h/ } ,
required => 1,
coerce => 1,
trigger => \&_new_image ,
);

has step => (
traits => ['Counter'],
is => 'rw',
isa => 'Int',
default => 0,
handles => {
inc_step => 'inc',
reset_step => 'reset',
}
);

my $white = SDL::Color->new(0xFF, 0xFF, 0xFF);

sub new_image {
my ($self,$image) = @_;

croak "new_image does not match old image size"
unless $image->w eq $self->width and $image->h eq $self->height ;
sub _new_image {
my $self = shift ;
my ($image,$old) = @_;

# blit old image
$self->image->alpha(0xff) ;
$self->image->draw($self->_bg_frame->surface);
return unless @_ > 1 ;
$self->SUPER::_new_image(@_) ;

$self->image->surface( $image );

$self->reset_step; # will trigger a redraw on next loop
say "fadeinout blit old image";
$old->alpha(0xff) ;
$old->draw($self->_bg_frame->surface);
}

sub transition {
my $self = shift;

if ( $self->step <= $self->max_steps) {
my $alpha = int($self->step * 0xFF / $self->max_steps) ;
if ( $self->busy ) {
my $alpha = $self->progress( 0xFF ) ;
say "alpha $alpha, other ", 0xff - $alpha ;
my $transition = SDLx::Surface->new( width=> $self->width, height=> $self->height) ;

Expand All @@ -103,8 +81,7 @@ sub transition {
$self->_bg_frame->surface->blit( $transition);
$self->image ->surface->blit( $transition);

$self->inc_step if $self->step <= $self->max_steps;

$self->inc_step;
return $transition ;
}
else {
Expand Down
57 changes: 5 additions & 52 deletions lib/SDLx/SlideShow/RollOver.pm
@@ -1,4 +1,4 @@
package SDLx::RollOver ;
package SDLx::SlideShow::RollOver ;

use 5.10.1;

Expand All @@ -16,71 +16,24 @@ use Any::Moose;
use Any::Moose '::Util::TypeConstraints' ;
# use Any::Moose '::Meta::Attribute::Native::Trait::Array' ;

has max_steps => ( is => 'rw', isa => 'Int', default => 26 );

has _bg_frame => (
is => 'ro',
isa => 'SDLx::Surface',
lazy => 1,
builder => '_build_bg_frame',
);

sub _build_bg_frame {
my $self = shift ;
my $s = SDLx::Surface->new( width => $self->width, height => $self->height);
SDL::Video::set_color_key( $s, 0, 0 );
SDL::Video::set_alpha($s, SDL_RLEACCEL, 0);
$self->image->blit($s) ;
return $s ;
}

has image => (
is => 'rw',
isa => 'SDLx::Surface',
handles => { qw/width w height h/ } ,
required => 1,
);

has step => (
traits => ['Counter'],
is => 'rw',
isa => 'Int',
default => 0,
handles => {
inc_step => 'inc',
reset_step => 'reset',
}
);

sub new_image {
my ($self,$image) = @_;

croak "new_image does not match old image size"
unless $image->w eq $self->width and $image->h eq $self->height ;

$self->image( $image );

$self->reset_step; # will trigger a redraw on next loop
}
extends 'SDLx::SlideShow::Any' ;

sub transition {
my $self = shift;

my $busy = 0;
if ($self->step <= $self->max_steps) {
if ($self->busy) {
my $max_s = $self->max_steps ;
my $s = $self->step ;
my $slide_mark = int( $self->width * ($max_s -$s) / $max_s ) ;
my $slide_mark = $self->regress( $self->width ) ;
my $slide_width = int( $self->width / $max_s ) + 1 ;

my $rect_to_blit = [ $slide_mark,0, $slide_width, $self->height ] ;
$self->image->blit($self->_bg_frame, $rect_to_blit, $rect_to_blit) ;
$self->_bg_frame->update ;
$self->inc_step ;
$busy = 1;
}

return wantarray ? ($self->_bg_frame, $busy) : $self->_bg_frame ;
return $self->_bg_frame ;
}

__PACKAGE__->meta->make_immutable();
Expand Down
67 changes: 14 additions & 53 deletions lib/SDLx/SlideShow/SlideOut.pm
@@ -1,4 +1,4 @@
package SDLx::Slider ;
package SDLx::SlideShow::SlideOut ;

use 5.10.1;

Expand All @@ -16,87 +16,48 @@ use Any::Moose;
use Any::Moose '::Util::TypeConstraints' ;
# use Any::Moose '::Meta::Attribute::Native::Trait::Array' ;

has max_steps => ( is => 'rw', isa => 'Int', default => 26 );

# holds old and new image side by side
has _bg_frame => (
is => 'ro',
isa => 'SDLx::Surface',
lazy => 1,
builder => '_build_bg_frame',
);
extends 'SDLx::SlideShow::Any' ;

sub _build_bg_frame {
my $self = shift ;
my $s = SDLx::Surface->new( width => 2 * $self->width, height => $self->height);
# disable alpha color key stuff to avoid messing up photos
SDL::Video::set_color_key( $s, 0, 0 );
SDL::Video::set_alpha($s, SDL_RLEACCEL, 0);
$s->draw_rect( undef , [ 0x80, 0x80, 0x80 ] );
return $s ;
}

has image => (
is => 'rw',
isa => 'SDLx::Surface',
handles => { qw/width w height h/ } ,
required => 1,
);

has step => (
traits => ['Counter'],
is => 'rw',
isa => 'Int',
default => 0,
handles => {
inc_step => 'inc',
reset_step => 'reset',
}
);

has background_color => (
is => 'rw',
isa => 'ArrayRef',
default => sub { [ 20, 50, 170, 255 ] } ,
) ;


my $white = SDL::Color->new(0xFF, 0xFF, 0xFF);

sub new_image {
my ($self,$image) = @_;
}

croak "new_image does not match old image size"
unless $image->w eq $self->width and $image->h eq $self->height ;
sub _new_image {
my $self = shift ;
my ($image,$old) = @_;

# blit old image
$self->image->blit($self->_bg_frame);
say "blitting in double sized bg_frame" ;
# blit old image on left side of double sized bg_frame
$old->blit($self->_bg_frame) if defined $old ;

$self->image( $image );

# blit new image on right side of double sized bg_frame
$image -> blit (
$self->_bg_frame,
undef, # source
[ $self->width + 1 , 0, $self->width, $self->height]
[ $self->width , 0, $self->width, $self->height]
) ;

$self->reset_step; # will trigger a redraw on next loop
$self->SUPER::_new_image(@_) ;
}

sub transition {
my $self = shift;

if ($self->step <= $self->max_steps) {
if ($self->busy) {
my $transition = SDLx::Surface->new( width=> $self->width, height=> $self->height) ;
SDL::Video::set_alpha($transition, SDL_RLEACCEL, 0xff);
my $slide_mark = int( $self->width * $self->step / $self->max_steps ) ;
my $slide_mark = $self->progress( $self->width ) ;

$self->_bg_frame->blit($transition,
[ $slide_mark,0, $self->width + $slide_mark, $self->height ], # source
) ;
$self->_bg_frame->update ;
$self->inc_step ;

return $transition ;
}
else {
Expand Down
46 changes: 29 additions & 17 deletions t/slider.t
Expand Up @@ -11,7 +11,7 @@ use lib 'lib' ;

use SDLx::App ;
use SDLx::Rect ;
use SDLx::Slider ;
use SDLx::SlideShow ;
use SDLx::Surface ;

my $app = SDLx::App->new (
Expand All @@ -21,32 +21,44 @@ my $app = SDLx::App->new (
exit_on_quit => 0, # quit handle by event loop
) ;

# draw original surface
$app->draw_rect ( undef, 0x808080ff ) ;
$app->draw_rect ( SDLx::Rect->new(50,50,600,400), 0xFFFF00FF );
$app->sync ;

my @slides ;
while (@slides < 5) {
# create new surface to be slided over the original one
my $slide_in = SDLx::Surface->new(width => 800, height => 600) ;
$slide_in->draw_rect ( undef, 0x800080ff ) ;
my $c = 100 + 20 * @slides ;
$slide_in->draw_rect ( SDLx::Rect->new($c,$c,60,40), 0xFF00FFFF );
my $c = 100 + 30 * @slides ;
$slide_in->draw_rect ( SDLx::Rect->new($c,$c,460,340), 0xFF00FFFF );
push @slides, $slide_in;
}

my $slider = SDLx::Slider->new(image => $app) ;
ok( $slider, 'slider created with current image' );
my $test_only = shift @ARGV ;

# my $slider = SDLx::Slider->new(image => $app) ;
foreach my $s_file (glob("lib/SDLx/SlideShow/*.pm")) {
# draw original surface
$app->draw_rect ( undef, 0x808080ff ) ;
$app->draw_rect ( SDLx::Rect->new(50,50,600,400), 0xFFFF00FF );
$app->sync ;

while (@slides){
$slider->new_image(shift @slides) ;
my $s_class = $s_file ;
next if $s_class =~ m!/Any.pm$!;
say "test $test_only" ;
next if $test_only and ($s_class !~ /$test_only/i) ;
$s_class =~ s!.*/!!;
$s_class =~ s!\.pm$!! ;
my $slider = SDLx::SlideShow->new(image => $app, slideshow_class => $s_class) ;
ok( $slider, "created $s_class slider" );
my @l_slides = @slides ;

while (@l_slides){

foreach my $i (1.. 30) {
ok( 1, 'new_image added' );
$slider ->transition ->blit($app) ;
$app->sync;
SDL::delay(10) ;
foreach my $i (1.. 30) {
$slider ->transition ->blit($app) ;
$app->sync;
SDL::delay(10) ;
}

$slider->image(shift @l_slides) ;
}
}

Expand Down

0 comments on commit cd05ec4

Please sign in to comment.