{$I+,Q+,S+,R+}
{                 Paneve‘io Juozo Bal‡ikonio gimnazijos
                         2t4 klas‚s mokionio
                         Pauliaus Kutkai‡io
                          baigiamojo etapo
                      I u‘davinio sprendimas
  Pakavimui naudoju Hufmano med‘io algorit….                                                                           }
Program Pakavimas;
 Type Info=Record
       Kiek:LongInt;
       C:Integer;
       Ko:String[150];
          End;
  Var M:Array[1..8]Of 0..128;
      Tek:Array[Chr(1)..Chr(255)]Of Info;
      I,J:Integer;
      S:String;
   Procedure Atstatymas;
    Var I,J,K:Integer;
        Tar:Info;
     Begin
      For I:=1 To 255 Do
       For J:=1 To 255 Do
        If Tek[Chr(I)].C<>I Then
         Begin
          Tar:=Tek[Chr(I)];
          K:=Tek[Chr(I)].C;
          Tek[Chr(I)]:=Tek[Chr(K)];
          Tek[Chr(K)]:=Tar;
         End;
     End;
   Procedure Rusiuok;
    Var Tar:Info;
     Begin
      For I:=1 To 254 Do
       For J:=I+1 To 255 Do
        If Tek[Chr(I)].Kiek<Tek[Chr(J)].Kiek
         Then
          Begin
           Tar:=Tek[Chr(I)];
           Tek[Chr(I)]:=Tek[Chr(J)];
           Tek[Chr(J)]:=Tar;
          End;
     End;
   Function Versk(T:String):Integer;
    Var Sum,K:Integer;
     Begin
      Sum:=0;
       If Length(T)<8 Then
                       For K:=Length(T) To 8 Do
                        T:=T+'0';
       For K:=1 To 8 Do
        If T[K]='1' Then Sum:=Sum+M[K];
      Versk:=Sum;
     End;
   Procedure Kodavimas;
    Var B,A:Text;
        Si:Char;
        E:String;
     Begin
      Assign(B,'Progr.Pas');
      Assign(A,'Progr.Pak');
       Reset(B);
       ReWrite(A);
        I:=1;
         While Tek[Chr(I)].Kiek<>0 Do
          Begin
           Write(A,Chr(Tek[Chr(I)].C));
           Inc(I);
          End;
         Atstatymas;
         WriteLn(A);
        While Not EOF(B)Do
         Begin
          While Not EOLn(B)Do
           Begin
            Read(B,Si);
            S:=S+Tek[Si].Ko;
            If Length(S)>7 Then
                            While Length(S)>7 Do
                             Begin
                             E:=Copy(S,1,8);
                             Write(A,Chr(Versk(E)));
                             Delete(S,1,8);
                            End;
          End;
          While Length(S)>7 Do
           Begin
            E:=Copy(S,1,8);
            Write(A,Chr(Versk(E)));
            Delete(S,1,8);
           End;
          If S<>'' Then Write(A,Chr(Versk(S)));
          Write(A,'&',8-Length(S));
          WriteLn(A);
          ReadLn(B);
         End;
      Close(B);
      Close(A);
     End;
   Procedure Medzio_Darymas;
    Var Kod:String;
        Ra:Integer;
     Begin
      Tek[Chr(1)].Ko:='1';
      Tek[Chr(1)].Ko:='10';
      Kod:='1';
      I:=2;
       While Tek[Chr(I)].Kiek<>0 Do
        Begin
         If Tek[Chr(I)].Ko<>''
          Then
           Begin
            Ra:=0;
            J:=I+1;
             While (Tek[Chr(J)].Kiek<>0)And(Ra<>2) Do
              Begin
               If Tek[Chr(J)].Ko='' Then
                Begin
                 Inc(Ra);
                 If Ra=1 Then Tek[Chr(J)].Ko:=Tek[Chr(I)].Ko+'0';
                 If Ra=2 Then Tek[Chr(J)].Ko:=Tek[Chr(I)].Ko+'1';
                End;
              Inc(J);
             End;
           End;
        Inc(I);
       End;
     End;
   Procedure Prad_Duom;
    Var B:Text;
        D:Char;
     Begin
      M[1]:=1;
      M[2]:=2;
      M[3]:=4;
      M[4]:=8;
      M[5]:=16;
      M[6]:=32;
      M[7]:=64;
      M[8]:=128;
      Assign(B,'Progr.Pas');
       Reset(B);
        For I:=1 To 255 Do
         Begin
          Tek[Chr(I)].Ko:='';
          Tek[Chr(I)].Kiek:=0;
          Tek[Chr(I)].C:=I;
         End;
        While Not EOF(B) Do
         Begin
          While Not EOLn(B) Do
           Begin
            Read(B,D);
            Inc(Tek[D].Kiek);
           End;
          ReadLn(B);
         End;
      Close(B);
     End;
Begin
 Prad_Duom;
 Rusiuok;
 Medzio_Darymas;
 Kodavimas;
End.{ Gedimino LukÕio, KTU Gimnazija, 4c, 1 uØd. }
{ IdÓja: pakuoti pagal didelÔ baziniÖ ØodØiÖ, proced×rÖ ir t.t. rinkinÔ,
  t.p. "apnaikinti" tarpus. Tiesa, yra ir daug kitÖ pakavimo metodÖ,
  bet Õitie pasirodÓ geriausi, o uØdaviniÖ sprendimo laikas kaip beb×tÖ
  ribotas... }

{$A+,B-,D+,E+,F-,G-,I-,L+,N-,O-,P-,Q-,R-,S-,T-,V+,X+}
{$M 16384,0,655360}
const CDazn : array [34..208] of string =
  ('ABS', 'ARRAY', 'ASM', 'ASSIGN', 'APPEND', 'ARCTAN', 'BEGIN',
   'BLOCK', 'BOOLEAN', 'BYTE', 'BREAK', 'UPCASE', 'CASE', 'CONCAT',
   'CHAR', 'CHDIR', 'CONSTRUCTOR', 'CONTINUE', 'COPY', 'CHR',
   'COS', 'CREATEDIR', 'CRT', 'CLOSE', 'CLRSCR', 'CLREOL', 'DEC', 'DELAY',
   'DELETE', 'DOSEXITCODE', 'DOS', 'ERROR', 'DESTRUCTOR', 'DOWNTO',
   'DISPOSE', 'DIV', 'EXEC', 'ELSE', 'EXIT', 'EXP', 'END', 'EOF',
   'EOLN', 'ERASE', 'FILE', 'FORWARD', 'FRAC', 'FREE', 'FILL',
   'FIND', 'FUNCTION', 'FLAG', 'FLUSH', 'GET', 'COLOR', 'DATE', 'TIME',
   'IMAGE', 'GOTO', 'GRAPH', 'HALT', 'HEAP', 'IMPLEMENTATION', 'INIT',
   'INC', 'INDEX', 'INHERITED', 'INLINE', 'INPUT', 'INSERT', 'INTEGER',
   'SHORTINT', 'INTERFACE', 'INTERRUPT', 'IORESULT', 'KEEP', 'KEYPRESSED',
   'LABEL', 'LOAD', 'LENGTH', 'LIBRARY', 'LIMIT', 'LINE', 'LONGINT', 'LOW',
   'MESSAGE', 'MIN', 'MAX', 'MARK', 'MOD', 'MKDIR', 'MEM', 'NEW',
   'NEXT', 'NIL', 'FALSE', 'TRUE', 'NORMAL', 'ITEM', 'NOT', 'NUMBER',
   'OBJECT', 'ODD', 'OUTPUT', 'PACK', 'PALETTE', 'PARAM', 'PRED',
   'PREV', 'PROCEDURE', 'PROGRAM', 'PUT', 'POS', 'RANDOM', 'RELEASE',
   'READLN', 'READ', 'REMOVE', 'RENAME', 'REPEAT', 'RECORD', 'RESET', 'XOR',
   'REWRITE', 'RMDIR', 'ROUND', 'SHOW', 'SHR', 'SIN', 'SIZE', 'SAVE',
   'SOUND', 'SQR', 'SEARCH', 'SEEK', 'SET', 'STRING', 'STR', 'SUCC', 'SWAP',
   'SHL', 'TRUNC', 'TEXT', 'THEN', 'TYPE', 'UNIT', 'USES', 'UNTIL', 'VAL',
   'VAR', 'VIRTUAL', 'WHILE', 'WHERE', 'WRITELN', 'WINDOW',
   'POINTER', 'OUT', 'AND', 'CONST', 'FOR', 'ORD', 'WRITE', 'WIN', 'RUN',
   'MOVE', 'PROG', 'EIL', 'DAT', 'TXT', 'DUOM', 'HIDE', 'PAV', 'RASTI',
   'SPAUSD', 'IVESTI');

var inf, outf : text;
    s, cc : string;
    i : integer;

procedure Pack (var eil: string);

  var tps, len : byte;
      i : integer;
      Changed : boolean;

  begin
    i := 1;
    while i <= length(eil) do
      begin
        if eil[i] = chr(255) then insert (chr(33), eil, i+1);
        i := i + 1;
      end;
    i := 1;
    while i <= length(eil) do
      begin
        if eil[i] = chr(254) then insert (chr(33), eil, i+1);
        i := i + 1;
      end;
    repeat
      Changed := false;
      tps := pos(' ', eil);
      if tps > 0 then
        begin
          len := 1;
          while eil[len + tps] = ' ' do
            len := len + 1;
          if len > 2 then
            begin
              delete (eil, tps, len);
              insert (chr(255) + chr(len+31), eil, tps);
              Changed := true;
            end;
        end;
    until not Changed;
    repeat
      Changed := false;
      for i := 34 to 208 do
        begin
          tps := pos(CDazn[i], eil);
          while tps > 0 do
            begin
              delete (eil, tps, length(CDazn[i]));
              insert (chr(254) + chr(i), eil, tps);
              Changed := true;
              tps := pos(CDazn[i], eil);
            end;
        end;
    until not Changed;
  end;

begin
  Assign (inf, 'progr.pas');
  Assign (outf, 'progr.pak');
  Reset (inf);
  Rewrite (outf);
  while not eof(inf) do
    begin
      s := '';
      while not eoln(inf) do
      begin
        Read (inf, cc);
        s := s + cc;
      end;
      for i := 1 to length(s) do s[i] := UpCase(s[i]);
      Pack (s);
      if not eof(inf) then
        begin
          WriteLn (outf, s);
          ReadLn (inf);
        end
      else Write (outf, s);
    end;
  close (inf);
  close (outf);
end.
{$A+,B-,D+,E-,F-,G+,I+,L+,N-,O-,P+,Q+,R+,S+,T-,V+,X+}
{$M 16384,0,655360}
{
Rokas MASIULIS,
Antano Vienuolio vidurinó mokykla,
12 (4 gim.) klasó,
pirmo uýdavinio, pirma dalis: suspaudimas
}


{*** Komentaras ***
}

 type tmas=array[1..65500]of byte;
      ptlapas=^tlapas;
      tlapas=record s:longint;
                    p1,p2:ptlapas;
                    t1,t2:boolean;   {true reiskias yra reiksme r1}
                    r1,r2:byte;
             end;

const orm:array[1..8]of byte=
      ($01,$02,$04,$08,$10,$20,$40,$80);
  var md,mr:^tmas;
      fd:file;
      dydis:longint;
      daznis:array[0..255] of word;
      plapas:ptlapas;
      pos:longint;
      dpos:byte;
      mas:array[0..255]of byte;
      medis:array[0..255]of tlapas;
      kodas:array[0..255,0..35]of byte;

  procedure Sdaznis;
      var i:word;
    begin
      for i:=0 to 255 do
        daznis[i]:=0;
      for i:=1 to dydis do
        inc(daznis[md^[i]]);
    end;

  procedure mesk(nr,ilg:byte);
    var i:integer;
      begin
        for i:=nr+1 to ilg do
          medis[nr-1]:=medis[nr];
      end;

  procedure kurk_medi;
      var i:word;
          ilgis:byte;
          min1,min2:integer;
          kiek:longint;
          lap1,lap2:ptlapas;
    begin
      for i:=0 to 255 do begin
        medis[i].p1:=nil;
        medis[i].p2:=nil;
        medis[i].t1:=true;
        medis[i].t2:=false;
        medis[i].r1:=daznis[i];
        medis[i].s:=daznis[i];
      end;
      ilgis:=255;
      for i:=255 downto 0 do begin
        if medis[i].r1=0 then mesk(i,ilgis);
        dec(ilgis);
      end;
      repeat
        kiek:=medis[0].s+1000;
        min1:=0;
        for i:=0 to ilgis do
          if medis[i].s<kiek then begin
            min1:=i;
            kiek:=medis[i].s;;
          end;
        kiek:=maxint*1024;
        for i:=0 to ilgis do
          if medis[i].s<kiek then
            if i<>min1 then begin
              min2:=i;
              kiek:=medis[i].s;;
            end;
        getmem(lap1,sizeof(tlapas));
        getmem(lap2,sizeof(tlapas));
        lap1^:=medis[min1];
        lap2^:=medis[min2];
        medis[min1].s :=lap1^.s+lap2^.s;
        medis[min1].t1:=false;
        medis[min1].t2:=false;
        medis[min1].p1:=lap1;
        medis[min1].p2:=lap2;
        mesk(min2,ilgis);
        dec(ilgis);
      until ilgis=2;
      getmem(lap1,sizeof(tlapas));
      getmem(lap2,sizeof(tlapas));
      lap1^:=medis[min1];
      lap2^:=medis[min2];
      plapas^.p1:=lap1;
      plapas^.p2:=lap2;
      plapas^.t1:=false;
      plapas^.t2:=false;
    end;

  procedure spausk;
      var i,n:longint;
          kiek:byte;

    begin
      pos:=1;
      mr^[1]:=0;
      dpos:=0;
      for i:=1 to 65500 do mr^[pos]:=0;
      for i:=1 to dydis do begin
        kiek:=kodas[md^[i],0];
        mr^[pos]:=mr^[pos];
        for n:=0 to kiek div 8 do begin
          mr^[pos+n  ]:=mr^[pos+n  ] or kodas[md^[i],n+1] shl dpos;
          mr^[pos+n+1]:=mr^[pos+n+1] or kodas[md^[i],n+1] shr 8-dpos;
        end;
        pos:=pos+(kiek+dpos) div 8;
        dpos:=(kiek+dpos) mod 8;
      end;
    end;

  procedure suprastink;
      var i:longint;
    begin
      for i:=1 to dydis do
        if md^[i] in [byte('A')..byte('Z')] then inc(md^[i],32);
    end;

  procedure rasykmedi;
      var i:longint;
    begin
      for i:=1 to dydis do
        begin

        end;
    end;

 var nr:integer;

  procedure paruosk(p:ptlapas;s:string);
      var i:byte;
    begin
      if p^.t1=false then
        if p^.p1<>nil then
          paruosk(p^.p1,s+'0');
      if p^.t2=false then
        if p^.p2<>nil then
          paruosk(p^.p2,s+'1');
      if p^.t1 then begin
        kodas[p^.r1,0]:=byte(s[0]);
        for i:=0 to kodas[p^.r1,0]-1 do
          begin
            if i mod 8=0 then
              kodas[p^.r1,(i div 8)+1]:=0;
            if s[i+1]='1' then
               kodas[p^.r1,(i div 8)+1]:=kodas[p^.r1,(i div 8)+1]*2+1
                          else
               kodas[p^.r1,(i div 8)+1]:=kodas[p^.r1,(i div 8)+1]*2;
          end;
      end;
    end;

begin
  getmem(md,sizeof(tmas));
  getmem(mr,sizeof(tmas));
  getmem(plapas,sizeof(tlapas));
  assign(fd,'progr.pas');
  reset(fd,1);
  dydis:=filesize(fd);
  blockread(fd,md^,dydis);
  close(fd);
  assign(fd,'progr.pak');
  rewrite(fd,1);
  suprastink;
  sdaznis;
  kurk_medi;
  nr:=0;paruosk(plapas,'');
  spausk;
  rasykmedi;
  blockwrite(fd,mr^,pos);
  close(fd);
  freemem(md,sizeof(tmas));
  freemem(mr,sizeof(tmas));
  writeln(pos);
end.{
  Vidmantas Maskoli×nas (mailto:vmm@operamail.com)
  MarijampolÓs 6-oji vidurinÓ mokykla, 10 klasÓ
  UØdavinys nr. 1 (Paskalio programÖ pakavimas)
}

{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q+,R+,S+,T-,V+,X+}
program pack;
var t, tt: text;
    i: integer;
    s: string;

procedure update(var s: string);
const ilgis = 242;
      c: array [128..ilgis] of string =
{#127+byte -- spaces}
(
'implementation',
'blockwrite(',
'blockwrite',
'blockread(',
'procedure ',
'procedure',
'blockread',
'interface',
'function ',
'function',
'shortint',
'writeln(',
'writeln;',
'dispose(',
'rewrite(',
'program ',
'program',
'longint',
'pointer',
'integer',
'pointer',
'string[',
'string ',
'assign(',
'concat(',
'insert(',
'delete(',
'length(',
'readln(',
'assign',
'concat',
'insert',
'delete',
'length',
'readln',
'repeat',
'string',
'record',
'single',
'double',
'downto',
'reset(',
'write(',
'close(',
'readln',
'reset',
'write',
'close',
'begin',
'while',
'uses ',
'unit ',
'array',
'until',
'const',
'read(',
'real',
'read',
'uses',
'byte',
'then',
'else',
'type',
'text',
'file',
'real',
'unit',
'ord(',
'chr(',
' := ',
'pos(',
'inc(',
'dec(',
'eof(',
'end.',
' < ',
' > ',
' = ',
'ord',
'chr',
'pos',
'inc',
'dec',
'var',
'shl',
'end',
'shr',
'and',
'new',
'xor',
'eof',
'not',
'for',
'do',
'to',
'if',
'<>',
'>=',
'<=',
':=',
'or',
'of',
'in',
''')',
'an',
''',',
' : ',
': ',
');',
', ',
' [',
'] ',
'];',
'(''',
'..'

);
var p, pp: byte;
begin
  for p := 1 to length(s) do
    if s[p] in ['A'..'Z'] then s[p] := chr(ord(s[p]) + $20);
  while pos('  ', s) <> 0 do begin
    p := pos('  ', s);
    pp := p;
    while s[pp] = ' ' do inc(pp);
    delete(s, p, pp-p);
    insert(#127+chr(pp), s, p)
  end;
  for i := 128 to ilgis do
    while pos(c[i], s) <> 0 do begin
      p := pos(c[i], s);
      delete(s, p, length(c[i]));
      insert(chr(i), s, p)
    end;
end;

begin
  assign(t, 'MASKOA1.PAS');
  reset(t);
  assign(tt, 'PROGR.PAK');
  rewrite(tt);

  while not eof(t) do begin
    readln(t, s);
    update(s);
    writeln(tt, s)
  end;

  close(tt);
  close(t)
end.{Ignas Mikalajûnas KTU Gimnazija
        3b Klasó
     Uýdavinys Nr 1 
      Pakuotojas
}
{$A+,B-,D+,E+,F+,G-,I+,L+,N-,O-,P-,Q+,R+,S+,T-,V+,X+}
{$M 65520,0,655360}
program compress;
var c1, c2, c3, c4, c5: char;
    dat, rez: text;
    pab, pak: boolean;
procedure up;
  begin
    c1 := upcase(c1);
    c2 := upcase(c2);
    c3 := upcase(c3);
    c4 := upcase(c4);
    c5 := upcase(c5);
  end;

begin
  assign(dat, 'progr.pas');
  assign(rez, 'progr.pak');
  reset(dat);
  rewrite(rez);

  read(dat,c1,c2,c3,c4,c5);
  while not eof(dat) do
    begin
      if (c1 + c2 + c3 + c4 + c5) = 'BEGIN'
        then
          begin
            write(rez, 'b');
            read(dat, c1, c2, c3, c4, c5);
            up;
            pak := true;
          end
        else
      if (c1 + c2 + c3) = 'END'
        then
          begin
            write(rez, 'e');
            c1 := c4;
            c2 := c5;
            read(dat, c3, c4, c5);
            up;
            pak := true;
          end
        else
if (c1+c2+c3+c4)= ' := ' then
begin
write(rez,'t');
c1:=c5;
read(dat,c2,c3,c4,c5);
up;
pak:=true;
end else

if (c1+c2+c3+c4+c5)= 'WHILE' then
begin
write(rez,'w');
read(dat,c1,c2,c3,c4,c5);
up;
pak:=true;
end else

if (c1+c2+c3+c4+c5)= 'WRITE' then
begin
write(rez,'r');
read(dat,c1,c2,c3,c4,c5);
up;
pak:=true;
end else

if (c1+c2)= 'IF' then
begin
write(rez,'i');
c1:=c3;
c2:=c4;
c3:=c5;
read(dat,c4,c5);
up;
pak:=true;
end else

if (c1+c2+c3+c4)= 'THEN' then
begin
write(rez,'h');
c1:=c5;
read(dat,c2,c3,c4,c5);
up;
pak:=true;
end else

if (c1+c2+c3+c4)= 'READ' then
begin
write(rez,'v');
c1:=c5;
read(dat,c2,c3,c4,c5);
up;
pak:=true;
end else

if (c1+c2+c3+c4+c5)= 'PROCE' then
begin
write(rez,'p');
read(dat,c1,c2,c3,c4,c5);
up;
pak:=true;
end else

if (c1+c2+c3+c4+c5)= 'FALSE' then
begin
write(rez,'x');
read(dat,c1,c2,c3,c4,c5);
up;
pak:=true;
end else


if (c1+c2+c3+c4+c5)= 'FUNCT' then
begin
write(rez,'m');
read(dat,c1,c2,c3,c4,c5);
up;
pak:=true;
end else

if (c1+c2+c3)= 'VAR' then
begin
write(rez,'a');
c1:=c4;
c2:=c5;
read(dat,c3,c4,c5);
up;
pak:=true;
end else


if (c1+c2+c3)= 'ASM' then
begin
write(rez,'s');
c1:=c4;
c2:=c5;
read(dat,c3,c4,c5);
up;
pak:=true;
end else

if (c1+c2+c3)= 'FOR' then
begin
write(rez,'f');
c1:=c4;
c2:=c5;
read(dat,c3,c4,c5);
up;
pak:=true;
end else

if (c1+c2+c3)= ' + ' then
begin
write(rez,'y');
c1:=c4;
c2:=c5;
read(dat,c3,c4,c5);
up;
pak:=true;
end else

if (c1+c2+c3)= ' - ' then
begin
write(rez,'u');
c1:=c4;
c2:=c5;
read(dat,c3,c4,c5);
up;
pak:=true;
end else

if (c1+c2+c3)= ' / ' then
begin
write(rez,'o');
c1:=c4;
c2:=c5;
read(dat,c3,c4,c5);
up;
pak:=true;
end else

if (c1+c2+c3)= ' * ' then
begin
write(rez,'g');
c1:=c4;
c2:=c5;
read(dat,c3,c4,c5);
up;
pak:=true;
end else

if (c1+c2+c3)= 'NOT' then
begin
write(rez,'k');
c1:=c4;
c2:=c5;
read(dat,c3,c4,c5);
up;
pak:=true;
end else

if (c1+c2+c3)= ');'+chr(13) then
begin
write(rez,'q');
c1:=c4;
c2:=c5;
read(dat,c3,c4,c5);
up;
pak:=true;
end else

if (c1+c2)= 'DO' then
begin
write(rez,'d');
c1:=c3;
c2:=c4;
c3:=c5;
read(dat,c4,c5);
up;
pak:=true;
end else


if (c1+c2+c3+c4)= 'TRUE' then
begin
write(rez,'z');
c1:=c5;
read(dat,c2,c3,c4,c5);
up;
pak:=true;
end else

if (c1+c2+c3+c4)= 'WORD' then
begin
write(rez,'j');
c1:=c5;
read(dat,c2,c3,c4,c5);
up;
pak:=true;
end else

if (c1+c2+c3+c4)= 'ELSE' then
begin
write(rez,'l');
c1:=c5;
read(dat,c2,c3,c4,c5);
up;
pak:=true;
end else

if (c1+c2+c3+c4)= 'CASE' then
begin
write(rez,'c');
c1:=c5;
read(dat,c2,c3,c4,c5);
up;
pak:=true;
end else


if (c1+c2)= 'IN' then
begin
write(rez,'n');
c1:=c3;
c2:=c4;
c3:=c5;
read(dat,c4,c5);
up;
pak:=true;
end;

if not pak
then
begin
write(rez,c1);
c1:=c2;
c2:=c3;
c3:=c4;
c4:=c5;
read(dat,c5);
up;
end;
pak:=false;
end;
write(rez,c1,c2,c3,c4,c5);
close(rez);
end.{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V+,X+}
{$M 16384,0,655360}


{ Jurgis Pažukonis }
{   VTGTM lic‚jus  }
{     11 klas‚     }
{    1 u‘davinys   }


program pakavimas;
  const kitas = 255;
        tarpas = 254;

        kzodz = 122;
        maxzodz = 253;
        maxlength = 40;
        konst_zodziai : array [1 .. kzodz] of string[maxlength] =
                  ('program', 'unit', 'interface', 'implementation',
                   'uses', 'label', 'const', 'type',
                   'var', 'procedure', 'function', 'begin', 'end',
                   'array', 'of', 'string', 'record', 'integer', 'longint', 'real', 'boolean',
                   'text', 'char',
                   'assign', 'reset', 'rewrite', 'append', 'close',
                   'write', 'read', 'writeln', 'readln', 'for', 'to', 'do', 'while', 'repeat', 'until',
                   'if', 'then', 'else', 'and', 'or', 'not', 'xor',
                   'true', 'false', 'div', 'mod', 'dec', 'inc', 'chr','ord', 'length',
                   'copy', 'delete', 'insert',
                   'fillchar', 'getmem', 'freemem', 'move',

                   ':=', chr(13)+chr(10),
                   ' ',
                   'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm',
                   'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z',
                   '0', '1', '2', '3', '4', '5', '6', '7', '8', '9',
                   chr(39), '(', ')', '+', '-', '*', '/', '[', ']', '{', '}',',', '.', ';', ':',
                   '#', '$', '@', '^','=', '<', '>');

  type buffer = array [1 .. 65000] of char;

   var f : file;
       fo : file of byte;
       fi : ^buffer;

       c, k, cc : word;
       sz, ck : word;
       kd : byte;
       koment : boolean;
       lst : integer;

       zodziai : array [1 .. maxzodz] of string[maxlength];

       kz : integer;

       st : string;

begin
  assign (f, 'progr.pas'); reset (f, 1);
  sz := filesize(f);
  getmem (fi, sz+1);
  blockread (f, fi^, filesize(f));
  fi^[sz+1] := chr(0);
  close (f);

  for c := 1 to sz do
    if (fi^[c] >= 'A') and (fi^[c] <= 'Z') then
      fi^[c] := chr(ord(fi^[c])+ord('a')-ord('A'));

  assign (fo, 'progr.pak'); rewrite (fo);

  for ck := 1 to kzodz do
    zodziai[ck] := konst_zodziai[ck];

  kz := kzodz;
  ck := 1;
  while (ck <= sz) and (kz < maxzodz) do
    if (fi^[ck] in ['a' .. 'z', '_']) and not koment then
      begin
        st := '';
        while (fi^[ck] in ['0' .. '9', 'a'..'z', '_']) do
          begin st := st + fi^[ck]; inc (ck) end;
        c := 1;
        while (c <= kz) and
              not ( (length(st) = length(zodziai[c])) and
                    (copy(st, 1,length(st)) = copy (zodziai[c], 1,length(st)))) do inc (c);
        if c > kz then
          begin inc (kz); zodziai[kz] := st; end;
      end
      else begin
             if (fi^[ck] = '{') then koment := true;
             if (fi^[ck] = '}') then koment := false;
             inc (ck);
           end;


  kd := kz-kzodz;
  write (fo, kd);
  for ck := kzodz+1 to kz do
    for c := 0 to length (zodziai[ck]) do
    begin
      kd := ord(zodziai[ck,c]);
      write (fo, kd);
    end;

  ck := 1;
  while ck <= sz do
  begin
    if (fi^[ck] = ' ') and (fi^[ck+1] = ' ') then
      begin
        c := 0;
        while (fi^[ck] = ' ') and (c < 255) do
          begin inc (ck); inc (c); end;
        kd := tarpas;
        write (fo, kd);
        write (fo, byte(c));
        continue;
      end;

    { jei ne tarpas: }
    k := 0; cc := 1;
    while (cc <= kz) do
    begin
      st := zodziai[cc];
      lst := length (st);
      c := 1;
      while (c <= lst) and (st[c] = fi^[ck+c-1]) do inc (c);
      if (c > lst) and
         ((k = 0) or (lst > length(zodziai[k]))) then k := cc;
      inc (cc);
    end;

    if k = 0 then
      begin
        kd := kitas;
        write (fo, kd);
        kd := ord(fi^[ck]);
        write (fo, kd);
        inc (ck)
      end
      else begin
             write (fo, byte(k));
             ck := ck + length(zodziai[k])
          end;
  end;

  close (fo);
  freemem (fi, sz);
end.

{andrius paukžt‚                  }
{žven‡ioni— 2-oji vid. mokykla    }
{12 a klas‚                       }
{žven‡ioni— raj.                  }
{pirmas u‘davinys                 }
program pack;
 const dr =  ['A'..'Z','�','€','‹','­','Ÿ','§','¦','’'];
       zenk = [39..60,62..64,91..122,130,133,135,138,141,145,150..151,158];
       lot = [97..122,61,46,93,48..57,36,94,58,59,34,39,40..47];
       pab = [13,32,40,46,58..59];
 var a :char;
     i :integer;
     ab :byte;
     f :text;
     fr :file of byte;
     zod :string;

 procedure maz(var a :char);
 begin
   case a of
    'A' :a:='a'; 'B' :a:='b'; 'C' :a:='c'; 'D' :a:='d'; 'E' :a:='e';
    'F' :a:='f'; 'G' :a:='g'; 'H' :a:='h'; 'I' :a:='i'; 'J' :a:='j';
    'K' :a:='k'; 'L' :a:='l'; 'M' :a:='m'; 'N' :a:='n'; 'O' :a:='o';
    'P' :a:='p'; 'Q' :a:='q'; 'R' :a:='r'; 'S' :a:='s'; 'T' :a:='t';
    'U' :a:='u'; 'V' :a:='v'; 'W' :a:='w'; 'X' :a:='x'; 'Y' :a:='y';
    'Z' :a:='z'; '�' :a:='…'; '€' :a:='‡'; '‹' :a:='Š'; '�' :a:='‚';
    '­' :a:='�'; 'Ÿ' :a:='ž'; '§' :a:='—'; '¦' :a:='–'; '’' :a:='‘';
  end
 end;

 procedure ras(a :char);
  var bb :byte;
 begin
   bb:=ord(a);
   write(fr,bb)
 end;

 procedure rasl(a :string);
  var bb :byte;
 begin
   for i:=1 to length(a) do
    begin
     bb:=ord(a[i]);
     write(fr,bb)
   end;
 end;


 procedure kom;
 begin
  ras(a);
  while a<> '}' do
   begin
     read(f,a);
     if a in dr then maz(a);
     ras(a);
   end;
 end;

 procedure eilp;
  var bb :byte;
 begin
   bb:=10;
   read(f,a); write(fr,bb)
 end;
 procedure ziurek(zod :string);
  var num,ab :byte;
 begin
   num:=0;
   if zod = 'program' then  num:=1 else
   if zod =  'char' then num:=12 else
   if zod =  'boolean' then num:=14 else
   if zod =  'text' then num:=15 else
   if zod =  'var' then num:=24 else
   if zod =  'integer' then num:=8 else
   if zod =  'begin' then num:=2 else
   if zod =  'end' then num:=3 else
   if zod =  'longint' then num:=11 else
   if zod =  'while ' then num:=4 else
   if zod =  'maxlongint;' then num:=28;
  if num=0 then rasl(zod+a)
           else write(fr,num);
  ab:=ord(a); if (ab=13)and(num>0) then eilp;
  if (zod = 'begin')and(a=' ') then ras(' ');
 end;


begin
  assign(f,'progr.pas'); reset(f);
  assign(fr,'progr.pak'); rewrite(fr);
  while not eof(f) do
   begin
     read(f,a);
     zod:='';
     if a in dr then maz(a);
     if a = '{' then kom;
     if a = ' ' then ras(a);
     ab:=ord(a);
     if ab = 13 then eilp;
     if (ab in lot) then
      begin
        while not(ab in pab) do
         begin
           zod:=zod+a;
           read(f,a);
           if a in dr then maz(a);
           ab:=ord(a)
         end;
        ziurek(zod)
      end;
   end;

  close(fr); close (f);
end.{                           Saulius Petrauskas
                       Klaip‚dos �‘uolyno gimnazija
                               10 c klas‚
                                 u‘d. 1                                      }

{ Ÿ� u‘davin� sprend‘iau naudodamasis Lempel-ZIW duomen— suglaudinimo
  algoritmu. Jis yra vienas populiariausi—. Duomenys spaud‘iami taip:
  skaitome eilutŠ, jeigu randame kad ka‘kada tokia eilut‚ jau buvo
  tai ražome tik jos indeks…, jei tai nauja eilut‚ j… �simename ir
  priskiriame indeks…. Eilut‚ms saugoti sukuriamas ‘odynas                    }

{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q+,R-,S+,T-,V+,X+}
{$M 65000,0,655360}
program pakavimas;
  type
     duom = record
               dat: array[0..64999] of byte;    { 65 kb duomen— masyvas }
               posb, post: word;
             end;
     duom_p=^duom;        { duomenys atmintyje }

   const maxz = 1024-1;    { ‘odyno dydis }
         maxs = 70;      { eilut‚s dydis }

   var   dkiek: word;    { perskaityt— duomen— kiekis }
           dic: array[256..maxz] of string[maxs];   { ‘odynas }

  Procedure Suspausk( inbuf: duom_p; var outbuf: duom_p );
  { supakuoja inbuf masyv… ir rezultat… �ražo � outbuf }
     var old: string[maxs];
           k: char;
          nn, kod, kelbit, d: word;

    Procedure WriteBit(x, kbit: word );
    { �ražo x skai‡i— nurodytu bit— kiekiu � masyv… }
      var i: byte;
    begin
      with outbuf^ do
        for i := 1 to kbit do
        begin
          dat[post] := dat[post] + x shr (kbit - i) and 1 shl posb;
          posb := posb + 1;
          if posb = 8 then begin post := post + 1; posb := 0 end;
        end;
     end;

    Function Yra(s: string): boolean;
    { patikrina ar eilut‚ s yra ‘odyne }
      var y: word;
          l: byte;
    begin
      Yra := false;
      l := length(s);
      if l = 1 then   { jei tik vienas simbolis tai eilut‚ yra ‘odyne }
      begin
        Yra := true;
        kod := Ord(s[1]);
        Exit
      end;
      for y := 256 to d do
        if s[1] = dic[y][1] then   { d‚l greitumo tikriname tik primus simbolius }
          if dic[y] = s then       { tikriname ar ‘od‘iai sutampa }
          begin
            Yra := true;
            kod := y;    { randame indeks… }
            Exit
          end
    end;

    Procedure EndDic;   { ižvalome ‘odyn… }
    begin
      FillChar(dic,sizeof(dic),#0);
      d := 256;
    end;

  begin
    FillChar(dic, sizeof(dic), #0);   { u‘pildome ‘odyn… nuliais }
    FillChar(outbuf^.dat, sizeof(outbuf^.dat), 0);   { u‘pildome rezultat… 0 }
    d := 256;           { ‘odyno pad‚tis }
    old := '';
    kelbit := 10;         { keliais bitais ražysime duomenis }
    outbuf^.posb := 0;   { rezultat— masyvo pozicija bitais }
    outbuf^.post := 0;   { rezultat— masyvo pozicija baitais }
    inbuf^.posb := 0;    { pradini— d. masyvo pozicija bitais }
    inbuf^.post := 0;    { pradini— d. masyvo pozicija baitais }

    for nn := 0 to dkiek - 1 do
      begin
        K := chr( inbuf^.dat[nn] );   { imame vien… simbol� iž pradini— d. }
        if Yra( old + K ) then old := old + K   { jei ta eilut‚ jau buvo }
        else
        begin
          dic[d] := old + K;        { jei naujas ‘odis, �vedame � ‘odyn… }
          WriteBIT(Kod, kelbit);    { u‘ražome � rezultatus }
          old := K;
          kod := ord(k);
          d := d + 1;
          if d > maxz - 1 then EndDic; { jei baigesi zodynas }
        end
    end;
    WriteBIT(Kod, kelbit);
    { randame pozicij… baitais : }
    if outbuf^.posb > 0 then outbuf^.post := outbuf^.post + 1;
  end;

  var prad, rez: file;   { pradini— duomen— ir rezultat— bylos }
      duomin, duomout: duom_p;   { duomenys }

  Procedure MazRaid;
  { masyve did‘i…sias raides pakei‡ia ma‘osiomis }
    var i: word;
  begin
    for i := 0 to dkiek do
      if duomin^.dat[i] in [65..90] then duomin^.dat[i] := duomin^.dat[i] + 32;
  end;

begin
  { atveriame pradini— duomen— byl… }
  Assign( prad, 'progr.pas');
  Reset( prad, 1 );
  { atveriame rezultat— byl… }
  Assign( rez,  'progr.pak');
  Rewrite( rez, 1);
  { rezervuojame atmint� duomenims }
  new(duomin);
  new(duomout);
  { skaitome ir spaud‘iame duomenis }
  BlockRead( prad, duomin^.dat, 65000, dkiek);
  MazRaid;
  Suspausk( duomin, duomout);
  BlockWrite( rez, duomout^.dat, duomout^.post);
  { atlaisviname rezervuot… atmint� }
  dispose(duomin);
  dispose(duomout);
  { u‘veriame bylas }
  close( prad );
  close( rez );
end.{I+,Q+,R+,S+}
{$M 16384,0,655360}                                                                                {
                   Panev‚‘io J. Bal‡ikonio gimnazijos
                   3t4 klas‚s mokinio
                   Domanto Rasalskio
                   informatikos olimpiados
                   baigiamosios dalies
                   pirmojo u‘davinio sprendimas
                   "PAKAVIMAS"

                            Id‚jos apražymas
            Naudoju Hufmano ižpakavimo algoritm… (buvo apražytas
     "Kompiuterijoje").
                                                                                        }

program supakuok;
type med = ^medis;
       medis = record
         r : string [ 1 ];
         a, n, V : med;
       end;
       simbol = record
         c : char;
         i : word;
       end;
       lauk = ^laukas;
       laukas = record
         s : word;
         n : lauk;
         m : med;
       end;
       tip = 0 .. maxlongint;
       simbo = Array [ 1 .. 255 ] of simbol;

  Var c, c1 : char;
      m : med;
      b, b1 : text;
      db, ib : string;
      s, s1 : simbo;
      l : lauk;
      mak : pointer;
      im : array [ 0 .. 255 ] of string [ 100 ];
      kod : string;

  procedure quicksort( lo,hi: integer);

    procedure sort(l,r: integer);
      Var i, j, x : integer;
          y : simbol;
    begin
      i := l;
      j := r;
      x := s [ ( l + r ) div 2 ]. i;
      repeat
        while s [ i ]. i < x do i := i + 1;
          while x < s [ j ]. i do j := j - 1;
            if i <= j then
              begin
                y := s [ i ];
                s [ i ] := s [ j ];
                s [ j ] := y;
                i := i + 1;
                j := j - 1;
              end;
      until i > j;
      if l < j then sort ( l, j );
      if i < r then sort ( i, r );
end;

begin
  sort ( lo, hi );
end;

  function pat ( e : string; k : word ) : boolean;
    Var a, i : byte;
  begin
    a := ord ( e [ ( ( k - 1 ) div 8 ) + 1 ] );
    i := ( k - 1 ) mod 8 + 1;
    a := ( a shr ( 8 - i ) ) shl 7;
    if a > 0 then
      pat := true
    else
      pat := false;
  end;

  function idek ( e : string; k : word; l : boolean ) : string;
    Var l1 : boolean;
        i, j, a, b : byte;
        c1 : char;
        e1 : string;
  begin
    e1 := e;
    while length ( e1 ) * 8 < k do
      e1 := e1 + char ( 0 );
    l1 := pat ( e1, k );
    if l1 = l then
      begin
        idek := e1;
        exit;
      end;
    c1 := e1 [ ( ( k - 1 ) div 8 ) + 1 ];
    a := ord ( c1 );
    i := ( k - 1 ) mod 8 + 1;
    if not l then
      a := not a;
    b := 128 shr ( i - 1 );
    a := a or b;
    if not l then
      a := not a;
    e1 [ ( ( k - 1 ) div 8 ) + 1 ] := char ( a );
    idek := e1;
  end;

  procedure smedip;
    Var l1, l2, l3 : lauk;
        m1 : med;
        i : tip;
  begin
    l1 := l;
    while l^. n <> nil do
      begin
        i := l^. s + l^. n^. s;
        new ( m1 );
        m1^. a := nil;
        m1^. n := l^. m;
        m1^. V := l^. n^. m;
        l^. m^. a := m1;
        l^. n^. m^. a := m1;
        m1^. r := '';
        l1 := l^. n^. n;
        dispose ( l^. n );
        dispose ( l );
        l := l1;
        new ( l2 );
        l2^. s := i;
        l2^. m := m1;
        if ( l^. s > l2^. s ) or ( l = nil ) then
          begin
            l2^. n := l;
            l := l2;
          end else begin
            l1 := l;
            while l1^. n <> nil do
              begin
                if l1^. n^. s > l2^. s then
                  break;
                l1 := l1^. n;
              end;
            l2^. n := l1^. n;
            l1^. n := l2;
          end;
      end;
    m := l^. m;
  end;

  procedure isskleisk_medi;
    Var i : byte;
        gl : boolean;
        e : string;
        m1, m2 : med;
        c2 : char;
    label atgal;
  begin
    kod := '';
    for i := 0 to 255 do im [ i ] := '';
    gl := true;
    e := '';
    m1 := m;
    while gl do
      begin
        if m1^. r <> '' then
          begin
            im [ ord ( m1^. r [ 1 ] ) ] := e;
            kod := kod + m1^. r;
            goto atgal;
          end;
        if m1^. n <> nil then
          begin
            m1 := m1^. n;
            e := e + '0';
            continue;
          end;
        if m1^. V <> nil then
          begin
            m1 := m1^. V;
            e := e + '1';
            continue;
          end;
        atgal:
        if m1^. a <> nil then
          begin
            c2 := e [ length ( e ) ];
            delete ( e, length ( e ), 1 );
            m2 := m1;
            m1 := m1^. a;
            case c2 of
              '0' : begin
                      if m1^. n <> nil then
                        dispose ( m1^. n );
                      m1^. n := nil;
                    end;
              '1' : begin
                      if m1^. V <> nil then
                        dispose ( m1^. V );
                      m1^. V := nil;
                    end;
            end;
          end else
            gl := false;
      end;
     end;

procedure pakuos;
    Var i, j, a, k : word;
        e1, e2, e3 : string;
        gl : boolean;
        l1 : lauk;
  begin
    assign ( output, 'progr.pak' );
    assign ( input, 'progr.pas' );
    reset ( input );
    rewrite ( output );
    for i := 1 to 255 do
      begin
        s [ i ]. c := chr ( i );
        s [ i ]. i := 0;
      end;
    while not eof ( input ) do
      begin
        read ( input, c );
        if ( c >= 'a' ) and ( c <= 'z' )
          then c := upcase ( c );
        inc ( s [ ord ( c ) ]. i );
      end;
    s1 := s;
    close ( input );
    quicksort ( 1, 255 );
    e1 := '';
    new ( l );
    l1 := l;
    for i := 1 to 255 do
      if s [ i ]. i <> 0 then
        begin
          new ( l1^. n );
          l1 := l1^. n;
          e1 := e1 + s [ i ]. c;
          l1^. s := s [ i ]. i;
          new ( l1^. m );
          with l1^. m^ do
            begin
              n := nil;
              v := nil;
              a := nil;
              r := s[ i ]. c;
            end;
        end else
          c := s [ i ]. c;
    l1^. n := nil;
    l^. s := 1;
    new ( l^. m );
    with l^. m^ do
      begin
        a := nil;
        n := nil;
        v := nil;
        r := c;
      end;
    {l := l^. n;{}
    e1 := c + e1;
    e3 := e1;
    l1 := l;
    writeln ( length ( e1 ) );
    while l1 <> nil do
      begin
        write ( l1^. m^. r, l1^. s, ' ' );
        l1 := l1^. n;
      end;
    writeln;
    smedip;
    isskleisk_medi;
    reset ( input );
    inc ( s1 [ ord ( c ) ]. i );{}
    read ( input, c1 );
    if ( c1 >= 'a' ) and ( c1 <= 'z' )
      then c1 := upcase ( c1 );
    a := 1;
    gl := true;
    e2 := '';
    while true do
      begin
        for j := 1 to length ( im [ ord ( c1 ) ] ) do
          begin
            k := ord ( c1 );
             if im [ k ] [ j ] = '1' then
              e2 := idek ( e2, a, true )
            else
              e2 := idek ( e2, a, false );
            if a = 8 then
              begin
                write ( e2 [ 1 ] );
                e2 := '';
                a := 0;
              end;
            inc ( a );
          end;
        {asm
          IN AL, 60H
          DEC Al
          JNZ @@TOLIAU
          MOV AX, 4C00H
          INT 21H
          @@TOLIAU:
        end;}
        if c1 = c then
          break;
        if not eof ( input )
          then begin
                 read ( input, c1 );
                 if ( c1 >= 'a' ) and ( c1 <= 'z' )
                   then c1 := upcase ( c1 );
               end
        else
          c1 := c;
      end;
    if e2 [ 1 ] <> '' then
      write ( e2 [ 1 ] );
    close ( input );
    close ( output );
  end;
begin
  pakuos;
end.Program SadzeA1;
{

 Autorius:  Justas Sadzevi‡ius,
            Kaunas,
            KTU Gimnazija,
            3c kl.



 Id‚jos apražas:

  Kadangi paskalio programose dauguma raid‘i— kombinacij— kartojasi
(pvz. "integer"), tai galima sudaryti "‘odyn…", kuriame b–t— suražyti
visi galimi tokie "‘od‘iai". Kiekvienas ‘odis �gyt— savo skaitinŠ reikžmŠ.
’odynas ižsaugomas byloje. Po ‘odyno � byl… suražomas ne programos tekstas,
o j� sudaran‡i— "‘od‘i—" reikžm‚s (gauname u‘koduot… programos tekst…).
  Ižspaud‘iant tereikia nuskaityti ‘odyn… ir vietoj po jo einan‡i— skai‡i—
iž ‘odyno ižrinkti ‘od‘ius.


}


type
 TZodis     = record
               zod_mem      : pointer;
               zod_size     : integer;
              end;
 TZodynas   = record
               Zodziai      : array [10..5000] of TZodis;
               VisoZodz     : integer;
              end;


var
Zodynas            : TZodynas;
Data               : pointer;
ElNum, NumZod      : integer;
PASFile_Size       : integer;
i                  : integer;
PACKFILE           : file;



{----------------------------------------------------------------------------}


Procedure Load_PasFile (name : string);
var
InF                : file;
i                  : integer;
begin
assign (InF, name);
reset (InF,1);
PASFile_size:=filesize(InF);

getmem (Data, PASFile_size+10);

blockread (InF, Data^, PASFile_size);

ElNum:=0;

close(InF);

end;


{----------------------------------------------------------------------------}


Procedure UpString (var s :string);
var
i               : integer;
begin
for i := 1 to Length(s) do
  s[i] := UpCase(s[i]);
end;


{----------------------------------------------------------------------------}


Procedure Pridek_Zodi(zodis : string);
var
i, z_seg        : integer;
begin

inc (zodynas.VisoZodz);
i:=length(zodis);
getmem(zodynas.zodziai[Zodynas.VisoZodz].zod_mem, i+10);
z_seg:=seg(zodynas.zodziai[Zodynas.VisoZodz].zod_mem^);
zodynas.zodziai[Zodynas.VisoZodz].zod_size:=length(zodis);
for i:= 1 to length(zodis) do
    begin
     mem[z_seg : i - 1] := ord(zodis[i]);

    end;

end;


{----------------------------------------------------------------------------}

Function Rask_Zodi (var galas: integer) : integer;
var
i, j, k, ZodNum : integer;
MemEl           : byte;
zodis, zodyno_z : string;
z_seg           : integer;
zodis_rastas    : boolean;
begin

i:=ElNum;
MemEl:=mem[seg(Data^):i];
zodis:='';
while ((MemEl<>32) and (MemEl<>13) and (i<=PASFile_Size)) do
 begin
  zodis:=zodis + chr(MemEl);
  inc (i);
  MemEl:=mem[seg(Data^):i];
 end;
UpString(zodis);


zodnum:=-1;


if (zodis<>'') then
               begin
                for j:=11 to Zodynas.Visozodz do
                    begin
                     zodyno_z:='';
                     z_seg:=seg(zodynas.zodziai[j].zod_mem^);
                     zodis_rastas:=true;
                     if (Zodynas.zodziai[j].zod_size=length(zodis)) then
                     for k:= 0 to Zodynas.zodziai[j].zod_size-1 do
                         begin
                         zodyno_z:= zodyno_z + chr(mem[z_seg:k]);
                         if zodis[k+1]<>chr(mem[z_seg:k]) then
                                                          begin
                                                           zodis_rastas:=false;
                                                           break;
                                                          end;
                         end
                         else
                         zodis_rastas:=false;
                     if zodis_rastas   then
                                       begin
                                        zodnum:=j;
                                        break;
                                       end;

                    end;
                if zodnum = -1 then {’odis nerastas}
                               begin
                               Pridek_Zodi(zodis);
                               zodnum:=zodynas.VisoZodz;
                               end;
               Rask_Zodi:=zodnum;
               end
               else { arba tarpas, arba daug tarp—, arba eilut‚s galas, }
               begin{ arba �vedamosios bylos galas }

                if (memel=10) or (memel=13) then
                            begin
                            inc (i,2);
                            Rask_zodi:=1;
                            end;
                if memel=32 then
                            begin
                            k:=1;
                            while (mem[seg(Data^):i]=32) do
                                  begin
                                   inc (i);
                                   inc (k);
                                  end;
                            Rask_zodi:=-k-1;
                            end;

                if i>PASFile_Size then Rask_Zodi:=-1;
               end;

galas:=i;
end;


{----------------------------------------------------------------------------}

Procedure File_AddZodynas (var f : file);
var
buff            : array [1..256] of byte;
i, j, z_seg     : integer;
begin


buff[1]:=zodynas.visozodz div 256;
buff[2]:=zodynas.visozodz - buff[1]*256;
blockwrite (f, buff, 2);


for i:=10 to zodynas.visozodz do
    begin
     buff[1]:=zodynas.zodziai[i].zod_size div 256;
     buff[2]:=zodynas.zodziai[i].zod_size - buff[1]*256;
     z_seg:=seg(zodynas.zodziai[i].zod_mem^);
     blockwrite (f, buff, 2);

     for j:=1 to zodynas.zodziai[i].zod_size do
         begin
         buff[j]:=mem[z_seg:j-1];
         end;
     blockwrite (f, buff, zodynas.zodziai[i].zod_size);

    end;


end;


{----------------------------------------------------------------------------}


Procedure File_AddInt(var f : file; i : integer);
var
buff            : array [1..2] of byte;
begin


if i<0 then
   begin
    buff[1]:=255;
    i:=i*(-1)-1;
    buff[2]:=i;
   end
   else
   begin
    buff[1]:=i div 256;
    buff[2]:=i - buff[1]*256;
   end;

blockwrite (f, buff, 2);

end;


{----------------------------------------------------------------------------}


Procedure Save_PakFile_start (var f : file; name : string);
begin
assign (f, name);
rewrite (f, 1);
end;

{----------------------------------------------------------------------------}

Procedure Save_PakFile_end (var f : file);
begin
close(f);
end;

{----------------------------------------------------------------------------}




begin

Zodynas.VisoZodz:=10;
Load_PasFile('PROGR.PAS');

Save_PakFile_start (PACKFILE,'PROGR.PAK');

NumZod:=Rask_Zodi(i);

while ((NumZod<>-1) and (ElNum<PasFile_size)) do
      begin
      File_AddInt( PACKFILE, NumZod);
      ElNum:=i;
      NumZod:=Rask_Zodi(i);
      end;
File_AddInt( PACKFILE, 0);
File_AddZodynas (PACKFILE);
Save_PakFile_end (PACKFILE);




end.





{$I+,Q+,R+,S+}
{$M 16384,0,655360}
                                                                                                {
                 Panev‚‘io J. Bal‡ikonio gimnazijos
                       2T4 klas‚s mokinio
                         Justo Samuolio
                   I u‘davinio sprendimas (supakavimas)
                                                                                                }
Program Paskalio_programu_pakavimas;

    Const DuomByla = 'progr.pas';
          PakByla = 'progr.pak';
          N = 80;
          M : Array [ 1 .. N ] Of String =
                    ( 'CONST ', 'END.', 'END;', 'VAR ','USES','WRITELN',
                      ' THEN ',
                      'READ', 'CLOSE', 'TEXT', 'WORD', 'REAL', 'SINGLE',
                      'DOUBLE', 'BEGIN', 'BYTE', 'ARRAY',
                      'PROGRAM ', 'PROCEDURE ', 'FUNCTION ', 'INTEGER', 'BOOLEAN',
                      'LONGINT', 'SHORTINT', 'MAXINT', 'MAXLONGINT', 'STRING',
                      'WRITE', 'READLN', 'BLOCKREAD', 'BLOCKWRITE', 'IMPLEMENTATION',
                      'CONSTUCTOR', 'INITGRAPH', 'CLOSEGRAPH', 'DELETE', 'INSERT',
                      'CLEARDEVICE;', 'ASSEMBLER', 'RANDOM', 'RANDOMIZE;', 'ASSIGN',
                      'REWRITE', 'ABSOLUTE ', 'INTERFACE', 'GETTIME', 'GETDATE',
                      'GETMAXX','GETMAXY', 'CIRCLE', 'FILLPOLY', 'FILLELLIPSE', 'ELLIPSE',
                      'CONTINUE', 'DETECT;', 'SWAPVECTORS;', 'LENGTH', 'CONCAT',
                      'FILLCHAR', 'DRAWPOLY', 'SETCOLOR', 'SETTEXTSTYLE', 'SETTEXTJUSTIFY',
                      'GETMOUSEVENT', 'FORWARD', 'TEXTBACKGROUND', 'TEXTCOLOR',
                      'KEYPRESSED', 'DISPOSE', 'NOSOUND', 'POINTER', 'READKEY',
                      'SETFILLSTYLE', 'MAXLINELENGTH', 'SETBGCOLOR', 'WINDOW',
                      '{$M 16384,0,655360}', '{$I+,Q+,R+,S+}', 'UPCASE',
                       '{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q+,R+,S+,T-,V+,X+}'
                       );


    Var Kiek : Word;

 Procedure Apdoroti ( Eil : String; Var Ne : String );
  Var I, J, P ,K : Integer;
      Simb, S2, Eil2 : String;
 Begin
  For I := 1 To Length ( Eil ) Do
   Eil [ I ] := UpCase ( Eil [ I ] );
  If Pos ( '   ', Eil ) <> 0  Then
   Begin
    K := 0;
    While Eil [ 1 ] = ' ' Do
     Begin
      Inc ( K );
      Delete ( Eil, 1, 1 );
     End;
    Str ( K, Eil2 );
    Eil2 := ')' + Eil2 + '(';
    Insert ( Eil2, Eil, 1 );
   End;
  For I := 1 To N Do
   If Pos ( M [ I ], Eil ) <> 0 Then
    Begin
     P := Pos ( M [ I ], Eil );
     Delete ( Eil, P, Length ( M [ I ] ) );
     Str ( I, S2 );
     Simb := '^' + S2 + '&';
     Insert ( Simb, Eil, P );
    End;
  Ne := Eil;
 End;

 Procedure Pakuoti;
  Var B1, B2 : Text;
      Eil : String;
 Begin
  Assign ( B1, DuomByla );
  Reset ( B1 );
  Assign ( B2, PakByla );
  ReWrite ( B2 );
  While Not Eof ( B1 ) Do
   Begin
    ReadLn ( B1, Eil );
    Apdoroti ( Eil, Eil );
    If EOF ( B1 ) Then Write ( B2, Eil )
                  Else WriteLn ( B2, Eil );
   End;
  Close ( B1 );
  Close ( B2 );
 End;

BEGIN
   Pakuoti;
END.{

     Povilas Skruibis
     Luk÷iù V.Grybo vidurinó mokykla, öakiu rajonas, 12 klasó
     Mokytojas Antanas Burk÷aitis
     Pirmas uýdavinys - Pakavimas

}

program Pakavimas;
  var i, a, b : Integer;
      tt, pp : Text;
      s, g : String;
      o : Char;
  procedure Versti(var s : String);
    var i : integer;
  begin
    ReadLn(tt, s);
    for i := 1 to length(s) do
      if (ord(s[i]) >= 97) and (ord(s[i]) <= 122)
        then s[i] := chr(ord(s[i]) - 32);
  end;
begin
  Assign(tt, 'prog.pas');
  Assign(pp, 'prog.pak');
  Reset(tt);
  Rewrite(pp);
  a := 1; b := 0;
  repeat
    Versti(s);
    i := 0; a := 1;
    repeat
      Inc(i);
      if (s[i+1] = ' ') or (i = Length(s))
        then begin
               g := copy(s,a,i - a + 1);
               a := i + 1;
               if g = 'PROGRAM' then g := '`';
               if g = ' VAR' then g := '~';
               if g = ' INTEGER;' then g := #753;
               if g = 'BEGIN' then g := #754;
               if g = ' BEGIN' then g := #757;
               if g = 'END.' then g := #755;
               if g = ' END;' then g := #756;
               if g = ' DIV' then g := #758;
               if g = ' MOD' then g := #759;
               Write(pp, g);
               g := ' ';
             end;
    until Length(s) = i;
    if not Eof(tt) then WriteLn(pp);
  until Eof(tt);
  Close(tt);
  Close(pp);
end.{$I+,Q+,R+,S+}
                                                                              {
==============================================================================
               Panev‚‘io Juozo Bal‡ikonio gimnazijos
               3t4 klas‚s mokinio
               Jono ’ostauto
               1 u‘davinio sprendimas ( pakavimas )

==============================================================================}

  Program PirmasUzdavinys;
    Uses Strings;
    Const DByla = 'PROGR.PAS';
          RByla = 'PROGR.PAK';
          Raides = [ 'A' .. 'Z', 'a' ..'z' ];
    Type Sk = 0 .. 9;
    var rb: text;
    Procedure GalYraZ ( Zod: String );
    Begin
      If Zod = 'PROGRAM' Then Write ( Rb, 'a' ) Else
      If Zod = 'USES' Then Write ( Rb, 'b' ) Else
      If Zod = 'TYPE' Then Write ( Rb, 'c' ) Else
      If Zod = 'PROCEDURE' Then Write ( Rb, 'd' ) Else
      If Zod = 'FUNCTION' Then Write ( Rb, 'e' ) Else
      If Zod = 'STRING' Then Write ( Rb, 'f' ) Else
      If Zod = 'BEGIN' Then Write ( Rb, 'g' ) Else
      If Zod = 'END' Then Write ( Rb, 'h' ) Else
      If Zod = 'LIBRARY' Then Write ( Rb, 'i' ) Else
      If Zod = 'STRING' Then Write ( Rb, 'j' ) Else
      If Zod = 'REPEAT' Then Write ( Rb, 'k' ) Else
      If Zod = 'UNTIL' Then Write ( Rb, 'l' ) Else
      If Zod = 'WHILE' Then Write ( Rb, 'm' ) Else
      If Zod = 'CONST' Then Write ( Rb, 'n' ) Else
      If Zod = 'NOT' Then Write ( Rb, 'o' ) Else
      If Zod = 'INTEGER' Then Write ( Rb, 'p' ) Else
      If Zod = 'BOOLEAN' Then Write ( Rb, 'r' )
      Else write ( rb, zod );
    End;
    Procedure Vykdymas;
      Var Db: Text;
          Simb, BSimb: Char;
          Eil: String;
    Begin
      Assign ( Db, DByla );
      Reset ( Db );
      ReWrite ( Rb );
      Eil := '';
      While Not Eof ( Db ) Do
        Begin
          Read ( Db, Simb );
          If Simb In Raides
            Then Eil := Eil + uPcASE ( Simb )
            Else
            Begin
              If Eil <> '' Then GalYraZ ( Eil );
              Write ( Rb, Simb );
              Eil := '';
            End;
        End
    End;
  Begin
    Assign ( Rb, RByla );
    Vykdymas;
    Close (Rb );
  End.                {     Mantas Audickas       }
         { Panev‚‘io Vytauto ’emkalnio gimnazija  3a klas‚ }
                    { 1 -as u‘davinys }

{ Sprendimo id‚ja:
  programa skaito bylos simbolius, ir iežko pakavimo programos �ražyto
  dviej— simboli— kodo. J� radusi, ji kei‡ia t… kod… � paskalio kalbos
  ‘od�. Jei kodo n‚ra, simbolius �ražo tokius kokius perskaito.
}
program ispakuoti;
  const
    DB = 'progr.pak';
    RB = 'progr.kap';
    kiek = 54;

  RZodziai: array[1..kiek] of string[15] =
  ( 'AND','AMS','ARRAY','BEGIN','CASE','CONST','CONSTRUCTOR','DESTRUCTOR',
    'DIV','DOWNTO','ELSE','END','EXOPRTS','FILE','FOR','FUNCTION',
    'GOTO','IMPLEMENTATION','INHERITED','INLINE','INTERFACE',
    'LABEL','MOD','NIL','NOT','OBJECT','PACKED','PROCEDURE','PROGRAM',
    'RECORD','REPEAT','SET','SHL','SHR','STRING','THEN','TYPE','UNIT','UNTIL',
    'USES','VAR','WHILE','WITH','XOR','ABSOLUTE','ASSMEBLER','EXTERNAL','FAR',
    'FORWARD','INTERRUPT','NEAR','PRIVATE','PUBLIC','VIRTUAL' );

var fd, fr : text;
    ch : char;
    k : byte;
begin
  assign ( fd, DB );
  reset ( fd );
  assign ( fr, RB );
  rewrite ( fr );
    while not EOF ( fd ) do
      begin
        read ( fd, ch );
        if ch = #0
          then begin
            read ( fd, ch );
            if ch = #1
              then  begin
                read ( fd, ch );
                k := ord ( ch );
                write ( fr, RZodziai[k] )
              end
            else  write ( fr, ch )
          end
         else  write ( fr, ch );
      end;
  close ( fd );
  close ( fr );
end.program extr;
  const max = 61;
        pak : array [1..max] of string [20] = ('and', ' ', 'or', 'not', 'xor',
        'array', 'begin', 'end', 'div', 'mod', 'do', 'to', 'downto', 'if',
        'then', 'else', 'file', 'of', 'for', 'function', 'procedure',
        'implementation', 'interface', 'nil', 'case', 'program', 'record',
        '=', 'repeat', 'until', '(', ')', '+', '-', '*', '/', 'set',
        'string', '[', ']', 'type', 'unti', 'uses', 'var', 'while', 'integer',
        'longint', 'real', 'word', '.', ';', 'const', 'assign', 'byte', 'shl', 'shr', ',', ':',
        'reset', 'close', 'rewrite');
        raide = max + 1;
        simbolis = 0;
        endofline = max + 2;
  type failas = file of byte;
  var inpf : failas;
      outf : text;
      liko : byte;
      seno : byte;
      x, z : byte;
  procedure skaityk (var f : failas; var z : byte; k : byte);
    var x : byte;
        zz1, zz2 : byte;
  begin
    if seno < k
      then begin
             if not eof (f)
                then read (f, x);
             zz1 := liko shl (8 - seno) and $FF;
             zz2 := x shr (8 - k + seno) and $FF;
             zz1 := zz1 shr (8 - k);
             z := zz1 or zz2;
             liko := x;
             seno := 8 - k + seno
           end
      else begin
             liko := liko shl (8 - seno) and $FF;
             liko := liko shr (8 - seno) and $FF;
             z := liko shr (seno - k) and $FF;
             seno := seno - k
           end;
  end;
begin
  assign (inpf, 'progr.pak');
  reset (inpf);
  assign (outf, 'progr.kap');
  rewrite (outf);
  liko := 0;
  seno := 0;
  while not eof (inpf) do
    begin
      skaityk (inpf, z, 6);
      case z of
        simbolis: begin
                    skaityk (inpf, z, 8);
                    while z <> simbolis do
                      begin
                        write (outf, chr (z));
                        skaityk (inpf, z, 8)
                      end;
                  end;
        raide: begin
                 skaityk (inpf, z, 5);
                 while z <> 0 do
                   begin
                     write (outf, chr (z + 96));
                     skaityk (inpf, z, 5)
                   end
               end;
        endofline: writeln (outf, ' ');
        else write (outf, pak [z]);
      end
    end;
  close (inpf);
  close (outf)
end.Program Pak;
  Const reserved: array[1..54] of string[15] = ('AND','ASM','ARRAY', 'BEGIN', 'CASE', 'CONST',
                                     'CONSTRUCTOR', 'DESTRUCTOR','DIV', 'DO', 'DOWNTO',
                                     'ELSE', 'END', 'EXPORTS', 'FILE', 'FOR',
                                     'FUNCTION', 'GOTO', 'IF', 'IMPLEMENTATION',
                                     'IN', 'INHERITED', 'INLINE', 'INTERFACE',
                                     'LABEL', 'LIBRARY', 'MOD', 'NIL', 'NOT',
                                     'OBJECT', 'OF', 'OR', 'PACKED', 'PROCEDURE',
                                     'PROGRAM', 'RECORD', 'REPEAT', 'SET', 'SHL', 'SHR',
                                     'STRING', 'THEN', 'TO', 'TYPE', 'UNIT', 'UNTIL',
                                     'USES', 'VAR', 'WHILE', 'WITH', 'XOR', 'STRING', 'BOOLEAN', 'CHAR');

  Const FunkcPr: array[1..302] of string[20] = ('ABS', 'ABTSRACT', 'ADDR', 'ALLOCMULTISEL', 'APPEND',
                                            'ARC', 'ARCTAN', 'ASSIGN', 'ASSIGNCRT', 'ASSIGNED',
                                            'BAR', 'BAR3D', 'BLOCKREADREAD', 'BLOCKWRITE', 'BREAK',
                                            'CHDIR', 'CHR', 'CIRCLE', 'CLEARDEVICE', 'CLEARVIEWPORT',
                                            'CLOSE', 'CLOSEGRAPH', 'CLREOL', 'CLRSCR', 'CONCAT', 'CONTINUE',
                                            'COPY', 'COS', 'CREATEDIR', 'CSEG', 'CURSORTO', 'DEC', 'DELAY',
                                            'DELETE', 'DELLINE', 'DETECTGRAPH', 'DISKFREE', 'DISKSIZE', 'DISPOSE',
                                            'DONEMEMORY', 'DONEWINCRT', 'DOSEXITCODE', 'DOSVERSION', 'DRAWPOLY', 'DSEG',
                                            'ELLIPSE', 'ENVCOUNT', 'ENVSTR', 'EOF', 'EOLN', 'ERASE', 'EXCLUDE', 'EXEC', 'EXIT',
                                            'EXP', 'FILEEXPAND', 'FILEPOS', 'FILESEARCH', 'FILESIZE', 'FILESPLIT' ,'FILLCHAR',
                                            'FILLELLIPSE', 'FILLPOLY', 'FINDFIRST', 'FINDNEXT', 'FLOODFILL', 'FLUSH', 'FRAC',
                                            'FREEMEM', 'FREEMULTISEL', 'FSPLIT',
                                            'GETARCCOORDS', 'GETARGCOUNT', 'GETARGSTR', 'GETASPECTRATIO', 'GETBKCOLOR',
                                            'GETCBREAK', 'GETCOLOR', 'GETCURDIR', 'GETDATE', 'GETDEFAULTPALLETE', 'GETDIR',
                                            'GETDRIVERNAME', 'GETENV', 'GETENVVAR', 'GETFATTR', 'GETGRAPHMODE',
                                            'GETFILLPATTERN', 'GETFILLSETTINGS', 'GETFTIME', 'GETIMAGE', 'GETINTVEC',
                                            'GETLINESETTINGS', 'GETMAXCOLOR', 'GETMAZMODE', 'GETMAXX', 'GETMAXY',
                                            'GETMEM', 'GETMODENAME', 'GETMODERANGE', 'GETPALETTE', 'GETTEXTSETTINGS',
                                            'GETPALLETESIZE', 'GETPIXEL', 'GETTIME', 'GETVERIFY', 'GETVIEWSETTINGS', 'GETX',
                                            'GETY', 'GOTOXY', 'GRAPHRESULT','HALT', 'HI', 'HIGH', 'HIGHVIDEO', 'IMAGESIZE',
                                            'INC', 'INCLUDE', 'INITGRAPH', 'INITMEMORY','INITWINCRT', 'INSERT', 'INSLINE',
                                            'INSTALLUSERDRIVER', 'INSTALLUSERFONT', 'INT', 'INTR','IORESULT', 'KEEP',
                                            'KEYPRESSED', 'LENGTH', 'LINE', 'LINEREL', 'LINETO', 'LN', 'LO', 'LONGDIV',
                                            'LONGMUL','LOW', 'LOWMEMORY', 'LOWVIDEO', 'MARK', 'MAXAVAIL', 'MEMALLOC',
                                            'MEMALLOCSEG', 'MEMAVAIL', 'MKDIR', 'MOVE','MOVEREL', 'MOVETO', 'MSDOS',
                                            'NEW', 'NORMVIDEO', 'NOSOUND', 'ODD', 'OFS', 'ORD', 'OUTTEXT', 'OUTTEXTXY',
                                            'OVRCLEARBUFF', 'OVRGETBUF', 'OVRGETRETRY', 'OVRINIT', 'OVRINITEMS', 'OVRSETBUF',
                                            'PACKTIME', 'PARAMCOUNT', 'PARAMSTR', 'PI', 'PIESLICE', 'POS', 'PRED', 'PTR',
                                            'PUTIMAGE', 'PUTPIXEL', 'RANDOM', 'RANDOMIZE', 'READ','READBUF', 'READKEY',
                                            'READLN', 'RECTANGLE', 'REGISTERBGIGRIVER', 'REGISTERBGIFONT','REGISTERODIALOGS',
                                            'REGISTEROSTDWNDS', 'REGISTERTYPE', 'REGISTERTYPE', 'REGISTERVALIDATE', 'RELEASE',
                                            'REMOVEDIR', 'RENAME', 'RESET', 'RESTORECRTMODE','RESTOREMEMORY','REWRITE','RMDIR',
                                            'ROUND', 'RUNERROR', 'SCROLLTO, SECTOR','SEEK', 'SEEKEOF', 'SEELEOLN', 'SEG',
                                            'SETACTIVEPAGE', 'SETASPECTRATIO', 'SETBKCOLOR', 'SETCBREAK', 'SETCOLOR',
                                            'SETCURDIR', 'SETDATE', 'SETFATTR', 'SETFILLPATTERN', 'SETFILLSTYLE', 'SETFTIME',
                                            'SETGRAPHMODE', 'SETINTVEC','SETLINESTYLE', 'SETPALLETE', 'SETRGBPALLETE',
                                            'SETTEXTSTYLE', 'SETTIME', 'SETTIME', 'SETUSERCHARSIZE', 'SETVERIFY','SETVIEWPORT',
                                            'SETVISUALPAGE', 'SETWRITEMODE', 'SIN', 'SIZEOF', 'SOUND', 'SPTR', 'SQR', 'SQRT',
                                            'SSEG','TEXTBACKGROUND', 'TEXTCOLOR', 'TEXTHEIGHT', 'TEXTMODE', 'TEXTWIDTH',
                                            'TRACKCURSOR', 'TRUNC', 'TRUNCATE', 'TYPEOF','STR', 'STRCAT', 'STRCOMP', 'STRCOPY',
                                            'STRDISPOSE', 'STRECOPY', 'STREND', 'STRLCAT', 'STRICOMP', 'STRLCOMP','STRLCOPY',
                                            'STRLEN', 'STRLICOMP', 'STRLOWER', 'STRMOVE', 'STRNEW', 'STRPAS', 'STRPCOPY',
                                            'STRPOS', 'STRSCAN', 'STRRSCAN', 'STRUPPER', 'SUCC', 'SWAP', 'SWAPVECOTRS',
                                            'UNPACKTIME', 'UPCASE', 'VAL', 'WHEREX', 'WHEREY', 'WINDOW','WRITE', 'WRITEBUF',
                                            'WRITECHAR', 'WRITELN', 'ABSOLUTE', 'ASSEMBLER', 'EXPORT', 'EXTERNAL', 'FAR',
                                            'FORWARD', 'INDEX', 'INTERRUPT', 'NEAR','PRIVATE','PUBLIC','RESIDENT','VIRTUAL',
                                            'SHORTINT', 'INTEGER', 'LONGINT', 'BYTE', 'WORD', 'REAL', 'SINGLE', 'DOUBLE',
                                            'EXTENDED', 'COMP');
  Const skiryba = [' ', ':', '(', ')', ',', '.', '<', '>', '=', '+', '*', '-', ';'];

Procedure IsSpauskres(var s: String);
  Begin
    S := reserved[(ord(S[1]) - 60)];
  End;

Procedure IsSpauskFunkcPr(var s: String);
  Var b: integer;
      c: integer;
begin
  val(s, b, c);
  S := funkcpr[b];
End;


  Var Txt, Txt2: Text;
      C, g: Char;
      S: String;
      sk: byte;
      b: boolean;

Procedure makespace(s: string);
  Var b: integer;
      c, i: integer;
begin
  Val(s, b, c);
  For i := 1 to b do
   Write(txt2, ' ');
End;

 Begin
   Assign(Txt, 'Progr.pak');
   Assign(Txt2, 'Progr.kap');
   Reset(Txt);
   Rewrite(Txt2);
   s := '';
   c := #0;
   b := false;
   While not eof(Txt) Do
     Begin
       s := '';
       If b then begin b := false; c := g; End
        else read(txt, C);
        S := c;

       If (c = chr(254)) or (c = '!') then
         Begin
          s := '';
          read(txt, g);
          while g in ['0'..'9'] Do begin
            s := s + g;
            read(txt, g);
          end;
          b := true;
          IsspauskFunkcPr(s);
         End;
       If c = chr(255) then
         Begin
          read(txt, c);
          s := c;
          Isspauskres(s);
         End;
        write(txt2, s);
       if eoln(txt) and (not b) then begin writeln(txt2); readln(txt); end;
     End;
   Close(Txt);
   Close(Txt2);
 End.