Program versgyakorisag;
{TARCSI ADAM}
{Feladat: vers gyakoris gi elemz‚se}
Uses newdelay,crt;
Var f:text;
    be,elozo,sor,szo:string;
    vane,joe:boolean;
    i,j,mdb,maxm,mshdb,maxmsh,szodb,h,sordb,mf,mshf:integer;
    ch:char;
    db: array [0..64] of integer;

Function Letezik_e(FileName: string): Boolean;
Var
  f: file;
Begin
  {$I-}
  Assign(f, FileName);
  Reset(f);
  Close(f);
  {$I+}
  Letezik_e:= (IOResult = 0) and (FileName <> '');
End;

Procedure megnyit(var f:text; fn:string);
Begin
 {$I-}
 assign(f,fn);
 reset(f);
End;

Procedure megnyitir(var f:text; fn:string);
Begin
 {$I-}
 assign(f,fn);
 rewrite(f);
End;

Function betu(var c:char):boolean;
Begin
  If ((ord(c) in [65..90]) or (ord(c) in [97..122])) or ((ord(c) in [128..165]))then betu:=true
  else If (ord(c)=235) or (ord(c)=214) or (ord(c)=233) or (ord(c)=224) or (ord(c)=251) or (ord(c)=181) or (ord(c)=138) or
  (ord(c)=235) or (ord(c)=214) or (ord(c)=233) or (ord(c)=224) or (ord(c)=251) then betu:=true
       else betu:=false;
End;

Procedure Feltolt(var f:text);
Begin
  For i:=0 to 64 do db[i]:=0;
  szodb:=0;
  h:=0;
  sordb:=0;
  While not (eof(f)) do
    Begin
      readln(f,sor);
      If length(sor)>0 then inc(sordb);
      While length(sor)>0 do
      Begin
        szo:='';
        While (length(sor)>0) and not(betu(sor[1])) do
            delete(sor,1,1);
        If length(sor)>0 then szodb:=szodb+1;
        While (length(sor)>0) and betu(sor[1]) do
          Begin
           szo:=szo+sor[1];
           If h=0 then h:=1
                  else h:=h+1;
           If ord(sor[1]) in [97..122] then db[ord(sor[1])-97]:=db[ord(sor[1])-97]+1
           else if ord(sor[1]) in [65..90] then db[ord(sor[1])-65]:=db[ord(sor[1])-65]+1
           else if ord(sor[1]) in [128..255] then Begin
                   CASE ord(sor[1]) of
                        128: db[33]:=db[33]+1;
                        138: db[37]:=db[37]+1;
                        142: db[30]:=db[30]+1;
                        143: db[32]:=db[32]+1;
                        144: db[28]:=db[28]+1;
                        146: db[43]:=db[43]+1;
                        153: db[46]:=db[46]+1;
                        154: db[27]:=db[27]+1;
                        165: db[62]:=db[62]+1;
                        181: db[58]:=db[58]+1;
                        214: db[59]:=db[59]+1;
                        224: db[60]:=db[60]+1;
                        233: db[61]:=db[61]+1;
                        235: db[64]:=db[64]+1;
                        251: db[64]:=db[64]+1;
                      else db[ord(sor[1])-102]:=db[ord(sor[1])-102]+1;
                   end;
                   End;
           delete(sor,1,1);
          End;
      End;
    End;
End;

Function magan_e(i:integer):boolean;
Begin
If i in [0,4,8,14,20,46,27,60,37,61,64,59,58,28] then magan_e:=true
                                                 else magan_e:=false;
{(i=0) or (i=4) or (i=8) or (i=14) or (i=20) or (i=46) or (i=27) or (i=60)
   or (i=37) or (i=61) or (i=64) or (i=59) or (i=58) or (i=28) then magan_e:=true
   else magan_e:=false;}
End;

Procedure Kiir;
Begin
 mdb:=0; mshdb:=0;
 maxm:=0;
 maxmsh:=1;
 h:=0;
 For i:=0 to 64 do
 Begin
   h:=h+db[i];
   If db[i]>0 then
    If magan_e(i) then Begin
                        mf:=mf+1;
                        mdb:=mdb+db[i];
                        If db[i]>db[maxm] then maxm:=i;
                       End
                  else Begin
                        mshf:=mshf+1;
                        mshdb:=mshdb+db[i];
                        If db[i]>db[maxmsh] then maxmsh:=i;
                       End;

{ELLENŠRZ�SRE    If db[i]<>0 then Begin
                      if i in [0..25] then Writeln(chr(i+97),' :',db[i])
                                      else if i in [26..63] then Writeln(chr(i+102),' :',db[i])
                                       else Writeln(chr(251),' :',db[64]);

                    End;}

 End;
 Writeln(#10#13'A VERS GYAKORISµGA: ',#10#13);
 Writeln(f,#10#13'A VERS GYAKORISµGA: ',#10#13);
 Writeln('A szavak sz ma: ',szodb:10);
 Writeln('A sorok sz ma: ',sordb:11);
 Writeln(f,'A szavak sz ma: ',szodb:10);
 Writeln(f,'A sorok sz ma: ',sordb:11);
 If szodb<>0 then Begin
                    Writeln('Az  tlagos sz¢hossz: ',h div szodb:5);
                    Writeln(f,'Az  tlagos sz¢hossz: ',h div szodb:5);
                  End
             else Begin
                    Writeln('Az  ltagos sz¢hossz: nincs benne sz¢');
                    Writeln(f,'Az  ltagos sz¢hossz: nincs benne sz¢');
                  End;
 Writeln('A betûk sz ma: ',h:11);
 Writeln(f,'A betûk sz ma: ',h:11);
 If maxm in [0..25] then i:=maxm+97
                    else if maxm in [26..63] then i:=maxm+102
                                             else i:=251;
 If db[maxm]>0 then Begin
                      Writeln('A mag nhangz¢k sz ma: ',mdb:4);
                      Writeln('A leggyakoribb maganhangz¢ az ',chr(i),', ',db[maxm],' db');
                      Writeln(mf,' f‚le mag nhangz¢ fordul el‹');
                      Writeln(f,'A mag nhangz¢k sz ma: ',mdb:4);
                      Writeln(f,'A leggyakoribb maganhangz¢ az ',chr(i),', ',db[maxm],' db');
                      Writeln(f,mf,' f‚le mag nhangz¢ fordul el‹');
                    End
               else Begin
                     Writeln('Nincs benne mag nhangz¢ ');
                     Writeln(f,'Nincs benne mag nhangz¢ ');
                    End;
 If maxmsh in [0..25] then j:=maxmsh+97
                      else if maxmsh in [26..63] then j:=maxmsh+102;
 If db[maxmsh]>0 then Begin
                       Writeln('A m ssalhangz¢k sz ma: ',mshdb:3);
                       Writeln('A leggyakoribb m ssalhangz¢ a(z) ',chr(j),', ',db[maxmsh],' db');
                       Writeln(mshf,' f‚le m ssalhangz¢ fordul el‹');
                       Writeln(f,'A m ssalhangz¢k sz ma: ',mshdb:3);
                       Writeln(f,'A leggyakoribb m ssalhangz¢ a(z) ',chr(j),', ',db[maxmsh],' db');
                       Writeln(f,mshf,' f‚le m ssalhangz¢ fordul el‹');
                      End
                 else Begin
                       Writeln('Nincs benne m ssalhangz¢ ');
                       Writeln(f,'Nincs benne m ssalhangz¢ ');
                      End;
 Writeln(#10#13,'™sszegz‚s'#10#13);
 Writeln(f,#10#13,'™sszegz‚s'#10#13);
 If (0<mf) and (mf<10) then Begin
          Writeln('Kev‚s fajta mag nhangz¢ forul el‹ a versben, sok az ism‚tl‹d‚s');
          Writeln(f,'Kev‚s fajta mag nhangz¢ forul el‹ a versben, sok az ism‚tl‹d‚s');
         End;
 Writeln('A mag n- illetve m ssalhangz¢kb¢l k”vetkeztethet�nk a vers hangulat ra: ');
 Writeln(f,'A mag n- illetve m ssalhangz¢kb¢l k”vetkeztethet�nk a vers hangulat ra: ');
 If db[maxm]>0 then
 Begin
 Write('Az ',chr(i),' sok el‹fordul sa miatt a vers hangulata ');
 Write(f,'Az ',chr(i),' sok el‹fordul sa miatt a vers hangulata ');
 If chr(i) in ['i','¡','�','û','”','‹'] then Begin
                                               Writeln('kellemes, vid m.');
                                               Writeln(f,'kellemes, vid m.');
                                             End
                                        else Begin
                                               Writeln('kellemetlen, szomor£.');
                                               Writeln(f,'kellemetlen, szomor£.');
                                             End;
 End;
 If db[maxmsh]>0 then
 Begin
 Write('A gyakori ',chr(j),' miatt a vers ');
 Write(f,'A gyakori ',chr(j),' miatt a vers ');
 If chr(j) in ['m','n','l','z'] then Begin
                                       writeln('kellemes, vid m, zenei, l gy.');
                                       writeln('kellemes, vid m, zenei, l gy.');
                                     End
                                else Begin
                                       writeln('kem‚ny, kellemetlen.');
                                       writeln(f,'kem‚ny, kellemetlen.');
                                     End;
 End;
End;

BEGIN
TextBackground(blue);
Textcolor(yellow);
Repeat
 clrscr;
 Writeln('Vers gyakoris g nak vizsg lata' );
 Write('(F) jlbol, vagy (B)illentyûzetr‹l k¡v n olvasni? ');
 joe:=false;
 vane:=true;
 repeat
 ch:=readkey;
 {$I-}
 until ch in['B','b','F','f'];
 Textcolor(white);
 writeln(ch);
 Textcolor(yellow);
 if (ch='f') or (ch='F') then Begin
                               i:=1;
                               Repeat
                                write('Örja be a file nevet (kiterjeszt‚ssel egy�tt):  ');
                                Textcolor(white);
                                readln(be);
                                Textcolor(yellow);
                                i:=i+1;
                                If (i>3) then Begin
                                               joe:=true;
                                               vane:=false;
                                              End;
                               until ((letezik_e(be)) and (length(be)<=12)) or joe;
                               if vane then megnyit(f,be);
                              End
                         else Begin
                               clrscr;
                               writeln('G‚pelje be a verset: ');
                               Writeln('Ha egym s ut n k‚t �res sort ¡r az olvas s befejez‹dik');
                               megnyitir(f,'out.txt');
                               elozo:=' ';
                               Repeat
                                 textcolor(white);
                                 readln(be);
                                 textcolor(yellow);
                                 If (be='') and (elozo='') then joe:=true
                                                           else writeln(f,be);
                                 elozo:=be;
                               Until joe;
                               close(f);
                               megnyit(f,'out.txt');
                              End;
Until vane;
Feltolt(f);
close(f);
megnyitir(f,'eredm.txt');
Kiir;
close(f);
{$I+}
textcolor(white);
Write(#10#13,'Nyomjon meg egy billentyût a kil‚p‚shez!');
readkey;
END.