{ ASCII.PAS                 Copyright (c) TrSek alias Zdeno Sekerak }
{ Program zobrazi ascii tabulku OS.                                 }
{ Pred svojim spustenim si zapameta podklad a potom ho vrati spat.  }
{                                                                   }
{ Datum:28.05.1996                             http://www.trsek.com }

program ascii;
uses crt,dos;

const cground=blue;ctext=yellow;cnadpis=red;cpodnad=green;
      ccisla=yellow;cpodklad=black;
      pos=8;

var x,y:integer;
    a:array[1..80,1..25] of char;
    h:char;

procedure KurzorZap(ZapVyp:boolean);
 var
    Regs : Registers;
  begin
     with Regs do
     begin
        AH := $03;
        BH := $00;
        Intr($10,Regs);
        If not (Zapvyp) then
        CH := CH or $20
        else
        CH := CH and $DF;
        AH := $01;
        Intr($10,Regs);
     end;
  end;

procedure nacitajob;
var x,y:integer;
    regs:registers;
begin
 for x:=1 to 80 do for y:=1 to 25 do begin
   gotoxy(x,y);
   regs.bh:=0;regs.ah:=8;
   intr($10,regs);
   a[x,y]:=chr(regs.al);
   end;
end;

procedure vypisob;
var x,y:integer;
begin
 for x:=80 downto 1 do for y:=1 to 25 do begin
  if not ((x=80) and (y=25)) then begin
   gotoxy(x,y);write(a[x,y]);
   end;
  end;
end;

procedure farba(cground,ctext:integer);
begin
 textbackground(cground);
 textcolor(ctext);
end;

procedure writexy(x,y:integer;text:string);
begin
gotoxy(x,y);writeln(text);
end;

procedure znak(x,y,ch,col:integer);
begin
 farba(col,ccisla);
 if (ch>255)or(ch=7)or(ch=10)or(ch=8)or(ch=13) then ch:=32;
 gotoxy(x*3+3,y+pos);
 writeln(' ',char(ch),' ');
end;

BEGIN
 nacitajob;
 farba(cpodklad,cnadpis);
 farba(cground,cnadpis);
 for y:=1 to 16 do
  writexy(1,y+pos-4,'                                                                                ');
 farba(cpodnad,cnadpis);
 writexy(14,pos-5,'ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
 writexy(14,pos-4,'º  American Standard Code for Information Interchange. º');
 writexy(14,pos-3,'ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ');
 farba(cground,ctext);
 writexy(1,pos-2,' º 0  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25');
 writexy(1,pos-1,'ÍÎÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ');
 for y:=0 to 9 do begin
  gotoxy(1,y+pos);writeln(y,'º');
  end;
 writexy(1,pos+10,'ÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ');
 writexy(63,pos+11,'Software by Trsek');
 gotoxy(3,pos+11);writeln('Ovl danie:',chr(24),' ',chr(25),' ',chr(26),' ',chr(27),' Esc-koniec.');
 writexy(3,pos+12,'Znak m  v ASCII k¢de hodnotu : 109  ');
 for x:=0 to 9 do
  for y:=0 to 25 do znak(y,x,y*10+x,cground);
 x:=10;y:=9;
 znak(x,y,x*10+y,cpodklad);
 kurzorzap(false);

 repeat
  h:=readkey;
  znak(x,y,x*10+y,cground);
  if h=#0 then case readkey of
                #72:y:=y-1;
                #80:y:=y+1;
                #75:x:=x-1;
                #77:x:=x+1;
                #72:x:=x-1;
                end;
  if x>25 then begin x:=0;y:=y+1;end;
  if x<0 then if y<6 then begin
     x:=25;y:=y-1;if y<0 then y:=10;
     end
  else begin
     x:=24;y:=y-1;if y<0 then y:=9;
     end;
  if (y=9) and (x>24) then begin x:=0;y:=1;end;
  if y>9 then begin
     y:=0;x:=x+1;if x>25 then x:=0;
     end;
  if y<0 then begin
     y:=9;x:=x-1;if x<0 then x:=24;
     end;
  if (x*10+y)>255 then begin
     x:=0;if y<9 then y:=y+1;
     end;
  znak(x,y,x*10+y,cpodklad);
  farba(cground,ctext);
  gotoxy(3,pos+12);write('Znak m  v ASCII k¢de hodnotu : ',x*10+y,'   ');
  kurzorzap(false);
 until (h=#13) or (h=#27);
 farba(0,15);
 vypisob;
 farba(1,14);gotoxy(1,1);
 write(' ASCII  Copyright  (c).    Softwre  by  TRSEK.    All  right  reserved   TRSEK.');
END.