program pan2;
    var
    quantopan,oldapan,impo,fois,unch,index,oldindex,xpos,occ,lk:byte;
    lenlunlet,oldlunlet,time,cah,asci_code,volte:integer;
    ch,let:char;
    altrogiro:array [1..30] of integer;
    pan:string[255];
    poso:string[15];
    num_in_let,nocc:string[20];
    num:array[1..100] of string[25];

                procedure cambio;
                          begin;
                          if (time=1) then
                          oldapan:=1;
                          quantopan:=length(pan);
                          gotoxy(1,22);
                          if (oldapan<>quantopan) then
                          begin;
                          unch:=0;
                          end
                          else
                          begin;
                          unch:=unch+1;
                          end;
                          oldapan:=quantopan;
                          end;

               procedure riempi; {immette in memoria i numeri in lettere}
                   var
                      nfilein:string[14];
                      filein:file of string[25];
                            begin;
                              index:=0;
                              nfilein:=('num100.dat');
                              assign(filein,nfilein);
                              reset(filein);
                              repeat;
                              index:=index+1;
                              read(filein,num[index]);
                              until (index=100);
                              close(filein);
                            end;

                                  procedure conta;
                                            var
                                            par:char;
                                            begin;
                                                  lk:=0;
                                                  occ:=0;
                                                        repeat;
                                                        lk:=lk+1;
                                                        par:=(copy(pan,lk,1));
                                                            if upcase(let)=upcase(par)
                                                            then occ:=occ+1;
                                                   until (lk=length(pan));
                                             end;
      Procedure memory;
                begin;
                oldlunlet:=altrogiro[fois];
                end;

                            procedure nomina;
                              begin;
                              oldindex:=index;
                                         if (time>1) then
                                         memory
                                         else
                                         oldlunlet:=lenlunlet;
                              index:=0;
                                            case occ of
                                               100..199 : cah:=occ-100;
                                               200..299 : cah:=occ-200;
                                               else
                                               cah:=occ;   {indice per cercare il numero}
                                            end;
                              repeat ;
                                     index:=index+1;
                              until (index=cah);
                                            case occ of
                                               100..199 : num_in_let:='cento'+num[index];
                                               200..299 : num_in_let:='duecento'+num[index];
                                            else
                                               num_in_let:=num[index];
                                            end;
                              lenlunlet:=length(num_in_let);
                              altrogiro[fois]:=lenlunlet;
                              end;

                                   procedure position;
                                             begin;
                                             poso:=let+',';
                                             end;

                                    procedure cancella;
                                             begin;
                                                  position;
                                                  xpos:=pos(poso,pan);
                                                  delete(pan,xpos-oldlunlet-1,oldlunlet);
                                             end;

                                   procedure scrivi;
                                           begin;
                                              volte:=volte+1;
                                              conta;     {conta il numero delle lettere}
                                              if (occ>0)
                                              then
                                              nomina    {trasforma le cifre in numeri in lettere}
                                              else
                                              num_in_let:='zero';
                                              lenlunlet:=length(num_in_let);
                                              if (volte=1) and (time=1)
                                              then
                                                  begin;
                                                   {let := upcase(let);}
                                                   pan:=pan+' '+num_in_let+' '+let+',';
                                                  end
                                                  else
                                                      begin;
                                                        cancella;
                                                        position;
                                                        xpos:=pos(poso,pan);
                                                        insert(num_in_let,pan,xpos-1);
                                                      end;
                                              gotoxy(1,10);

                                              write(copy(pan,1,length(pan)-1)+'.');
                                              write('                         ');
                                           end;

                      procedure registra;
                      var
                         vavia:string[14];
                         fileout:file of string[255];
                         begin;
                               vavia:=('PAN.REC');
                               assign(fileout,vavia);
                               rewrite(fileout);
                               write(fileout,pan);
                               close (fileout);
                         end;

{                       procedure presento;
                                 begin;
                                 clrscr;
                                 gotoxy(17,10);
                                 write('Simone Mazzucconi & Turbo Pascal presentano...');
                                 gotoxy(29,14);
                                 write('PROGRAMMA PANGRAMMA');
                                 read(kbd,ch);
                                 end;}

begin;
{presento;}
clrscr;
riempi;
volte:=0;
fois:=0;
impo:=0;
time:=0;
pan:=('Questo tautogramma contiene');
repeat;
      clrscr;
      {gotoxy (63,2);
      writeln('Muz Software House');
      gotoxy (25,22);
      writeln  ('Written in TurboPascal');}
      cambio;
      time:=time+1;
{      gotoxy(64,17);
      write('Loop nø ',time);}
      asci_code:=97;
              repeat;
                       case asci_code of
                       106 : asci_code:=asci_code+2;
                       119 : asci_code:=asci_code+3;
                       end;
                       let:=upcase(chr(asci_code));
                       fois:=asci_code-96;

                                   repeat;
                                   impo:=impo+1; {passa oltre nei casi di ricorsione infinita}
                                                      scrivi;
                                                      conta;
                                   until (oldindex=occ) or (impo=5);
                                   impo:=0;

                       volte:=0;
{                       gotoxy(2,17);
                       write('Sto contando le ',chr(asci_code+1));}
                       asci_code:=asci_code+1 ;

              until (asci_code=123);
until (unch=3);
registra;
end