#!/net/quake/bin/perl
# Program for reading 1:2M USGS DLGs in SDTS TVP format.
# Geoffrey Ely 1/15/98
# Modify the sections boxed with number signs to customize your job.

#########################################################
$dlg=		"CAHY"; $attp_modn=	"AHYF";		#
$dlg=		"CATR"; $attp_modn=	"ARDF";		#
$dir=		"tvp/";					#
#########################################################

$poly_modn=	"PC01";
$line_modn=	"LE01";

sub read_module;
sub select_lines;
sub connect_lines;
sub write_file;

read_module	( $attp_modn );
read_module	( $poly_modn );
read_module	( $line_modn );

#########################################################
# Choose the features to be extracted			#
# Attibute codes are listed in the Data User's Guide	#
$ocean=		"0500116";				#
$shoreline=	"0500200";				#
$closure=	"0500202";				#
$stream=	"0500412";				#
$lake=		"0500421";				#
$ferrie=	"1700214";				#
$null=		"";					#
#select_lines	( 'is',  'any',    $null	);	#
#select_lines	( 'is',  'line',   $shoreline	);	#
#select_lines	( 'is',  'border', $null	);	#
#select_lines	( 'or',  'poly',   $ocean	);	#
#select_lines	( 'not', 'closed', $null	);	#
#select_lines	( 'not', 'line',   $closure	);	#
#connect_lines;	# Useful for coastlines and borders	#
#select_lines	( 'and', 'closed', $null	);	#
select_lines	( 'is',  'any',    $null	);	#
select_lines	( 'not', 'line',   $ferrie	);	#
#########################################################

write_file	( 3, '-' );
exit;

sub read_module {
  sub read_ldr;
  sub read_dir;
  sub read_dat;
  $modn=$_[0];
  $file="$dir$dlg$modn.DDF";
  open ( FILE, "$file" );
  printf STDERR "reading %-12s ", $file;
  $r=1; $repeate = ""; 
  while ($r > 0) {
    if ( $repeate !~ "R" ) {
      read_ldr; if ($r<=0) { last; }
      read_dir; if ($r<=0) { last; }
    }
    read_dat; if ($r<=0) { last; }
  }
  close ( FILE );
  printf STDERR "%5d records read\n", $rcid;
}

sub read_ldr {
  $ldr_len = 24;
  $r = read( FILE, $ldr_buff, $ldr_len, 0);
  if ($r<=0) { return $r; }
  $repeate = substr ( $ldr_buff, 6, 1 );
  $rec_len = substr ( $ldr_buff, 0, 5 );
  $dir_len = substr ( $ldr_buff, 12, 5 ) - $ldr_len;
  $dat_len = $rec_len - $ldr_len - $dir_len;
  $fld_len_len = substr ( $ldr_buff, 20, 1 );
  $fld_pos_len = substr ( $ldr_buff, 21, 1 );
  $fld_tag_len = substr ( $ldr_buff, 23, 1 );
  $dir_fld_len = $fld_len_len + $fld_pos_len + $fld_tag_len;
  return $r;
}

sub read_dir {
  $r = read( FILE, $dir_buff, $dir_len, 0 );
  if ($r<=0) { return $r; }
  $rec_num = ($dir_len - 1) / $dir_fld_len;
  for($i=0; $i<$rec_num; $i++) {
    $pos = $i*$dir_fld_len;
    $tag[$i] = substr ( $dir_buff, $pos, $fld_tag_len );
    $len[$i] = substr ( $dir_buff, $pos+$fld_tag_len, $fld_len_len );
    $pos[$i] = substr ( $dir_buff, $pos+$fld_tag_len+$fld_len_len, $fld_pos_len );
  }
  return $r;
}

sub read_dat {
  $sadr_len = 8;
  $r = read( FILE, $dat_buff, $dat_len, 0 );
  if ($r<=0) { return; }
  for($i=0; $i<$rec_num; $i++) {
    $dat = substr( $dat_buff, $pos[$i], $len[$i] );
    chop $dat;
    if   ($tag[$i] =~ "0001") { $rcid=int($dat); }
    elsif($tag[$i] =~ "LINE") { $num_lines=$num_sel=$line[$rcid]=$rcid; $line_sel[$rcid]=0; }
    elsif($tag[$i] =~ "ATTP") { $attp[$rcid] = substr($dat, 0, 7); }
    elsif($tag[$i] =~ "POLY") { $poly_obrp[$rcid] = substr($dat, 10, 2); }
    elsif($tag[$i] =~ "PIDL") { $pidl[$rcid] = substr($dat, 4, 6); }
    elsif($tag[$i] =~ "PIDR") { $pidr[$rcid] = substr($dat, 4, 6); }
    elsif($tag[$i] =~ "SNID") { $snid[$rcid] = substr($dat, 4, 6); }
    elsif($tag[$i] =~ "ENID") { $enid[$rcid] = substr($dat, 4, 6); }
    elsif($tag[$i] =~ "SADR") { $sadr[$rcid] = $dat; $sadr_num[$rcid] = ($len[$i]-1)/$sadr_len; }
    elsif($tag[$i] =~ "ATID") { $atid = $dat;
      $count=0;
      $sub_len = 10;
      $sub_num = ($len[$i] - 1) / $sub_len;
      for($j=0; $j<$sub_num; $j++) {
        $pos = $j*$sub_len;
        $atid_modn = substr($atid, $pos, 4);
        $atid_rcid = substr($atid, $pos+4, 6);
        if ($atid_modn == $attp_modn) {
          $ent{$modn}[$rcid][$count] = substr($attp[$atid_rcid],0,7);
          $count++;
        }
      }
      $ent_num{$modn}[$rcid] = $count;
    }
  }
}

sub select_lines {
  $op=$_[0];
  $type=$_[1];
  $code=$_[2];
  $num_sel=0;
  printf STDERR "selecting %-3s %-6s %-7s ", $op, $type, $code;
  for($lid=1; $lid<=$num_lines; $lid++) {
    $sel=0;
    if    ($type=~"all") { $sel=1; }
    elsif ($type=~"border") {
      $pol=$poly_obrp[$pidl[$lid]]; $por=$poly_obrp[$pidr[$lid]];
      if($pol!~"PW" && $por!~"PW" && ($pol=~"PX" || $por=~"PX")) { $sel=1; }
    }
    elsif ($type=~"closed") { if($snid[$lid]==$enid[$lid]) { $sel=1; }}
    elsif ($type=~"poly") {
      $sub_num = $ent_num{$poly_modn}[$pidl[$lid]];
      for($j=0; $j<$sub_num; $j++) { if ( $ent{$poly_modn}[$pidl[$lid]][$j] =~ $code) { $sel=1; } }
      $sub_num = $ent_num{$poly_modn}[$pidr[$lid]];
      for($j=0; $j<$sub_num; $j++) { if ( $ent{$poly_modn}[$pidr[$lid]][$j] =~ $code) { $sel=1; } }
    }
    elsif ($type=~"line") {
      $sub_num = $ent_num{$line_modn}[$lid];
      for($j=0; $j<$sub_num; $j++) { if ($ent{$line_modn}[$lid][$j] =~ $code) { $sel=1; } }
    }
    elsif ($type=~"any") { if($sub_num = $ent_num{$line_modn}[$lid]) { $sel=1; } }
    if(!$sadr_num[$lid] && $line_sel[$lid]) { $sel=0; }
    if    ($op=~"is")  { $line_sel[$lid] = $sel; }
    elsif ($op=~"or")  { $line_sel[$lid] = $line_sel[$lid] || $sel}
    elsif ($op=~"and") { $line_sel[$lid] = $line_sel[$lid] && $sel}
    elsif ($op=~"not") { $line_sel[$lid] = $line_sel[$lid] && !$sel}
    if ($line_sel[$lid]) { $num_sel++; }
  }
  printf STDERR "%5d lines now selected\n", $num_sel;
}

sub connect_lines {
  $num_sel=0;
  print STDERR "connecting lines     ";
  if($dlg=~"CAHY") { $first=858; }
  if($dlg=~"NVHY") { $first=823; $line_rev[$first]=1; }
  for($lid=1; $lid<=$num_lines; $lid++) {
    if($line_sel[$lid]) {
      if(!$num_sel && !$first) { $first = $lid; }
      $adj_line[$snid[$lid]][$adj_num[$snid[$lid]]]=$lid;
      $adj_line[$enid[$lid]][$adj_num[$enid[$lid]]]=$lid;
      $adj_num[$snid[$lid]]++;
      $adj_num[$enid[$lid]]++;
      $num_sel++;
    }
  }
  $num_lines=$num_sel;
  for($new_lid=1; $new_lid<=$num_sel; $new_lid++) {
    if($new_lid==1)		{ $lid=$first; }
    if($line_rev[$lid])		{ $end_node=$snid[$lid]; }
    else			{ $end_node=$enid[$lid]; }
    $line[$new_lid] = $lid;
    if($adj_line[$end_node][0]!=$lid) {
      $next_lid = $adj_line[$end_node][0]; }
    else {
      $next_lid = $adj_line[$end_node][1]; }
    if($enid[$next_lid]==$end_node) { $line_rev[$next_lid] = 1; }
    $lid = $next_lid;
  }
  printf STDERR "%5d lines connected\n", $num_sel;
}

sub write_file {
  $mode=$_[0];
  $out_file=$_[1];
  $out_file="STDOUT";
  $new_lid=0;
  printf STDERR "writing %-12s ", $out_file;
  for($i=1; $i<=$num_lines; $i++) {
    if($line_sel[$line[$i]]) {
      $new_lid++;
      $lid=$line[$i];
      $pol=$poly_obrp[$pidl[$lid]];
      $por=$poly_obrp[$pidr[$lid]];
      if($mode=3) { printf ">\n"; }
      if($mode<2) {
        printf "> %4d %4d %2s %4d %2s %4d %4d %4d %1d %4d\n",
          $new_lid, $lid, $pol, $pidl[$lid], $por, $pidr[$lid],
          $snid[$lid], $enid[$lid], $line_rev[$lid], $sadr_num[$lid], $ent{$line_modn}[$lid][1];
      }
      if($mode>0) {
        $scale = .000001;
        for($j=0; $j<$sadr_num[$lid]; $j++) {
          $pos = $j*$sadr_len;
          if($line_rev[$lid]) { $pos = ($sadr_num[$lid]-$j-1)*$sadr_len; }
          ($x, $y) = unpack( "I I", substr( $sadr[$lid], $pos, $sadr_len) );
          $x = $x * $scale; $y = $y * $scale;
          printf "%12f %12f\n", $x, $y;
        }
      }
    }
  }
  printf STDERR "%5d lines written\n", $new_lid;
}