Tools/process-dem.pl

   1 #!/usr/bin/perl
   2
   3 #---------------------------------------------------------------------------
   4 # Toplevel script to automate DEM file processing and conversion
   5 #
   6 # Written by Curtis Olson, started January 1998.
   7 #
   8 # Copyright (C) 1997  Curtis L. Olson  - curt@infoplane.com
   9 #
  10 # This program is free software; you can redistribute it and/or modify
  11 # it under the terms of the GNU General Public License as published by
  12 # the Free Software Foundation; either version 2 of the License, or
  13 # (at your option) any later version.
  14 #
  15 # This program is distributed in the hope that it will be useful,
  16 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 # GNU General Public License for more details.
  19 #
  20 # You should have received a copy of the GNU General Public License
  21 # along with this program; if not, write to the Free Software
  22 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  23 #
  24 # $Id$
  25 # (Log is kept at end of this file)
  26 #---------------------------------------------------------------------------
  27
  28
  29 $| = 1;                         # flush buffers after every write
  30
  31
  32 # return the file name root (ending at last ".")
  33 sub file_root {
  34     my($file) = @_;
  35     my($pos);
  36
  37     $pos = rindex($file, ".");
  38     return substr($file, 0, $pos);
  39 }
  40
  41
  42 # set the FG_ROOT environment variable if it hasn't already been set.
  43 if ( $ENV{FG_ROOT} eq "" ) {
  44     # look for a file called fgtop as a place marker
  45     if ( -e "fgtop" ) {
  46         $ENV{FG_ROOT} = ".";
  47     } elsif ( -e "../fgtop" ) {
  48         $ENV{FG_ROOT} = "..";
  49     }
  50 }
  51
  52
  53 # 1.  Start with file.dem
  54
  55 $dem_file = shift(@ARGV);
  56 $error = shift(@ARGV);
  57 $error += 0.0;
  58
  59 print "Source file = $dem_file  Error tolerance = $error\n";
  60
  61 if ( $error < 0.5 ) {
  62     die "I doubt you'll be happy with an error tolerance as low as $error.\n";
  63 }
  64
  65 # 2.  dem2node $FG_ROOT dem_file tolerance^2 (meters)
  66 #
  67 #     - dem2node .. dem_file 160000
  68 #
  69 #     splits dem file into 64 file.node's which contain the
  70 #     irregularly fitted vertices
  71
  72 $command = "./Dem2node/demfit $ENV{FG_ROOT} $dem_file $error";
  73
  74 print "Running '$command'\n";
  75
  76 open(OUT, "$command |");
  77 while ( <OUT> ) {
  78     print $_;
  79     if ( m/Scenery/ ) {
  80         $subdir = $_;
  81         $subdir =~ s/Dir = //;
  82     }
  83 }
  84 close(OUT);
  85
  86
  87 # 3.  triangle -q file (Takes file.node and produces file.1.node and
  88 #                      file.1.ele)
  89
  90 $subdir = "../Scenery/w120n030/w111n033";
  91 print "Subdirectory for this dem file is $subdir\n";
  92
  93 @FILES = `ls $subdir`;
  94 foreach $file ( @FILES ) {
  95     print $file;
  96     chop($file);
  97     if ( ($file =~ m/\.node$/) && ($file !~ m/\.\d\.node$/) ) {
  98         $command = "./Triangle/triangle -q $subdir/$file";
  99         print "Running '$command'\n";
 100         open(OUT, "$command |");
 101         while ( <OUT> ) {
 102             print $_;
 103         }
 104         close(OUT);
 105
 106         # remove input file.node
 107         unlink("$subdir/$file");
 108     }
 109 }
 110
 111
 112 # 4.  fixnode file.dem subdir
 113 #
 114 #     Take the original .dem file (for interpolating Z values) and the
 115 #     subdirecotry containing all the file.1.node's and replace with
 116 #     fixed file.1.node
 117
 118 $command = "./FixNode/fixnode $dem_file $subdir";
 119 print "Running '$command'\n";
 120 open(OUT, "$command |");
 121 while ( <OUT> ) {
 122     print $_;
 123 }
 124 close(OUT);
 125
 126
 127 # 4.1 findedges file (.1.node) (.1.ele)
 128
 129 #     Extract the edge vertices (in original geodetic coordinates) and
 130 #     normals (in cartesian coordinates) and save them in something
 131 #     very close to the .obj format as file.north, file.south,
 132 #     file.east file.west.
 133
 134 @FILES = `ls $subdir`;
 135 foreach $file ( @FILES ) {
 136     chop($file);
 137     if ( $file =~ m/\.1\.node$/ ) {
 138         $file =~ s/\.node$//;  # strip off the ".node"
 139
 140         $command = "./FindEdges/findedges $subdir/$file";
 141         print "Running '$command'\n";
 142         open(OUT, "$command |");
 143         while ( <OUT> ) {
 144             print $_;
 145         }
 146         close(OUT);
 147     }
 148 }
 149
 150
 151 exit(1);
 152
 153
 154 # 4.2 read in tri files (node/ele) skipping edges, read edges out of
 155 #     edge files, save including proper shared edges (as node/ele)
 156 #     files.  If my edge and adjacent edge both exist, use other,
 157 #     delete mine.  If only mine exists, use it.
 158
 159
 160 # 4.3 Retriangulate fixed up files (without -q option)
 161
 162
 163 # 5.  tri2obj file (.1.node) (.1.ele)
 164 #
 165 #     Take the file.1.node and file.1.ele and produce file.1.obj
 166
 167 @FILES = `ls $subdir`;
 168 foreach $file ( @FILES ) {
 169     chop($file);
 170     if ( $file =~ m/\.1\.node$/ ) {
 171         $file =~ s/\.node$//;  # strip off the ".node"
 172
 173         $command = "./Tri2obj/tri2obj $subdir/$file";
 174         print "Running '$command'\n";
 175         open(OUT, "$command |");
 176         while ( <OUT> ) {
 177             print $_;
 178         }
 179         close(OUT);
 180
 181         unlink("$subdir/$file.node");
 182         unlink("$subdir/$file.node.orig");
 183         unlink("$subdir/$file.ele");
 184     }
 185 }
 186
 187
 188 # 6.  strip file.1.obj
 189 #
 190 #     Strip the file.1.obj's
 191 #
 192 # 7.  cp bands.d file.2.obj
 193 #
 194 #     strips produces a file called "bands.d" ... copy this to file.2.obj
 195
 196 @FILES = `ls $subdir`;
 197 foreach $file ( @FILES ) {
 198     chop($file);
 199     if ( $file =~ m/\.1\.obj$/ ) {
 200         $command = "./Stripe_u/strips $subdir/$file";
 201         print "Running '$command'\n";
 202         open(OUT, "$command |");
 203         while ( <OUT> ) {
 204             print $_;
 205         }
 206         close(OUT);
 207
 208         # copy to destination file
 209         $newfile = $file;
 210         $newfile =~ s/\.1\.obj$//;
 211         print "Copying to $subdir/$newfile.2.obj\n";
 212         open(IN, "<bands.d");
 213         open(OUT, ">$subdir/$newfile.2.obj");
 214         while ( <IN> ) {
 215             print OUT $_;
 216         }
 217         close(IN);
 218         close(OUT);
 219
 220         unlink("$subdir/$file");
 221     }
 222 }
 223
 224
 225 # 8.  fixobj file-new
 226 #
 227 #     Sort file.2.obj by strip winding
 228
 229 @FILES = `ls $subdir`;
 230 foreach $file ( @FILES ) {
 231     chop($file);
 232     if ( $file =~ m/\.2\.obj$/ ) {
 233         $newfile = $file;
 234         $newfile =~ s/\.2\.obj$/.obj/;
 235
 236         $command = "./FixObj/fixobj $subdir/$file $subdir/$newfile";
 237         print "Running '$command'\n";
 238         open(OUT, "$command |");
 239         while ( <OUT> ) {
 240             print $_;
 241         }
 242         close(OUT);
 243
 244         unlink("$subdir/$file");
 245     }
 246 }
 247
 248
 249 #---------------------------------------------------------------------------
 250 # $Log$
 251 # Revision 1.2  1998/01/12 20:42:08  curt
 252 # Working on fitting tiles together in a seamless manner.
 253 #
 254 # Revision 1.1  1998/01/09 23:06:46  curt
 255 # Initial revision.
 256 #