home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 6 / 06.iso / b / b002 / 3.ddi / NEWMODS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-03-10  |  8.8 KB  |  252 lines
  1. program new_modules;
  2.  
  3. var
  4.  
  5.  
  6.     ref_units                               : string[3];
  7.     val_units,title,ref_system,flag_defn    : string[66];
  8.     val_recs,rows,cols                      : longint;
  9.     val_fields,val_file_type                : byte;
  10.     legend,data_format,geo_type             : integer;
  11.     old_data_type,old_file_type             : integer;
  12.     new_data_type,new_file_type             : integer;
  13.     wxmin,wxmax,wymin,wymax,unit_dist       : real;
  14.     flag_value,resolution,cellx,celly       : real;
  15.     posn_error,val_error,min,max            : real;
  16.     posn_error_flag, resolution_flag,
  17.      val_error_flag, flag_flag              : boolean;
  18.     legend_text                             : array [0..255] of string[66];
  19.     path                                    : string[40];
  20.     digi_port,plot_port,prn_port            : string[4];
  21.     drive,units                             : string[2];
  22.     old_image,new_image                     : string[8];
  23.     image_docfile_extension                 : string[4];
  24.     image_file_extension                    : string[4];
  25.     vector_docfile_extension                : string[4];
  26.     vector_file_extension                   : string[4];
  27.     values_docfile_extension                : string[4];
  28.     values_file_extension                   : string[4];
  29.  
  30. {***************************************************************************}
  31. procedure create_new_documentation_file;
  32.  
  33. var
  34.     docfile        : text;
  35.     docname        : string[80];
  36.     i              : integer;
  37.  
  38. begin
  39.  
  40.     docname:=drive+path+new_image+image_docfile_extension;
  41.     assign(docfile,docname);
  42.     rewrite(docfile);
  43.  
  44.   if ((new_data_type=0) and (new_file_type=1)) then new_data_type:=2;
  45.  
  46.   writeln(docfile,'file title  : ',title);
  47.   case new_data_type of
  48.   0 : writeln(docfile,'data type   : integer');
  49.   1 : writeln(docfile,'data type   : real');
  50.   2 : writeln(docfile,'data type   : byte');
  51.   end;
  52.  
  53.   case new_file_type of
  54.   0 : writeln(docfile,'file type   : ascii');
  55.   1 : writeln(docfile,'file type   : binary');
  56.   2 : writeln(docfile,'file type   : packed binary');
  57.   end;
  58.  
  59.   writeln(docfile,'columns     : ',cols);
  60.   writeln(docfile,'rows        : ',rows);
  61.  
  62.   writeln(docfile,'ref. system : ',ref_system);
  63.   writeln(docfile,'ref. units  : ',ref_units);
  64.   {*** note that both ref_system and ref_units MUST be in LOWER CASE ***}
  65.  
  66.   writeln(docfile,'unit dist.  : ',unit_dist:9:7);
  67.   writeln(docfile,'min. X      : ',wxmin:9:7);
  68.   writeln(docfile,'max. X      : ',wxmax:9:7);
  69.   writeln(docfile,'min. Y      : ',wymin:9:7);
  70.   writeln(docfile,'max. Y      : ',wymax:9:7);
  71.  
  72.   if posn_error_flag then writeln(docfile,'pos''n error : ',posn_error:9:7)
  73.                      else writeln(docfile,'pos''n error : unknown');
  74.   if resolution_flag then writeln(docfile,'resolution  : ',resolution:9:7)
  75.                      else writeln(docfile,'resolution  : unknown');
  76.   if new_data_type=1 then writeln(docfile,'min. value  : ',min:9:7)
  77.                      else writeln(docfile,'min. value  : ',min:1:0);
  78.   if new_data_type=1 then writeln(docfile,'max. value  : ',max:9:7)
  79.                      else writeln(docfile,'max. value  : ',max:1:0);
  80.   if val_units='' then writeln(docfile,'value units : unspecified')
  81.                   else writeln(docfile,'value units : ',val_units);
  82.   {*** note that val_units MUST be in LOWER CASE ***}
  83.  
  84.   write(docfile,'value error : ');
  85.   if not val_error_flag then writeln(docfile,'unknown') else writeln(docfile,val_error:9:7);
  86.  
  87.   write(docfile,'flag value  : ');
  88.   if not flag_flag then writeln(docfile,'none') else
  89.     begin
  90.      if new_data_type=1 then writeln(docfile,flag_value:9:7)
  91.                         else writeln(docfile,flag_value:1:0);
  92.     end;
  93.  
  94.   if flag_defn='' then writeln(docfile,'flag def''n  : none')
  95.                    else writeln(docfile,'flag def''n  : ',flag_defn);
  96.  
  97.   writeln(docfile,'legend cats : ',legend);
  98.   if legend<>0 then begin
  99.     if legend>255 then legend:=255;
  100.     for i:=0 to (legend-1) do begin
  101.       write(docfile,'category',i:3,' : ');
  102.       writeln(docfile,legend_text[i]);
  103.     end; {for}
  104.     end;
  105.  
  106.   close(docfile);
  107.  
  108. end;
  109.  
  110.  
  111. {***************************************************************************}
  112. procedure read_documentation_file;
  113.  
  114. var
  115.     docfile     : text;
  116.     docname     : string[80];
  117.     description : string[14];
  118.     i,err_code  : integer;
  119.     tmpstr      : string[66];
  120.  
  121. begin
  122.  
  123.  
  124.   docname:=drive+path+old_image+image_docfile_extension;
  125.   assign(docfile,docname);
  126.   reset(docfile);
  127.  
  128.   read(docfile, description); readln(docfile,title);
  129.   read(docfile,description); readln(docfile,description);
  130.   if description = 'integer'      then old_data_type:=0 else
  131.   if description = 'real'         then old_data_type:=1 else
  132.   if description = 'byte'         then old_data_type:=2 else
  133.   if description = 'word'         then old_data_type:=3 else old_data_type:=999;
  134.  
  135.   if old_data_type>3 then begin
  136.     writeln('Error : The ',description,' data type is not supported by this module');
  137.     halt;
  138.     end;
  139.  
  140.   read(docfile,description); readln(docfile,description);
  141.   if description = 'ascii'  then old_file_type:=0 else
  142.   if description = 'binary' then old_file_type:=1 else
  143.   if description = 'packed binary' then old_file_type:=1 else old_file_type:=999;
  144.  
  145.   if old_file_type>1 then begin
  146.     writeln('Error : The ',description,' file type is not supported by this module');
  147.     halt;
  148.     end;
  149.  
  150.   read(docfile,description);readln(docfile,cols);
  151.   read(docfile,description);readln(docfile,rows);
  152.   read(docfile,description);readln(docfile,ref_system);
  153.  
  154.   read(docfile,description);readln(docfile,tmpstr);
  155.   for i:=1 to length(tmpstr) do tmpstr[i]:=upcase(tmpstr[i]);
  156.   if ((tmpstr='M') or (tmpstr='FT') or (tmpstr='MI')
  157.   or (tmpstr='KM') or (tmpstr='DEG') or (tmpstr='RAD')) then ref_units:=tmpstr;
  158.  
  159.   read(docfile,description);readln(docfile,unit_dist);
  160.   read(docfile,description);readln(docfile,wxmin);
  161.   read(docfile,description);readln(docfile,wxmax);
  162.   read(docfile,description);readln(docfile,wymin);
  163.   read(docfile,description);readln(docfile,wymax);
  164.   cellx:=(wxmax-wxmin)/cols;
  165.   celly:=(wymax-wymin)/rows;
  166.  
  167.   read(docfile,description);readln(docfile,tmpstr);
  168.     posn_error_flag:=false;posn_error:=0;
  169.     for i:=length(tmpstr) downto 1 do if tmpstr[i]=' ' then delete(tmpstr,i,1);
  170.     val(tmpstr,posn_error,err_code);
  171.     if err_code=0 then posn_error_flag:=true;
  172.  
  173.   read(docfile,description);readln(docfile,tmpstr);
  174.     resolution_flag:=false;resolution:=0;
  175.     for i:=length(tmpstr) downto 1 do if tmpstr[i]=' ' then delete(tmpstr,i,1);
  176.     val(tmpstr,resolution,err_code);
  177.     if err_code=0 then resolution_flag:=true;
  178.  
  179.   read(docfile,description);readln(docfile,min);
  180.   read(docfile,description);readln(docfile,max);
  181.   read(docfile,description);readln(docfile,val_units);
  182.  
  183.   read(docfile,description);readln(docfile,tmpstr);
  184.     val_error_flag:=false;val_error:=0;
  185.     for i:=length(tmpstr) downto 1 do if tmpstr[i]=' ' then delete(tmpstr,i,1);
  186.     val(tmpstr,val_error,err_code);
  187.     if err_code=0 then val_error_flag:=true;
  188.  
  189.   read(docfile,description);readln(docfile,tmpstr);
  190.     flag_flag:=false;flag_value:=0;
  191.     for i:=length(tmpstr) downto 1 do if tmpstr[i]=' ' then delete(tmpstr,i,1);
  192.     val(tmpstr,flag_value,err_code);
  193.     if err_code=0 then flag_flag:=true;
  194.  
  195.   read(docfile,description);readln(docfile,flag_defn);
  196.   read(docfile,description);readln(docfile,legend);
  197.  
  198.   if legend<>0 then begin
  199.     if legend>255 then legend:=255;
  200.     for i:=0 to (legend-1) do begin read(docfile,description);
  201.          readln(docfile,legend_text[i]);
  202.          end; {for}
  203.     end;
  204.  
  205.   close (docfile);
  206.  
  207. end;
  208.  
  209.  
  210. {***************************************************************************}
  211. procedure read_env_file;
  212.  
  213. var temp     : text;
  214.     env_txt  : string[40];
  215.     i        : integer;
  216.  
  217. begin
  218.  
  219.   path:='';drive:='';
  220.   assign(temp,'idrisi.env'); {$I-} reset(temp); {$I+}
  221.  
  222.   readln(temp); readln(temp);
  223.   read(temp,env_txt);readln(temp,drive);
  224.   read(temp,env_txt);readln(temp,path);
  225.  
  226.   read(temp,env_txt);readln(temp,image_file_extension);
  227.   read(temp,env_txt);readln(temp,image_docfile_extension);
  228.   read(temp,env_txt);readln(temp,vector_file_extension);
  229.   read(temp,env_txt);readln(temp,vector_docfile_extension);
  230.   read(temp,env_txt);readln(temp,values_file_extension);
  231.   read(temp,env_txt);readln(temp,values_docfile_extension);
  232.  
  233.   read(temp,env_txt);readln(temp,ref_units);
  234.   read(temp,env_txt);readln(temp,digi_port);
  235.   read(temp,env_txt);readln(temp,plot_port);
  236.   read(temp,env_txt);readln(temp,prn_port);
  237.   close(temp);
  238.  
  239.   if path='none' then path:='';
  240.   if drive='no' then drive:='' else if (drive[2]<>':') then drive:='';
  241.  
  242. end;
  243.  
  244. {***************************************************************************}
  245.  
  246. begin
  247.  
  248.     {main program goes here}
  249.  
  250.  
  251. end.
  252.