{~ Trajectory of a visual binary star ~}

 { Has to be converted to the appropriate code page;
   the original one is 'Kamenicky'}

program tr_bin_t; {by Tomáš Rezek, formal adaptation Jeník Hollan}

uses dos,DbBridge, un_str_m,binaries,params;
var  k,a,b,c,d,e,f,g,h,i,x,y,z,m,pom,h0,h1,maga,magb,scal:real;
     data,co,soubor                                :string[20];
     HLEDAM                                        :STRING[15];
     jmeno                                         :string[44];
     Name                                          :STRING;
     n,GRADE,gd,gm,  j                             :integer;
   RecNo:           word;
   ch: char; ix,iy: integer;
const
     RA:real=0; Decl:real=0;
     FromBinaries:boolean=false;
cl=#10;
cl2=cl+cl;
hl1=cl+
'tr_bin_t [  { period/1a   periastron_passage/1a   eccentricity    semiaxis/1"'+cl+
'          inclination/1°   ascending_node_pos._angle   periastron_longitude }'+cl+
'        | { {RecNO_in_binorbit.dbf} | {ADS#} | {Name_in_binorbit.dbf} } ]'+cl;
hl2=
'       [first_time/1a   last_time/1a   step/1a]' +cl2;

hl3=
'TRajectory of a visual BINary'+cl+
'  Default interval is from 2000 to 2030 with step of 5 a'+cl+cl;

hl4=
'Computation by Tomas Rezek (1993 and 1994), parameters by Jan Hollan (1996),' +cl+
'(text version tr_bin_t 2006), N. Copernicus Obs. and Planetarium in Brno.'+cl;
hl5=
'(subject to the GNU General Public License, http://www.gnu.org/copyleft;'+cl+
' source code available at http://astro.sci.muni.cz/pub/hollan/programmes)'+cl2;

function  asin(x:real):real;  begin  asin:=sin(x*pi/180); end;
function  acos(x:real):real;  begin  acos:=cos(x*pi/180); end;
function   tan(x:real):real;  begin tan:=asin(x)/acos(x); end;
function indeg(x:real):real;  begin      indeg:=180*x/pi; end;

procedure help;
begin
 write(hl1,hl2,hl3,hl4,hl5);
 halt;
end;

procedure vypocet(H:real);
begin
X:=360/A;
Y:=X*(H-B);
I:=Y;
repeat pom:=I; I:=pom + (Y + 180*C/pi * asin(pom) - pom) / ( 1 - C*acos(pom));
until abs(pom-i) < 0.0000001;
X:=2 * indeg(arctan(tan(I/2) * sQrt((1+c)/(1-c))));
Y:=D*(1-c*acos(i));
m:=F + indeg(arctan (acos(e)*asin(x+g)/acos(x+g)));
if m<0 then m:=M+360;
z:=Y * acos(x+g)/acos(m-f);
if z<0 then M:=M+180;
while m>360 do m:=m-360 ;
Z:=abs(Z);
end;

function fv(n:byte):real;
var auxr:real; j:integer;
begin
 val(paramstr(n),auxr,j);
 if j>0 then begin 
   writeln('Parameter ', n,': ', paramstr(n),' is no number, but should be!'); 
         halt; end;
 fv:=auxr
end;

procedure zadani;
begin
  a:=0;b:=0; c:=0;d:=0;e:=0;f:=0;g:=0;
  h0:=2000;
  h1:=2030;
  k:=5;

     writeln('         E F E M E R I D A   V I Z U Á L N Í   D V O J H V Ě Z D Y ');
     writeln('         --------------------------------------------------------- ');
     writeln;
   Writeln(' Lze spustit se sedmi parametry-elementy,');
   Writeln('   a navíc s ev. s třemi dalšími (od, do, krok - vše v letech),');
   Writeln(' nebo oněch sedm elementů nahradit číslem záznamu v databázi,');
   Writeln('  ADS# či jménem dvojhvězdy (pole Name souboru binorbit.dbf).');

if paramcount=0 then
 begin
  help
 end

else

 if paramcount>9 then {elementy z příkazové řádky}
  begin
   a:=fv(1);b:=fv(2); c:=fv(3);d:=fv(4);e:=fv(5);f:=fv(6);g:=fv(7);
   h0:=fv(8);h1:=fv(9);k:=fv(10);
  end

 else                  {elementy z Binaries.dbf}

  begin
   if paramcount>1 then       {from, to, step}
    begin
     h0:=fv(2); if paramcount>2 then begin
                      h1:=fv(3); if paramcount>2 then k:=fv(4); end;
     if not (h1>h0) then 
      begin
       writeln('To: ',h1,' is to be larger than From: ',h0);
       halt;
      end; 		      
     if not (k>0) then 
      begin
       writeln('Step: ',k,' is to be larger then 0 years');
       halt;
      end; 		      
    end;                                
   {RecNo:=round(fv(1))}
   val(paramstr(1),RecNo,j);
   if RecNo=0 then {Name or ADS number}
    begin
      Name:=paramstr(1);
      if __cvtstr(copy(Name,1,3),_to_upcase_str)='ADS' then {ADS#}
       begin
        Name:=copy(Name,4,5);
        if not read_bin(Name,RA,Decl,RecNo) then
         begin
          writeln('The ADS number',Name,' not found!');
          halt
         end
       end
      else                                         {Name}
       if (pos('?',paramstr(1))>0) or (pos('-h',paramstr(1))>0) then
        begin
         help;
        end
       else
        if not read_bin(Name,RA,Decl,RecNo) then
         begin
          writeln(Name,' not found!');
          halt
         end
    end

   else        {Record number}

    begin
     if not DbInitSearch(Loc_bin,'binorbit.dbf') then
      begin
       writeln('Binorbit.dbf found nowhere in directories .\;',Loc_Bin,'!');
       exit
      end;
     if not DbRead(RecNo,rec) then
      begin
       writeln('There is no record ',RecNo,' in Binorbit.dbf!');
       halt
      end
     else
      begin {getting the coordinates}
       val(__CvtStr(rec[DbFieldNum('ALPHA')],_rem_lead_white_str),RA,j);
       val(__CvtStr(rec[DbFieldNum('DELTA')],_rem_lead_white_str),Decl,j);
       RA:=RA/1E3;
       Decl:=Decl/1E3;
      end
    end;

   j:=DbFieldNum('ADS');
   jmeno:=rec[DbFieldNum('ADS')];
   if __cvtstr(jmeno,_rem_white_str) ='' then jmeno:=rec[DbFieldNum('NAME')];
   val(__cvtstr(rec[DbFieldNum('PERIOD_Y')],_rem_white_str),a,j);
   val(__cvtstr(rec[DbFieldNum('PERIAS_T')],_rem_white_str),b,j);
   val(__cvtstr(rec[DbFieldNum('ECCEN')],_rem_white_str),c,j);
   val(__cvtstr(rec[DbFieldNum('SEMIAX')],_rem_white_str),d,j);
   val(__cvtstr(rec[DbFieldNum('INCLIN')],_rem_white_str),e,j);
   val(__cvtstr(rec[DbFieldNum('NODE')],_rem_white_str),f,j);
   val(__cvtstr(rec[DbFieldNum('LNGPER')],_rem_white_str),g,j);
   if RecNo>0 then FromBinaries:=true;
  end;

end;




procedure zapis;
begin
     writeln;
     writeln('                 DVOJHVĚZDA  : ',jmeno);
     writeln('                 ----------          ');
     writeln;
     write('  Perioda P [r]                   : ');     writeln(A:10:4);
     write('  Čas průchodu periastrem T0 [r]  : ');     writeln(B:10:4);
     write('  Výstřednost dráhy e             : ');     writeln(C:10:4);
     write('  Velká poloosa dráhy a ["]       : ');     writeln(D:10:4);
     write('  Inklinace i [st]                : ');     writeln(E:10:4);
     write('  Úhel výstup. uzlu OMEGA [st]    : ');     writeln(F:10:4);
     write('  Vzdálenost periastra omega [st] : ');     writeln(G:10:4);
  if (RA=0) and (Decl=0) then writeln else
     writeln('  RA, Decl. J2000.0  /1°:     ',RA:10:3,Decl:10:3);
     writeln('  ----------------------------------------------------------------------------');
     writeln;
     writeln('          Datum  [r]      Vzdálenost ["]     Pozič. úhel [st]                  ');
     writeln('          ----------      --------------     ----------------                  ');
end;

procedure vypis;
begin
n:=n+1;
if n/5 = int(n/5) then begin writeln; end;
{writeln  ('           ',H:8:3,'            ',Z:6:3,'                ',M:5:1);}
writeln('           ',H:8:3,'            ',Z:6:3,'                ',M:5:1);
end;


begin     {of the Main programme}
FileMode:=0; {will open the files by reset as Read Only
               -- they can be then marked so even if not on a CD;
               here it enables to have *.bgi and *.chr read-only}

 zadani;
 scal:=140/d;
 zapis;
 H:=H0;N:=-1;
 vypocet(H);
 while H <= H1 do
  begin
   vypocet(H);
   vypis;
   ix:=round(z*acos(m)*scal)+320 ;
   iy:=round(-z*asin(m)*scal)+240 ;
   H:=H+K;
  end;
 vypocet(1994);
 if FromBinaries then
  begin
   writeln;  writeln;
   DbDisp(RecNo);
   writeln;
   DbClose
  end;
end.