2x_zoom.pl 2.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123
  1. #!/usr/bin/perl
  2. # Daniel "Trizen" Șuteu
  3. # License: GPLv3
  4. # Date: 11 March 2017
  5. # https://github.com/trizen
  6. # A simple gap-filling algorithm for applying a 2x zoom to an image.
  7. use 5.010;
  8. use strict;
  9. use warnings;
  10. use Imager;
  11. use List::Util qw(sum);
  12. my $file = shift(@ARGV) // die "usage: $0 [image]\n";
  13. my $img = Imager->new(file => $file)
  14. or die Imager->errstr();
  15. my $width = $img->getwidth;
  16. my $height = $img->getheight;
  17. my @matrix;
  18. foreach my $y (0 .. $height - 1) {
  19. foreach my $x (0 .. $width - 1) {
  20. $matrix[$y][$x] = $img->getpixel(x => $x, y => $y);
  21. }
  22. }
  23. my $out_img = Imager->new(xsize => 2 * $width,
  24. ysize => 2 * $height);
  25. sub gap_color {
  26. my ($x, $y) = @_;
  27. my @neighbors;
  28. if ($y > 0) {
  29. # Top neighbor
  30. if ($x < $width) {
  31. push @neighbors, $matrix[$y - 1][$x];
  32. }
  33. # Top-right neighbor
  34. if ($x < $width - 1) {
  35. push @neighbors, $matrix[$y - 1][$x + 1];
  36. }
  37. # Top-left neighbor
  38. if ($x > 0) {
  39. push @neighbors, $matrix[$y - 1][$x - 1];
  40. }
  41. }
  42. if ($y < $height - 1) {
  43. # Bottom neighbor
  44. if ($x < $width) {
  45. push @neighbors, $matrix[$y + 1][$x];
  46. }
  47. # Bottom-right neighbor
  48. if ($x < $width - 1) {
  49. push @neighbors, $matrix[$y + 1][$x + 1];
  50. }
  51. # Bottom-left neighbor
  52. if ($x > 0) {
  53. push @neighbors, $matrix[$y + 1][$x - 1];
  54. }
  55. }
  56. if ($y < $height) {
  57. # Left neighbor
  58. if ($x > 0) {
  59. push @neighbors, $matrix[$y][$x - 1];
  60. }
  61. # Right neighbor
  62. if ($x < $width - 1) {
  63. push @neighbors, $matrix[$y][$x + 1];
  64. }
  65. }
  66. # Get the RGBA colors
  67. my @colors = map { [$_->rgba] } @neighbors;
  68. my @red = map { $_->[0] } @colors;
  69. my @blue = map { $_->[1] } @colors;
  70. my @green = map { $_->[2] } @colors;
  71. my @alpha = map { $_->[3] } @colors;
  72. #<<<
  73. # Compute the average gap-filling color
  74. my @gap_color = (
  75. sum(@red ) / @red,
  76. sum(@blue ) / @blue,
  77. sum(@green) / @green,
  78. sum(@alpha) / @alpha,
  79. );
  80. #>>>
  81. return \@gap_color;
  82. }
  83. foreach my $y (0 .. $#matrix) {
  84. foreach my $x (0 .. $#{$matrix[$y]}) {
  85. #<<<
  86. # Fill the gaps
  87. $out_img->setpixel(x => 2 * $x, y => 2 * $y, color => $matrix[$y][$x]);
  88. $out_img->setpixel(x => 2 * $x + 1, y => 2 * $y + 1, color => gap_color($x + 1, $y + 1));
  89. $out_img->setpixel(x => 2 * $x + 1, y => 2 * $y, color => gap_color($x + 1, $y ));
  90. $out_img->setpixel(x => 2 * $x, y => 2 * $y + 1, color => gap_color($x, $y + 1));
  91. #>>>
  92. }
  93. }
  94. $out_img->write(file => '2x_zoom.png');