dhg

program uvp3;
uses crt;
type
  arr=array[1..18] of integer;
const
  menus:array[1..5] of string= ('Input array',
                                'Output original array',
                                'Conditional sorting',
                                'Output changed array',
                                'Exit');
var
 realarr,changedarr:arr;
 rmode,num :Byte;

procedure Frame (x1,y1,x2,y2,txt_col:Integer);
const
 a=#186; b=#187;
 c=#188; d=#200;
 e=#201; f=#205;
var
 i:Integer;
begin
 window(1,1,80,25);
 textColor(txt_col);
 gotoXY(x1,y1);
 Write(e);
 for i:=x1+1 to x2-1 do
  Write(f);
 Write(b);
 for i:=y1+1 to y2-1 do
 begin
  gotoXY(x1,i);
  write(a);
  gotoXY(x2,i);
  Write(a);
 end;
 gotoXY(x1,y2);
 Write(d);
 for i:=x1+1 to x2-1 do
  Write(f);
 Write(c);
 window(x1+1,y1+1,x2-1,y2-1);
 textColor(txt_col);
 clrscr;
end;





Procedure menu(var mode:Byte);
Var
 k,i:Byte;
 code:Char;
Begin
 frame (1,1,23,8,14);
 writeln('MENU');
 k:=1;
 code:=' ';
 While code<>#13 do
 begin
   For i:=1 to 5 do
   begin
     If i=k then
       TextBackGround(Green)
     else
       textbackground(black);
     GotoXY(1,i+1);
     Write(menus[i]);
   end;
   code:=ReadKey;
   If code=#0 then
   begin
     code:=ReadKey;
     If code=#72 then
       If k>1 then k:=k-1
       else k:=5
     else if code=#80 then
       If k<5 then k:=k+1
       else k:=1;
   end;
   mode:=k;
 end;
end;

procedure input_array(var a,b:arr; var n:byte);
var
  i:integer;
begin
  write('Enter num: ');
  read(n);
  writeln('Enter array: ');
  for i:=1 to n do
  begin
    read(a[i]);
    b[i]:=a[i];
  end;
end;

procedure output_array(a:arr;n:byte; const s:string);
var
  i:integer;
begin
  writeln(s);
  for i:=1 to n do
    write(a[i],' ');
end;

procedure condit_sort(var a:arr; n:byte);
var
  s,i,k,r:integer;
begin
  s:=1;
  i:=1;
  while i<=n do
  begin
    s:=s+a[i];
    i:=i+2;
  end;
  writeln('s =',s,'; first el is ',a[i]);
  if s>a[1] then
  begin
    writeln('s>first el. Array should be sorted');

    for i:=1 to n-1 do
    begin
      if a[i]<a[i+1] then
      begin
        r:=a[i];
        a[i]:=a[i+1];
        a[i+1]:=a[i];
      end;
      if i>1 then  for k:=i+1 downto 2 do
      begin
        if a[k-1]<a[k] then
        begin
          r:=a[k];
          a[k]:=a[k-1];
          a[k-1]:=r;
        end
        else break;
      end;
  end;
end;

begin
  clrscr;
  while true do
  begin
    menu(rmode);
    case rmode of
      1:begin
          frame(1,11,80,16,14);
          input_array(realarr,changedarr,num);
        end;
      2:begin
          frame(1,11,80,16,14);
          output_array(realarr,num,'ORIGINAL ARRAY');
        end;
      3:begin
          frame(26,1,80,9,14);
          condit_sort(changedarr,num);
        end;
      4:begin
          frame(1,19,80,23,14);
          output_array(changedarr,num,'CHANGED ARRAY');
        end;
      5:exit
    end;
  end;
end.