 {~ Decoding usual parameters of programmes by J.Hollan, common help-consts. ~}
 (* {~ (params_g is same as params.pas, but disables redirection ~}
   {~   due to using graph_m8.pas) ~} *)

   { params_g is produced from params by running p2text.bat;
     params_g should never be edited }

unit params(* _g *);
(*
 Copyright (C) 1999 Jan Hollan;
  by "program" this unit is further meant.

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*)

interface
uses (* crt,  {it is used by graph_m8 anyway} *)
    {units by J.Hollan:}
     un_str_m,
     solar_ut,{this one namely because of declarations of
                 Lambda, Fi, YYYY,MM,ND,DD,HH,MI,SS,HS and t_UT=1.}
     angles_o,
     str_num
     (* , graph_m8 *);

const                  {for Help information and output}
h0=
'                      ------------------ '+cl+
' (press Q to quit, any other key to see the next page of explanation)';
h0last=
'                      ------------------ '+cl+
' (press Q to quit, any other key to see the last page of explanation)';
h0Enter=
'                      ------------------ '+cl+
' (press Q <Enter> to quit, just <Enter> to see the next page)';
h0EnterLast=
'                      ------------------ '+cl+
' (press Q <Enter> to quit, just <Enter> to see the last page)';
h0clear=#13+
'                                                                            '
+#13;
 t_UTC_given:boolean=false;
 tt_UT:real=0;  {(Temps Terrestrique - UT) / 1 d}
 tt_ut_set:boolean=false;
h_refraction=
'If needed, three parameters for computing refraction can be added:'+cl+
' PR  pressure / 1013.25 kPa (default 0.97)'+cl+
' CT  Celsius air temperature / 1 K (default 10)'+cl+
' RH  Relative humidity of the air / 1 % (default 70)'+cl;
hTT=
' TT#[unit] can force a Terrestric Time - UTC difference'+cl+
'  (the default unit is second, may be m[in], h, d or s explicitly)'+cl;
Zenith_extinction:word=20;
AM_inst_Faint:boolean=false; {Air Mass is given instead of Faintness}
h_zen_ext=
'ZE  Zenith extinction / 1 cmag (default 20)'+cl;

 h_svga1=
'SVGA#    or'  +cl+
'SVGA256:# Try SVGA 256-color mode # (default 4 for the 1024x768 resolution'+cl+
'                                3 would set the 800x600 mode)'+cl+
'SVGA16:# is a 16 color alternative for 0.5 MB cards'+cl;
h_svga2=
'SVGA:#   is another 256-color alternative, if you have svga.bgi'+cl+
'  Caution, some cards lock up the computer so that just RESET helps.'+cl+
'  (For the Free Pascal Compiler, the SVGA option is obsolete'+cl+
'   as the executable uses some VESA mode in any case.)'+cl;

var
 Par: string;
 YY2:integer; MM2, DD2 :word;
 code , code_aux : integer;

function Par_Date:boolean;
function Par_Time:boolean;
function Par_TT_UT:boolean;
function Par_Time_or_TT:boolean;
function Par_UT:  boolean;
function Par_Lambda:boolean;
function Par_Fi:boolean;
function Par_RelPres:boolean;
function Par_RelHum:boolean;
function Par_CelTemp:boolean;
function Par_ZenExt:boolean;
function Par_RA:boolean;
function Par_Decl:boolean;
function Par_BabLike
 (start_b:byte;par_s,name_s:string;var quant:real;DorH:char;lim:word):boolean;
procedure Par_SVGA;
procedure wri_text(s:string);
procedure cont_or_halt; {processing question on continuing help}
procedure c_o_halt;     {putting, processing and wiping that question}


implementation


function Par_Date:boolean;
begin
 Par_Date:=false;
 if length(Par)<2 then
  begin
   wri_text('The date is empty.');
   exit
  end;
 Par:=copy (Par,2,length(Par)-1);
 val(Par,DD,code);
 code_aux:=code;
 if code > 0 then {more then just a day}
  begin
   __St2DtStr(Par,yy2,mm2,dd2,_Euro_Dt_Str);
   if yy2=-32000 then  {not full dd.mm.yy}
    begin
     val(copy(Par,1,code_aux-1),dd,code);
     if length(Par)>code_aux then
      begin
       Par:=copy(Par,code_aux+1,length(Par)-code_aux);
       val(Par,mm2,code_aux);
       if mm2=0 then
        val(copy(Par,1,code_aux-1),mm2,code);
       if mm2>0 then mm:=mm2;
      end
    end
   else
    begin YYYY:=yy2; mm:=mm2; dd:=dd2
    end
  end;
 Datum:=__Dt2StStr(YYYY,mm,dd,_Euro_Dt_Str);
 if Datum='' then
  wri_text('The date is no dd.mm.yy')
 else
  begin
   Par_Date:=true;
   if not t_UTC_given then
    if MM in [4..10] then
     t_UT:=2
    else
     t_UT:=1;
  end;
end;

function Par_Time:boolean;
const OK:integer=1;
var hours:real;
begin
 Par_Time:=false;
 if length(Par)<2 then
  begin
   wri_text('The T parameter (Time) is empty.');
   exit
  end;
 Par:=copy (Par,2,length(Par)-1);
 if pos('.',Par)>0 then
  val(Par,hours,OK);
 if (pos('.',Par)=0) or (OK>0) then
  begin
   if not __2TimeStr(Par,hh,mi,ss,hs) then
    wri_text('The T (Time) parameter is no hh.mi.ss')
   else
    begin
     Time:=__Time2str(hh,mi,ss,hs,_inc_sec_str);
     Par_Time:=true
    end;
   exit;
  end;
 Par_Time:=true;
 Time:=hours2hhmmss(hours,hh,mi,ss,hs);
end;

function Par_TT_UT:boolean;
var OK,OK0:integer;
begin
 Par_TT_UT:=false;
 if length(Par)<3 then
  begin
   wri_text('The TT parameter (Time_Terestrique-UTC) is empty.');
   exit
  end;
 Par:=copy (Par,3,length(Par)-2);
 val(Par,tt_UT,OK);
 if OK>1 then
  begin
   val(copy(Par,1,OK-1),tt_UT,OK0);
                  {OK has been erroneously overwritten before Feb2001,
                              OK0 introduced just Feb 8 2001}
   case UpCase(Par[OK]) of
    'S': ;
    'M': tt_UT:=tt_UT*60;
    'H': tt_UT:=tt_UT*3600;
    'D': tt_UT:=tt_UT*86400;
   else
    begin
     wri_text('The TT parameter unit is unknown.');
     exit
    end;
   end;
  end;
 tt_UT:=tt_UT/86400;
 tt_ut_set:=true;
 Par_TT_UT:=true;
end;

function Par_Time_or_TT:boolean;
begin
 Par_Time_or_TT:=false;
 if length(Par)<2 then
  begin
   wri_text('The T parameter (Time) is empty.');
   exit
  end;
 if Par[2]='T' then
  Par_Time_or_TT:=Par_TT_UT
 else
  Par_Time_or_TT:=Par_Time;
end;

function Par_UT:boolean;
begin
 if Par_BabLike(3,'UT','Time-UTC',t_UT,'H',24) then
  begin
   Par_UT:=true;
   t_UTC_given:=true;
  end
 else
  Par_UT:=false;
end;

function Par_Lambda:boolean;
begin
 if Par_BabLike(2,'L','Longitude',lambda,'D',360) then
  begin
   Lambda:=deg_to_rad(Lambda);
   Par_Lambda:=True
  end
 else
  Par_Lambda:=false;
end;

function Par_Fi:boolean;
begin
 if Par_BabLike(2,'F','Latitude',Fi,'D',90) then
  begin
   Fi:=deg_to_rad(Fi);
   sin_Fi:=sin(Fi); cos_Fi:=cos(Fi);
   Par_Fi:=True
  end
 else
  Par_Fi:=false;
end;

function Par_RA:boolean;
begin
  Par_RA:=Par_BabLike(3,'RA','Right Ascension',RA,'D',360);
end;

function Par_Decl:boolean;
begin
  Par_Decl:=Par_BabLike(3,'De','Declination',Decl,'D',90);
end;

function Par_relpres:boolean;
begin
 Par_relpres:=false;
 if length(Par)<2 then
  begin
   wri_text('The PR parameter (relative atm. pressure) is empty.');
   exit
  end;
 if Par[2]='R' then
  begin
   pressure_db_101325:=ss2r(par,3);
   if pressure_db_101325<0.02 then
    wri_text('PR gives no valid pressure divided by 1013.25 Pa: '+par)
   else
    Par_relpres:=true;
  end;
end;

function Par_relhum:boolean;
begin
 Par_relhum:=false;
 if length(Par)<2 then
  begin
   wri_text('The RH parameter (relative humidity / 1 %) is empty.');
   exit
  end;
 if Par[2]='H' then
  begin
   Relative_Humidity:=ss2r(par,3);
   if Relative_Humidity<0.01 then
    wri_text('RH gives no valid relative humidity: '+par)
   else
    Par_relhum:=true;
  end;
end;

function Par_celtemp:boolean;
begin
 Par_celtemp:=false;
 if length(Par)<2 then
  begin
   wri_text('The CT parameter (Celsius temperature / 1 degree) is empty.');
   exit
  end;
 if Par[2]='T' then
  begin
   Celsius_temp:=ss2r(par,3);
   if Celsius_temp<-273 then
    wri_text('CT gives no valid Celsius temperature / 1 K: '+par)
   else
    Par_celtemp:=true;
  end;
end;

function Par_ZenExt:boolean;
begin
 Par_zenext:=false;
 if length(Par)<2 then
  begin
   wri_text('The ZE parameter (Zenith extinction / 1 cmag) is empty.');
   exit
  end;
 case Par[2] of
 'E':
  begin
   Zenith_extinction:=ss2i(par,3);
   if Zenith_extinction<15 then
    wri_text('Zenith extinction cannot be under 15 cmag.')
   else
    Par_zenext:=true;
  end;
 'M':
  begin AM_inst_Faint:=true; Par_zenext:=true;
  end;
 end;
end;

function Par_BabLike
  (start_b:byte;
   par_s,name_s:string;
 var quant:real;
   DorH:char;
   lim:word)
 :boolean;
begin
 Par_BabLike:=false;
 if length(Par)<start_b then
  begin
   wri_text('The '+par_s+' parameter ('+name_s+') is empty.');
   exit
  end;
 Par:=copy(Par,start_b,length(Par)-(start_b-1));
 if not BabS2DecO(Par,quant,DorH) then
  wri_text('The '+par_s+' parameter is no valid '+name_s+'.')
 else
  if abs(quant)<=lim then   {it is a second check, if DorH in ['D','H']}
   Par_BabLike:=True
  else
   wri_text('The '+par_s+' parameter ('+name_s+
            ') is not in the <-'+SI(3,lim)+','+SI(3,lim)+'> interval.');
end;

procedure Par_SVGA;
 begin
 (*  if length(par)>3 then
     if copy(par,1,4)='SVGA' then
      begin
       if ItemCountD(':',par)>1 then
        begin
         SVGAmode:=I_S(ItemStrD(':',2,par));
         SVGA_driverName:=ItemStrD(':',1,par);
        end
       else
        case length(par) of
         5: SVGAmode:=ss2i(par,5);
         4: ;
         else SVGA_driverName:=par;
        end;
       SVGA:=true;
      end;
  *)
 end;

procedure wri_text(s:string);
 begin
  (* if gm_open then gm_close;
  highvideo; *)
  writeln(s);
  (* lowvideo *)
 end;

procedure cont_or_halt;
 var reply:string;
 begin
  readln(reply);
   if reply<>'' then
    if (UpCase(reply[1])='Q')
    or (ord(reply[1])<32) then halt;
 end;

procedure c_o_halt;
 begin
  write(h0enter);
  cont_or_halt;
  write(h0clear);
 end;

end.
