anim_flipcard.pl
Creates an animated GIF that flips or twirls a 3D "card" but with multiple images.

In this article, I discuss a Perl script that simulates either flipping or twirling a 3D "card". However, being a digital simulation, we are not confined to only having two images on a "card" as demonstrated by the following animated GIF image, consisting of four images:

Leonardo da Vinci, Mona_Lisa, St. Anne

The principle behind the illusion is a particular sequence of distorted views of the source images. Each distortion for the recto image is a parallelogram with its dimension further increased on one side and decreased on the opposite side by the same amount. Concurrent to this, the two sides in question move symmetrically towards a central line. The overall effect is to have this central line appear as the axis of rotation. Finally the whole process is reverse to bring the verso image to the recto position.

Generating the sequence requires specifying the proper coordinates for the apexes of each parallelogram. The process for twirling an image during the first-quarter turn is illustrated in the following diagram:

The corners of the source image (blue dots) are displaced towards end points (yellow dots) lying on a vertical line, equidistant from the vertical sides. In turn the top two end positions are equidistant from the top side. Similarly for the bottom two points with respect to the bottom side. For each intermediate position (red dots), the source image is mapped onto the parallelogram delineated by the relocated corners. The displacements are halted just before reaching the end points (green dots). Otherwise, we would be attempting to represent the "card" on edge. But the digital "card" has no thickness which would cause the image mapping to fail.

As indicated in the above diagram, all displacements occur along directed line segments. The required intermediate coordinates can be linearly interpolated using the parametric representation for a line segment. For any point P(x,y) on the line segment between P(x0,y0) and P(x1,y1), we have

x = λx1 + (1 - λ)x0, and y = λy1 + (1 - λ)y0,
where λ ϵ [0,1]. Letting λ evolve as λ|0→1 results in the directed line segment from P(x0,y0) to P(x1,y1).

Two caveats to keep in mind here. Points on a line are real numbers and thus dense, whereas screen pixels are integers and thus discreet. So using the parametric representation for interpolating pixel coordinates will always require taking the integer part of the computational results. Consequently, slight discrepancies might occur between the actual and theoretical positioning of a parallelogram. Furthermore, roundoff often comes into play when incrementing λ by a given step size. For example, a step size of 0.1 does not have a finite binary representation. So, after 10 steps, λ will be slightly less than 1. Thus, additional discrepancies in a parallelogram's apexes can be expected.

As with all our previous animation scripts, an XML file conveys the animation specifications. To explain the required XML tags, let's examine the data file demo_twirlcard.xml ( [Download demo_twirlcard.xml]   [MD5 checksum] ). It governs the creation of the following animated GIF image:

Leonardo da Vinci, Mona_Lisa, St. Anne
XML file "demo_twirlcard.xml" Remarks
<animation> start of XML declaration
<simulation>twirl</simulation> the type of simulation. The other valid option is flip.
<output>demo_twirlcard.gif</output> name of the output file
<frames>20</frames> the number of intermediate, interpolated frames for each quarter turn
<delay>5</delay> the number of milliseconds in delaying the image views
<loops>0</loops> the number of times to cycle the animated GIF: 0 results in infinite looping
<imageDims> all constituent images to be scaled to the following pixel dimensions
<width>100</width> in pixels
<height>150</height> in pixels
<stretch>10</stretch> in pixels. Vertical (twirl case) or horizontal (flip case) distance along the axis of "rotation" of the theoretical corner end points from a source-image side (see above diagram).
</imageDims> end of image specifications
<image>Leonardo.jpg</image> filename of the 1st image. Images are processed in the order of their declaration.
<image>Mona_Lisa.jpg</image> filename of the 2nd image
<image>St_Anne.jpg</image> filename of the 3rd image
<image>webpraxis.jpg</image> filename of the 4th image
</animation> end of XML declaration

For the processing phase, Perl is used along with ImageMagick's drawing primitives accessed through its PerlMagick interface. The Perl script anim_flipcard.pl, displayed below, is the resulting code. It is released for personal, non-commercial and non-profit use only. Note in passing that the aforementioned discussion clearly implies that there are many coordinates to track and displace. No attempt has been made to render the code more compact or increase its computational efficiency. The emphasis is strictly on clarity where repetition has been favored over abstraction.

The listing includes the line numbers in order to reference them in the following general remarks.

If you have any questions regarding the code or my explanations, please do not hesitate in contacting me.


anim_flipcard.pl -- [Download latest version: v1.0.0 - September 24, 2009]   [MD5 checksum]
001 use strict;
002 use warnings;
003 use Image::Magick;
004 use Term::ANSIScreen qw/:color :cursor :screen/;
005 use Win32::Console::ANSI qw/ Cursor /;
006 use XML::Simple;
007     $XML::Simple::PREFERRED_PARSER  = 'XML::Parser';
008 use constant FATAL => colored ['white on red'], "\aFATAL ERROR: ";
009 #===== Copyright 2009, Webpraxis Consulting Ltd. - ALL RIGHTS RESERVED - Email: webpraxis@gmail.com ============================
010 # anim_flipcard.pl: Creates an animated GIF that flips or twirls a 3D "card" but with multiple images.
011 #===============================================================================================================================
012 #           Usage : perl anim_flipcard.pl XmlFile
013 #       Arguments : XmlFile = path of XML file for the animation specifications.
014 #     Input Files : See arguments.
015 #    Output Files : The animated GIF specified in the XML data file.
016 # Temporary Files : None.
017 #         Remarks : See http://www.webpraxis.ab.ca/flips/anim_flipcard.shtml for details.
018 #         History : v1.0.0 - September 24, 2009 - Original release.
019 #===============================================================================================================================
020 # 0) INITIALIZE:
021 $| = 1;                                                                                 #set STDOUT buffer to auto-flush
022 cls();                                                                                  #clear screen
023 print colored ['black on white'], "$0\n\n\n",                                           #display program name
024       colored ['reset'], 'Initializing... ';                                            #report start of initialization
025
026 my $XmlFile         = shift || die FATAL, 'No XML file specified';                      #get path of XML data file
027 my $Anim            = XMLin( $XmlFile, ForceArray => [qw(image)] );                     #read the XML data file
028 my $ImgWidth        = $$Anim{imageDims}{width};                                         #parameterize the width of the images
029 my $ImgHeight       = $$Anim{imageDims}{height};                                        #parameterize the height of the images
030 my $ImgStretch      = $$Anim{imageDims}{stretch};                                       #parameterize the image distortion
031 my $Simulation      = $$Anim{simulation};                                               #parameterize the simulation request
032 my $NoImages        = @{ $$Anim{image} };                                               #get the number of specified images
033 my @Spinners        = ( '-', '\\', '|', '/' );                                          #define symbols for spinner
034 my $CanvasWidth     = $ImgWidth;                                                        #canvas width in pixels
035     $CanvasWidth   += 2 * $ImgStretch if $Simulation eq 'flip';
036 my $CanvasHeight    = $ImgHeight;                                                       #canvas height in pixels
037     $CanvasHeight  += 2 * $ImgStretch if $Simulation eq 'twirl';
038 print colored ['bold green'], "XML data read\n\n";                                      #report end of initialization
039 #-------------------------------------------------------------------------------------------------------------------------------
040 # 1) LOAD AND SCALE THE IMAGES:
041 print 'Reading & scaling images... ';                                                   #report start of image processing
042 my $Images = Image::Magick->new( magick => 'JPG' );                                     #instantiate an object for the images
043
044 die FATAL, "Even number of images required\n" if $NoImages % 2;                         #check for even number of images
045 for( 0..$NoImages-1 ) {                                                                 #repeat for each source image
046     my $file = $$Anim{image}[$_];                                                       # parameterize the file name
047     die FATAL, "Cannot locate image file '$file'\n" unless -e $file;                    # check image existence
048     $Images->Read( $file );                                                             # read image file
049 }                                                                                       #until all images processed
050 $Images->Quantize( colors => 256, colorspace => 'RGB' );                                #ensure uniform color space
051 $Images->Scale( geometry => "${ImgWidth}x${ImgHeight}!" );                              #scale images to specified dimensions
052 print colored ['bold green'], "Done\n\n";                                               #report end of image processing
053 #-------------------------------------------------------------------------------------------------------------------------------
054 # 2) CREATE ANIMATION FRAMES:
055 print 'Creating animation frames... ';                                                  #report start of frame processing
056 my ($CursorX, $CursorY) = Cursor();                                                     #record cursor position
057
058 my $Canvas              = Image::Magick->new( magick => 'GIF' );                        #instantiate an image object for the canvas
059 my $Frames              = Image::Magick->new( magick => 'GIF' );                        #instantiate an image object for animation frames
060 my $FrameNo             = 0;                                                            #init no of animation frames
061 my $Interpolate         = sub   {   my ( $lambda, $start, $end ) = @_;                  #anonymous sub for interpolating x,y-coordinates
062                                     int( $lambda * $end + ( 1. - $lambda ) * $start );
063                                 };
064 my $DeltaLambda         = 1. / ( $$Anim{frames} + 1. );                                 #set transit step-size
065
066 my $ImgX_topLeft;                                                                       #top-left corner coords for 2D image
067 my $ImgY_topLeft;
068 my $ImgX_bottomRight;                                                                   #bottom-right corner coords for 2D image
069 my $ImgY_bottomRight;
070 my $ImgX_mid;                                                                           #mid coord along x-axis
071 my $ImgY_mid;                                                                           #mid coord along y-axis
072 if( $Simulation eq 'twirl' ) {
073     $ImgX_topLeft       = 0;
074     $ImgY_topLeft       = $ImgStretch;
075     $ImgX_bottomRight   = $CanvasWidth  - 1;
076     $ImgY_bottomRight   = $CanvasHeight - 1 - $ImgStretch;
077     $ImgX_mid           = $ImgX_bottomRight / 2;
078 } elsif( $Simulation eq 'flip' ) {
079     $ImgX_topLeft       = $ImgStretch;
080     $ImgY_topLeft       = 0;
081     $ImgX_bottomRight   = $CanvasWidth  - 1 - $ImgStretch;
082     $ImgY_bottomRight   = $CanvasHeight - 1;
083     $ImgY_mid           = $ImgY_bottomRight / 2;
084 } else {
085     die FATAL, "Invalid simulation request '$Simulation'\n";
086 }
087
088 my $x_left;                                                                             #perspective apex coords when twirling
089 my $x_right;
090 my $y_topLeft;
091 my $y_bottomLeft;
092 my $y_topRight;
093 my $y_bottomRight;
094
095 my $y_top;                                                                              #perspective apex coords when flipping
096 my $y_bottom;
097 my $x_topLeft;
098 my $x_bottomLeft;
099 my $x_topRight;
100 my $x_bottomRight;
101
102 for my $imgIdx ( 0..$NoImages - 1 ) {                                                   #repeat for each pairing of images
103     #QUARTER RIGHT-HAND-RULE TURN OF RECTO IMAGE:
104     for( my $lambda = 0.; $lambda < 1. - $DeltaLambda/2.; $lambda += $DeltaLambda ) {   # repeat for each transit step
105         if( $Simulation eq 'twirl' ) {                                                  #  interpolate twirl apex coords & draw frame
106             $x_left         = &$Interpolate( $lambda,   $ImgX_topLeft,      $ImgX_mid                           );
107             $x_right        = &$Interpolate( $lambda,   $ImgX_bottomRight,  $ImgX_mid                           );
108             $y_topLeft      = &$Interpolate( $lambda,   $ImgY_topLeft,      0                                   );
109             $y_bottomLeft   = &$Interpolate( $lambda,   $ImgY_bottomRight,  $ImgY_bottomRight   + $ImgStretch   );
110             $y_topRight     = &$Interpolate( $lambda,   $ImgY_topLeft,      $ImgY_topLeft       + $ImgStretch   );
111             $y_bottomRight  = &$Interpolate( $lambda,   $ImgY_bottomRight,  $ImgY_bottomRight   - $ImgStretch   );
112             &drawTwirlFrame( $imgIdx );
113         } else {                                                                        #  interpolate flip apex coords & draw frame
114             $y_top          = &$Interpolate( $lambda,   $ImgY_topLeft,      $ImgY_mid                           );
115             $y_bottom       = &$Interpolate( $lambda,   $ImgY_bottomRight,  $ImgY_mid                           );
116             $x_topLeft      = &$Interpolate( $lambda,   $ImgX_topLeft,      $ImgX_topLeft       + $ImgStretch   );
117             $x_bottomLeft   = &$Interpolate( $lambda,   $ImgX_topLeft,      0                                   );
118             $x_topRight     = &$Interpolate( $lambda,   $ImgX_bottomRight,  $ImgX_bottomRight   - $ImgStretch   );
119             $x_bottomRight  = &$Interpolate( $lambda,   $ImgX_bottomRight,  $ImgX_bottomRight   + $ImgStretch   );
120             &drawFlipFrame( $imgIdx );
121         }                                                                               # end if-else
122     }                                                                                   # until all steps processed
123     #QUARTER RIGHT-HAND-RULE TURN OF VERSO IMAGE:
124     for(my $lambda=$DeltaLambda; $lambda < 1.-$DeltaLambda/2.; $lambda+=$DeltaLambda) { # repeat for each transit step
125         if( $Simulation eq 'twirl' ) {                                                  #  interpolate twirl apex coords & draw frame
126             $x_left         = &$Interpolate( $lambda,   $ImgX_mid,                          $ImgX_topLeft       );
127             $x_right        = &$Interpolate( $lambda,   $ImgX_mid,                          $ImgX_bottomRight   );
128             $y_topLeft      = &$Interpolate( $lambda,   $ImgY_topLeft       + $ImgStretch,  $ImgY_topLeft       );
129             $y_bottomLeft   = &$Interpolate( $lambda,   $ImgY_bottomRight   - $ImgStretch,  $ImgY_bottomRight   );
130             $y_topRight     = &$Interpolate( $lambda,   0,                                  $ImgY_topLeft       );
131             $y_bottomRight  = &$Interpolate( $lambda,   $ImgY_bottomRight   + $ImgStretch,  $ImgY_bottomRight   );
132             &drawTwirlFrame( ( $imgIdx + 1 ) % $NoImages );
133         } else {                                                                        #  interpolate flip apex coords & draw frame
134             $y_top          = &$Interpolate( $lambda,   $ImgY_mid,                          $ImgY_topLeft       );
135             $y_bottom       = &$Interpolate( $lambda,   $ImgY_mid,                          $ImgY_bottomRight   );
136             $x_topLeft      = &$Interpolate( $lambda,   0,                                  $ImgX_topLeft       );
137             $x_bottomLeft   = &$Interpolate( $lambda,   $ImgX_topLeft       + $ImgStretch,  $ImgX_topLeft       );
138             $x_topRight     = &$Interpolate( $lambda,   $ImgX_bottomRight   + $ImgStretch,  $ImgX_bottomRight   );
139             $x_bottomRight  = &$Interpolate( $lambda,   $ImgX_bottomRight   - $ImgStretch,  $ImgX_bottomRight   );
140             &drawFlipFrame( ( $imgIdx + 1 ) % $NoImages );
141         }                                                                               # end if-else
142     }                                                                                   # until all steps processed
143 }                                                                                       #until all images processed
144 print   locate( $CursorY, $CursorX ), clline,                                           #report end of frame processing
145         colored ['bold green'], $FrameNo, " frames\n\n";
146 undef $Canvas;                                                                          #destroy the canvas object
147 undef $Images;                                                                          #destroy the source image object
148 #-------------------------------------------------------------------------------------------------------------------------------
149 # 3) CREATE ANIMATED GIF IMAGE:
150 print 'Creating animated GIF image... ';                                                #report start of animation processing
151 $Frames->Write                                                                          #output the animation
152             (   delay       => $$Anim{delay},
153                 loop        => $$Anim{loops},
154                 dispose     => 'background',
155                 filename    => $$Anim{output}
156             );
157 print colored ['bold green'], $$Anim{output}, "\n";                                     #report end of animation processing
158 exit;
159 #===== SUBROUTINES =============================================================================================================
160 #     Usage : &drawTwirlFrame( $IMGINDEX );
161 #   Purpose : Draw a "twirl" animation frame with the specified image index
162 # Arguments : $IMGINDEX = index of the ImageMagick object $Images.
163 #      Subs : None.
164 #   Remarks : None.
165 #   History : v1.0.0 - September 24, 2009 - Original release.
166
167 sub drawTwirlFrame {                                                                    #begin sub
168     my $imgIdx = shift;                                                                 # parameterize the argument
169
170     @$Canvas = ();                                                                      # clear the canvas
171     $Canvas->Set( size => "${CanvasWidth}x${CanvasHeight}" );                           # set canvas size
172     $Canvas->ReadImage( 'xc:transparent' );                                             # set canvas background to transparent
173     $Canvas->Composite                                                                  # init canvas with designated image
174                 (   image           => $Images->[$imgIdx],
175                     compose         => 'Over',
176                     geometry        => "${ImgWidth}x${ImgHeight}+0+$ImgStretch"
177                 );
178     $Canvas->Distort                                                                    # match image corners to perspective apexes:
179                 (   points          =>  [   $ImgX_topLeft,      $ImgY_topLeft,      $x_left,    $y_topLeft,    # top left
180                                             $ImgX_topLeft,      $ImgY_bottomRight,  $x_left,    $y_bottomLeft, # bottom left
181                                             $ImgX_bottomRight,  $ImgY_topLeft,      $x_right,   $y_topRight,   # top right
182                                             $ImgX_bottomRight,  $ImgY_bottomRight,  $x_right,   $y_bottomRight # bottom right
183                                         ],
184                     type            => 'Bilinear',
185                     'virtual-pixel' => 'transparent',
186                     'best-fit'      => 1,
187                 );
188     push @$Frames, @$Canvas;                                                            # add canvas to image sequence
189     print   locate( $CursorY, $CursorX ), clline,                                       # report frame processing
190             colored ['bold yellow'], '(', $Spinners[++$FrameNo % 4], ')';
191 }                                                                                       #end sub drawTwirlFrame
192 #-------------------------------------------------------------------------------------------------------------------------------
193 #     Usage : &drawFlipFrame( $IMGINDEX );
194 #   Purpose : Draw a "flip" animation frame with the specified image index
195 # Arguments : $IMGINDEX = index of the ImageMagick object $Images.
196 #      Subs : None.
197 #   Remarks : None.
198 #   History : v1.0.0 - September 24, 2009 - Original release.
199
200 sub drawFlipFrame {                                                                     #begin sub
201     my $imgIdx = shift;                                                                 # parameterize the argument
202
203     @$Canvas = ();                                                                      # clear the canvas
204     $Canvas->Set( size => "${CanvasWidth}x${CanvasHeight}" );                           # set canvas size
205     $Canvas->ReadImage( 'xc:transparent' );                                             # set canvas background to transparent
206     $Canvas->Composite                                                                  # init canvas with designated image
207                 (   image           => $Images->[$imgIdx],
208                     compose         => 'Over',
209                     geometry        => "${ImgWidth}x${ImgHeight}+$ImgStretch+0"
210                 );
211     $Canvas->Distort                                                                    # match image corners to perspective apexes:
212                 (   points          =>  [   $ImgX_topLeft,      $ImgY_topLeft,      $x_topLeft,     $y_top,    # top left
213                                             $ImgX_topLeft,      $ImgY_bottomRight,  $x_bottomLeft,  $y_bottom, # bottom left
214                                             $ImgX_bottomRight,  $ImgY_topLeft,      $x_topRight,    $y_top,    # top right
215                                             $ImgX_bottomRight,  $ImgY_bottomRight,  $x_bottomRight, $y_bottom  # bottom right
216                                         ],
217                     type            => 'Bilinear',
218                     'virtual-pixel' => 'transparent',
219                     'best-fit'      => 1,
220                 );
221     push @$Frames, @$Canvas;                                                            # add canvas to image sequence
222     print   locate( $CursorY, $CursorX ), clline,                                       # report frame processing
223             colored ['bold yellow'], '(', $Spinners[++$FrameNo % 4], ')';
224 }                                                                                       #end sub drawFlipFrame
225 #===== Copyright 2009, Webpraxis Consulting Ltd. - ALL RIGHTS RESERVED - Email: webpraxis@gmail.com ============================
226 # end of anim_flipcard.pl
			

© 2024 Webpraxis Consulting Ltd. – ALL RIGHTS RESERVED.