{ Starting number 3 - final of ICP'97
  Behem meneni palety se mi nepodarilo odstranit blikani obrazovky
  Nevim, cim to je, zatim vsude se meneni jen 14 barev v palete bez blikani obeslo ???...
  Mozna ze by pomohlo cekani na prekeresleni obrazu grafickou kartou,
  to se da zjisti ctenim z jejiho portu, postup si ale nepamatuji }
{$I-}
uses crt,dos;
type region=record index      :byte;
                   x1,y1,x2,y2:word;{ Zaporna cisla se stejne nevyskytuji }
            end;
     prg   =^region;
     tbr   = array[0..199,0..319] of boolean;
     scrt  = array[0..199,0..319] of byte;
var scr: scrt absolute $A000:$0000;
    buffer :^scrt;
    border:^tbr;
    f:text;
    p:array[1..1000] of prg;
    trg:prg;
    m:pointer;
    cnt,i,j,mx,my,lx,ly,start,fin,px,py:word;
    level:string;
    selected,lastsel,ib,bf:byte;
    ch:char;
    b,bb:boolean;

procedure set13h;assembler;
asm
  mov ah,0
  mov al,13h
  int 10h
end;

procedure set03h;assembler;
asm
  mov ah,0
  mov al,03h
  int 10h
end;

procedure minit;assembler;
asm
  mov ax,0
  int 33h
  mov ax,1
  int 33h
end;

procedure mshow;assembler;
asm
  mov ax,1
  int 33h
end;

procedure mhide;assembler;
asm
  mov ax,2
  int 33h
end;

function mlbt(var x,y:word):boolean;
var r:registers;
begin
 with r do
  begin
   mlbt:=false;
   r.ax:=3;
   intr($33,r);
   if r.bx and 1<>0 then
   begin mlbt:=true;          { Bohuzel, v zadani nebyla sluzba pro zjisteni }
                              { souradnic posledniho kliknuti ..}
         x:=r.cx div 2+1;     { jinak ujizdi z obrazovky !!!!!!!!!!!!! }
         y:=r.dx+1;
   end;
  end;
end;

var th,tm,ts,tss,lst:word;
function timechanged:boolean;   { DOSovske hodnoty casu se updatuji kazdy tik timeru }
                                { Lepsi by bylo sledovat poctiadlo v bloku BIOSu - ale }
begin gettime(th,tm,ts,tss);    { adresu si nepamatuji }
      timechanged:=(lst<>tss);
      lst:=tss;
end;

function in_rect(var x,y,x1,y1,x2,y2:word):boolean;
var b:boolean;
begin
  b:=(x>=x1) and (x<=x2) and (y>=y1) and (y<=y2);
  in_rect:=b;
end;

function owned(var x,y:word;var index:byte):boolean;
var i:word;
begin
  i:=1;
  while (i<=cnt)
  and not in_rect(x,y,p[i]^.x1,p[i]^.y1,p[i]^.x2,p[i]^.y2)
      do inc(i);
  owned:=(i<=cnt);
  index:=p[i]^.index;
end;

procedure setpal(onlyborder:boolean);
var i:byte;
    j:word;
    pal:array[0..255,0..2] of byte;
    r:registers;
begin
  if onlyborder
  then begin
       for i:= 240 to 246 do
       begin j:=i+bf;
             if j>253 then dec(j,14);
             pal[j,0]:=8*(i-240);
             pal[j,1]:=8*(i-240);
             pal[j,2]:=8*(i-240);
       end;
       for i:= 247 to 253 do
       begin j:=i+bf;
             if j>253 then dec(j,14);
             pal[j,0]:=8*(253-i);
             pal[j,1]:=8*(253-i);
             pal[j,2]:=8*(253-i);
       end;
       r.bx:=240;
       r.cx:=14;
       r.es:=seg(pal[240]);
       r.dx:=ofs(pal[240]);
       end
  else begin pal[0,0]:=0;
             pal[0,1]:=0;
             pal[0,2]:=0;
             pal[255,0]:=255;
             pal[255,1]:=255;
             pal[255,2]:=255;
             for i:= 1 to 239 do
             begin pal[i,0]:=((i shr 5)*255) div 7;
                   pal[i,1]:=(((i shr 2) and 7)*255) div 7;
                   pal[i,2]:= ((i and 3)*255) div 3;
             end;
             r.bx:=0;
             r.cx:=256;
             r.es:=seg(pal);
             r.dx:=ofs(pal);
       end;
  r.ax:=$1012;
  intr($10,r);
end;

procedure rectangle(x1,y1,x2,y2:word;color:byte);
var y:word;
begin
  for y:=y1 to y2 do fillchar(buffer^[y,x1],x2-x1+1,color);
end;

procedure display;
var i,j:word;
begin
   mhide;
   for i:=1 to cnt do
    with p[i]^ do
     rectangle(x1,y1,x2,y2,index);
   move(buffer^,scr,320*200);
   if selected<>0 then
   begin for j:=0 to 199 do
          for i:=0 to 319 do
           if border^[j,i] then
             scr[j,i]:=240+(j+i) mod 14;
   end;
   mshow;
end;

var ei,ej,efx,efy:word;

procedure examine;
begin
  bb:=false;
  if (px=0) or (py=0) or (px>=319) or (py>=199)
  then bb:=true
  else begin ei :=pred(px);
             efx:=succ(px); efy:=succ(py);
             while ei<=efx do
             begin ej:=pred(py);
                   while ej<=efy do
                   begin bb:=(buffer^[ej,ei]<>selected);
                         if bb then break;
                         inc(ej);
                   end;
                   if bb then break;
                   inc(ei);
             end;
       end;
  if bb then border^[py,px]:=true;
end;

begin
  if paramcount=0 then
  begin writeln('Please specify a file name');
        exit;
  end;
  mark(m);
  new(trg);
  new(border);
  new(buffer);
  fillchar(buffer^,320*200,0);
  selected:=0;
  ch:=#0;
  lx:=0; ly:=0; start:=0; fin:=0; lastsel:=1; bf:=0;
  cnt:=0;

  assign(f,paramstr(1));
  reset(f);
  if IOResult<>0 then
  begin writeln('File not exist');
        exit;
  end;
  readln(f,level);
  while not SeekEof(f) do
  begin inc(cnt);
        new(p[cnt]);
        with p[cnt]^ do
        begin read(f,index);
              read(f,x1);
              read(f,y1);
              read(f,x2);
              readln(f,y2);
        end;
  end;
  close(f);
                              { SROVNANI !! }
  for i:=1 to cnt do
   for j:=1 to cnt-1 do
    if p[j]^.index<p[j+1]^.index then
     begin trg:=p[j];
           p[j]:=p[j+1];
           p[j+1]:=trg;
     end;

  set13h;
  setpal(false);
  setpal(true);
  minit;
  repeat
    if keypressed
    then begin ch:=readkey;
               if ch=#0 then ch:=readkey;
         end;
    if mlbt(mx,my) and ((mx<>lx) or (my<>ly)) then
         begin lx:=mx;ly:=my;
               if owned(mx,my,ib) then
               begin selected:=ib;

                     i:=0;
                     repeat inc(i);
                     until p[i]^.index=selected;
                     start:=i;
                     repeat inc(i);
                     until (i>cnt) or (p[i]^.index<>selected);
                     fin:=pred(i);

                     fillchar(border^,320*200,0);
                     for i:=start to fin do
                     with p[i]^ do
                     begin px:=x1; for py:=y1 to y2 do examine;
                           px:=x2; for py:=y1 to y2 do examine;
                           py:=y1; for px:=x1 to x2 do examine;
                           py:=y2; for px:=x1 to x2 do examine;
                     end;

               end;
         end;
    if lastsel<>selected then display;
    lastsel:=selected;
    if timechanged then
    begin inc(bf);
          if bf>=15 then bf:=0;
          setpal(true);
    end;
  until ch = #27;
  set03h;
{  for i:=1 to cnt do
    if p[i-1]^.index<>p[i]^.index then writeln(p[i]^.index);}
  release(m);
end.