home *** CD-ROM | disk | FTP | other *** search
/ GRIPS 2: Government Rast…rocessing Software & Data / GRIPS_2.cdr / dos / adrg / source / proxtrct.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-04-06  |  6.7 KB  |  201 lines
  1. procedure proxtrct( var full_path_zdr:string; var n_cols_of_tiles1: integer;
  2.                    var start_tile, nstartrow, nstartcol: longint;
  3.                    var center_lat, center_lon, asz, bs, lat0, lon0 : real );
  4.  
  5.  
  6. { read files TRANSH01.THF and *.GEN from the CD-ROM and write a file
  7.   with important information to compute geographic coordinates from
  8.   pixel positions or pixel pos. from geo. coords.}
  9.  
  10. type
  11.  
  12.   str2 = array[0..1] of char;
  13.   str3 = array[0..2] of char;
  14.   str5 = array[0..4] of char;
  15.   str8 = array[0..7] of char;
  16.   str10 = array[0..9] of char;
  17.   str11 = array[0..10] of char;
  18.   str21 = array[0..20] of char;
  19.  
  20. var
  21.   cdr : string[1];
  22.   ch : char;
  23.   wrtcnt : word;
  24.   buf : array[0..1999] of char;
  25.   asz_str, bs_str, pub_date : str8;
  26.   lon_ul_zdr, lon_lr_zdr, lon0_zdr : str11;
  27.   lat_ul_zdr, lat_lr_zdr, lat0_zdr : str10;
  28.   chart_code : str2;
  29.   n_rows_of_tiles, n_cols_of_tiles : str3;
  30.   zdr_path, gen_path : str21;
  31.   dir_skip : str5;
  32.  
  33.   asz1,        bs1,
  34.   lon_ul_zdr1, lat_ul_zdr1,
  35.   lon_lr_zdr1, lat_lr_zdr1,
  36.   lon0_zdr1,   lat0_zdr1,
  37.   lon_ul_dd,   lat_ul_dd,
  38.   lon_lr_dd,   lat_lr_dd,
  39.   clon,        clat,
  40.   slon_ul,     slat_ul,
  41.   slon_lr,     slat_lr,
  42.   r,           c              : real;
  43.  
  44.   n_rows_of_tiles1, code, i, ds_int, extra : integer;
  45.  
  46.   fael : file;
  47.  
  48.   dlon_ul,mlon_ul, dlat_ul,mlat_ul,
  49.   dlon_lr,mlon_lr, dlat_lr,mlat_lr    : longint;
  50.  
  51.  
  52. {$I pdmstodd.pas}
  53. {$I ddtodms.pas}
  54.  
  55. begin                  {** procedure extract **}
  56. { get the drive name for the CD-ROM from the environment variable CDROMDSK
  57.   (the same that terrabase uses) }
  58.   cdr :=getenv('CDROMDSK');
  59.  
  60. { The TRANSH01.THF file keeps the same name for all the ADRG discs,
  61.   read this file to extract the pathname for the .GEN file and the
  62.   ZDR image file. }
  63.  
  64.   assign(fael, cdr+':\TRANSH01.THF'); reset(fael,1);
  65.  
  66. { read all the ASCII values as characters }
  67.  
  68.   blockread(fael, buf      ,  1281, wrtcnt);
  69.   blockread(fael, pub_date ,     8, wrtcnt);
  70.   blockread(fael, buf      ,     1, wrtcnt);
  71.   blockread(fael, chart_code ,   2, wrtcnt);
  72.   blockread(fael, buf        ,1529, wrtcnt); {1844}
  73.   blockread(fael, dir_skip   ,   5, wrtcnt);
  74.   val(dir_skip, ds_int ,code);
  75.   blockread(fael, buf        ,ds_int+145, wrtcnt);
  76.   blockread(fael, gen_path   ,  21, wrtcnt);
  77.   blockread(fael, buf        , 135, wrtcnt); {135}
  78.   blockread(fael, zdr_path   ,  21, wrtcnt);
  79.  
  80. { change the slash to a backslash to use the string as the pathname in DOS }
  81.   for i := 0 to 20 do
  82.   begin   {for i loop}
  83.       if (gen_path[i] = '/') then gen_path[i] := '\';
  84.       if (zdr_path[i] = '/') then zdr_path[i] := '\';
  85.   end;    {for i loop}
  86.  
  87.   close(fael);
  88.  
  89. { build the path to the full resolution image file }
  90.   full_path_zdr := cdr+':\'+zdr_path;
  91.  
  92. { read other important values from the .GEN file }
  93.  
  94.  
  95.  
  96.   assign(fael, cdr+':\'+gen_path); reset(fael,1);
  97.   blockread(fael, buf        ,1003, wrtcnt);
  98.   blockread(fael, ch        ,   1, wrtcnt);
  99.  
  100.   extra := 0;
  101.   ds_int := 0;
  102.   if ( ch = 'T' )  then
  103.   begin
  104.       extra := 10;
  105.       blockread(fael, buf        ,   6, wrtcnt);
  106.       blockread(fael, dir_skip   ,   5, wrtcnt);
  107.       val(dir_skip, ds_int ,code)
  108.   end;
  109.   blockread(fael, buf        ,165+ds_int+129+extra, wrtcnt);
  110.  
  111.   blockread(fael, ch        ,   1, wrtcnt);
  112.   extra := 56;
  113.   if ( ch = 'T' )  then   extra := 77;
  114.  
  115.   blockread(fael, buf        ,   extra, wrtcnt);
  116.  
  117.   blockread(fael, lon_ul_zdr ,  11, wrtcnt);
  118.   blockread(fael, lat_ul_zdr ,  10, wrtcnt);
  119.   blockread(fael, buf        ,  21, wrtcnt);
  120.   blockread(fael, lon_lr_zdr ,  11, wrtcnt);
  121.   blockread(fael, lat_lr_zdr ,  10, wrtcnt);
  122.   blockread(fael, buf         ,  17, wrtcnt);
  123.   blockread(fael, asz_str    ,   8, wrtcnt);
  124.   blockread(fael, bs_str     ,   8, wrtcnt);
  125.   blockread(fael, lon0_zdr   ,  11, wrtcnt);
  126.   blockread(fael, lat0_zdr   ,  10, wrtcnt);
  127.   blockread(fael, buf        ,  89, wrtcnt);
  128.   blockread(fael, n_rows_of_tiles,  3, wrtcnt);
  129.   blockread(fael, n_cols_of_tiles,  3, wrtcnt);
  130.  
  131.   close(fael);
  132.  
  133. { transform the characters to numeric values (integer or real) }
  134.  
  135.   val(asz_str,asz,code);
  136.   val(bs_str,bs,code);
  137.   val(lon_ul_zdr,lon_ul_zdr1,code);
  138.   val(lon_lr_zdr,lon_lr_zdr1,code);
  139.   val(lat_ul_zdr,lat_ul_zdr1,code);
  140.   val(lat_lr_zdr,lat_lr_zdr1,code);
  141.   val(lat0_zdr,lat0_zdr1,code);
  142.   val(lon0_zdr,lon0_zdr1,code);
  143.   val(n_rows_of_tiles,n_rows_of_tiles1,code);
  144.   val(n_cols_of_tiles,n_cols_of_tiles1,code);
  145.  
  146. { compute decimal degree value for latitude and longitude angles that were
  147.   read in packed dms format }
  148.  
  149.   pdmstodd(lon_ul_zdr1, lon_ul_dd);
  150.   pdmstodd(lat_ul_zdr1, lat_ul_dd);
  151.   pdmstodd(lon_lr_zdr1, lon_lr_dd);
  152.   pdmstodd(lat_lr_zdr1, lat_lr_dd);
  153.   pdmstodd(lon0_zdr1, lon0);
  154.   pdmstodd(lat0_zdr1, lat0);
  155.  
  156.   ddtodms(lon_ul_dd,dlon_ul,mlon_ul,slon_ul);
  157.   ddtodms(lat_ul_dd,dlat_ul,mlat_ul,slat_ul);
  158.   ddtodms(lon_lr_dd,dlon_lr,mlon_lr,slon_lr);
  159.   ddtodms(lat_lr_dd,dlat_lr,mlat_lr,slat_lr);
  160.  
  161.     writeln;writeln;
  162.     writeln('            Select portion of the ADRG data to be extracted' );
  163.     writeln;
  164.     writeln('            Values in this ZDR are in the range:');
  165.       write('           ',dlat_ul,' ',mlat_ul,' ',slat_ul:4:0,'    ');
  166.     writeln('           ',dlon_ul,' ',mlon_ul,' ',slon_ul:4:0);
  167.       write('           ',dlat_lr,' ',mlat_lr,' ',slat_lr:4:0,'    ');
  168.     writeln('           ',dlon_lr,' ',mlon_lr,' ',slon_lr:4:0);
  169.     writeln;
  170.     writeln('            Enter Latitude of Center Point in the format:');
  171.     writeln('                          ZDDMMSS. ');
  172.     writeln('            where Z is the sign; DD = degrees; ');
  173.     writeln('            MM = minutes; and SS. = seconds ');writeln;
  174.  
  175.     repeat
  176.       write('            Enter Latitude: ');
  177.       readln(center_lat);
  178.       writeln
  179.     until ((center_lat >= lat_lr_zdr1) and (center_lat <= lat_ul_zdr1));
  180.  
  181.     writeln('            Enter Longitude of Center Point in the format:');
  182.     writeln('                          ZDDDMMSS. ');
  183.     writeln('            where Z is the sign; DDD = degrees; ');
  184.     writeln('            MM = minutes; and SS. = seconds ');writeln;
  185.     repeat
  186.       write('            Enter Longitude: ');
  187.       readln(center_lon);
  188.       writeln
  189.     until (( center_lon >= lon_ul_zdr1 ) and ( center_lon <= lon_lr_zdr1 ));
  190.  
  191.     pdmstodd(center_lat,clat);
  192.     pdmstodd(center_lon, clon);
  193.     r := bs * (lat0 - clat) / 360.0;
  194.     c := asz * (clon - lon0) / 360.0;
  195.     nstartrow := trunc(r/128) -1;  {-1 for EGA/ -2 for VGA to get closer to center}
  196.     nstartcol := trunc(c/128) -2;  {-2 to get closer to the center}
  197.     start_tile := nstartrow*n_cols_of_tiles1 + nstartcol;
  198.     no_of_cols_tiles := n_cols_of_tiles1;
  199.  
  200. end;     {** procedure extract **}
  201.