{*
 * @(#) markov.pas - Program for modeling Normal Markov Algorithm.
 * (c) 1994 Ivan Maidanski <ivmai@chat.ru> http://ivmai.chat.ru
 * Freeware program source. All rights reserved.
 **
 * Language: Turbo Pascal
 * Tested with: Turbo Pascal v7.0
 * Last modified: 1994-11-22 15:20:00 GMT+03:00
 *}

program MarkovTask;

{ Usage comments: The rules are written in the const 'R' }

{$B-}
uses Crt;
const R: array[1..16]
           of record
                Q,N: String;
                E: Boolean
              end
        = ((Q: '*p'; N: 'p1'; E: False),
           (Q: '*q'; N: 'q2'; E: False),
           (Q: '*'; N: ''; E: True),
           (Q: '1p'; N: 'p1'; E: False),
           (Q: '1q'; N: 'q1'; E: False),
           (Q: '2p'; N: 'p2'; E: False),
           (Q: '2q'; N: 'q2'; E: False),
           (Q: 'p1'; N: 'p'; E: True),
           (Q: 'q2'; N: 'q'; E: True),
           (Q: 'p2'; N: '+q'; E: False),
           (Q: 'q1'; N: '+p'; E: False),
           (Q: 'p+'; N: '+p'; E: False),
           (Q: 'q+'; N: '+q'; E: False),
           (Q: '+p'; N: 'q'; E: True),
           (Q: '+q'; N: 'p'; E: True),
           (Q: ''; N: '*'; E: False));
var S: String;
procedure Init;
 begin
   ClrScr;
   WriteLn;
   Write('Enter String: ');
   ReadLn(S)
 end;
function Search(C: Byte): Boolean;
 var N: Byte;
 begin
   N:=1;
   if R[C].Q=''
     then Insert(R[C].N,S,1)
     else begin
            N:=Pos(R[C].Q,S);
            if N>0
              then begin
                     Delete(S,N,Length(R[C].Q));
                     Insert(R[C].N,S,N)
                   end
          end;
   Search:=N=0
 end;
procedure DoStep(var C: Byte);
 begin
   C:=Low(R);
   while (C<=High(R)) and Search(C)
     do Inc(C);
   if C>High(R)
     then C:=0
 end;
procedure Wait;
 var C: Char;
 begin
   Delay(100);
   C:=ReadKey
 end;
procedure ShowWork(N,C: Byte);
 begin
   GotoXY(1,5);
   ClrEol;
   WriteLn('Step: ',N);
   ClrEol;
   Write('Rule: ',R[C].Q);
   if R[C].E
     then Write('|')
     else Write('-');
   WriteLn('->',R[C].N);
   ClrEol;
   WriteLn('Word: ',S);
   Wait
 end;
procedure Run;
 var N,C: Byte;
 begin
   N:=0;
   repeat
     DoStep(C);
     if C>0
       then begin
              Inc(N);
              ShowWork(N,C)
            end
   until (C=0) or (R[C].E)
 end;
procedure Done;
 begin
   WriteLn;
   WriteLn('Result: ',S);
   WriteLn;
   Wait
 end;
begin
  Init;
  Run;
  Done
end.