lib/SDL/Tutorial/.svn/text-base/Animation.pm.svn-base

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