Program Ex_1; {enc hint: edit _common_ value access to BGI path in your home drive}
 Uses crt,graph;

 Var int,int2:integer;
     matrixw,matrixh:integer;

     mymatrix:array[1..170,1..170]of string[1];
     position:array[1..170]of byte;

     positron:byte;

 const common='c:\bp\bgi';

procedure startlogo;
begin
 SETColoR(8);
 MoveTO(482,117);LineTO(526,117);MoveTO(526,117);LineTO(538,97);MoveTO(538,97);LineTO(514,77);
 MoveTO(514,77);LineTO(370,77);MoveTO(370,77);LineTO(326,97);MoveTO(326,97);LineTO(270,177);
 MoveTO(270,177);LineTO(270,233);MoveTO(270,233);LineTO(394,233);MoveTO(394,233);LineTO(422,261);
 MoveTO(422,261);LineTO(366,349);MoveTO(366,349);LineTO(326,373);MoveTO(326,373);LineTO(-26,373);
 MoveTO(-26,373);LineTO(-30,397);MoveTO(-30,397);LineTO(370,397);MoveTO(370,397);LineTO(462,341);
 MoveTO(462,341);LineTO(514,257);MoveTO(514,257);LineTO(454,197);MoveTO(454,197);LineTO(346,197);
 MoveTO(346,197);LineTO(346,165);MoveTO(346,165);LineTO(370,129);MoveTO(370,129);LineTO(402,105);
 MoveTO(402,105);LineTO(470,105);MoveTO(470,105);LineTO(482,117);MoveTO(538,97);LineTO(542,109);
 MoveTO(542,109);LineTO(530,129);MoveTO(530,129);LineTO(526,117);MoveTO(530,129);LineTO(486,129);
 MoveTO(486,129);LineTO(482,117);MoveTO(470,105);LineTO(474,117);MoveTO(474,117);LineTO(486,129);
 MoveTO(474,117);LineTO(406,117);MoveTO(406,117);LineTO(402,105);MoveTO(406,117);LineTO(374,141);
 MoveTO(374,141);LineTO(370,129);MoveTO(374,141);LineTO(350,177);MoveTO(350,177);LineTO(346,165);
 MoveTO(350,177);LineTO(350,197);MoveTO(270,233);LineTO(274,245);MoveTO(274,245);LineTO(398,245);
 MoveTO(398,245);LineTO(394,233);MoveTO(398,245);LineTO(418,265);MoveTO(514,257);LineTO(518,269);
 MoveTO(518,269);LineTO(466,353);MoveTO(466,353);LineTO(462,341);MoveTO(466,353);LineTO(374,409);
 MoveTO(374,409);LineTO(370,397);MoveTO(374,409);LineTO(-38,409);SETColoR(7);
 MoveTO(302,245);LineTO(306,269);MoveTO(306,269);LineTO(418,269);MoveTO(478,221);LineTO(530,221);
 MoveTO(530,221);LineTO(570,257);MoveTO(570,257);LineTO(518,345);MoveTO(518,345);LineTO(430,397);
 MoveTO(430,397);LineTO(394,397);MoveTO(374,197);LineTO(374,177);MoveTO(374,177);LineTO(398,145);
 MoveTO(398,145);LineTO(426,125);MoveTO(426,125);LineTO(482,125);SETColoR(4);
 MoveTO(242,417);LineTO(206,469);MoveTO(206,469);LineTO(274,469);MoveTO(274,469);LineTO(254,445);
 MoveTO(242,417);LineTO(310,417);MoveTO(310,417);LineTO(254,445);MoveTO(322,417);LineTO(378,417);
 MoveTO(378,417);LineTO(342,469);MoveTO(342,469);LineTO(286,469);MoveTO(286,469);LineTO(322,417);
 MoveTO(390,417);LineTO(446,417);MoveTO(446,417);LineTO(414,469);MoveTO(414,469);LineTO(354,469);
 MoveTO(354,469);LineTO(390,417);MoveTO(394,469);LineTO(410,445);MoveTO(370,429);LineTO(334,429);
 MoveTO(294,457);LineTO(330,457);MoveTO(426,469);LineTO(458,417);MoveTO(458,417);LineTO(510,417);
 MoveTO(510,417);LineTO(478,469);MoveTO(478,469);LineTO(426,469);MoveTO(442,469);LineTO(454,449);
 MoveTO(494,417);LineTO(482,437);MoveTO(522,417);LineTO(490,469);MoveTO(490,469);LineTO(542,469);
 MoveTO(542,469);LineTO(542,469);MoveTO(542,469);LineTO(574,417);MoveTO(574,417);LineTO(522,417);
 MoveTO(542,433);LineTO(526,457);SETColoR(12);MoveTO(150,195);LineTO(50,345);
 MoveTO(50,345);LineTO(245,345);MoveTO(245,345);LineTO(165,280);MoveTO(165,280);LineTO(270,230);
 MoveTO(150,195);LineTO(270,195);SETColoR(4);MoveTO(70,365);LineTO(275,365);
 MoveTO(275,365);LineTO(190,295);MoveTO(190,295);LineTO(300,245);MoveTO(70,365);LineTO(165,225);
 MoveTO(165,225);LineTO(270,225);setcolor(12);outtextxy(455,472,'KSAND Soft (Ks@nder)');
end;



procedure loadmaintmenu;
begin
 clrscr;textcolor(7);writeln;writeln(' [1] - one string encoding');writeln(' [2] - file encoding');
 writeln(' [3] - one string decoding');writeln(' [4] - file decoding');writeln(' [h] - help');writeln(' [q] - quit');
 writeln;write('Use this keys for access to program options');
end;


procedure deposition(onj:string);
var a,i,error:integer;
    s2:string;
begin
  onj:=onj+',';s2:='';positron:=0;
  for a:=1 to length(onj) do
   if((onj[a]<>',')and(onj[a]<>';'))then
   s2:=s2+onj[a] else
    begin
     val(s2,i,error);
     positron:=positron+1;
     position[positron]:=i;
     s2:='';
    end;

end;

procedure clearmatrix;
var a,a2:integer;
begin
 for a:=1 to 170 do
  for a2:=1 to 170 do
   mymatrix[a,a2]:='';
end;

procedure coding(s:string);
var a,a2,a3:integer;
begin

 clearmatrix;
 a3:=1;
 for a:=1 to matrixw do
  for a2:=1 to matrixh do
   begin
    mymatrix[a,a2]:=s[a3];
    a3:=a3+1;
   end;

 writeln;writeln('Matrix with your param created, show...');textcolor(14);
   for a:=1 to matrixw do
    begin
    for a2:=1 to matrixh do
     write(mymatrix[a,a2]:2);
     writeln;
    end;
 textcolor(7);

 writeln;writeln('Your string after generation : ');
 writeln;writeln('(with special parse)');textcolor(14);
 s:='';
 for a:=1 to positron do
  begin
  for a2:=1 to matrixh do
   begin
    s:=s+mymatrix[a2,position[a]];
    write(mymatrix[a2,position[a]]);
   end;
    textcolor(12);write('|');textcolor(14);
  end;
 textcolor(7);writeln;writeln('(without special parse)');textcolor(14);writeln(s);textcolor(7);
end;

procedure startfasttransaction;
var s,s2:string;
    av:byte;
    a,a2,a3:integer;
    f:text;

begin
 clrscr;textcolor(7);
 writeln('start console...');writeln;
 write('Please enter your matrix ');textcolor(15);write('WIDTH');textcolor(7);write(' param : ');
  textcolor(14);readln(matrixw);textcolor(7);if(matrixw>170)then matrixw:=170;
 write('Please enter your matrix ');textcolor(15);write('HEIGHT');textcolor(7);write(' param : ');
  textcolor(14);readln(matrixh);textcolor(7);if(matrixh>170)then matrixh:=170;
 write('Please enter your step-on-step ');textcolor(15);write('FORMAT');textcolor(7);
 write(' (hint: use "," or ";" symbol for deparse) : ');
  textcolor(14);readln(s);textcolor(7);deposition(s);
 write('Please enter your ');textcolor(15);write('string capture');textcolor(7);write(' : ');
  textcolor(14);readln(s);textcolor(7);
 write('Save your results in textfile ?');
 write(' (hint: ext file saving in special formatted if you selected [s] option, see help for etc key) [Y/S/R/All] ');av:=0;
 case readkey of
  'y':av:=1;
  'Y':av:=1;
  's':av:=2;
  'S':av:=2;
  'r':av:=3;
  'R':av:=3;
 end;
 coding(s);
 textcolor(7);
 if(av=1)then
  begin
   writeln;writeln('You call savemode option [Y]... Start savedialog...');
   writeln('(hint: use null string-filename for canceled operation)');
   textcolor(15);write('saveto');textcolor(7);write('(h: one string save):/>');textcolor(14);readln(s2);
   if(s2<>'')then
    begin
      assign(f,s2);rewrite(f);
       writeln(f,s);
      close(f);
    end;
  end;
 if(av=2)then
  begin
   writeln;writeln('You call savemode option [S]... Start savedialog...');
   writeln('(hint: use null string-filename for canceled operation)');
   textcolor(15);write('saveto');textcolor(7);write('(h: spec format):/>');textcolor(14);readln(s2);
   if(s2<>'')then
    begin
      assign(f,s2);rewrite(f);
       writeln(f,matrixw,'x',matrixh);
       for a:=1 to positron do write(f,position[a]);write(f,#13#10);
       writeln(f,s);
      close(f);
    end;
  end;

 writeln;write('Working is complete. Please pressed any key...');readkey;loadmaintmenu;
end;

procedure startlowtransaction;
var f:text;
    s:string;
begin
 clrscr;textcolor(7);
 writeln('start console...');writeln;
 write('Please enter your matrix ');textcolor(15);write('WIDTH');textcolor(7);write(' param : ');
  textcolor(14);readln(matrixw);textcolor(7);if(matrixw>170)then matrixw:=170;
 write('Please enter your matrix ');textcolor(15);write('HEIGHT');textcolor(7);write(' param : ');
  textcolor(14);readln(matrixh);textcolor(7);if(matrixh>170)then matrixh:=170;
 write('Please enter your step-on-step ');textcolor(15);write('FORMAT');textcolor(7);
 write(' (hint: use "," or ";" symbol for deparse) : ');
  textcolor(14);readln(s);textcolor(7);deposition(s);
 write('Please enter your ');textcolor(15);write('filename');textcolor(7);write(' : ');
  textcolor(14);readln(s);textcolor(7);

 if(s<>'')then
  begin
   assign(f,s);reset(f);
    while not eof(f) do
     begin
      readln(f,s);
      coding(s);writeln('Please pressed any key...');readkey;
     end;
   close(f);
  end;

 writeln;writeln('Please pressed any key...');readkey;loadmaintmenu;
end;

procedure encode(s:string);
var a,a2,a1:integer;
    apro:integer;
begin

 clearmatrix;
 a1:=1;
 a2:=1;
 for a:=1 to length(s) do
  begin
   mymatrix[position[a2],a1]:=s[a];
   if(a1<matrixw) then a1:=a1+1 else begin a1:=1;a2:=a2+1; end;
  end;


 writeln;writeln('Matrix with your param created, show...');textcolor(14);
  for a:=1 to matrixh do
   begin
    for a2:=1 to matrixw do
     write(mymatrix[a,a2]:2);
    writeln;
   end;
 textcolor(7);writeln;writeln('Your string is : ');textcolor(14);

 s:='';
 for a:=1 to matrixw do
  for a2:=1 to matrixh do
   s:=s+mymatrix[a2,a];
 writeln(s);textcolor(7);
end;


procedure startfastplace;
var s:string;
begin
 clrscr;textcolor(7);
 writeln('start console...');writeln;
 write('Please enter your matrix ');textcolor(15);write('WIDTH');textcolor(7);write(' param : ');
  textcolor(14);readln(matrixw);textcolor(7);if(matrixw>170)then matrixw:=170;
 write('Please enter your matrix ');textcolor(15);write('HEIGHT');textcolor(7);write(' param : ');
  textcolor(14);readln(matrixh);textcolor(7);if(matrixh>170)then matrixh:=170;
 write('Please enter your step-on-step ');textcolor(15);write('FORMAT');textcolor(7);
 write(' (hint: use "," or ";" symbol for deparse) : ');
  textcolor(14);readln(s);textcolor(7);deposition(s);
 write('Please enter your ');textcolor(15);write('codestring');textcolor(7);write(' : ');
  textcolor(14);readln(s);textcolor(7); encode(s);
 writeln;write('Working is complete. Please pressed any key...');readkey;loadmaintmenu;
end;

procedure helpf;
begin
 clrscr;writeln;textcolor(15);writeln('HELP Support');textcolor(7);
 writeln;write('Please pressed any key...');readkey;loadmaintmenu;
end;

begin
 initgraph(int,int2,common);startlogo;readkey;closegraph;loadmaintmenu; repeat case readkey of
 'q':halt; '1':startfasttransaction; '2':startlowtransaction; '3':startfastplace; 'h':helpf; end; until false;
end.