lib/SDL/Tutorial/Animation.pm

   1 #!/usr/bin/env perl
   2 #
   3 # Animation.pm
   4 #
   5 # Copyright (C) 2005 David J. Goehrig <dgoehrig@cpan.org>
   6 #
   7 # ------------------------------------------------------------------------------
   8 #
   9 # This library is free software; you can redistribute it and/or
  10 # modify it under the terms of the GNU Lesser General Public
  11 # License as published by the Free Software Foundation; either
  12 # version 2.1 of the License, or (at your option) any later version.
  13 #
  14 # This library is distributed in the hope that it will be useful,
  15 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 # Lesser General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU Lesser General Public
  20 # License along with this library; if not, write to the Free Software
  21 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
  22 #
  23 # ------------------------------------------------------------------------------
  24 #
  25 # Please feel free to send questions, suggestions or improvements to:
  26 #
  27 #       David J. Goehrig
  28 #       dgoehrig@cpan.org
  29 #
  30
  31 package SDL::Tutorial::Animation;
  32
  33 use strict;
  34 use warnings;
  35
  36 use SDL;
  37 use SDL::App;
  38 use SDL::Rect;
  39 use SDL::Color;
  40
  41 # change these values as necessary
  42 my $title                                = 'My SDL Animation';
  43 my ($width,      $height,      $depth)   = (  640,  480,   16 );
  44 my ($bg_r,       $bg_g,        $bg_b)    = ( 0x00, 0x00, 0x00 );
  45 my ($rect_r,     $rect_g,      $rect_b)  = ( 0x00, 0x00, 0xff );
  46 my ($rect_width, $rect_height, $rect_y)  = (  100,  100,  190 );
  47
  48 my $app = SDL::App->new(
  49         -width  => $width,
  50         -height => $height,
  51         -depth  => $depth,
  52 );
  53
  54 my $color = SDL::Color->new(
  55         -r => $rect_r,
  56         -g => $rect_g,
  57         -b => $rect_b,
  58 );
  59
  60 my $bg_color = SDL::Color->new(
  61         -r => $bg_r,
  62         -g => $bg_g,
  63         -b => $bg_b,
  64 );
  65
  66 my $background = SDL::Rect->new(
  67         -width  => $width,
  68         -height => $height,
  69 );
  70
  71 my $rect = create_rect();
  72
  73 # your code here, perhaps
  74 for my $x (0 .. 640)
  75 {
  76         $rect->x( $x );
  77         draw_frame( $app,
  78                 bg   => $background, bg_color   => $bg_color,
  79                 rect => $rect,       rect_color => $color,
  80         );
  81 }
  82
  83 # remove this line
  84 sleep 2;
  85
  86 # XXX - if you know why I need to create a new rect here, please tell me!
  87 $rect        = create_rect();
  88 my $old_rect = create_rect();
  89
  90 # your code also here, perhaps
  91 for my $x (0 .. 640)
  92 {
  93         $rect->x( $x );
  94         draw_undraw_rect( $app,
  95                 rect       => $rect,  old_rect => $old_rect,
  96                 rect_color => $color, bg_color => $bg_color,
  97         );
  98         $old_rect->x( $x );
  99 }
 100
 101 # your code almost certainly follows; remove this line
 102 sleep 2;
 103
 104 sub create_rect
 105 {
 106         return SDL::Rect->new(
 107                 -height => $rect_height,
 108                 -width  => $rect_width,
 109                 -x      => 0,
 110                 -y      => $rect_y,
 111         );
 112 }
 113
 114 sub draw_frame
 115 {
 116         my ($app, %args) = @_;
 117
 118         $app->fill(   $args{bg},   $args{bg_color}   );
 119         $app->fill(   $args{rect}, $args{rect_color} );
 120         $app->update( $args{bg} );
 121 }
 122
 123 sub draw_undraw_rect
 124 {
 125         my ($app, %args) = @_;
 126
 127         $app->fill(   $args{old_rect}, $args{bg_color}   );
 128         $app->fill(   $args{rect},     $args{rect_color} );
 129         $app->update( $args{old_rect} );
 130         $app->update( $args{rect} );
 131 }
 132
 133 1;
 134 __END__
 135
 136 =head1 NAME
 137
 138 SDL::Tutorial::Animation
 139
 140 =head1 SYNOPSIS
 141
 142         # to read this tutorial
 143         $ perldoc SDL::Tutorial::Animation
 144
 145         # to create a demo animation program based on this tutorial
 146         $ perl -MSDL::Tutorial::Animation=sdl_anim.pl -e 1
 147
 148 =head1 ANIMATING A RECTANGLE
 149
 150 Now that you can display a rectangle on the screen, the next step is to animate
 151 that rectangle.  As with movies, there's no actual motion.  Computer animations are just very very fast slideshows.  The hard work is creating nearly identical images in every slide (or frame, in graphics terms).
 152
 153 Okay, it's not that difficult.
 154
 155 There is one small difficulty to address, however.  Once you blit one surface
 156 onto another, the destination is changed permanently.  There's no concept of
 157 layers here unless you write it yourself.  If you fail to take this into
 158 account (and just about everyone does at first), you'll end up with blurry
 159 graphics moving around on the screen.
 160
 161 There are two approaches to solve this problem, redrawing the screen on every
 162 frame and saving and restoring the background for every object drawn.
 163
 164 =head2 Redrawing the Screen
 165
 166 Since you have to draw the screen in the right order once to start with it's
 167 pretty easy to make this into a loop and redraw things in the right order for
 168 every frame.  Given a L<SDL::App> object C<$app>, a L<SDL::Rect> C<$rect>, and
 169 a L<SDL::Color> C<$color>, you only have to create a new SDL::Rect C<$bg>,
 170 representing the whole of the background surface and a new SDL::Color
 171 C<$bg_color>, representing the background color.  You can write a
 172 C<draw_frame()> function as follows:
 173
 174         sub draw_frame
 175         {
 176                 my ($app, %args) = @_;
 177
 178                 $app->fill( $args{ bg }, $args{ bg_color } );
 179                 $app->fill( $args{rect}, $args{rect_color} );
 180                 $app->update( $args{bg} );
 181         }
 182
 183 Since you can change the C<x> and C<y> coordinates of a rect with the C<x()>
 184 and C<y()> methods, you can move a rectangle across the screen with a loop like
 185 this:
 186
 187         for my $x (0 .. 640)
 188         {
 189                 $rect->x( $x );
 190                 draw_frame( $app,
 191                         bg   => $bg,   bg_color   => $bg_color,
 192                         rect => $rect, rect_color => $color,
 193                 );
 194         }
 195
 196 If C<$rect>'s starting y position is 190 and its height and width are 100, the
 197 rectangle (er, square) will move across the middle of the screen.
 198
 199 Provided you can keep track of the proper order in which to redraw rectangles
 200 and provided you don't need the optimal speed necessary (since blitting every
 201 object takes more work than just blitting the portions you need), this works
 202 quite well.
 203
 204 =head2 Undrawing the Updated Rectangle
 205
 206 If you need more speed or want to make a different complexity tradeoff, you can
 207 take a snapshot of the destination rectangle I<before> you blit onto it.  That
 208 way, when you need to redraw, you can blit the old snapshot back before
 209 blitting to the new position.
 210
 211 B<Note:>  I have no idea how this will work in the face of alpha blending,
 212 which, admittedly, I haven't even mentioned yet.  If you don't know what this
 213 means, forget it.  If you do know what this means and know why I'm waving my
 214 hands here, feel free to explain what should and what does happen and why.  :)
 215
 216 With this technique, the frame-drawing subroutine has to be a little more
 217 complicated.  Instead of the background rect, it needs a rect for the previous
 218 position.  It also needs to do two updates (or must perform some scary math to
 219 figure out the rectangle of the correct size to C<update()>.  No thanks!).
 220
 221         sub undraw_redraw_rect
 222         {
 223                 my ($app, %args) = @_;
 224
 225                 $app->fill(   $args{old_rect}, $args{bg_color}   );
 226                 $app->fill(   $args{rect],     $args{rect_color} );
 227                 $app->update( $args{old_rect}, $args{rect}       );
 228         }
 229
 230 We'll need to create a new SDL::Rect, C<$old_rect>, that is a duplicate of
 231 C<$rect>, at the same position at first.  You should already know how to do
 232 this.
 233
 234 As before, the loop to call C<undraw_redraw_rect()> would look something like:
 235
 236         for my $x (0 .. 640)
 237         {
 238                 $rect->x( $x );
 239
 240                 undraw_redraw_rect( $app,
 241                         rect       => $rect,  old_rect => $old_rect,
 242                         rect_color => $color, bg_color => $bgcolor,
 243                 );
 244
 245                 $old_rect->x( $x );
 246         }
 247
 248 If you run this code, you'll probably notice that it's tremendously faster than
 249 the previous version.  It may be too fast, where the alternate technique was
 250 just fast enough.  There are a couple of good ways to set a fixed animation
 251 speed regardless of the speed of the processor and graphics hardware (provided
 252 they're good enough, which is increasingly often the case), and we'll get to
 253 them soon.
 254
 255 =head1 SEE ALSO
 256
 257 =over 4
 258
 259 =item L<SDL::Tutorial::Drawing>
 260
 261 basic drawing with SDL Perl
 262
 263 =item L<SDL::Tutorial::Images>
 264
 265 animating images
 266
 267 =back
 268
 269 =head1 AUTHOR
 270
 271 chromatic, E<lt>chromatic@wgz.orgE<gt>
 272
 273 Written for and maintained by the Perl SDL project, L<http://sdl.perl.org/>.
 274
 275 =head1 BUGS
 276
 277 No known bugs.
 278
 279 =head1 COPYRIGHT
 280
 281 Copyright (c) 2003 - 2004, chromatic.  All rights reserved.  This module is
 282 distributed under the same terms as Perl itself, in the hope that it is useful
 283 but certainly under no guarantee.