= 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, ") { # # 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() { # # 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