program karakter_tanimlama;
      uses
      crt,graph,dos;


      var
      karakterler   : array [0..1023] of byte;
      tablo_adresi_seg : word;
      tablo_adresi_ofs : word;
      a,ct          : byte;
      kp            : char;
      durum         : byte;
      s             : string;
      secilen_karakter : byte;
      deneme           : byte;
      target           : string[8];


      procedure byte_to_string(ascii:byte);
      begin
      target:='00000000';
      for a:=8 downto 1 do begin
      if ascii and trunc(exp((a-1)*ln(2)))<>0 then target[9-a]:='1' else
      target[9-a]:='0';
      end;
      end;





      procedure beep(a,b:integer);

      begin
      sound(a);delay(b);nosound;
      end;


      procedure grafik;

      var
      grDriver : Integer;
      grMode   : Integer;
      ErrCode  : Integer;
      begin
      grDriver := Detect;
      InitGraph(grDriver,grMode,'c:\tp\bgi');
      ErrCode := GraphResult;
      if ErrCode <> grOk then
      begin
      clrscr;
      writeln('grafik surucusu bulunamadi !');
      halt(1);
      end else
      end;



procedure editor_penceresi_secilisi(st:byte);
const
x = 30;
y = 300;

begin
if st=1 then begin
             setcolor(white);
             rectangle(x-1,y-1,x+161,y+161);
             end;
if st=0 then begin
             setcolor(black);
             rectangle(x-1,y-1,x+161,y+161);
             end;
end;


procedure karakter_tablosu_secilisi(st:byte);
const
x = 425;
y = 55;

begin
if st=1 then setcolor(white);
rectangle(x-9,y-9,x+25*8+1,y+25*16+9);
if st=0 then setcolor(black);
rectangle(x-9,y-9,x+25*8+1,y+25*16+9);
end;

procedure karakter_tablosu(x,y:integer);

var
a,b,c:integer;
begin
c:=25;
setcolor(white);
setfillstyle(solidfill,blue);

bar(x-8,y-8,x+c*8,y+c*16+8);
settextstyle(defaultfont,horizdir,2);


for a:=0 to 7 do begin
for b:=0 to 15 do begin
outtextxy(x+a*c,y+b*c,chr(128+a*16+b));
end;
end;
setcolor(lightmagenta);
rectangle(x-8,y-8,x+c*8,y+c*16+8);
settextstyle(triplexfont,0,3);
setcolor(lightgray);
outtextxy(x+1,y-49,'Karakter Tablosu');
setcolor(lightgreen);
outtextxy(x,y-50,'Karakter Tablosu');
end;


procedure editor_penceresi(x,y:integer);

var a,b,c:integer;

begin
c:=18;
setfillstyle(solidfill,blue);
for b:=0 to 7 do begin
for a:=0 to 7 do begin
bar(x+a*20,y+b*20,x+a*20+c,y+b*20+c);
end;
end;
setcolor(magenta);
rectangle(x-2,y-2,x+160,y+160);
end;

procedure karakter_tablosunu_tanimla;

const Vector = $1F;
var src, dst : pointer;
begin
  src := ptr (MemW [0:Vector*4+2],MemW [0:Vector*4]);
  dst := ptr (seg(karakterler), ofs(karakterler));
  move (src^, dst^, sizeof(karakterler));
  MemW [0:Vector*4] := Ofs (karakterler);
  MemW [0:Vector*4+2] := Seg (karakterler);
end;

procedure tablo_reset;
const Vector = $1F;
begin
  MemW [0:Vector*4] := tablo_adresi_ofs;
  MemW [0:Vector*4+2] := tablo_adresi_seg;
end;


procedure editor_imleci(x,y:integer;st:byte);

begin

if st=1 then begin
             setfillstyle(solidfill,white);
             bar(x,y,x+18,y+18);
             end;

if st=0 then begin
             setfillstyle(solidfill,blue);
             bar(x,y,x+18,y+18);
             end;


end;

procedure karakter_imleci(x,y:integer);

begin
setcolor(green);
repeat
      setrgbpalette(green,random(64),random(64),random(64));
      rectangle(x-2,y-2,x+17,y+17);
until (keypressed) or (kp=#9);

setcolor(blue);
rectangle(x-2,y-2,x+17,y+17);
end;

procedure karakteri_buyut(x,y:integer;karakter:byte);

begin

for ct:=0 to 7 do begin
                  byte_to_string(karakterler[(karakter-128)*8+ct]);
                  a:=1;
                  repeat
                  if target[a]='1' then editor_imleci(x+(a-1)*20,y,1);
                  if target[a]='0' then editor_imleci(x+(a-1)*20,y,0);
                  inc(a);
                  until a=9;
                  y:=y+20;
                  end;

end;

procedure define;
var a,b:byte;
X,Y:INTEGER;
begin
settextstyle(defaultfont,0,1);
for b:=0 to 7 do begin
target:='00000000';
for a:=0 to 7 do begin
if getpixel(40+a*20,310+b*20)=white then target[a+1]:='1';
if getpixel(40+a*20,310+b*20)=blue then target[a+1]:='0';
end;
deneme:=0;
for ct:=0 to 7 do begin
if target[8-ct]='1' then deneme:=deneme+trunc(exp(ct*ln(2))) else begin end;
end;
karakterler[(secilen_karakter-128)*8+b]:=deneme;
karakter_tablosunu_tanimla;

    setfillstyle(solidfill,black);
    bar(280,340,310,365);
    settextstyle(defaultfont,horizdir,3);
    setcolor(yellow);
    outtextxy(280,340,chr(secilen_karakter));


end;
end;

procedure karakter_tablosunu_kaydet;

var f : file;
    w: word;
begin
assign(f,'C:\karakter.tan');
rewrite (f,1);
blockwrite (f,karakterler,sizeof(karakterler),w);
close(f);
end;

procedure karakter_tablosunu_yukle;

var f : file;
    w: word;
begin
assign(f,'C:\karakter.tan');
reset(f,1);
blockread(f,karakterler,sizeof(karakterler),w);
close(f);
karakter_tablosunu_tanimla;
karakter_tablosu(425,55);
end;



procedure editor(karakter:byte);

var x,y:integer;

begin
x:=30;y:=300;
editor_penceresi_secilisi(1);
karakteri_buyut(x,y,karakter);
define;


x:=30;y:=300;
editor_imleci(x,y,1);
kp:=#0;

repeat;
define;
kp:=readkey;
setfillstyle(solidfill,black);
if (kp='Y') or (kp='y') then durum:=1;
if (kp='S') or (kp='s') then durum:=0;
if (kp='K') or (kp='k') then karakter_tablosunu_kaydet;
if (kp='L') or (kp='l') then karakter_tablosunu_yukle;

editor_imleci(x,y,durum);
if kp=#0 then case readkey of

    'K' : x:=x-20;
    'M' : x:=x+20;
    'H' : y:=y-20;
    'P' : y:=y+20;




    end;

    if x<30 then x:=30;
    if y<300 then y:=300;
    if x>170 then x:=170;
    if y>440 then y:=440;

    editor_imleci(x,y,1);


until kp=#9;

editor_penceresi_secilisi(0);
end;


procedure karakter_secme;

var x,y:integer;
begin
x:=450;y:=55;
karakter_tablosu_secilisi(1);
    settextstyle(defaultfont,horizdir,3);
    setcolor(yellow);
    outtextxy(280,340,chr(trunc(128+(x-425)/25*16+(y-55)/25)));
    str((trunc(128+(x-425)/25*16+(y-55)/25)),s);
    secilen_karakter:=(trunc(128+(x-425)/25*16+(y-55)/25));
    settextstyle(triplexfont,horizdir,4);
    outtextxy(260,415,s);
    karakteri_buyut(30,300,secilen_karakter);

repeat;
karakter_imleci(x,y);
kp:=readkey;
if (kp='K') or (kp='k') then karakter_tablosunu_kaydet;
    setfillstyle(solidfill,black);
    bar(280,340,310,365);
    bar(260,425,320,450);
if kp=#0 then case readkey of

         'K' : x:=x-25;
         'M' : x:=x+25;
         'H' : y:=y-25;
         'P' : y:=y+25;



             end else if (kp='c') or (kp='C') or (kp=#27) then begin
                            closegraph;
                            writeln('karakter tanimlama programindan
                            ciktiniz');
                            tablo_reset;
                            halt(0);

                            end;

    if x<425 then x:=425;
    if y<55 then y:=55;
    if x>600 then x:=600;
    if y>430 then y:=430;

    settextstyle(defaultfont,horizdir,3);
    setcolor(yellow);
    outtextxy(280,340,chr(trunc(128+(x-425)/25*16+(y-55)/25)));
    str((trunc(128+(x-425)/25*16+(y-55)/25)),s);
    secilen_karakter:=(trunc(128+(x-425)/25*16+(y-55)/25));
    karakteri_buyut(30,300,secilen_karakter);

    settextstyle(triplexfont,horizdir,4);
    outtextxy(260,415,s);
    karakter_imleci(x,y);
    setfillstyle(solidfill,black);
    bar(280,340,310,365);
    bar(260,425,320,450);


    if kp=#9 then begin end;
until kp=#9;

    settextstyle(defaultfont,horizdir,3);
    setcolor(yellow);
    outtextxy(280,340,chr(trunc(128+(x-425)/25*16+(y-55)/25)));
    str((trunc(128+(x-425)/25*16+(y-55)/25)),s);
    secilen_karakter:=(trunc(128+(x-425)/25*16+(y-55)/25));
    settextstyle(triplexfont,horizdir,4);
    outtextxy(260,415,s);
karakter_tablosu_secilisi(0);

end;

procedure reklam(x,y:integer);

begin
setcolor(white);
settextstyle(triplexfont,horizdir,2);
outtextxy(x+1,y+1,'KARAKTER TANIMLAMA PROGRAMI');
setcolor(magenta);
settextstyle(triplexfont,horizdir,2);
outtextxy(x,y,'KARAKTER TANIMLAMA PROGRAMI');

setcolor(lightred);
settextstyle(triplexfont,horizdir,1);
outtextxy(x,y+50,'Bu program Cenk TARHAN tarafindan');
outtextxy(x,y+70,'PCWorld/Turkiye Programlama Sanati');
outtextxy(x,y+90,'Eki icin yazilmistir...');

setcolor(red);
settextstyle(triplexfont,horizdir,1);
x:=x-1;y:=y-1;
outtextxy(x,y+50,'Bu program Cenk TARHAN tarafindan');
outtextxy(x,y+70,'PCWorld/Turkiye Programlama Sanati');
outtextxy(x,y+90,'Eki icin yazilmistir...');


end;

procedure kullanim(x,y:integer);

begin
setcolor(lightgreen);
settextstyle(triplexfont,horizdir,2);
outtextxy(x,y,'[ Y ] ... Yazma modu');
outtextxy(x,y+20,'[ S ] ... Silme modu');
outtextxy(x,y+40,'[ L ] ... Diskten dosya yukleme');
outtextxy(x,y+60,'[ K ] ... Diske dosya kaydetme');
outtextxy(x,y+80,'[ C ] ... Programdan cikis');
end;

procedure ornekleme_bolgesi(x,y:integer);

begin
setcolor(magenta);
rectangle(220,298,370,460);
line(220,330,370,330);
rectangle(220,380,370,415);
settextstyle(triplexfont,horizdir,1);
setcolor(lightblue);
outtextxy(x+1,y+1,' Karakter :');
setcolor(blue);
outtextxy(x,y,' Karakter :');


setcolor(lightblue);
outtextxy(x+1,y+86,'ASCII Kodu :');
setcolor(blue);
outtextxy(x,y+85,'ASCII Kodu :');

end;



{ ana programin baslangici }

begin
  tablo_adresi_ofs := MemW [0:$1f*4];
  tablo_adresi_seg := MemW [0:$1f*4+2];

grafik;
setcolor(darkgray);
rectangle(0,0,639,479);
karakter_tablosunu_tanimla;
karakter_tablosu(425,55);
editor_penceresi(30,300);
editor_imleci(30,300,2);
ornekleme_bolgesi(230,300);
kullanim(30,180);
reklam(10,5);
repeat
karakter_secme;
kp:=#0;
editor(secilen_karakter);
karakter_tablosu(425,55);
until (kp='c') or (kp='C');
closegraph;
writeln('karakter tanimlama programindan ciktiniz');
tablo_reset;
end.