uses crt,dos;
const
 q=10;
namereg:array[1..5]of string[25]=('ввод данных','создание','печать','недопоставлено','выход');

type
   TDate=record
                year:integer;
                month:byte;
                day:byte;
                end;
   contract=record
        Ncontr:byte;
        tovar:string[25];
        strana:string[25];
        firma:string[25];
        Vpost:integer;
        dateCON:TDate;
        dateISP:Tdate;
        TODAY:record
              V:integer;
              year:integer;
              month:byte;
              day:byte;
              end;
              end;
     dataarr=array [1..10] of string[25];

     PTree=^TTree;
     TTree=record
            x:contract;
            l,r:PTree;
     end;



var
  f:file of contract;
  a,b:dataarr;
  c:contract;
  tov,str,name:string[25];
  c1:byte;
  i,k,m,j,l,time,dlin:integer;
  txt:array[1..q] of string[25];
  siv,nom,til,ery,regime:integer;
  key:char;
  qwoto,w1:boolean;
  top:PTree;


procedure ENTER;
var
sim:char;
begin
assign(f,'materia.pas');
{$I-}
reset(f);
{$I+}
if ioresult=0 then begin
              writeln('файл уже существует');
              writeln('введите 11 для создания нового файла');
              writeln('введите 22 для добавления записи');
              readln(sim);
              if sim='2' then
                         seek(f,filesize(f))
                         else rewrite(f);
                   end
            else rewrite(f);
repeat
   write('номер контракта ');
   readln(c.ncontr);
   write('наименование товара ');
   readln(c.tovar);
   write('страна ');
   readln(c.strana);
   write('фирма ');
   readln(c.firma);
   write('общий объём поставок ');
   readln(c.Vpost);
   writeln('дата заключения контракта ');
   write('год ');
   readln(c.dateCON.year);
   write('месяц ');
   readln(c.dateCON.month);
   write('день ');
   readln(c.dateCON.day);
   writeln('дата исполнения контракта ');
   write('год ');
   readln(c.dateISP.year);
   write('месяц ');
   readln(c.dateISP.month);
   write('день ');
   readln(c.dateISP.day);
   writeln('количество товара постявленного сейчас ');
   write('объём поставки ');
   readln(c.TODAY.V);
   write('год ');
   readln(c.TODAY.year);
   write('месяц ');
   readln(c.TODAY.month);
   write('день ');
   readln(c.TODAY.day);
write(f,c);
writeln('продолжить ввод? [д/н] ');
readln(sim);
until sim='н';
close(f);
end;
procedure derevo(x1:contract;k:string;w1:boolean );
var
  N,T,P:PTree;

begin
new(N);
N^.x:=x1;
N^.l:=nil;
N^.r:=nil;
if top=nil then top:=N {если до этого дерева не было то мы подвешиваем корень}
 else begin
    P:=nil;
    T:=top;
    while T<>nil do begin
          if T^.x.tovar > N^.x.tovar then begin
                              P:=T;
                              T:=T^.l;
          end                           {идём до нужной позиции}
          else begin
              P:=T;
              T:=T^.r;
          end;
    end;
    if P^.x.tovar > N^.x.tovar then begin
	                                P^.l:=N;

             				 			if (P^.x.tovar=k) and w1 then
                                         if siv=1 then
                  						m:=m+P^.x.Vpost
         								 else if P^.x.tovar=k then
                  							i:=i+P^.x.TODAY.V;

                                end
      else begin
	       P^.r:=N;
              if (P^.x.tovar=k) and w1 then
			    if siv=1  then
                  m:=m+P^.x.Vpost
          else if P^.x.tovar=k then
                  i:=i+P^.x.TODAY.V;


          end ;


 end;
 end;
{procedure check (kkname ,kname:string);
var
 i:integer;
begin
{ if tek^.l<>nil then
       check(tek^.l,kname);}
 {if kkname=kname then
                  m:=m+tek^.x.Vpost;
{ if tek^.r<> nil then
       check(tek^.r,kname);}

{end;}
procedure print(tek:PTree);
begin
    if tek^.l <> nil then
           print(tek^.l);
    writeln(tek^.x.tovar);
{      writeln('номер контракта');
   writeln(tek^.x.ncontr);
   writeln(tek^.x.tovar);
    writeln(tek^.x .strana);
    writeln(tek^. x.firma);
    writeln(tek^.x.Vpost);
writeln('дата заключения контракта');
    writeln(tek^.x.datecon.year);
    writeln(tek^.x.datecon.month);
    writeln(tek^.x.datecon.day);
writeln('дата исполнения контракта');
    writeln(tek^.x.dateisp.year);
    writeln(tek^.x.dateisp.month);
    writeln(tek^.x.dateisp.day);
writeln('положение на сегодняшний день');
    writeln(tek^.x.TODAY.V);
    writeln(tek^.x.TODAY.year);
    writeln(tek^.x.TODAY.month);
    writeln(tek^.x.TODAY.day);
    writeln;}

    if tek^.r <> nil then
           print(tek^.r);
end;

procedure print11(tek:PTree);
begin
    if tek^.l <> nil then
           print(tek^.l);

       if  tek^.x.Vpost >tek^.x.TODAY.V then
            writeln(tek^.x.tovar);


    if tek^.r <> nil then
           print(tek^.r);
end;










{////////////////////////////////////////////////////////////////////}
procedure clean(tek:PTree);
var
  T,P:PTree;

begin
   while Tek^.l<> nil do begin
              P:=Tek;
              Tek:=Tek^.l;
              end;
              P^.l:=Tek^.r;
              dispose(Tek);

             end;

{/////////////////////////////////////////////////////////////////////}



procedure menu(var pos:integer);
var p:integer;
procedure cursor(on:boolean);
var r:registers;
begin
 R.AH:=1;
 if on then begin
        R.CH:=6;
        R.CL:=7;
        end
        else R.CH:=$20;
     intr(16,R);
   end;
begin
 textbackground(3);
 clrscr;
 textbackground(1);
 window(32,8,49,20);
 clrscr;
 textcolor(7);
 gotoxy(1,1);
 for p:=1 to 5 do begin
 gotoxy(3,p+2);
 write(namereg[p]);
 end;
 textbackground(7);
 textcolor(1);
 gotoxy(3,pos+2);
 write(namereg[pos]);
 cursor(false);
 repeat
 key:=readkey;
 if ord(key)<>13 then begin
            textbackground(1);
            textcolor(7);
            gotoxy(3,pos+2);
            write(namereg[pos]);
            if ord(key)=0 then begin
                    key:=readkey;
                    if ord(key)=80 then
                           if pos=5 then pos:=1
                               else pos:=pos+1
                           else if ord(key)=72 then
						   if pos=1 then pos:=5
                              else pos:=pos-1;
                             end;
                        textbackground(7);
                        textcolor(1);
                        gotoxy(3,pos+2);
                        write(namereg[pos]);
                        end;
                        until key=chr(13);
						window(1,1,80,25);
						cursor(true);
						textbackground(0);
						textcolor(15);
						clrscr;
						end;




begin
clrscr;


regime:=1;
repeat
 menu(regime);
case regime of
 1:enter;
 2:begin
writeln('введите наименование товара');
   readln(tov);
   assign(f,'materia.pas');
  {$I-}
  reset(f);
  {$I+}
  if ioresult<>0 then begin
                     writeln('файл не найден');
                     writeln('для продолжения нажмите ENTER');
                     readln;
                    end
   else begin
       m:=0; i:=0;
       writeln('1-вывод общего объёма поставок олределённого товара');
       writeln('2-вывод объёма товара поставленного на данный моомент');
       readln(siv);
       while not eof(f) do begin
                 read(f,c);
                 derevo(c,tov,true);

       end;


   close(f);

if siv=1 then
writeln(m)
else writeln(i);
writeln('нажмите для ENTER продолжения');
 end;
readln;
while top^.l<>nil do
clean(top);
end;
 3:begin
 { assign(f,'materia.pas');}
  {$I-}
{  reset(f);
  {$I+}
 { if ioresult<>0 then begin
                     writeln('файл не найден');
                     writeln('для продолжения нажмите ENTER');
                     readln;
                    end
   else begin

       while not eof(f) do begin
                 read(f,c);
                 derevo(c,tov,false);

       end;


close(f);
end;}
 print(top);
  readln;

{while top^.l<>nil do
clean(top);
  }
   end;
 4:begin
    print11(top);



  end;
 5:



 else;
end;
until regime=5;
while top^.l<>nil do


clean(top);
end.