program VGA;
uses Graph,Crt,Dos;
procedure writechar(x,y:integer;znak,color,background:byte);
var segment,offset:longint;
    attr,a:byte;
begin
 segment:=$B800;
 offset:=2*(80*y+x);
 a:=mem[segment:offset];
 mem[segment:offset]:=znak;
 Inc(offset);
 attr:=background shl 4;
 attr:=attr or color;
 a:=mem[segment:offset];
 mem[segment:offset]:=attr;
end;

function readchar(x,y:integer):byte;
var segment,offset:longint;
    attr:byte;
    pom:boolean;
begin
 segment:=$B800;
 offset:=2*(80*y+x);
 readchar:=mem[segment:offset];
end;


procedure setwm(mode:byte);
var rmode:byte;
begin
 port[$3ce]:=5;          {port 3ceh index 5 - Mode register}
 rmode:=port[$3cf];
 rmode:=rmode and 252;   {vynulujem posledne dva bity}
 rmode:=rmode or mode;   {nastavym Write Mode}
 port[$3cf]:=rmode;
end;

procedure setrm(mode:byte);
var rmode:byte;
begin
 port[$3ce]:=5;
 rmode:=port[$3cf];
 if mode=1 then rmode:=rmode or 8
           else rmode:=rmode and 247;
 port[$3cf]:=rmode;
end;

procedure writepixel0(x,y:integer;color:byte);
var i,segment,offset:longint;
    a,bit:byte;
begin
 setwm(0);
 segment:=$a000;
 offset:=80*y+(x div 8);
 bit:=1;
 for i:=1 to (7-(x mod 8)) do bit:=bit*2;
 port[$3c4]:=2;            {mapmask na 1111b}
 port[$3c5]:=15;
 port[$3ce]:=1;            {Enable S/R na 1111b}
 port[$3cf]:=15;
 port[$3ce]:=8;            {BitMask-povolim dany bit}
 port[$3cf]:=bit;
 port[$3ce]:=0;            {do S/R farba pixelu}
 port[$3cf]:=color;
 a:=mem[segment:offset];   {nacitam Latch register}
 mem[segment:offset]:=0;   {nieco zapisem}
end;

procedure writepixel2(x,y:integer;color:byte);
var i,segment,offset:longint;
    a,bit:byte;
begin
 setwm(2);
 segment:=$a000;
 offset:=80*y+(x div 8);
 bit:=1;
 for i:=1 to (7-(x mod 8)) do bit:=bit*2;
 port[$3c4]:=2;            {mapmask}
 port[$3c5]:=15;
 port[$3ce]:=1;            {Enable S/R}
 port[$3cf]:=15;
 port[$3ce]:=0;            {S/R}
 port[$3cf]:=15;
 port[$3ce]:=8;            {BitMask}
 port[$3cf]:=bit;
 a:=mem[segment:offset];
 mem[segment:offset]:=color;   {zapis farby na adresu}
 setwm(0);
end;

procedure writepixel3(x,y:integer;color:byte);
var i,segment,offset:longint;
    a,bit:byte;
begin
 setwm(3);
 segment:=$a000;
 offset:=80*y+(x div 8);
 bit:=1;
 for i:=1 to (7-(x mod 8)) do bit:=bit*2;
 port[$3c4]:=2;            {mapmask}
 port[$3c5]:=15;
 port[$3ce]:=1;            {Enable S/R}
 port[$3cf]:=15;
 port[$3ce]:=0;            {S/R}
 port[$3cf]:=color;
 port[$3ce]:=8;           {BitMask}
 port[$3cf]:=255;
 a:=mem[segment:offset];
 mem[segment:offset]:=bit;
 setwm(0);
end;

function readpixel1(x,y:integer;color:byte):boolean;
var i,segment,offset:longint;
    a,bit:byte;
begin
 setrm(1);
 segment:=$a000;
 offset:=80*y+(x div 8);
 bit:=1;
 for i:=1 to (7-(x mod 8)) do bit:=bit*2;
 port[$3ce]:=7;            {Color don't care}
 port[$3cf]:=15;
 port[$3ce]:=2;            {Color compare}
 port[$3cf]:=color;
 a:=mem[segment:offset];
 if a=0 then readpixel1:=false
        else readpixel1:=true;
end;

var gd,gm,errorcode,ii:integer;
    key:char;
    a,b,c,i:integer;
    p1,p2,p3:string;
begin
   clrscr;
   randomize;
   key:='r';
   textmode(3);
   repeat
   if key='r' then begin
     clrscr;
     writeln('                              Textovy Mod 80x25');
     for i:=1 to 1500 do
        writechar(random(80),2+random(23),32+random(70),random(16),random(16));
     a:=random(80);b:=random(25);
     str(a,p1);str(b,p2);
     if readchar(a,b)>32 then
         write('                           V bode '+p1+','+p2+' je znak '+Char(readchar(a,b)))
                         else
         write('                        V bode '+p1+','+p2+' je prazdny znak');
                  end;
     key:=readkey;
   until key='q';
   clrscr;
   gd:=3;                                      {ega}
   gm:=2;                                      {640x480x16}
   initgraph(gd,gm,'d:\bp\bgi\');
   errorcode:=graphresult;
   if (errorcode<>grOk) then begin
      writeln('Graphics error: ', grapherrormsg(errorcode));
      repeat until keypressed;
      halt(1);
                             end;
   key:='r';
   repeat
   if (key='t') or (key='r') then begin
     if key='r' then Cleardevice;
     Outtextxy(240,5,'Graficky mod 640x480');
     outtextxy(60,30,'WriteMode 0');
     outtextxy(280,30,'WriteMode 2');
     outtextxy(500,30,'WriteMode 3');
     for i:=1 to 5000 do begin
         writepixel0(Random(200),50+Random(400),Random(16));
         writepixel2(220+Random(200),50+Random(400),Random(16));
         writepixel3(440+Random(200),50+Random(400),Random(16));
                        end;
     a:=Random(640);b:=Random(480);
     for i:=0 to 15 do
      if readpixel1(a,b,i) then c:=i;
     str(a,p1);str(b,p2);str(c,p3);
     if (key='t') then begin
            setviewport(189,454,639,479,true);
            clearviewport;
                       end;
     setviewport(0,0,639,479,true);
     outtextxy(190,455,'V bode '+p1+','+p2+' je pixel farby '+p3);
                              end;
   key:=' ';
   key:=readkey;
   until key='q';
   closegraph;
end.