Changes between Initial Version and Version 1 of PerlMapScriptExamples35ex6

Timestamp:

Jan 29, 2009, 6:44:35 AM (15 years ago)

Author:

jmckenna

Comment:

--

PerlMapScriptExamples35ex6

@@ +1 @@
+= 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
+
+{{{
+#!perl
+#!/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