{       Starting Number  : 18                        }
{       Used Modules     : DOS,CRT (standart only)   }
{       Supported levels : 1-4 (all)                 }
program MView;
{$X+,B-,R-}
uses dos,crt;
type Page=array[0..199,0..319] of byte;{<===Video Page type}

var i,j,x,y,x1,y1,c:integer; {<==Diff vars}
    SCR:page absolute $A000:0000;{<=====mode 13 video memory zone.}
    f:text; {<===File Variable}
    lev:string; {<===File Level}
    bb:byte; {===Mouse Buttons flags}
    mx,my:word; {Mouse X,Y}
    v:^page; {Second Video page}
    kk:char; {char from Keyboard}
    p:integer;{<==\\      }
    pp:integer;{<===Vars for blinking border.}
    tt:word;   {<===MicroSeconds save}
    fn:string; {<==File Name}
    SR:SearchRec;

{========Draw Rectangle on Second Video Page=========}
procedure DrawRect(x,y,x1,y1,c:integer);
var i,j:integer;
begin
 for i:=y to y1 do
  for j:=x to x1 do v^[i,j]:=c;
end;

{=====Mouse Procedures. No Comments.===}
procedure InitMouse;assembler;
asm
 mov ax,0
 int 33h
end;

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

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

procedure GetM;assembler;
asm
 mov ax,3
 int 33h
 shr cx,1
 mov mx,cx
 mov my,dx
 mov bb,bl
end;

{======Palette Processing procs.====}
procedure Pal(c:word;r,g,b:byte);assembler;
asm
 mov ax,1010h
 mov bx,c
 mov ch,g
 mov cl,b
 mov dh,r
 int 10h
end;

procedure APal(s,l:word;sg,o:word);assembler;
asm
 mov bx,s
 mov cx,l
 mov ax,sg
 mov dx,o
 mov es,ax
 mov ax,1012h
 int 10h
end;

procedure InitPal;{<<=======Set Initial Palette}
var i:integer;
begin
 for i:=1 to 239 do Pal(i,
                        ((i shr 5)*63) div 7,
                        (((i shr 2) and 7)*63) div 7,
                        ((i and 3)*63) div 3);
 Pal(255,63,63,63);
end;


Procedure Scroll;{<<======Border Fading. Silly name of proc.}
var h,m,s,t:word;
begin
 GetTime(h,m,s,t);
 if t=tt then Exit;
 tt:=t;
 p:=p+pp;
 if  p>63 then begin p:=63; pp:=-pp; end;
 if  p<40 then begin p:=40; pp:=-pp; end;
 Pal(240,p,p,p);
end;

procedure FillZone(x,y,x1,y1,c:integer);{<<====Changes all colors except 0  }
var i,j:integer;                        {to color <c> in defined zone.}
begin
 for i:=x to x1 do
  for j:=y to y1 do
   if scr[j,i]<>0 then scr[j,i]:=c;
end;

procedure Show; {<======MDF File Preview.}
var x,y,x1,y1,c:word;
begin
Assign(f,fn);
Reset(f);
Readln(f,lev);
HideM;
while not eof(f) do
begin
 readln(f,c,x,y,x1,y1);
 x:=(x*22 div 32)+100;
 y:=(y*22 div 32);
 x1:=(x1*22 div 32)+100;
 y1:=(y1*22 div 32);
 for i:=y to y1 do
  for j:=x to x1 do scr[i,j]:=c;
end;
ShowM;
Close(f);
end;

procedure Quit;{<===No comments.}
begin
 HideM;
 TextMode(CO80);
 TextAttr:=$09;
 writeln('---<<<Avanced MAP Viewer.  Written on ICP ''97.>>>---');
 writeln;
 writeln('TIP: Start viewer without params to have a "open file" dialog.');
 writeln;
 ReadKey;
 Halt;
end;

procedure Select;{<<<=======Open file dialog.}
var ff:array[1..23] of string[12];
    i,k,n:integer;
    S:SearchRec;
begin
 HideM;
 p:=50;
 pp:=2;
 DirectVideo:=False;
 FindFirst('*.mdf',$3F,S);
 if DOSError<>0 then
 begin
  TextMode(co80);
  writeln('No MDF files!');
  Halt;
 end;
 n:=1;
 ff[n]:=S.Name;
 writeln(ff[n]);
 repeat
 FindNext(S);
 if DOSError=0 then
 begin
  inc(n);
  ff[n]:=S.Name;
  writeln(ff[n]);
 end;
 until (n>23) or (DOSError<>0);
 v^:=scr;
 ShowM;
 repeat
  GetM;
  Scroll;
  if KeyPressed then
   if ReadKey=#27 then Quit;
  if (mx<12*8) and (my<n*8) then
  begin
   i:=(my div 8)+1;
   if i<>k then
   begin
    HideM;
    scr:=v^;
    FillZone(0,k*8-8,12*8,k*8-1,7);
    FillZone(0,i*8-8,12*8,i*8-1,240);
    v^:=scr;
    fn:=ff[i];
    Show;
    k:=i;
    ShowM;
   end;
   end;
 until bb<>0;
 for i:=0 to 199 do
  for j:=0 to 319 do v^[i,j]:=0;
end;





procedure Border;{<<======Draw zone border.}
var c,i,j,cc:integer;
    ss:word;
begin
 HideM;
 DirectVideo:=false;
 ss:=0;
 SCR:=v^;
 c:=v^[my,mx];
 cc:=240;
 if (c>0) and (c<240) then
 for i:=0 to 199 do
  for j:=0 to 319 do
   if (v^[i,j]=c) then
   begin
    inc(ss);
   if (v^[i,j-1]<>c) or
      (v^[i,j+1]<>c) or
      (v^[i-1,j]<>c) or
      (v^[i+1,j]<>c) then
      begin
       scr[i,j]:=240;
       inc(cc);
       if cc>254 then cc:=240;
      end;
    end;
 GotoXY(40-7,1);
 write('S=',ss);
 ShowM;
 repeat
  GetM;
 until bb=0;
 pp:=2;
 p:=50;
 repeat
  GetM;
  Scroll;
 until (bb<>0) or KeyPressed;
end;


{==========MAIN PROG============}
begin
asm  {<<=======Set Video Mode}
 mov ax,13h
 int 10h
end;
New(v); {<==Create second video page.}
for i:=0 to 199 do
 for j:=0 to 319 do v^[i,j]:=0;{<====Clear it}
InitPal;  {<<===Set palette}
InitMouse;
ShowM;
fn:=ParamSTR(1); {<<===Explore prog parameters}
FindFirst(fn,$3F,SR);
if DOSError<>0 then Select;{<<==If bad, then open dialog}

{===========READ MAP==========}
Assign(f,fn);
Reset(f);
Readln(f,lev);
while not eof(f) do
begin
 readln(f,c,x,y,x1,y1);
 DrawRect(x,y,x1,y1,c);
end;
Close(f);
HideM;
SCR:=v^; {<<=====Show second video page}
ShowM;
kk:=#0;
repeat
GetM;                    {<<======Mouse control loop}
if bb<>0 then Border;
if KeyPressed then kk:=readKey;
until kk=#27; {<<===if <ESC> pressed then...}
Quit; {<<====Write some info and terminate.}
end.