{*
 * @(#) ir94_3.pas - Problem 3 ("Symbol recognition") solution
 * of the All-Russia Olympiad in Informatics in 1994.
 * (c) 1994 Ivan Maidanski <ivmai@chat.ru> http://ivmai.chat.ru
 * Freeware program source. All rights reserved.
 **
 * Language: Turbo Pascal
 * Tested with: Borland Pascal v5.5
 * Last modified: 1994-08-27 16:10:00 GMT+04:00
 *}

program IR94_3;

{$A+,B-,D+,E-,F-,I+,L+,N-,O-,R+,S+,V-}
{$M 4096,0,0}

uses Crt;
const MaxX=25;
const MaxY=80;
const MaxLet= 9;
const MaxLX= 5;
const MaxLY= 5;
var A,Aux,T: array[1..MaxX,1..MaxY] of Char;
const Letter: array[0..MaxLet] of Char
             =('?','A','V','J','L','M','O','S','F','U');
const Font: array[1..MaxLet,1..MaxLX,1..MaxLY] of Byte
           =(((0,0,1,0,0),
              (0,1,0,1,0),
              (1,0,0,0,1),
              (1,1,1,1,1),
              (1,0,0,0,1)),
             ((1,1,1,1,0),
              (1,0,0,0,1),
              (1,1,1,1,0),
              (1,0,0,0,1),
              (1,1,1,1,0)),
             ((1,0,1,0,1),
              (1,0,1,0,1),
              (0,1,1,1,0),
              (1,0,1,0,1),
              (1,0,1,0,1)),
             ((0,0,1,0,0),
              (0,1,1,1,0),
              (1,0,0,0,1),
              (1,0,0,0,1),
              (1,0,0,0,1)),
             ((0,1,1,1,0),
              (1,0,1,0,1),
              (1,0,1,0,1),
              (1,0,0,0,1),
              (1,0,0,0,1)),
             ((0,1,1,1,0),
              (1,0,0,0,1),
              (1,0,0,0,1),
              (1,0,0,0,1),
              (0,1,1,1,0)),
             ((0,1,1,1,1),
              (1,0,0,0,0),
              (1,0,0,0,0),
              (1,0,0,0,0),
              (0,1,1,1,1)),
             ((0,1,1,1,0),
              (1,0,1,0,1),
              (1,0,1,0,1),
              (1,0,1,0,1),
              (0,1,1,1,0)),
             ((1,0,1,1,0),
              (1,0,1,0,1),
              (1,1,1,0,1),
              (1,0,1,0,1),
              (1,0,1,1,0)));
procedure ReadFile;
 var F: Text;
 var S: String;
 var L,N,X,Y: Byte;
 begin
   WriteLn;
   Write('Enter File Name: ');
   ReadLn(S);
   Assign(F,S);
   Reset(F);
   Read(F,N);
   for X:=1 to MaxX
     do for Y:=1 to MaxY
          do T[X,Y]:=' ';
   for N:=N downto 1
     do begin
          Read(F,X);
          Read(F,Y);
          Read(F,L);
          for L:=L downto 1
            do T[X,Pred(Y+L)]:='*'
        end
 end;
procedure Wait;
 var C: Char;
 begin
   repeat
     C:=ReadKey;
     if C=#0
       then C:=ReadKey
   until C=' '
 end;
procedure Show;
 var X,Y: Byte;
 begin
   for X:=1 to MaxX
     do for Y:=1 to MaxY
          do begin
               GotoXY(Y,X);
               if (X<MaxX) or (Y<MaxY) or (T[X,Y]<>' ')
                 then Write(T[X,Y])
             end;
   Wait
 end;
procedure SearchNext(var I,J: Byte);
 var X,Y: Byte;
 begin
   for X:=1 to MaxX
     do for Y:=1 to MaxY
          do if T[X,Y]='*'
               then begin
                      I:=X;
                      J:=Y;
                      Exit
                    end;
   I:=0
 end;
procedure DelChar(X,Y: Byte; var Xmin,Ymin,Xmax,Ymax: Byte);
 var I,J: ShortInt;
 begin
   if (X>=1) and (X<=MaxX) and
      (Y>=1) and (Y<=MaxY) and (Aux[X,Y]='*')
     then begin
            if X<Xmin
              then Xmin:=X;
            if Y<Ymin
              then Ymin:=Y;
            if X>Xmax
              then Xmax:=X;
            if Y>Ymax
              then Ymax:=Y;
            Aux[X,Y]:=' ';
            for I:=-1 to 1
              do for J:=-1 to 1
                   do DelChar(X+I,Y+J,Xmin,Ymin,Xmax,Ymax)
          end
 end;
procedure GetMinMax(X,Y: Byte; var Xmin,Ymin,Xmax,Ymax: Byte);
 begin
   Aux:=T;
   Xmin:=X;
   Ymin:=Y;
   Xmax:=X;
   Ymax:=Y;
   DelChar(X,Y,Xmin,Ymin,Xmax,Ymax)
 end;
procedure CopyLetter(var Xmin,Ymin,Xmax,Ymax: Byte);
 var X,Y: Byte;
 begin
   for X:=1 to MaxX
     do for Y:=1 to MaxY
          do Aux[X,Y]:=' ';
   Xmax:=Xmax-Xmin+1;
   Ymax:=Ymax-Ymin+1;
   for X:=1 to Xmax
     do for Y:=1 to Ymax
          do Aux[X,Y]:=T[Xmin+X-1,Ymin+Y-1]
 end;
function GetAverageY(X,Ymin,Ymax: Byte): Boolean;
 var R,Y: Byte;
 begin
   R:=0;
   Y:=Ymin;
   while Y<=Ymax
     do begin
          if Aux[X,Y]='*'
            then Inc(R);
          Inc(Y)
        end;
   GetAverageY:=R/(Ymax-Ymin+1)>=0.5
 end;
function GetAverageX(Y,Xmin,Xmax: Byte): Boolean;
 var R,X: Byte;
 begin
   R:=0;
   X:=Xmin;
   while X<=Xmax
     do begin
          if Aux[X,Y]='*'
            then Inc(R);
          Inc(X)
        end;
   GetAverageX:=R/(Xmax-Xmin+1)>=0.5
 end;
procedure ScaleY(X,Ymax: Byte);
 var Y,Len: Byte;
 begin
   Len:=Ymax div MaxLY;
   if Len>0
     then for Y:=1 to MaxLY
         do if GetAverageY(X,Pred(Y)*Len+1,Y*Len)
              then A[X,Y]:='*'
              else A[X,Y]:=' '
 end;
procedure ScaleX(Y,Xmax: Byte);
 var X,Len: Byte;
 begin
   Len:=Xmax div MaxLX;
   if Len>0
     then for X:=1 to MaxLX
            do if GetAverageX(Y,Pred(X)*Len+1,X*Len)
              then A[X,Y]:='*'
              else A[X,Y]:=' '
 end;
function GiveMark(N: Byte): Real;
 var X,Y,I,J: Byte;
 begin
   I:=0;
   J:=0;
   for X:=1 to MaxLX
     do for Y:=1 to MaxLY
          do begin
               if Font[N,X,Y]=1
                 then Inc(I);
               if (Font[N,X,Y]=1) and (A[X,Y]='*') or
                  (Font[N,X,Y]=0) and (A[X,Y]<>'*')
                 then Inc(J)
             end;
   GiveMark:=J/I
 end;
function Analysis: Char;
 var Best,N: Byte;
 var BRes,Cur: Real;
 begin
   Best:=0;
   BRes:=0;
   for N:=1 to MaxLet
     do begin
          Cur:=GiveMark(N);
          if (Cur>BRes) and (Cur>1)
            then begin
                   Best:=N;
                   BRes:=Cur
                 end
        end;
   Analysis:=Letter[Best]
 end;
procedure FillTable(X,Y: Byte; C: Char);
 var I,J: ShortInt;
 begin
   if (X>=1) and (X<=MaxX) and
      (Y>=1) and (Y<=MaxY) and (T[X,Y]='*')
     then begin
            T[X,Y]:=C;
            for I:=-1 to 1
              do for J:=-1 to 1
                   do FillTable(X+I,Y+J,C)
          end
 end;
procedure Run;
 var X,Y,Xmin,Ymin,Xmax,Ymax: Byte;
 begin
   SearchNext(X,Y);
   while X>0
     do begin
          GetMinMax(X,Y,Xmin,Ymin,Xmax,Ymax);
          CopyLetter(Xmin,Ymin,Xmax,Ymax);
          for Xmin:=1 to Xmax
            do ScaleY(Xmin,Ymax);
          for Ymin:=1 to MaxLY
            do ScaleX(Ymin,Xmax);
          FillTable(X,Y,Analysis);
          Show;
          SearchNext(X,Y)
        end
 end;
begin
  ReadFile;
  Show;
  Run;
  WriteLn
end.