resize_orthos.pl

The resize_orthos.tar.gz is not available because I can't upload it. It is not required for the script to work, only to run the example. -sw ​http://www.highwayengineer.co.medina.oh.us/resize_orthos.tar.gz

#!/usr/bin/perl -w
#
# Copyright (C) 2002, Lowell Filak.
# You may distribute this file under the terms of the Artistic
# License.
#
# Given a directory containing tiff(s) and tfw(s), the original pixel size,
#   the destination directory for resized & recolored tiff(s), & the new
#   pixel size this routine will resize & recolor the tiff(s) and write
#   new wld files to match.
#
# Required modules are Getopt (normally included with Perl).
#   A successful install of ImageMagick
#   is required. The routine does NOT utilize the ImageMagick perl module
#   at this time. The routine also assumes a *n*x system, please change
#   command lines accordingly.
#   Please download resize_orthos.tar.gz also, and:
#     tar -xf resize_orthos.tar.gz --ungzip
#
# Suggested run line = ./resize_orthos.pl -orig=orthos -osize=8 -out=new -nsize=10
################################################################################
use Getopt::Long;
#
# Subroutine for bailout on error.
sub bailout {
  print "*** HELP! I've Fallen & I Can't Get Up!\n";
  #
  # Throw marker in output message.
  print "*********************************************************************\n";
  #
  # Print date & time.
  system("date");
  exit 0;
} # end subroutine
################################################################################
#
# Main routine.
#
# Grab input values.
&GetOptions('orig=s' => \$orthos_orig, 'osize=s' => \$orig_size, 'out=s' => \$orthos_out, 'nsize=s' => \$new_size);
#
# Check the input values.
if ( (!$orthos_orig) || (!$orig_size) || (!$orthos_out) || (!$new_size) ) {
  print "Syntax: resize.pl -orig=[original_dir] -osize=[original_pixel_size] -out=[out_dir] -nsize=[new_pixel_size]\n";
  bailout;
}
#
# Declare variables.
#   Note: Please change this to your path to convert (whereis convert).
$convert = '/usr/X11R6/bin/convert';
#
# Make sure out directory exists.
#
# Split the path apart.
@mpath = split('/',$orthos_out);
#
# How many members to the path.
$mpathcnt = scalar @mpath;
#
# Is the first member blank, ie. ' '/home/global .
# Basically was an absolute or relative path specified.
if (!$mpath[0]) {
  #
  # Start with 1.
  $start = 1;
  #
  # Start path with /.
  $cpath = '/';
}
 else {
  #
  # Start with 0.
  $start = 0;
  #
  # Start path with ''.
  $cpath = '';
 }
#
# End with total -1.
$mpathcnt = $mpathcnt - 1;
for $pathpart ($start .. $mpathcnt) {
  #
  # Set the create path.
  $cpath = $cpath . $mpath[$pathpart];
  if ( -e "$cpath" ) {
    #
    # Do nothing.
  }
   else {
    #
    # Create it.
    @mkdirerror = system("mkdir $cpath");
    if ( $mkdirerror[0] > 0 ) {
      print "*** Mkdir $cpath Failed!\n";
      bailout;
    }
     else {
      #
      # Fall through.
     }
   }
  #
  # For lack of a better term "Increment" path.
  $cpath = $cpath.'/';
}
#
# Append the new size to the out dir to allow for multiple new sizes.
$orthos_out = $orthos_out . "/" . "$new_size";
#
# Print date & time just for information.
#@dateerror = system("date");
#
# Create the destination directory.
@mkdirerror = system("mkdir $orthos_out");
#
# We know the original pixel size is $orig_size so use that to determine
#   the percentage of reduction for the new size.
#   Notes: Try to keep this so the division comes out evenly. Uneven results
#         can leave black lines between tiles. This may only work for flat
#         projections.
my $percentage = $orig_size / $new_size * 100;
#
# Check the percentage.
if ( $percentage > 100 ) {
  print "Argh! I have no idea what the output will look like if I resample smaller.\n";
  bailout;
}
 else {
  #
  # Fall through.
 }
#
# Create a list of files to convert.
system("ls -1 $orthos_orig/*.tif > orthos.list");
#
# Read-in and loop through each ortho.
#
# Open the list.
open(ORTHOS, "<orthos.list");
#
# Loop.
while(<ORTHOS>) {
  #
  # Split the full path apart.
  #
  # Grab the line.
  my $full_path = $_;
  #
  # Remove the newline.
  $full_path =~ s/\n//;
  #
  # Split on the /.
  my @full_path = split(/\//, $full_path);
  #
  # How many parts to the path.
  my $path_length = scalar(@full_path);
  #
  # Bring the count down one to match array start of 0.
  $path_length = $path_length - 1;
  #
  # File name is the last member of array.
  my $file = $full_path[$path_length];
  #
  # Chop off file extension.
  my @file = split(/\./, $file);
  #
  # Set world file name to just name without extension.
  my $tfw = $file[0];
  #
  # Create temp & out file name.
  my $tmp_out = "/tmp/" . $file;
  my $file_out = $orthos_out . "/" . $file;
  #
  # See if tiff already exists.
  if ( -e "$file_out") {
    #
    # Do nothing.
  }
   else {
    #
    # Convert the resized tif image into /tmp.
    my $convert_line = $convert . " -geometry " . $percentage . "\%x" . $percentage . "\% " . $full_path . " " . $tmp_out;
    #
    # For debugging only.
    print "$convert_line\n";
    #
    # run the resize convert statement.
    @converterror = system("$convert_line");
    #
    # Convert the recolored tif image into $orthos_out.
    #   Note: This currently allows for 256 colors. It has been reported that
    #         this number must be smaller to allow for antialiased fonts. I
    #         have not experienced this directly but if it does create a
    #         problem change the 256 to a lower number.
    $convert_line = $convert . " -colors 256 " . $tmp_out . " " . $file_out;
    #
    # For debugging only.
    print "$convert_line\n";
    #
    # run the resize convert statement.
    @converterror = system("$convert_line");
    #
    # Remove temporary resized file.
    unlink $tmp_out;
   }
  #
  # Create original & out world file names.
  #   Note: In this case the original images are tfw instead of world files.
  my $tfw_in = $orthos_orig . "/" . $tfw . ".tfw";
  my $tfw_out = $orthos_out . "/" . $tfw . ".wld";
  #
  # See if tfw already exists.
  if ( -e "$tfw_out") {
    #
    # Do nothing.
  }
   else {
    #
    # Open the existing tfw for reading to create the new tfw.
    #
    # For debugging only.
    #print "$tfw_in\n";
    #
    # Open it.
    open(TFW, "<$tfw_in");
    #
    # Open new tfw for writing.
    #
    # For debugging only.
    #print "$tfw_out\n";
    #
    # Open it.
    open(TFWOUT, ">$tfw_out");
    #
    # Set a line counter.
    my $linenum = 1;
    #
    # Loop through each line.
    while(<TFW>) {
      #
      # Grab the line.
      my $line = $_;
      #
      # Remove leading spaces.
      $line =~ s/^\s+//;
      #
      # Remove newline, carriage return, or both.
      $line =~ s/\015\012|\015|\012//g;
      #
      # For debugging only.
      #print "$line\n";
      #
      # Is it line #1 or #4.
      if ( $linenum == 1 ) {
        #
        # If so print the new pixel size (x).
        print TFWOUT "$new_size\.000000\n";
      }
      elsif ( $linenum == 4 ) {
        #
        # If so print the new pixel size negative (y).
        print TFWOUT "-$new_size\.000000\n";
      }
       else {
        #
        # Else just dump the existing line.
        print TFWOUT "$line\n";
       }
      #
      # Increment the line counter.
      $linenum = $linenum + 1;
    }
    #
    # Close the input and output world files.
    close TFWOUT;
    close TFW;
   }
}
#
# Close the orthos list.
close ORTHOS;
#
# Remove the orthos list.
unlink "orthos.list";

---

back to PerlMapScript