program md;
uses crt;
const MaxLen=50;
type  StringPos=1..MaxLen;
	  StringLen=0..MaxLen;
	  Str=^StringInstance;
	  StringInstance=record
		 strlen:StringLen;
		 data:array[StringPos]of char;
	  end;
          Mtype=1..15;
	  Stype=1..3;

var   m:integer;
	  S1,S2,str1,str2:Str;
	  rf,rs:Stype;
	  pos:StringPos;
	  len:StringLen;
	  ok:char;
	  yn,cra,crb,crc:boolean;
	  c1,c2:string[30];

Procedure Create(var S:Str; var created:boolean);
Begin
  new(S);
  S^.strlen:=0;
  created:=true;
end;

Procedure Terminate(var S:Str; var created:boolean);
Begin
  if created then begin
  dispose(S); created:=false;
                  end;
end;

Function Empty(S:Str):boolean;
Begin
  Empty:=S^.strlen=0;
end;

Function Full(S:Str):boolean;
Begin
  Full:=S^.strlen=MaxLen;
end;

Procedure Append(var S:Str);
var f:char;
Begin
  if not Full(S) then
  with S^ do Begin
			   Window(27,21,49,24);
			   TextBackGround(0); ClrScr;
			   Window(25,20,47,23);
			   TextBackGround(7); ClrScr;
			   TextColor(8);
			   Write(' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ');
			   Write(' ³  Enter character: ³ ');
			   Write(' ³                   ³ ');
			   Write(' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
			   Window(36,22,40,22);
			   TextColor(0);
			   ReadLn;
			   ReadLn(f);
			   strlen:=strlen+1;
			   data[strlen]:=f;
			 end;
end;

Procedure Concatinate(var S1:str; var S2:Str);
var i,k:StringLen;
Begin
  if not Empty(S2) then Begin
  if S1^.strlen+S2^.strlen<=MaxLen then
  k:=s2^.strlen
  else k:=MaxLen-S1^.strlen;
  with S1^ do Begin
  for i:=1 to k do
  data[strlen+i]:=S2^.data[i];
  strlen:=strlen+k;
  end;
  end;
end;

Procedure Substring(S1:Str; var S2:str; pos:StringPos; len:StringLen);
var k:StringLen;
Begin
  if(len>0)and(S1^.strlen>=pos+len-1)then Begin
  for k:=1 to len do
  S2^.data[k]:=S1^.data[pos+k-1];
  S2^.strlen:=len;
  end;
end;




Function Match(S1,S2:Str; pos:StringPos):boolean;
var i,last:StringPos;
	cont:boolean;
Begin
  i:=1;
  last:=S2^.strlen;
  cont:=true;
  Match:=false;
  if (not Empty(S2))and(S1^.strlen>=S2^.strlen+pos-1) then
  while(cont)and(S2^.data[i]=S1^.data[pos]) do
  if i=last then Begin
				   cont:=false;
				   match:=true;
				 end
  else Begin
		 i:=i+1;
		 pos:=pos+1;
	   end;
end;

Function Find(S1,S2:Str; pos:StringPos):StringLen;
var kbegin,kend:StringPos;
	found:boolean;
Begin
  kbegin:=pos;
  kend:=S1^.strlen-S2^.strlen+1;
  found:=false;
  While (not found)and(kbegin<=kend) do
  if Match(S1,S2,kbegin) then found:=true
  else kbegin:=kbegin+1;
  if found then Find:=kbegin else Find:=0;
end;

Procedure MakeEmpty(var S:Str);
Begin
  if not Empty(S) then S^.strlen:=0;
end;

Procedure ReadString(var S:Str);
var pos:StringPos;
	c:char;
Begin
  MakeEmpty(S);
  pos:=1;
  with S^ do Begin
			   Repeat
				 c:=ReadKey;
				 data[pos]:=c;
				 Write(data[pos]);
				 pos:=pos+1
			   Until(c=#13)or(pos>MaxLen);
			   strlen:=pos-2;
			 end;
end;


procedure menu;
  var oper:array[1..11] of string[20];
     c:char;
   begin
   window(4,3,19,15);
   textbackground(blue); clrscr;
   textcolor(0);
   oper[1]:=('     CREATE     ');
   oper[2]:=('    TERMINATE   ');
   oper[3]:=('     LENGTH     ');
   oper[4]:=('      FULL      ');
   oper[5]:=('     EMPTY      ');
   oper[6]:=('   CONCATENATE  ');
   oper[7]:=('    SUBSTRING   ');
   oper[8]:=('      FIND      ');
   oper[9]:=('   READSTRING   ');
   oper[10]:=('   WRITESTRING  ');
   oper[11]:=('      EXIT      ');
   for m:=1 to 11 do begin
                      gotoxy(1,m+1);
                      write(oper[m]);
                     end;
  m:=1;
  Textcolor(15);
  Textbackground(2);
  gotoxy(1,m+1);
  write(oper[m]);
  Repeat
    Repeat c:=readkey until (c=#0) or (c=#13);
    if c=#0 then begin
                  repeat c:=readkey until (c=#72) or (c=#80);
                  case c of
                   #72: begin
                          textbackground(blue);
                          textcolor(0);
                          gotoxy(1,m+1);
                          write(oper[m]);
                          m:=m-1;
                          if m<1 then m:=11;
                          textbackground(2);
                          textcolor(15);
                          gotoxy(1, m+1);
                          write(oper[m]);
                        end;
                   #80: begin
                          textbackground(blue);
                          textcolor(0);
                          gotoxy(1,m+1);
                          write(oper[m]);
                          m:=m+1;
                          if m>11 then m:=1;
                          textbackground(2);
                          textcolor(15);
                          gotoxy(1,m+1);
                          write(oper[m]);
                         end;
                   end;
                 end
                 until (c=#13);
  end;

 { writeln('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
  writeln('º                 MENU                  º');
  writeln('ºÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĺ');
  writeln('º                   ³                   º');
  writeln('º 1 - Create        ³ 6 - Concatenate   º');
  writeln('º 2 - Terminate     ³ 7 - Substring     º');
  writeln('º 3 - Length        ³ 8 - Find          º');
  writeln('º 4 - Empty         ³ 9 - Readstring    º');
  writeln('º 5 - Full          ³ 10 - Writestring  º');
  writeln('º                   ³    <Esc> - exit   º');
  writeln('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ');}

  Procedure ChooseOne;
Begin


  Window(25,20,55,23);
  TextBackGround(4); ClrScr;
  TextColor(0);
  Write(' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ');
  Write(' ³  Enter number of string:  ³ ');
  Write(' ³                           ³ ');
  Write(' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
  Window(28,22,45,22);
  TextColor(0);
  Write('  1 or 2: ');
  Window(45,22,50,22);
  TextColor(0);
  Repeat Read(rf) Until (rf=1)or(rf=2);
end;

Procedure WriteString(S:Str; rf:Stype);
var pos:StringPos;
Begin

Window(25,6*rf-4,75,6*rf-3);
  TextBackGround(black); ClrScr;
  TextColor(9);
  Write(' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ');
  Write(' ³ String ',rf,':                                     ³');
  Window(59,6*rf-3,73,6*rf-3);
  TextColor(6);
  Write(' LENGTH=',S^.strlen,' ');
  Window(25,6*rf-2,75,6*rf-1);
  TextBackGround(black); ClrScr;
  TextColor(9);
  Write(' ³                                               ³ ');
  Write(' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
  case rf of
  1: S1:=str1; 2: S1:=str2;
  end;
  if not Empty(S1) then
  Begin
        Textcolor(green);
	Window(27,6*rf-2,73,6*rf-2);
	with S1^ do
	for pos:=1 to strlen do Write(data[pos]);
  end;
end;

Procedure ReadPos;
Begin
  Window(27,21,49,24);
 { TextBackGround(0); ClrScr;
  Window(25,20,47,23);}
  TextBackGround(7); ClrScr;
  TextColor(8);
  Write(' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ');
  Write(' ³  Enter position:  ³ ');
  Write(' ³                   ³ ');
  Write(' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
  Window(36,22,40,22);
  TextColor(0);
  Read(pos); Write(pos);
end;

Procedure ReadLen;
Begin
  Window(50,21,72,24);
 { TextBackGround(0); ClrScr;
  Window(48,20,70,23);}
  TextBackGround(7); ClrScr;
  TextColor(8);
  Write(' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ');
  Write(' ³   Enter length:   ³ ');
  Write(' ³                   ³ ');
  Write(' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
  Window(59,22,62,22);
  TextColor(0);
  Read(len); Write(len);
end;

Procedure SayOk;
Begin
  Window(10,27,20,30);
  TextBackGround(4); ClrScr;
  TextColor(14);
  Write(' ÚÄÄÄÄÄÄÄ¿ ');
  Write(' ³  OK?  ³ ');
  Write(' ³ (y/n) ³ ');
  Write(' ÀÄÄÄÄÄÄÄÙ');
  Repeat ok:=ReadKey Until (ok='y')or(ok='Y')or(ok='n')or(ok='N');

Window(10,27,20,30);
  TextBackGround(Black); ClrScr;
end;

Procedure OnEmpty;
Begin
  Window(37,21,64,24);
 { TextBackGround(0); ClrScr;
  Window(35,20,62,23);}
  TextBackGround(4); ClrScr;
  TextColor(14);
  Write(' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ');
  Write(' ³  Your string is empty  ³ ');
  Write(' ³    ( press any key )   ³ ');
  Write(' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
  ReadKey;
end;

Procedure YesNo(yn:boolean; c1,c2:string);
Begin
  Window(27,21,77,24);
 { TextBackGround(0); ClrScr;
  Window(25,20,75,23);}
  TextBackGround(3); ClrScr;
  TextColor(14);
  Write(' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ');
  Write(' ³                                               ³ ');
  Write(' ³                Press any key                  ³ ');
  Write(' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
  Window(28,21,72,21);
  TextColor(1);
  if yn=true then Write(c1,' ',c2) else Write(c1,' not ',c2);
  ReadKey;
end;

Procedure ChooseTwo;
Begin
  {Window(27,21,77,24);
  TextBackGround(0); ClrScr;}
  Window(25,20,75,23);
  TextBackGround(0); ClrScr;
  TextColor(white);
  Write(' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ');
  Write(' ³  Enter two numbers of string:                 ³ ');
  Write(' ³                                               ³ ');
  Write(' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
  TextColor(8);
  GoToXY(5,3); Write('FIRST');
  GoToXY(24,3); Write('SECOND');
  Window(57,21,74,21);
  TextColor(8);
  Write('  ( 1 or 2 )');
  Window(37,22,42,22);
  TextColor(white);
  Repeat Read(rf) Until (rf=1)or(rf=2);
  Write(rf);
  Window(57,22,62,22);
  TextColor(white);
  Repeat Read(rs) Until (rs=1)or(rs=2);
  Write(rs);
end;

Procedure FoundLen;
Begin
  Window(27,21,77,24);
{  TextBackGround(0); ClrScr;
  Window(25,20,75,23);}
  TextBackGround(3); ClrScr;
  TextColor(14);
  Write(' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ');
  Write(' ³                                               ³ ');
  Write(' ³                Press any key                  ³ ');
  Write(' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
  Window(28,21,72,21);
  TextColor(1);
  if Find(S1,S2,pos)=0 then
  Write(   '          Substring is not found')
  else Write('      Substring is found at position ',Find(S1,S2,pos));
  ReadKey;
End;

Procedure ReadWin(rf:Stype);
Begin
  {Window(27,21,77,24);
  TextBackGround(0); ClrScr;}
  Window(25,20,75,23);
  TextBackGround(0); ClrScr;
  TextColor(white);
  Write(' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ');
  Write(' ³       Enter One String per line:              ³ ');
  Write(' ³                                               ³ ');
  Write(' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
  TextColor(white);
  Window(28,22,72,22);
  case rf of
  1: ReadString(str1);
  2: ReadString(str2);
  End;
  end;
procedure EnterSubstr(rf:Stype);
begin
  Window(25,20,75,23);
  TextBackGround(0); ClrScr;
  TextColor(white);
  Write(' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ');
  Write(' ³          Enter Your Substring:                ³ ');
  Write(' ³                                               ³ ');
  Write(' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
  TextColor(white);
  Window(28,22,72,22);
  case rf of
  1: ReadString(str1);
  2: ReadString(str2);
  End;
End;

var
ending:boolean;
created:boolean;

begin

   ending:=false;
   cra:=false; crb:=false;
  Repeat
	TextBackGround(0); ClrScr;
        if cra then WriteString(str1,1);
	if crb then WriteString(str2,2);
  TextBackground(0);

   clrscr;
  menu;
  {m:=readkey;}

  case m of
   1:begin
   ChooseOne;
			  case rf of
			  1: if not cra then
				 Begin Create(str1, created); cra:=true end;
			  2: if not crb then
				 Begin Create(str2,created); crb:=true end;
                                 end;
			  Window(25,20,77,24);
			  TextBackGround(Black); ClrScr;
			End;
     { Create(S, created);}


   2:begin
     { Terminate(S,created);}
                       ChooseOne;
			  SayOk;
			  if (ok='y')or(ok='Y') then
			  Begin
				case rf of
				1: if cra then
				   Begin Terminate(str1,created); cra:=false end;
				2: if crb then
				   Begin Terminate(str2,created); crb:=false end;
                                 end;
				Window(25,6*rf-4,77,6*rf);
				TextBackGround(black); ClrScr;
			  End;
			  Window(25,20,77,24);
			  TextBackGround(blue); ClrScr;
                          end;

   3:begin
   {ChooseOne;
   {case rf of
   1:Length(str1);
   2:Length(str2);}

     end;

   4:begin
     {ChooseOne;
     case rf of
     1:Empty(str1);
     2:Empty(str2);
            end;}

     end;

   5:begin
     ChooseOne;
     case rf of
     1:Full(str1);
     2:Full(str2);
             end;
     end;

   6:begin
                          ChooseTwo;
			  SayOk;
			  if(ok='y')or(ok='Y') then Begin
			  case rf of
			  1: S1:=str1; 2: S1:=str2;
			  end;
			  case rs of
			  1: S2:=str1; 2: S2:=str2;
			  end;
			  Concatinate(S1,S2);       End;
			  Window(25,20,77,24);
			  TextBackGround(Blue); ClrScr;
			End;



   7:begin
                          Choosetwo;
			  ReadPos;
			  ReadLen;
			  SayOk;
			  if(ok='y')or(ok='Y')then Begin
			  case rf of
			  1: S1:=str1; 2: S1:=str2;
			  end;
			  case rs of
			  1: S2:=str1; 2: S2:=str2;
			  end;
			  Substring(S1,S2,pos,len); End;
			  Window(25,20,77,24);
			  TextBackGround(Blue); ClrScr;
			End;

   8:begin
                          ChooseOne;
			  ReadPos;
                          EnterSubstr(rf);
			  case rf of
			  1: S1:=str1; 2: S1:=str2;
			  end;
			  case rs of
			  1: S2:=str1; 2: S2:=str2;
		  end;

                          if  (find(s1,s2,pos)<>0) then begin
                          window(25,20,75,24);
                          Textbackground(black);
                          Textcolor(white);
                          write('Substring is found')
                          end
                           else
                            write('Substring is not found');

			  {FoundLen;
			  Window(25,20,77,24);
			  TextBackGround(Blue); ClrScr;}
			End;



   9:begin
   ChooseOne;
			  ReadWin(rf);
			  Window(25,20,77,24);
			  TextBackGround(blue); ClrScr;
     { ReadString(S);}
     end;

  10:begin
     {ChooseOne;clrscr;
     case rf of
     1:Writestring(str1, rf);
     2:Writestring(str2, rf);
       end;}
      end;
  11: ENDING:=true;


   end;
  { until(m=#27);}

  until(ending=true);





End.