uses crt;
const VGA = $A000;
type bmp=record
          typ,
          typ2:char;
          velsub:longint;
          rez,
          rez2:integer;
          offset:longint;
          velhlav,
          sirka,
          vyska:longint;
          planes,
          bitnabod:integer;
          kompresia,
          velobr,
          Xpixnameter,
          Ypixnameter,
          farieb,
          dolfarieb:longint;
         end;
     farby=record
            pr:array [0..255] of byte;
            pb:array [0..255] of byte;
            pg:array [0..255] of byte;
           end;
     virtual=array [1..64000] of byte;
     virtptr=^virtual;
var r,b,g:byte;
    i,j:integer;
    obrazok:bmp;
    pom:file of byte;
    farb1:farby;
procedure grafmod;
begin
 asm
  mov ax,0013h
  int 10h
 end;
end;
procedure textmod;
begin
 asm
  mov ax,0003h
  int 10h
 end;
end;
Procedure bod (X,Y : Integer; Col : Byte; kde:word);
begin
  Mem [kde:X+(Y*320)]:=Col;
end;
procedure ulozfar (farba:byte);
begin
 port [$3c8]:=farba;
 port [$3c9]:=R;
 port [$3c9]:=B;
 port [$3c9]:=G;
end;
procedure nacitaj (nazov:string; var prem:bmp; var col:farby);
var p:byte;
    subor:file of bmp;
begin
 assign (subor,nazov);
 reset (subor);
 read (subor,prem);
 close (subor);
 if prem.bitnabod=24 then begin
  textmod;
  write ('Subor ',nazov,' pouziva vela farieb.');
  halt;
 end;
 assign (pom,nazov);
 reset (pom);
 seek (pom,54);
 for i:=0 to 255 do begin
  read (pom,col.pg[i]); read (pom,col.pb[i]); read (pom,col.pr[i]);read (pom,p);
  col.pr[i]:=col.pr[i] div 4;
  col.pb[i]:=col.pb[i] div 4;
  col.pg[i]:=col.pg[i] div 4;
 end;
end;
procedure initcolor (prem:farby);
begin
 for i:=0 to 255 do begin
  r:=prem.pr[i];
  b:=prem.pb[i];
  g:=prem.pg[i];
  ulozfar (i);
 end;
end;
procedure norle(image:bmp; kde:word);
var farba:byte;
    poms,l:integer;
begin
 with image do begin
  poms:=sirka;
  if vyska>200 then begin
   if (vyska*sirka>64000) then begin
    offset:=offset+(sirka*(vyska-200));
    vyska:=200;
   end;
  end;
  if sirka>320 then sirka:=320;
  seek (pom,offset);
  for i:=vyska-1 downto 0 do begin
   for j:=0 to sirka-1 do begin
    read (pom,farba);
    bod (j,i,farba,kde);
   end;
   if poms>320 then seek (pom,filepos(pom)+(poms-320));
  end;
 end;
 close (pom);
end;
procedure rle(image:bmp;kde:word);
var cis1,cis2,farba:byte;
    x,y,pocet:longint;
begin
 x:=0; y:=0;
 seek (pom,image.offset);
 repeat
  read (pom,cis1);
  read (pom,cis2);
  if cis1=0 then begin
   if cis2=0 then begin x:=0; y:=y+1; end;
   if cis2=1 then ;
   if cis2=2 then begin
                   read (pom,cis1); read (pom,cis2); x:=cis1; y:=cis2;
                  end;
   if cis2>2 then begin
    for i:=1 to cis2 do begin
     read (pom,farba);
     bod (x,199-y,farba,kde);
     x:=x+1;
     pocet:=pocet+1;
    end;
    if cis2 mod 2<>0 then read (pom,cis2);
   end;
  end else begin
   for i:=1 to cis1 do begin
    bod (x,199-y,cis2,kde);
    x:=x+1;
    pocet:=pocet+1;
   end;
  end;
 until ((cis1=0) and (cis2=1)) or (pocet=64000);
 close (pom);
end;
procedure bitmap(adres:string; picture:bmp; segment:word; var color:farby);
begin
 nacitaj (adres,picture,color);
 if segment=VGA then initcolor (color);
 if picture.kompresia=0 then norle (picture,segment) else
 if picture.kompresia=1 then rle (picture,segment);
end;
procedure cakaj;
begin
 repeat until (port[$3DA] and 8>0);
 repeat until (port[$3DA] and 8=0);
end;
begin
 grafmod;
 bitmap ('C:\title.bmp',obrazok,VGA,farb1);
 readkey;
 textmod;
end.