USES Graph,Crt,Dos;
 CONST RG=180./3.1415926; OO=Ord('0'); GR=3.14159265/180.;
 VAR  MORE,PROJ:CHAR; F1:TEXT;
      GD,GM,CHANGE,I,J,K,L,M,N,MAS,IY,IM,ID,X0,Y0:INTEGER;
      TIME,TST,XY:REAL;
      S2,SD,SM:STRING[2]; S6:STRING[6];
      SY:STRING[5]; S3:STRING[3]; GDIR:STRING;
      CON:ARRAY[1..12OF STRING[3];
      PLANET:ARRAY[1..7OF STRING;
      PERIOD,P0,AP,OMEGA,C2,PAR,E,XH,YH,XG,YG,
      GEOL,AGE,HL:ARRAY[1..7OF REAL;
      ZOD:ARRAY[1..7OF INTEGER;
      label 1,2,3;
 
 FUNCTION YEARS(YY,MM,DS:INTEGER):REAL;
 VAR  DAYS:INTEGER;
 BEGIN
      DAYS:=365*((YY-1MOD 4)+30*(MM-1)+DS+ROUND(2.+0.55*(MM-8));
      IF MM<3 THEN DAYS:=DAYS+2;
      IF (YY MOD 4=0AND (MM>2THEN DAYS:=DAYS+1;
      YEARS:=YY-((YY-1MOD 4)+DAYS/365.25;
 END;
 
 FUNCTION PERIHEL(NPL:INTEGER;YEAR:REAL):REAL;
 BEGIN PERIHEL:=P0[NPL]-PERIOD[NPL]*(TRUNC((P0[NPL]-YEAR)/PERIOD[NPL])+1);
 END;
 
 FUNCTION HELIOLONG(NPL:INTEGER;DT:REAL):REAL;
 BEGIN HELIOLONG:=AP[NPL]+OMEGA[NPL]*DT+C2[NPL]*SIN(2.*PI*DT/PERIOD[NPL]);
 END;
 
 FUNCTION RH(NPL:INTEGER;HGR:REAL):REAL;
 BEGIN RH:=PAR[NPL]/(1.+E[NPL]*COS((HGR-AP[NPL])*GR));
 END;
 
 FUNCTION ALPHA(XX,YY:REAL):REAL;
 VAR V2:REAL;
 BEGIN IF XX=0THEN V2:=90.*(2.-YY/ABS(YY))
       ELSE V2:=ARCTAN(YY/XX)*RG;
       IF XX<0THEN V2:=V2+180.;
       IF ((XX>0AND (YY<0)) THEN V2:=V2+360.;
       IF V2>=360THEN V2:=V2-360.;
       IF V2<0THEN V2:=V2+360.;
       ALPHA:=V2;
 END;
 
 PROCEDURE WAIT;
 VAR  SIM:CHAR;
 BEGIN REPEAT UNTIL KeyPressed; SIM:=ReadKey;
 END;
 
 BEGIN PLANET[1]:='Solnce'; PLANET[2]:='Mars';
       PLANET[3]:='Jupiter'; PLANET[4]:='Saturn';
       PLANET[5]:='Mercury'; PLANET[6]:='Venera'; PLANET[7]:='Luna';
       CON[1]:='Ryb'; CON[2]:='Ovn'; CON[3]:='Tel'; CON[4]:='Blz';
       CON[5]:='Rak'; CON[6]:='Lev'; CON[7]:='Dev'; CON[8]:='Ves';
       CON[9]:='Skr'; CON[10]:='Str'; CON[11]:='Koz'; CON[12]:='Vod';
       ASSIGN(F1,'ELEMENTS.DAT'); RESET(F1);
       FOR I:=1 TO 7 DO BEGIN
       READ(F1,PERIOD[I],P0[I],AP[I],OMEGA[I],C2[I],PAR[I],E[I]);
       END;
       CLOSE(F1);
       MAS:=100; TST:=0.02; XY:=1.150; X0:=360; Y0:=200;
       GDIR:='';
 
       REPEAT ClrScr; CHANGE:=0;
       REPEAT ClrScr;
       WRITELN('BGI файлы в директории ',GDIR,' , X/Y =',XY:6:3,',');
       WRITELN('Mасштаб = ',MAS:4,' , X0 = ',X0:4,' , Y0 = ',Y0:4);
       WRITELN('Что Вы хотите изменить ?');
       WRITELN('(0-ничего, 2-BGI директорию, 3-X/Y, 4-масштаб, 5-X0, 6-Y0).');
       REPEAT UNTIL KEYPRESSED; CHANGE:=ORD(READKEY)-OO; CASE CHANGE OF
                  2BEGIN WRITE(' BGI дир: '); READLN(GDIR) END;
                  3BEGIN WRITE(' Отношение X/Y  = '); READLN(XY) END;
                  4BEGIN WRITE(' Масштаб = '); READLN(MAS) END;
                  5BEGIN WRITE(' X0 = '); READLN(X0) END;
                  6BEGIN WRITE(' Y0 = '); READLN(Y0) END;
                  ELSE CHANGE:=0
            END UNTIL CHANGE=0;
 WRITELN(' Введите год, месяц и число.');
 READLN(IY,IM,ID);
 1:TIME:=YEARS(IY,IM,ID);
 
             GD:=0; INITGRAPH(GD,GM,'');
       CLEARDEVICE;
       SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
       STR(IY,SY); STR(IM,SM); STR(ID,SD);
       OUTTEXTXY(20,10,SD+'.'+SM+'.'+SY);
 LINE(X0,Y0,X0,Y0);
 FOR I:=1 TO 12 DO
       BEGIN L:=X0+TRUNC(1.3*XY*MAS*COS(30.*I*GR));
             M:=Y0-TRUNC(1.3*MAS*SIN(30.*I*GR));
             MOVETO(L,M);
             L:=X0+TRUNC(1.4*XY*MAS*COS(30.*I*GR));
             M:=Y0-TRUNC(1.4*MAS*SIN(30.*I*GR));
             LINETO(L,M);
             L:=X0+TRUNC(1.7*XY*MAS*COS(15.*(2*I-1)*GR));
             M:=Y0-TRUNC(1.7*MAS*SIN(15.*(2*I-1)*GR));
             OUTTEXTXY(L,M,CON[I]);
 END;
 
 FOR I:=1 TO 7 DO
       BEGIN AGE[I]:=TIME-PERIHEL(I,TIME);
       IF AGE[I]>PERIOD[I] THEN AGE[I]:=AGE[I]-PERIOD[I];
       IF AGE[I]<0THEN AGE[I]:=AGE[I]+PERIOD[I];
       HL[I]:=HELIOLONG(I,AGE[I]);
       XH[I]:=RH(I,HL[I])*COS(HL[I]*GR);
       YH[I]:=RH(I,HL[I])*SIN(HL[I]*GR);
       IF (I>1AND (I<7THEN BEGIN
             XG[I]:=XH[I]-XH[1];
             YG[I]:=YH[I]-YH[1];
       END;
       IF I=1 THEN BEGIN
             XG[I]:=-XH[1]; YG[I]:=-YH[1];
       END;
       IF I=7 THEN BEGIN
             XG[I]:=XH[I]; YG[I]:=YH[I];
       END;
 
       GEOL[I]:=ALPHA(XG[I],YG[I]);
       L:=ROUND(XY*MAS*COS(GEOL[I]*GR))+X0;
       M:=Y0-ROUND(MAS*SIN(GEOL[I]*GR));
       S6:=COPY(PLANET[I],1,6);
       OUTTEXTXY(L,M,S6);
       ZOD[I]:=1+TRUNC(GEOL[I]/30.0);
 END;
       L:=10; M:=GETMAXY-60;
       OUTTEXTXY(L+12,M+50,'Moсква , 1992');
       SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,2);
       OUTTEXTXY(L,M,'Double D');
       OUTTEXTXY(L,M+25,'software');{ WAIT};
       goto 3;
 
       {CLEARDEVICE; CIRCLE(X0,Y0,2);
       SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
       OUTTEXTXY(20,10,SD+'.'+SM+'.'+SY);
 
       FOR I:=1 TO 6 DO
       BEGIN L:=X0+ROUND(0.5*MAS*XH[I]*XY);
             M:=Y0-ROUND(0.5*MAS*YH[I]);
             CIRCLE(L,M,1);
       END; WAIT;}

       2:CLOSEGRAPH;
       textmode(2);
       WRITELN(ID,'.',IM,'.',IY);
       FOR I:=1 TO 7 DO BEGIN J:=ZOD[I];
       WRITELN(PLANET[I],' : ',GEOL[I]:5:1,' ( ',CON[J],' )'); END;
       3:WRITELN('Хотите построить другую картинку (Y/N) ?');
       REPEAT UNTIL KEYPRESSED;
       MORE:=READKEY;
        if (more='x'or(more='X'then begin
        id:=id+1;
        goto 1;
        end;
        if (more='z'or (more='Z'then begin
        id:=id-1;
        goto 1;
        end;
        if (more='s'or (more='S'then goto 1;
        if (more='c'or (more='C'then goto 2;
        IF (MORE='Y'OR (MORE='y')
       THEN MORE:='Y' ELSE MORE:='N' UNTIL MORE='N'{CLRSCR};
 END.