API tools faq
paste
AbdealiJK

Code to find EXIF Faces

AbdealiJK
May 6th, 2016
93
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Perl 22.76 KB | None | 0 0
raw download clone embed print report
  1. #!/usr/bin/perl -w
  2. # Taken from:
  3. # http://u88.n24.queensu.ca/pub/facetest.pl
  4. # http://u88.n24.queensu.ca/exiftool/forum/index.php?topic=3156.0
  5. #------------------------------------------------------------------------------
  6. # File:         facetest.pl
  7. #
  8. # Syntax:       facetest.pl [MAKE|DIR|FILE]...
  9. #
  10. # Description:  test face detection/recognition decoding
  11. #
  12. # Revisions:    2011/02/26 - P. Harvey created
  13. #               2011/03/27 - PH Restructured to provide FaceList() function
  14. #                            and added support for more makes
  15. #
  16. # Face Colors:  Red/Blue - basic face area from newer/older format metadata
  17. #               Green    - primary face(s)?
  18. #               Orange   - recognized faces
  19. #
  20. # Notes:      - requires imagemagick 'convert' to be installed
  21. #             - draws rectangles around faces and writes resized output images
  22. #             - output images are written to 'tmp' directory
  23. #             - defaults to input directory of '../testpics/facedetect/Olympus'
  24. #             - processes only JPG images
  25. #------------------------------------------------------------------------------
  26. use strict;
  27.  
  28. BEGIN { unshift @INC, 'lib' }
  29. use Image::ExifTool;
  30.  
  31. sub FaceList($$);   # prototype for the subroutine that does all of the hard work
  32.  
  33. # configurable parameters
  34. my $resize = 640;   # maximum width of rescaled images
  35. my $dstdir = 'tmp'; # destination directory for output images
  36.  
  37. my @files = @ARGV;
  38. @files or push @files, '../testpics/facedetect/Olympus';
  39. my $exifTool = new Image::ExifTool;
  40.  
  41. mkdir $dstdir;      # make sure destination directory exists
  42.  
  43. my $file;
  44. foreach $file (@files) {
  45.     unless (-e $file) {
  46.         my $f = "../testpics/facedetect/$file";
  47.         unless (-e $f) {
  48.             warn("Can't open $file\n");
  49.             next;
  50.         }
  51.         $file = $f;
  52.     }
  53.     if (-d $file) {
  54.         # read all files in directory (recursively)
  55.         opendir DIR, $file or warn("Error opening $file\n"), next;
  56.         my @f = readdir DIR;
  57.         closedir DIR;
  58.         foreach (@f) {
  59.             next if /^\./;
  60.             push @files, "$file/$_";
  61.         }
  62.         next;
  63.     }
  64.     next unless $file =~ /\.jpe?g$/i; # process only JPEG images
  65.        
  66.     print "==== $file ";
  67.     my $info = $exifTool->ImageInfo($file);
  68.    
  69.     # get the list of face information hashes
  70.     my $faceList = FaceList($exifTool, $info);
  71.  
  72.     unless (ref $faceList) {
  73.         print "[no face information]\n";
  74.         warn "$faceList\n" if $faceList;
  75.         next;
  76.     }
  77.     print "[$$info{Make}]\n";
  78.  
  79.     my ($width, $height) = @$info{'ImageWidth','ImageHeight'};
  80.     my $aspect = $height / $width;
  81.     # calculate dimensions for a resized image with a max width of $resize pixels
  82.     my ($rw, $rh);
  83.     if ($aspect < 1) {
  84.         ($rw, $rh) = ($resize, int($resize * $aspect + 0.5));
  85.     } else {
  86.         ($rw, $rh) = (int($resize / $aspect + 0.5), $resize);
  87.     }
  88.     my @s = ($rw,$rh,$rw,$rh);  # scaling factors for face coordinates
  89.  
  90.     # initialize 'convert' command with default drawing parameters
  91.     my $cmd = "convert '$file' -fill none -strokewidth 2 -resize ${rw}x$rh";
  92.  
  93.     my $index = -1;
  94.     foreach my $faceInfo (@$faceList) {
  95.         # set the rectangle colour
  96.         my $idx = $$faceInfo{Type} || 0;
  97.         unless ($idx == $index) {
  98.             $index = $idx;
  99.             $idx = 2 if $idx > 3;
  100.             $cmd .= ' -stroke ' . ['red','green','blue','orange']->[$idx];
  101.         }
  102.         # scale the face rectangle to the coordinates of the resized image
  103.         my @p;
  104.         for (my $i=0; $i<4; ++$i) {
  105.             $p[$i] = int($$faceInfo{Position}[$i] * $s[$i] + 0.5);
  106.         }
  107.         # draw the face rectangle
  108.         $cmd .= " -draw 'rectangle $p[0],$p[1] $p[2],$p[3]'";
  109.  
  110.         if (defined $$faceInfo{Rotation}) {
  111.             # draw the face orientation
  112.             my $ang = $$faceInfo{Rotation} * 3.14159 / 180;  # convert to radians
  113.             my ($cx, $cy) = (($p[0]+$p[2])/2, ($p[1]+$p[3])/2);
  114.             my ($w, $h) = (abs($p[2]-$p[0]), abs($p[3]-$p[1]));
  115.             my ($x, $y) = (int(($cx+$w/2*sin($ang))*10)/10, int(($cy-$h/2*cos($ang))*10)/10);
  116.             $cmd .= " -draw \"path 'M $cx,$cy L $x,$y'\"";
  117.         }
  118.     }
  119.     $index > -1 or print("No face\n"), next;
  120.  
  121.     # add destination filename to command
  122.     my $name = $file;
  123.     $name =~ s/.*\///; # remove directory name
  124.     $cmd .= " '$dstdir/$name'";
  125.  
  126.     # resize the image and draw the face positions
  127.     print "$cmd\n";
  128.     system $cmd;
  129. }
  130.  
  131. #------------------------------------------------------------------------------
  132. # check to see if all specified tags were found
  133. # Inputs: 0) tag info hash, 1) message to return, 2-N) tag names
  134. # Returns: true if specified tags exist
  135. sub Found($$@)
  136. {
  137.     local $_;
  138.     my $info = $_[0];
  139.     foreach (@_[2..$#_]) {
  140.         next if defined $$info{$_};
  141.         $_[1] = "Missing $_";
  142.         return 0;
  143.     }
  144.     return 1;
  145. }
  146.  
  147. #------------------------------------------------------------------------------
  148. # Get margines and size of cropped image area in face detect frame
  149. # Inputs: 0/1) face detect frame width/height
  150. #         2) aspect ratio of original image (must be < 1)
  151. # Returns: 0/1) X/Y cropped border size
  152. #          2/3) width/height of cropped image
  153. sub GetCropArea($$$)
  154. {
  155.     my ($fw, $fh, $aspect) = @_;
  156.     my $crop_w = $fw;
  157.     my $crop_h = $fw * $aspect;
  158.     if ($crop_h > $fh) {
  159.         $crop_w = $fh / $aspect;
  160.         $crop_h = $fh;
  161.     }
  162.     my ($crop_x, $crop_y) = (($fw - $crop_w) / 2, ($fh - $crop_h) / 2);
  163.     return ($crop_x, $crop_y, $crop_w, $crop_h);
  164. }
  165.  
  166. #------------------------------------------------------------------------------
  167. # Return normalized face information from tags extracted by ExifTool
  168. # Inputs: 0) ExifTool object reference
  169. #         1) image information hash reference (from call to ImageInfo)
  170. # Returns: undef if there is no face-detect information, or
  171. #          error string if there there were no faces or there was an error, or
  172. #          reference to array of face information hashes on success
  173. # Face information hash elements:
  174. #   Position - left,top,right,bottom coordinates of face as a fraction of image size
  175. #   Rotation - [optional] CW rotation angle of face in degrees
  176. #   Type     - [optional] type of face information:
  177. #                         0=normal, 1=primary, 2=old models, 3=recognized
  178. #   Name     - [optional] face name if recognized (FujiFilm, Panasonic)
  179. #   Age      - [optional] age of person (FujiFilm, Panasonic)
  180. #   Category - [optional] camera category for this face (FujiFilm)
  181. sub FaceList($$)
  182. {
  183.     local $_;
  184.     my ($exifTool, $info) = @_;
  185.     my ($tag, $make, @faceList, $wasRotated, $msg, $i);
  186.    
  187.     return undef unless $$info{ImageWidth} and $$info{ImageHeight};
  188.  
  189.     my ($width, $height) = @$info{'ImageWidth','ImageHeight'};
  190.     # all face detect coordinates are in unrotated image
  191.     if ($height > $width) {
  192.         # image was probably rotated, but face detect coordinates are always
  193.         # given for the unrotated image, so assume that width is the long dimension
  194.         my $tmp = $width;
  195.         $width = $height;
  196.         $height = $tmp;
  197.         $wasRotated = 1;
  198.     }
  199.     my $aspect = $height / $width;
  200.     my ($fw, $fh);  # face detect frame width/height
  201.     my ($sx, $sy);  # x/y scaling factors
  202.  
  203.     # get the ExifTool manufacturer group name
  204.     foreach $tag ('FacesDetected', 'ValidAFPoints') {
  205.         next unless defined $$info{$tag};
  206.         $make = $exifTool->GetGroup($tag, 1);
  207.         last;
  208.     }
  209.     my $model = $$info{Model} || '';
  210.     $make or return 'Unrecognized face information!';
  211. #
  212. # unfortunately each manufacturer has its own way of storing face detection
  213. # information, so we must handle them all differently...
  214. #
  215.     if ($make eq 'Sony') {
  216.  
  217.        return $msg unless Found($info, $msg, 'FacesDetected', 'Face1Position');
  218.         # calculate scaling factors for face detect area coordinates
  219.         ($sx, $sy) = (1/$width, 1/$height);
  220.         for ($i=1; ; ++$i) {
  221.             my $tag = "Face${i}Position";
  222.             last unless $$info{$tag};
  223.             my @a = split ' ', $$info{$tag};
  224.             last unless @a >= 4;
  225.             my ($x1, $y1) = ($a[1]*$sx, $a[0]*$sy);
  226.             my ($x2, $y2) = ($x1+$a[3]*$sx, $y1+$a[2]*$sy);
  227.             push @faceList, { Position => [$x1, $y1, $x2, $y2] };
  228.         }
  229.  
  230.     } elsif ($make eq 'FujiFilm') {
  231.  
  232.         return $msg unless Found($info, $msg, 'FacesDetected', 'FacePositions');
  233.         my $n = $$info{FacesDetected} or return 'No faces';
  234.         my @a = split ' ', $$info{FacePositions};
  235.         ($sx, $sy) = (1/$width, 1/$height);
  236.         for ($i=0; $i<$n; ++$i) {
  237.             my ($x1, $y1) = ($a[$i*4]*$sx, $a[$i*4+1]*$sy);
  238.             my ($x2, $y2) = ($a[$i*4+2]*$sx, $a[$i*4+3]*$sy);
  239.             my $faceInfo = { Position => [$x1, $y1, $x2, $y2] };
  240.             push @faceList, $faceInfo;
  241.             my $name = $$info{"Face${i}Name"};
  242.             next unless defined $name;
  243.             $$faceInfo{Type} = 3; # recognized face
  244.             $$faceInfo{Name} = $name;
  245.             $$faceInfo{Category} = $$info{"Face${i}Category"};
  246.             # calculate age
  247.             my $bday = $$info{"Face${i}Birthday"} or next;
  248.             my $date = $$info{DateTimeOriginal} || $$info{CreateDate} or next;
  249.             my @t1 = $bday =~ /\d+/g;
  250.             my @t2 = $date =~ /\d+/g;
  251.             push @t1, 0 while @t1 < 6;  # pad with zeros
  252.             push @t2, 0 while @t1 < 6;
  253.             my $borrow = 0;
  254.             my ($j, @age);
  255.             for ($j=5; $j>=0; --$j) {
  256.                 $age[$j] = $t2[$j] - $t1[$j] - $borrow;
  257.                 $age[$j] >= 0 and $borrow = 0, next;
  258.                 last unless $j;
  259.                 # handle borrow in subtraction
  260.                 $borrow = 1;
  261.                 my $add = [0, 12, 0, 24, 60, 60]->[$j];
  262.                 $add and $age[$j] += $add, next;
  263.                 # borrow days from the month before
  264.                 my ($m, $y) = ($t2[1]-1, $t2[0]);
  265.                 $age[$j] += [31,31,28,31,30,31,30,31,31,30,31,30]->[$m];
  266.                 # handle leap years if month is February
  267.                 $age[$j] += 1 if $m==2 and $y % 4 and ($y % 100 or not $y % 400);
  268.             }
  269.             $$faceInfo{Age} = sprintf('%.4d:%.2d:%.2d %.2d:%.2d:%.2d', @age);
  270.         }
  271.  
  272.     } elsif ($make eq 'Nikon') {
  273.  
  274.         return $msg unless Found($info, $msg, 'FacesDetected', 'FaceDetectFrameSize', 'Face1Position');
  275.         ($fw,$fh) = split ' ', $$info{FaceDetectFrameSize};
  276.         # (note: have seen crazy $fh for S550, so scale Y by same factor as X)
  277.         ($sx,$sy) = (1/$fw, 1/$fh);
  278.         for ($i=1; ; ++$i) {
  279.             my $val = $$info{"Face${i}Position"} or last;
  280.             my @a = split ' ', $val;
  281.             # (have seen high bit set in a S550 sample, so reset it just in case)
  282.             my ($x1,$y1) = (($a[0]&0x7fff)*$sx, ($a[1]&0x7fff)*$sy);
  283.             my ($x2,$y2) = ($x1+$a[2]*$sx, $y1+$a[3]*$sy);
  284.             push @faceList, { Position => [$x1, $y1, $x2, $y2] };
  285.         }
  286.  
  287.     } elsif ($make eq 'Panasonic') {
  288.  
  289.         return $msg unless Found($info, $msg, 'FacesDetected', 'Face1Position');
  290.         # face detect frame is 320 pixels wide unless aspect ratio is less than 3/4
  291.         if ($aspect <= 3/4) {
  292.             ($fw, $fh) = (320, 320 * $aspect);
  293.         } else {
  294.             ($fw, $fh) = (240 / $aspect, 240);
  295.         }
  296.         ($sx, $sy) = (1/$fw, 1/$fh);
  297.         my $type;
  298.         for ($type=0; $type<2; ++$type) {
  299.             my $pre = $type ? 'Recognized' : '';
  300.             for ($i=1; ; ++$i) {
  301.                 my $val = $$info{"${pre}Face${i}Position"} or last;
  302.                 my @a = split ' ', $val;
  303.                 my ($x1,$y1) = (($a[0]-$a[2]/2)*$sx, ($a[1]-$a[3]/2)*$sy);
  304.                 my ($x2,$y2) = ($x1+$a[2]*$sx, $y1+$a[3]*$sy);
  305.                 my $faceInfo = { Position => [$x1, $y1, $x2, $y2] };
  306.                 push @faceList, $faceInfo;
  307.                 next unless $type;
  308.                 $$faceInfo{Type} = 3;  # use index 3 for recognized faces
  309.                 $$faceInfo{Name} = $$info{"RecognizedFace${i}Name"};
  310.                 $$faceInfo{Age} = $$info{"RecognizedFace${i}Age"};
  311.             }
  312.         }
  313.  
  314.     } elsif ($make eq 'Pentax') {
  315.  
  316.         return $msg unless Found($info, $msg, 'FacesDetected', 'Face1Position');
  317.         my $n = $$info{FacesDetected};
  318.         $n or return 'No faces';
  319.         ($sx,$sy) = (1/$width, 1/$height);
  320.         for ($i=1; $i<=$n; ++$i) {
  321.             my $val = $$info{"Face${i}Position"} or last;
  322.             my ($x,$y) = split ' ', $val;
  323.             $val = $$info{"Face${i}Size"} or last;
  324.             my ($w,$h) = split ' ', $val;
  325.             my ($x1,$y1) = (($x-$w/2)*$sx, ($y-$h/2)*$sy);
  326.             my ($x2,$y2) = ($x1+$w*$sx, $y1+$h*$sy);
  327.             push @faceList, { Position => [$x1, $y1, $x2, $y2] };
  328.         }
  329.         if ($$info{'FacePosition'}) {
  330.             my ($x,$y) = split ' ', $$info{FacePosition};
  331.             my $w = 100; # (just pull a number for the face size out of thin air)
  332.             my ($x1,$y1) = ($x/100-$w/2, $y/100-$w/2);
  333.             my ($x2,$y2) = ($x1+$w, $y1+$w);
  334.             # set the Type for the primary face
  335.             push @faceList, { Position => [$x1, $y1, $x2, $y2], Type => 1 };
  336.         }
  337.  
  338.     } elsif ($make eq 'Sanyo') {
  339.  
  340.         return $msg unless Found($info, $msg, 'FacesDetected', 'FacePosition');
  341.         # face detect frame is 640 pixels wide
  342.         ($fw, $fh) = (640, 640 * $aspect);
  343.         ($sx, $sy) = (1/$fw, 1/$fh);
  344.         my $val = $$info{"FacePosition"} or last;
  345.         my @a = split ' ', $val;
  346.         my ($x1,$y1) = ($a[0]*$sx, $a[1]*$sy);
  347.         my ($x2,$y2) = ($a[2]*$sx, $a[3]*$sy);
  348.         push @faceList, { Position => [$x1, $y1, $x2, $y2] };
  349.  
  350.     } elsif ($make eq 'Casio') {
  351.  
  352.         return $msg unless Found($info, $msg, 'FacesDetected', 'FaceDetectFrameSize', 'Face1Position');
  353.         # extract face orientation if available
  354.         my $rot;
  355.         $rot = $$info{FaceOrientation} =~ /(\d+)/ ? $1 : 0 if $$info{FaceOrientation};
  356.         ($fw, $fh) = split ' ', $$info{FaceDetectFrameSize};
  357.         my ($crop_x, $crop_y, $crop_w, $crop_h) = GetCropArea($fw, $fh, $aspect);
  358.         ($sx, $sy) = (1/$crop_w, 1/$crop_h);
  359.         for ($i=1; ; ++$i) {
  360.             my $val = $$info{"Face${i}Position"} or last;
  361.             my @a = split ' ', $val;
  362.             my ($x1,$y1) = (($a[0]-$crop_x)*$sx, ($a[1]-$crop_y)*$sy);
  363.             my ($x2,$y2) = (($a[2]-$crop_x)*$sx, ($a[3]-$crop_y)*$sy);
  364.             my $faceInfo = { Position => [$x1, $y1, $x2, $y2] };
  365.             $$faceInfo{Rotation} = $rot if defined $rot;
  366.             push @faceList, $faceInfo;
  367.         }
  368.  
  369.     } elsif ($make eq 'Ricoh') {
  370.  
  371.         return $msg unless Found($info, $msg, 'FacesDetected', 'FaceDetectFrameSize', 'Face1Position');
  372.         ($fw, $fh) = split ' ', $$info{FaceDetectFrameSize};
  373.         my ($sx, $sy) = (1/$fw, 1/$fh);
  374.         for ($i=1; ; ++$i) {
  375.             my $val = $$info{"Face${i}Position"} or last;
  376.             my ($x,$y,$w,$h) = split ' ', $val;
  377.             my ($x1,$y1) = ($x/$fw, $y*$sy);
  378.             my ($x2,$y2) = (($x+$w)*$sx, ($y+$h)*$sy);
  379.             push @faceList, { Position => [$x1, $y1, $x2, $y2] };
  380.         }
  381.  
  382.     } elsif ($make eq 'Canon') {
  383.  
  384.         # older models store face detect information
  385.         if ($$info{FacesDetected} and $$info{FaceDetectFrameSize}) {
  386.             return 'No faces' unless $$info{FacesDetected};
  387.             ($fw, $fh) = split ' ', $$info{FaceDetectFrameSize};
  388.             $fw or ($fw,$fh) = (320,240);
  389.             ($sx,$sy) = (1/$fw, 1/$fh);
  390.             my $facewid = $$info{FaceWidth} || 35;
  391.             for ($i=1; ; ++$i) {
  392.                 my $val = $$info{"Face${i}Position"} or last;
  393.                 my @a = split ' ', $val;
  394.                 my ($x1,$y1) = (($a[0]+$fw/2-$facewid)*$sx, ($a[1]+$fh/2-$facewid)*$sy);
  395.                 my ($x2,$y2) = ($x1+$facewid*2*$sx, $y1+$facewid*2*$sy);
  396.                 # set Type to 2 for older Canon face-detect information
  397.                 push @faceList, { Position => [$x1, $y1, $x2, $y2], Type => 2 };
  398.             }
  399.         } else { # newer models use AF points
  400.             return $msg unless Found($info, $msg, 'ValidAFPoints', 'AFImageWidth', 'AFImageHeight',
  401.                               'AFAreaXPositions', 'AFAreaYPositions', 'PrimaryAFPoint');
  402.             # test for face detect mode
  403.             unless ($$info{AFAreaMode} and $$info{AFAreaMode} =~ /Face/) {
  404.                 return 'Face detect off';
  405.             }
  406.             my ($width, $height) = @$info{'AFImageWidth', 'AFImageHeight'};
  407.             my @x = split ' ', $$info{AFAreaXPositions};
  408.             my @y = split ' ', $$info{AFAreaYPositions};
  409.             # sometimes widths are stored separately for each AF area
  410.             my (@w, @h);
  411.             if ($$info{AFAreaWidths}) {
  412.                 @w = split ' ', $$info{AFAreaWidths};
  413.                 @h = split ' ', $$info{AFAreaHeights};
  414.             } elsif ($$info{AFAreaWidth}) {
  415.                 @w = ($$info{AFAreaWidth}) x (scalar @x);
  416.                 @h = ($$info{AFAreaHeight}) x (scalar @x);
  417.             } else {
  418.                 return 'No AF area size';
  419.             }
  420.             # convert to positive coordinates
  421.             $_ += $width/2 foreach @x;
  422.             $_ += $height/2 foreach @y;
  423.             # EOS models have Y flipped
  424.             if ($model =~ /EOS/) {
  425.                 $_ = $height - $_ foreach @y;
  426.             }
  427.             # calculate scaling factors for AF area coordinates
  428.             ($sx,$sy) = (1/$width, 1/$height);
  429.             for ($i=0; $i<$$info{ValidAFPoints}; ++$i) {
  430.                 my ($x1,$y1) = (($x[$i]-$w[$i]/2)*$sx, ($y[$i]-$h[$i]/2)*$sy);
  431.                 my ($x2,$y2) = ($x1+$w[$i]*$sx, $y1+$h[$i]*$sy);
  432.                 push @faceList, { Position => [$x1, $y1, $x2, $y2] };
  433.             }
  434.         }
  435.  
  436.     } elsif ($make eq 'Olympus') {
  437.  
  438.         # Olympus stores 1 or 2 (or maybe more in the future) sets of face-detect data.
  439.         # I'm not sure why, but the 2nd set (Type 1) seems to be more accurate.
  440.         return $msg unless Found($info, $msg, 'FacesDetected', 'FaceDetectArea');
  441.         my @f = split ' ', $$info{FacesDetected};
  442.         return 'No faces' unless $f[0] or $f[1];
  443.         my @a = split ' ', ${$$info{FaceDetectArea}};
  444.         my (@m, $type, $index);
  445.         if ($$info{MaxFaces}) {
  446.             @m = split ' ', $$info{MaxFaces};
  447.             $type = 'new';
  448.             $index = 0;
  449.         } else {
  450.             push @m, 0;
  451.             $index = 2; # information from older models
  452.         }
  453.  
  454.         # get face detect frame size
  455.         if ($$info{FaceDetectFrameSize} and
  456.             $$info{FaceDetectFrameSize} =~ /^(\d+) (\d+)/)
  457.         {
  458.             ($fw, $fh) = ($1, $2);
  459.         } else {
  460.             ($fw, $fh) = (240, 180);  # empirically determined for older models
  461.         }
  462.  
  463.         # get width/height of largest resized image that fits into face detect frame
  464.         my ($crop_w, $crop_h, $crop_x, $crop_y);
  465.         if ($$info{FaceDetectFrameCrop} and
  466.             $$info{FaceDetectFrameCrop} =~ /^(\d+) (\d+) (\d+) (\d+)/)
  467.         {
  468.             ($crop_x, $crop_y, $crop_w, $crop_h) = ($1, $2, $3, $4);
  469.         } else {
  470.             ($crop_x, $crop_y, $crop_w, $crop_h) = GetCropArea($fw, $fh, $aspect);
  471.         }
  472.         ($sx, $sy) = (1/$crop_w, 1/$crop_h);
  473.         my $rot = 90; # default rotation angle to landscape
  474.         my ($orient, $max);
  475.         $orient = $1 if $$info{Orientation} and $$info{Orientation} =~ /(\d+)/;
  476.         my $pos = 0;
  477.         foreach $max (@m) {
  478.             my $faces = shift @f;
  479.             my $face;
  480.             for ($face=0; $face<$faces; ++$face) {
  481.                 last if $pos + 4 > scalar @a;
  482.                 my $n = $pos + $face * ($type ? 4 : 8);
  483.                 my ($x1,$y1,$x2,$y2,$xc,$yc,$rotation);
  484.                 if ($type) {
  485.                     my ($x,$y,$w,$r) = @a[$n..($n+3)];
  486.                     if (defined $orient) {
  487.                         # the angle depends on orientation for some models (doh!)
  488.                         $r -= $orient if $model eq 'u-7050';
  489.                     } else {
  490.                         # rotate by 270 if any face orientation is 270 degrees
  491.                         $rot = 270 if $r == 270;
  492.                         # again, angle depends on orientation for some models
  493.                         $r -= $rot if $wasRotated and $model =~ /^FE4030/;
  494.                     }
  495.                     $rotation = $r;
  496.                     $rotation += 360 if $rotation < 0;
  497.                     my $hx = $w * $sx / 2;
  498.                     my $hy = $w * $sy / 2;
  499.                     # adjust coordinates for cropped border and normalize
  500.                     $xc = ($x - $crop_x) * $sx;
  501.                     $yc = ($y - $crop_y) * $sy;
  502.                     ($x1, $y1) = ($xc - $hx, $yc - $hy);
  503.                     ($x2, $y2) = ($x1 + $w * $sx, $y1 + $w * $sy);
  504.                 } else {
  505.                     # adjust coordinates for cropped image
  506.                     for ($i=$n; $i<$n+8; $i+=2) {
  507.                         $a[$i] = ($a[$i] - $crop_x) * $sx;
  508.                         $a[$i+1] = ($a[$i+1] - $crop_y) * $sy;
  509.                     }
  510.                     my ($x3,$y3,$x4,$y4);
  511.                     ($x1,$y1,$x2,$y2,$x3,$y3,$x4,$y4) = @a[$n..($n+7)];
  512.                     if ($y1 == $y2) {
  513.                         $rotation = $x1 < $x2 ? 0 : 180;
  514.                     } else {
  515.                         $rotation = $y1 < $y2 ? 90 : 270;
  516.                     }
  517.                     $x2 = $x3 if $x2 == $x1;
  518.                     $y2 = $y3 if $y2 == $y1;
  519.                 }
  520.                 # draw the face rectangle and line pointing to the top of the face
  521.                 push @faceList, {
  522.                     Position => [$x1, $y1, $x2, $y2],
  523.                     Rotation => $rotation,
  524.                     Type => $index,
  525.                 };
  526.             }
  527.             $pos += $max * 4;
  528.             ++$index;
  529.         }
  530.  
  531.     } else {
  532.  
  533.         return "Sorry, $make images not yet supported";
  534.  
  535.     }
  536.  
  537.     # finally, rotate face coordinates if image was rotated
  538.     if ($wasRotated) {
  539.         my $rot = 270;
  540.         my $faceInfo;
  541.         foreach $faceInfo (@faceList) {
  542.             next unless defined $$faceInfo{Rotation};
  543.             $rot = $$faceInfo{Rotation} < 180 ? 90 : 270;
  544.             last;
  545.         }
  546.         # rotate face coordinates
  547.         foreach $faceInfo (@faceList) {
  548.             my $p = $$faceInfo{Position};
  549.             if ($rot == 90) {
  550.                 @$p = ($$p[1], 1-$$p[0], $$p[3], 1-$$p[2]);
  551.             } else {
  552.                 @$p = (1-$$p[1], $$p[0], 1-$$p[3], $$p[2]);
  553.             }
  554.             next unless defined $$faceInfo{Rotation};
  555.             $$faceInfo{Rotation} -= $rot;
  556.             $$faceInfo{Rotation} += 360 if $$faceInfo{Rotation} < 0;
  557.         }
  558.     }
  559.     return \@faceList;
  560. }
  561.  
  562. # end
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!