program analyze(input,output);
{
  Analyze text file
  Call it: ANAL file (opt)

  opt my be S if output should be sorted
}
const
  TERMWIDTH    = 67.0;
  MAXROW       = 24;
type
  hexstr       = string[4];
  datrec       = record
                   b   : byte;
                   cha : integer;
                 end;
var
  F            : text;
  ch           : char;
  opt          : char;
  row          : integer;
  i            : integer;
  j            : integer;
  mx           : integer;
  chi          : integer;
  ASCIIset     : integer;
  CTRLset      : integer;
  BINset       : integer;
  CHARset      : integer;
  chb          : byte;
  data         : array[0..255] of datrec;
  chv          : real;

procedure Init;
Begin
  for i:=0 to 255 do
  begin
    data[i].b:=i;
    data[i].cha:=0;
  end;
  mx:=0;
  row:=0;
  ASCIIset:=0;
  CTRLset:=0;
  BINset:=0;
  CHARset:=0;
End;

procedure BadCall;
Begin
  writeln('Analyze text file');
  writeln('Call it: ANAL file (opt)');
  writeln;
  writeln('opt may be S if output should be sorted');
  halt;
End;

procedure BadFile;
Begin
  writeln('Cannot find file ',ParamStr(1));
  halt;
End;

function max(a,b:integer):integer;
Begin
  if (a>b) then max:=a
           else max:=b;
End;

procedure Update(x:char);
Begin
  case x of
    #$00..#$1f : CTRLset:=CTRLset+1;
     ' '..'~'  : ASCIIset:=ASCIIset+1;
    else         BINset:=BINset+1;
  end;
End;

function ASCII(x:byte):hexstr;
Begin
  if (chr(x) in [' '..'~']) then ASCII:='('+chr(x)+')'
                            else ASCII:='   ';
End;

function Hex(x:byte):hexstr;

  function Nibble(x:byte):char;
  begin
    case x of
       0.. 9 : Nibble:=chr(x+ord('0'));
      10..15 : Nibble:=chr(x-10+ord('A'));
    end;
  end;

Begin
  Hex:=Nibble(x shr 4)+Nibble(x and $0f);
End;

procedure Sort;
var
  offset       : integer;
  limit        : integer;
  tausch       : integer;
  line         : integer;

  procedure switch(var a,b:datrec);
  var
    c          : datrec;
  begin
    c:=a;
    a:=b;
    b:=c;
  end;

Begin
  writeln('Sorting data...');
  offset:=128;
  while (offset>0) Do
  begin
    limit:=255-offset;
    repeat
      tausch:=0;
      for line:=0 to limit do
        if (data[line].cha>data[line+offset].cha) then
        begin
          switch(data[line],data[line+offset]);
          tausch:=line;
        end;
      limit:=tausch-offset;
    until (tausch=0);
    offset:=offset div 2;
  end;
End;

{
procedure Sort;
var
  i            : integer;
  j            : integer;

  procedure switch(var a,b:datrec);
  var
    c          : datrec;
  begin
    c:=a;
    a:=b;
    b:=c;
  end;

Begin
  writeln('Sorting data...');
  for i:=1 to 255 do
    for j:=255 downto i do
      if (data[j-1].cha>data[j].cha) then switch(data[j-1],data[j]);
End;
}

procedure NL;
var
  ch           : char;
Begin
  writeln;
  row:=row+1;
  if (row>MAXROW) then
  begin
    write('<< MORE >>'#13);
    repeat until keypressed;
    read(kbd,ch);
    write('          '#13);
    row:=0;
    if (ch=^C) then
    begin
      writeln('User break');
      halt;
    end;
  end;
End;

BEGIN
  if (ParamCount=0) or (ParamCount>2) then BadCall;
  assign(F,ParamStr(1));
  {$I-}reset(F);{$I+}
  if (IOResult<>0) then BadFile;
  if (ParamCount=2) then opt:=upcase(ParamStr(2))
                    else opt:=' ';
  if not (opt in [' ','S']) then BadCall;
  Init;
  writeln('Reading file...');
  while not eof(F) do
  begin
    read(F,ch);
    data[ord(ch)].cha:=data[ord(ch)].cha+1;
    Update(ch);
  end;
  for i:=0 to 255 do mx:=max(mx,data[i].cha);
  if (opt='S') then Sort;
  for i:=0 to 255 do
  begin
    chi:=data[i].cha;
    if (chi<>0) then
    begin
      chb:=data[i].b;
      write(Hex(chb),ASCII(chb),'<',chi:5,'>:');
      chv:=chi*TERMWIDTH/mx;
      for j:=1 to trunc(chv) do write('*');
      NL;
      CHARset:=CHARset+1;
    end;
  end;
  NL;
  write('Statistic');
  NL;
  write('ASCII=',ASCIIset,', Control=',CTRLset,', Binary=',BINset);
  NL;
  chv:=ASCIIset+CTRLset+BINset;
  write('Total=',chv:5:0,' Bytes');
  NL;
  writeln('Found ',CHARset,' out of 256 possible combinations');
END.