program mapview;
{$m 65500,66000,66000}
uses crt;

{
MAP VIEWER
starting number: 15 - Jakub Travnik

Program supports all levels(1-4) of MDF format.


If found an error in sample file "souame.mdf", there is
index=0 on line 52 and some following lines,
so I add option to allow to continue although index is not
in range <1,239> as specified in description of definition file.

}


const maxlines=5000;{maximal number of datalines in input file}

type trgb=record r,g,b:byte end;{palette entry}
     tpal=array[0..255] of trgb;{full palette}
     tdataline=record           {sctructure for storing read data}
                index:byte;
                x1,y1,x2,y2:integer;
               end;
     tdata=array[0..maxlines] of tdataline;{array of data entries}
     tscreen=array[-1..200,-1..320] of byte;{array for virtual screen}
     tprocedure=pointer;

var data:tdata;
    virtscreen:^tscreen;
    mousex,mousey:integer;      {mouse coordinates are stored here after}
    mouseb:byte;                {call to getmouse}
    pal:tpal;                   {array of colors of palette}
    oldexit:tprocedure;
    errorline:integer;

procedure setgraphics;
{sets graphics mode $13 (320x200x256) works with all VGA and compat.}
begin
asm
mov ax,$13
int $10
end;
end;

procedure restoretext;
{return back to text mode 3 (80*25)}
begin
asm
mov ax,3
int $10
end;
end;

procedure err(s:string);
{writes error message to screen and exits}
begin
restoretext;
writeln(s);
dispose(virtscreen);
halt;
end;

procedure readerror;
{handler of error for reading numbers from file}
var s:string;
begin
exitproc:=oldexit;
str(errorline,s);
err('Error: bad number on line:'+s);
end;

procedure putpixel(x,y:integer;c:byte);
{draw pixel at x,y coord. with c - color on real screen}
begin
mem[sega000:(y*320)+x]:=c;
end;

function getpixel(x,y:integer):byte;
{reads pixel from real screen located at x,y}
begin
getpixel:=mem[sega000:(y*320)+x];
end;

function getkey:char;
{returns key if it's in buffer, but otherwise return 0 and don't wait}
var c:char;
begin
getkey:=#0;
if keypressed then
 begin
 c:=readkey;
 if c=#0 then c:=readkey;{avoid extended keys}
 getkey:=c;
 end;
end;

procedure setpalentries(lo,hi:integer);
{sets palette entries in range <lo,hi> from pal array}
var palseg,palofs,count:word;
begin
palseg:=seg(pal[lo]);
palofs:=ofs(pal[lo]);
count:=hi-lo;
asm
mov ax,palseg
mov es,ax
mov dx,palofs
mov ax,$1012
mov bx,lo
mov cx,count
int $10
end;
end;

procedure setpal;
{makes nice palette and activates it}
var a:integer;
begin
pal[0].r:=0;pal[0].g:=0;pal[0].b:=0;
for a:=1 to 239 do
 begin
 pal[a].r:=((a shr 5)*255) div 7;
 pal[a].g:=((a shr 2)*255) div 7;
 pal[a].b:=((a and 3)*255) div 3;
 end;
for a:=240 to 247 do
 begin
 pal[a].r:=(a-240)*8;
 pal[a].g:=(a-240)*8;
 pal[a].b:=(a-240)*8;
 end;
for a:=248 to 254 do
 begin
 pal[a].r:=(254-a)*8;
 pal[a].g:=(254-a)*8;
 pal[a].b:=(254-a)*8;
 end;
setpalentries(0,255);
end;

procedure initmouse;
{resets mouse and show it}
begin
asm
mov ax,0
int $33
mov ax,1
int $33
end;
end;

procedure mouseon;
{show mouse cursor}
begin
asm
mov ax,1
int $33
end;
end;

procedure mouseoff;
{hide mouse cursor}
begin
asm
mov ax,2
int $33
end;
end;

procedure getmouse;
{stores mouse coord and button state to mousex,mousey,mouseb}
var x,y:integer;
    b:byte;
begin
asm
mov ax,3
int $33
mov x,cx
mov y,dx
mov b,bl
end;
mousex:=x div 2;{strange mouse driver causes this}
mousey:=y;
mouseb:=b and 1;
end;

procedure drawbox(x1,y1,x2,y2:integer;c:byte);
{draws box on real screen}
var a,b:integer;
begin
for a:=x1 to x2 do
 for b:=y1 to y2 do putpixel(a,b,c);
end;

procedure drawvirtbox(x1,y1,x2,y2:integer;c:byte);
{draws box on virtual screen}
var a,b:integer;
begin
for a:=x1 to x2 do
 for b:=y1 to y2 do virtscreen^[b,a]:=c;
end;

procedure display(x,y,l:integer);
{displays map without selected object}
var a:integer;
begin
for a:=0 to l do
 begin
 drawbox(data[a].x1,data[a].y1,data[a].x2,data[a].y2,data[a].index);
 end;
end;

procedure drawframe(index:byte;l:integer);
{draw frame only}
{selected object is drawn to virtual screen and}
{borders are computed and drawn to real screen}
var a,b,c:integer;
begin
fillchar(virtscreen^,sizeof(tscreen),0);
for a:=0 to l do
 if data[a].index=index then
  begin
  drawvirtbox(data[a].x1,data[a].y1,data[a].x2,data[a].y2,1);
  end;
for a:=0 to 319 do
 for b:=0 to 199 do
 begin
 if (virtscreen^[b,a]=1) then    {check for border}
  if (virtscreen^[b+1,a+1]<>1) or
     (virtscreen^[b+1,a]<>1) or
     (virtscreen^[b+1,a-1]<>1) or
     (virtscreen^[b-1,a+1]<>1) or
     (virtscreen^[b-1,a]<>1) or
     (virtscreen^[b-1,a-1]<>1) or
     (virtscreen^[b,a+1]<>1) or
     (virtscreen^[b,a-1]<>1)
    then
    begin
    c:=(a+b) mod 15;
    putpixel(a,b,240+c);
    end
    else putpixel(a,b,index);
 end;
end;

procedure run(lastindex:integer);
{process all mouse input and controls selecting}
var a,b,c:integer;
begin
initmouse;
mouseoff;
display(0,0,lastindex);
mouseon;
repeat
getmouse;
if mouseb<>0 then
 if getpixel(mousex,mousey)<>0 then
 begin
 mouseoff;
 display(0,0,lastindex);
 drawframe(getpixel(mousex,mousey),lastindex);
 mouseon;
 end
 else
 begin
 mouseoff;
 display(0,0,lastindex);
 mouseon;
 end;
for b:=0 to 199 do
 begin
  for a:=0 to 319 do
  begin
  c:=getpixel(a,b);
  if (c>=240) and (c<=253) then putpixel(a,b,c+1)
   else if c=254 then putpixel(a,b,240);
  end;
 getmouse;
 if mouseb<>0 then break;
 end;
until getkey=#27;{ESC}
end;


{main program}
{reads data and check them and store it to data array}
{then it calls run procedure}
var f:text;
    s,ss:string;
    a,b:integer;
    c:char;
const dontcheckindex:boolean=false;
begin
new(virtscreen);
writeln('Map viewer.');
if paramcount=0 then err('Usage: 15mview <datafile>');
assign(f,paramstr(1));
{$i-}                 {check if file exist}
reset(f);
if ioresult<>0 then err('Could not open file "'+s+'".');
{$i+}
readln(f,s);
if copy(s,1,4)<>'MDF/' then err('Bad file format.');{all levels supported}
a:=0;
while not eof(f) do
 begin
 if a>maxlines then err('Maximum number of lines exceeded.');
 oldexit:=exitproc;              {start error handling}
 exitproc:=@readerror;           {}
 errorline:=a+1;
 read(f,data[a].index);                               {read data}
 read(f,data[a].x1);
 read(f,data[a].y1);
 read(f,data[a].x2);
 read(f,data[a].y2);
 exitproc:=oldexit;              {remove error handler}
 inc(a);
 end;
close(f);
dec(a);
for b:=0 to a-1 do {now check if they are correct}
 begin
 str(b+2,s);
 if ((data[b].index>239) or (data[b].index<1)) and (not dontcheckindex) then
  begin
  str(data[b].index,ss);   {see comment at top of source}
  writeln('Index on line '+s+' is not in range <1,239> actual value is:'+ss);
  writeln('Press [I] to Ignore, [A] to ignore All, other keys to exit.');
  c:=upcase(readkey);
  if (c<>'I') and (c<>'A') then err('Program aborted by user.');
  if c='A' then dontcheckindex:=true;
  end;
 if (data[b].x1>319) or (data[b].x1<0) then err('Error x1 not in range on line:'+s);
 if (data[b].x2>319) or (data[b].x2<0) then err('Error x2 not in range on line:'+s);
 if (data[b].y1>199) or (data[b].y1<0) then err('Error y1 not in range on line:'+s);
 if (data[b].y2>199) or (data[b].y2<0) then err('Error y2 not in range on line:'+s);
 end;
setgraphics;{set graphics mode}
setpal;     {set palette}
run(a);     {give user control}
restoretext;{set text mode}
dispose(virtscreen);
end.