program infalk1be1;
{Irta: Szamoskozi Peter - 2000. november 8.
szamosp(a)inf.elte.hu
Felhasznalas: ld. General Puplic Licence}

uses dos,crt;
const max=trunc(maxint/4); {szo es sorhossz}
type rekord=record hossza:integer; end;
var db:array[0..255] of integer;
hossz:array[1..max] of integer;
betudb,szodb,sordb:integer;
szo,sor:array[1..max] of rekord;
zgsmsh,zgtmsh,melymgr,magasmgr:integer;
f:text; {a kimenetnek}
szf:text; {innen olvas}
vege:char;

procedure szamol;
  procedure szonakvege(c:char; var szvege:integer);
  var sv:integer;
  begin
    sv:=ord(c);
    if (sv=32) then szvege:=0 else szvege:=1;
  end;
  procedure sorvege(var c:char; var svege:integer);
  var sv:integer;
  begin
    sv:=ord(c);
    if (sv=13) then svege:=0 else svege:=1;
  end;
  procedure fajta;
  var li:integer; k:char; i,j:integer;
  begin
    reset(szf);
    i:=1; j:=1;
    while not(eof(szf)) do begin
      read(szf,k); inc(db[ord(k)]); inc(betudb); k:=upcase(k);
      if ((k='B') or (k='D') or (k='G') or (k='V') or (k='Z')) then inc(zgsmsh)
        else if ((k='F') or (k='H') or (k='K') or (k='P') or (k='S') or (k='T')) then inc(zgtmsh)
        else if ((k='A') or (k='O') or (k='U')) then inc(melymgr)
        else if ((k='E') or (k='I')) then inc(magasmgr);
      sorvege(k,li);
      if (li=1) then inc(sor[sordb].hossza)
        else begin inc(sordb); {inc(i);} end;
      szonakvege(k,li);
      if (li=1) then inc(szo[szodb].hossza)
        else inc(szodb); {inc(j); space}
    end;
  close(szf);
  end;
begin
fajta;
end;

procedure kiir(var f:text);
var i:integer; szoatlag:integer;
yy,mm,dd,yow:word; {a datumhoz}
  procedure kicim;
  begin
    writeln(f,' ');
    writeln(f,'  A megadott szoveg gyakorisagi elemzese');
    getdate(yy,mm,dd,yow);
    writeln(f,'      Az elemzes keszult: ',yy,'.',mm,'.',dd,'.');
    writeln(f,'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~');
    writeln(f,' ');
  end;
begin
  rewrite(f);
  kicim;
  write(f,'Az osszes sor: '); writeln(f,sordb);
  writeln(f,' ');
  szodb:=db[32]+sordb-2;
  write(f,'A szavak szama: '); writeln(f,szodb);
  writeln(f,' ');
  writeln(f,'A sorok hossza (sor/karakter)');
  for i:=1 to sordb do begin
   write(f,i); write(f,' - ');
   if ((i>2) and ((i mod 10)=0)) then
   begin write(f,sor[i].hossza); writeln(f,','); end
     else begin write(f,sor[i].hossza); write(f,', '); end;
  end;
  writeln(f,''); writeln(f,' ');
  write(f,'Az egy sorra juto szavak szama (atlag): ');
  writeln(f,(szodb div sordb));
  writeln(f,'');
  writeln(f,'A szavak hossza: (szo[hossz])');
  for i:=1 to szodb do begin       {****}
    write(f,i); write(f,' - ');
    if ((i>2) and ((i mod 10)=0)) then
     begin write(f,szo[i].hossza); writeln(f,','); end
     else begin write(f,szo[i].hossza); write(f,', '); end;
  end;
  writeln(f,''); writeln(f,' ');
  write(f,'A szavak atlagos hossza: ');
  szoatlag:=0;
  for i:=1 to szodb do begin
    szoatlag:=(szoatlag+szo[i].hossza);
  end;
  szoatlag:=(szoatlag div szodb);
  writeln(f,szoatlag);
  writeln(f,' ');
  writeln(f,'Az szovegben levo betuk, ABC-szerint, Pl: betu(db)');
  for i:=32 to 255 do begin
    write(f,chr(i)); write(f,':'); write(f,'['); write(f,db[i]); write(f,']');
    write(f,', ');
    if ((i mod 10)=0) then writeln(f,'');
  end;
  writeln(f,''); writeln(f,' ');
  writeln(f,'A kulonbozo betufajtak darabszama');
  write(f,'zonges massalhangzok: '); writeln(f,zgsmsh);
  write(f,'zongetlen massalhangzok: '); writeln(f,zgtmsh);
  write(f,'mely, (rovid) maganhangzok: '); writeln(f,melymgr);
  {**}writeln(f,'');
  write(f,'magas (rovid) maganhangzok: '); writeln(f,magasmgr);
end;

procedure foprogram;
var kihova,behonnan:char; fnev:string;
szoveg:string; tart:text; cv:integer;x:char;
  procedure nullaz;
  var j:integer;
  begin
    betudb:=0;  sordb:=1; szodb:=1;
    for j:=1 to max do begin
    szo[j].hossza:=0; sor[j].hossza:=0; end;
    zgsmsh:=0; zgtmsh:=0; melymgr:=0; magasmgr:=0;
  end;
  procedure cim;
  begin
  writeln('Vers gyakorisag-mero program':2);
  writeln('Szamoskozi Peter - 2000.november':3);
  writeln;
  end;
  procedure befele;
  var i:integer;
  begin
    nullaz;
    clrscr;
    cim;
    repeat
      writeln;
      write('Honnan olvassam a szoveget? (File, Bill.)'); readln(behonnan);
      assign(szf,'e:\1\2\file.txt');
    until ((behonnan='f') or (behonnan='b'));
    if behonnan='f' then assign(szf,'e:\1\2\file.txt')
      else begin assign(tart,'tart.txt'); rewrite(tart);
        write('A befejezo-karakter a "kukac" (@)'); cv:=1;
        repeat
          writeln('Kerem a(z) ',cv,'. sort: ');
          readln(szoveg); writeln(tart,szoveg); x:=szoveg[length(szoveg)];
          inc(cv);
        until (x='@'); close(tart);
        assign(szf,'tart.txt'); end;
    for i:=1 to 255 do db[i]:=0;
  end; {proc. befele}
begin
  befele;
  writeln('Szamolok...'); szamol;
  repeat
    write('Hova irjam az eredmenyt? /File, Monitor/'); readln(kihova);
  until ((kihova='f') or (kihova='m'));
  if kihova='f' then assign(f,'ossz.txt') else assigncrt(f);
  if (kihova='f') then writeln('Az eredmenyek az "ossz.txt" file-ban vannak')
    else writeln('Az eredmenyek: ');
  kiir(f);
end;

begin
 repeat
   foprogram;
   writeln('Ha be akarja fejezni, nyomja meg az ESC-billentyut!');
   readln(vege);
 until (vege=#27);
end.