program _08mview; {starting number 8}
{!!! WARNING : CLICKING REGIONS IN LEVEL 4 FILES IS NOT WORKING ALWAYS O.K.
 !!! BUT THE PROGRAM WILL READ THESE FILES}
uses dos; {dos - standard BP unit}

const
 defsize = 200; {default size of each dynamic entry in map}
 always : boolean = false;
 shown : boolean = false;

var
 fn : string; {filename}
 sr : searchrec;
 f : text; {input text file}
 s : string; {temporary string}
 level,index,line : longint; {MDF file level; actual index}
 b,b2 : byte; {indexing variable}
 w : word; {temporary variable}
 beg,len : byte; {string-to-number-converting variables}
 x1,y1,x2,y2,xx1,yy1,xx2,yy2 : longint;
 map : array[1..239] of record {the map}
                         areas : word; {number of areas => sizeof(data)=areas*8}
                         data : pointer; {sequences of X1 Y1 X2 Y2 ...}
                        end;
 oldmode : byte; {original (text) video mode}
 pal : array[0..255,1..3] of byte; {VGA color palette}
 temp : array[1..14,1..3] of byte; {temporary palette cut}
 oldint1c : procedure; {old interrupt 1Ch vector - user timer routines}
 k : char;
 mx,my,but,x,y : word; {mouse and calculations variables}
 all : boolean; {help variable}
 selected : byte; {actually selected index}
 csh : byte; {color shift in user palette}
 intc : longint; {timer}
 tempp : pointer; {temporary pointer}

procedure Usage; {displays program syntax}
begin
 writeln;
 writeln('Syntax : ',paramstr(0),' <FILENAME>');
 writeln;
 writeln('<FILENAME>  An MDF map description');
 writeln;
end;

function strtoint(s : string) : longint; {converts positive numeric string to LongInteger}
var
 er : integer;
 out : longint;
begin
 val(s,out,er);
 if er <> 0 then out := -1; {not a valid number}
 strtoint := out;
end;

function InttoStr(l : longint) : string;
var
 out : string;
begin
 str(l,out);
 inttostr := out;
end;

procedure GetNextNull(s : string;start : byte;var beg,len : byte); {returns the starting position
 and length of a number in string}
var
 b : byte;
begin
 for b := start to length(s) do if (s[b] in ['0'..'9']) then break;
 beg := b;
 for b := beg to length(s) do if not (s[b] in ['0'..'9']) then break;
 if (b = length(s)) and (s[b] in ['0'..'9']) then inc(b);
 len := b-beg;
end;

procedure ParError(s : string);
var
 k : char;
begin
 writeln;
 writeln('Parsing error : ',s);
 if always then exit;
 write('Forget this entry and Continue, Exit or Always continue (C/E/A) : ');
 repeat
  asm
   xor ax,ax
   int 16h
   mov k,al
  end;
 until upcase(k) in ['C','E','A'];
 writeln(upcase(k));
 case upcase(k) of
  'E' : halt(1);
  'A' : always := true;
 end;
end;

procedure swap(var a,b : word);
var
 c : word;
begin
 if a > b then begin
  c := a;
  a := b;
  b := c;
 end;
end;

procedure Bar(x1,y1,x2,y2 : word;color : byte);
var
 y : word;
 len : word;
begin
 swap(x1,x2);
 swap(y1,y2);
 len := x2-x1+1;
 for y := y1 to y2 do fillchar(mem[segA000:y*320+x1],len,color);
end;

procedure Box(x1,y1,x2,y2 : word;color : byte);
var
 y : word;
 len : word;
begin
 swap(x1,x2);
 swap(y1,y2);
 len := x2-x1+1;
 fillchar(mem[segA000:y1*320+x1],len,color);
 fillchar(mem[segA000:y2*320+x1],len,color);
 for y := y1+1 to y2-1 do begin
  mem[segA000:y*320+x1] := color;
  mem[segA000:y*320+x2] := color;
 end
end;

procedure ShowMouse; assembler;
asm
 cmp shown,true
 je @end
 mov ax,0001h
 int 33h
 mov shown,true
 @end:
end;

procedure HideMouse; assembler;
asm
 cmp shown,false
 je @end
 mov ax,0002h
 int 33h
 mov shown,false
 @end:
end;

procedure drawindex(i : byte);
begin
 if map[i].areas > 0 then for b2 := 1 to map[i].areas do begin
  with map[i] do begin
   x1 := memw[seg(data^):ofs(data^)+(b2-1)*8];
   y1 := memw[seg(data^):ofs(data^)+(b2-1)*8+2];
   x2 := memw[seg(data^):ofs(data^)+(b2-1)*8+4];
   y2 := memw[seg(data^):ofs(data^)+(b2-1)*8+6];
  end;
  bar(x1,y1,x2,y2,i);
 end;
end;

procedure TestDraw(x,y : word);
begin
 all := true;
 for b := 1 to map[index].areas do begin
  if b = b2 then continue;
  with map[index] do begin
   xx1 := memw[seg(data^):ofs(data^)+(b2-1)*8];
   yy1 := memw[seg(data^):ofs(data^)+(b2-1)*8+2];
   xx2 := memw[seg(data^):ofs(data^)+(b2-1)*8+4];
   yy2 := memw[seg(data^):ofs(data^)+(b2-1)*8+6];
  end;
  if (x > xx1) and (x < xx2) and (y > yy1) and (y < yy2) then begin
   all := false;
   break;
  end;
 end;
 if all then mem[segA000:longint(y)*320+x] := 255;
end;

procedure SetPal; assembler;
asm
 mov ax,1012h
 xor bx,bx
 mov cx,256
 mov dx,seg pal
 mov es,dx
 mov dx,offset pal
 int 10h
end;

procedure GetMouseStatus(var x,y,but : word);
var
 tx,ty,tb : word;
begin
 asm
  mov ax,0003h
  int 33h
  mov tb,bx
  shr cx,1
  mov tx,cx
  mov ty,dx
 end;
 x := tx;
 y := ty;
 but := tb;
end;

procedure NewInt1c; interrupt;
begin
 inc(intc);
 asm
  pushf
 end;
 oldint1c;
end;

begin
 selected := 0;
 csh := 1;
 intc := 0;
 if paramcount < 1 then begin {no cmdline parameter}
  usage;
  halt(1);
 end;
 asm {testing if mouse is installated}
  mov ax,0000h
  int 33h
  mov w,ax
 end;
 if w = 0 then begin
  writeln('You need Microsoft or Logitech compatible mouse and driver');
  writeln('to start this program');
  halt(1);
 end;
 fn := paramstr(1);
 findfirst(fn,archive,sr);
 if DosError <> 0 then begin {file fn not found}
  writeln('File ',fn,' doesn''t exist');
  usage;
  halt(1);
 end;
 findnext(sr);
 if DosError = 0 then begin {more than one file exist}
  writeln('Don''t use wildcards');
  usage;
  halt(1);
 end;
 assign(f,fn);
 reset(f);
 readln(f,s); {reads the identificator and level number}
 if copy(s,1,4) <> 'MDF/' then begin
  writeln('File ',fn,' is not a valid MDF file');
  usage;
  halt(1);
 end;
 level := strtoint(copy(s,5,1));
 if (level < 1) or (level > 4) then begin
  writeln('Ony level 1,2,3 and 4 files are supported');
  usage;
  halt(1);
 end;
 if maxavail < 240*defsize*8 then begin
  writeln;
  writeln('Fatal error : no enought memory');
  halt(1)
 end;
 for b := 1 to 239 do begin {setup clear map}
  map[b].areas := 0;
  getmem(map[b].data,defsize*8); {default size for each data entry, can be changed if needed}
 end;
 write('Parsing');
 line := 1;
 while not eof(f) do begin {read all lines in the text file}
  inc(line);
  write('.');
  readln(f,s); {read the line}
  getnextnull(s,1,beg,len); {finds the index entry}
  index := strtoint(copy(s,beg,len)); {reads the index entry}
  if (index < 1) or (index > 239) then begin
   parerror('index entry on line '+inttostr(line)+' invalid');
   continue;
  end;
  getnextnull(s,beg+len,beg,len);
  x1 := strtoint(copy(s,beg,len)); {reads the X1 entry}
  if (x1 < 0) or (x1 > 319) then begin
   parerror('X1 entry on line '+inttostr(line)+' invalid');
   continue;
  end;
  getnextnull(s,beg+len,beg,len);
  y1 := strtoint(copy(s,beg,len)); {reads the Y1 entry}
  if (y1 < 0) or (y1 > 199) then begin
   parerror('Y1 entry on line '+inttostr(line)+' invalid');
   continue;
  end;
  getnextnull(s,beg+len,beg,len);
  x2 := strtoint(copy(s,beg,len)); {reads the X2 entry}
  if (x2 < 0) or (x2 > 319) then begin
   parerror('X2 entry on line '+inttostr(line)+' invalid');
   continue;
  end;
  getnextnull(s,beg+len,beg,len);
  y2 := strtoint(copy(s,beg,len)); {reads the Y2 entry}
  if (y2 < 0) or (y2 > 199) then begin
   parerror('Y2 entry on line '+inttostr(line)+' invalid');
   continue;
  end;
  inc(map[index].areas); {incements the number of areas/regions for the given index}
  if map[index].areas = defsize+1 then begin {the resulting data are larger then actualy allocated}
   getmem(tempp,defsize*8); {allocating a temporary buffer}
   move(map[index].data^,tempp^,defsize*8);
   freemem(map[index].data,defsize*8);
   if maxavail < 65520 then begin
    writeln;
    writeln('Fatal error : no enought memory');
    halt(1)
   end;
   getmem(map[index].data,65520); {allocating maximum size}
   move(tempp^,map[index].data^,defsize*8);
   freemem(tempp,defsize*8);
  end;
  with map[index] do begin {writing X1, Y1, X2 and Y2 entries}
   memw[seg(data^):ofs(data^)+(areas-1)*8] := x1;
   memw[seg(data^):ofs(data^)+(areas-1)*8+2] := y1;
   memw[seg(data^):ofs(data^)+(areas-1)*8+4] := x2;
   memw[seg(data^):ofs(data^)+(areas-1)*8+6] := y2;
  end;
 end;
 writeln;
 asm
  mov ah,0Fh
  int 10h    {getting current display mode}
  mov oldmode,al
  mov ax,13h
  int 10h {setting 320x200x8}
 end;
 pal[0,1] := 0;
 pal[0,2] := 0;
 pal[0,3] := 0;
 for b := 1 to 239 do begin {setting palette - no optimalisation done}
  pal[b,1] := longint((b shr 5)*255) div 7 shr 2;
  pal[b,2] := longint(((b shr 2) and 7)*255) div 7 shr 2;
  pal[b,3] := longint((b and 3)*255) div 3 shr 2;
 end;
 for b := 240 to 247 do begin {setting "user" palette}
  pal[b,1] := (b-240)*9;
  pal[b,2] := (b-240)*9;
  pal[b,3] := (b-240)*9;
 end;
 for b := 248 to 254 do begin
  pal[b,1] := integer(7-b+248)*9;
  pal[b,2] := integer(7-b+248)*9;
  pal[b,3] := integer(7-b+248)*9;
 end;
 pal[255,1] := 63;
 pal[255,2] := 63;
 pal[255,3] := 63;
 setpal;
 for b := 1 to 239 do drawindex(b);
 getintvec($1C,@oldint1c);
 setintvec($1C,addr(newint1c)); {set new 1Ch (user timer) interrupt vector}
 showmouse;
 repeat {clears the keyboard buffer}
  asm
   mov ah,01h
   int 16h
   mov k,al
  end;
 until k = #0;
 repeat
  asm
   mov ah,01h
   int 16h {is any key pressed}
   mov k,al
  end;
  if intc > 1 then begin
   if selected <> 0 then begin {palette rotating in 1/18 sec. intervals}
    for b := 0 to 13 do begin
     b2 := b+csh;
     if b2 > 14 then b2 := b2-14;
     temp[b2,1] := pal[240+b,1];
     temp[b2,2] := pal[240+b,2];
     temp[b2,3] := pal[240+b,3];
    end;
    {!!! A wait for a vertical monitor retrace should be made here, but}
    {!!! I don't remember without the documentation how to do it. Howewer,}
    {!!! it would remove the horrible horizontal blaking on S3 chips}
    asm
     mov ax,1012h
     mov bx,241
     mov cx,14
     mov dx,seg temp
     mov es,dx
     mov dx,offset temp
     int 10h
    end;
    inc(csh);
    if csh > 13 then csh := 1;
   end;
   intc := 0;
  end;
  getmousestatus(mx,my,but); {reading current mouse status}
  if (but and 1 = 1) then begin {!!! WARNING : SELECTING REGIONS IN LEVEL 4 FILES IS NOT WORKING ALWAYS O.K.}
   index := mem[segA000:longint(my)*320+mx]; {which index was selected}
   if (index < 1) or (index > 239) then continue;
   hidemouse;
   if (selected > 0) and (selected < 240) then drawindex(selected); {redraw previously selected index}
   if map[index].areas = 0 then continue; {is the index defined in map}
   selected := index;
   for b2 := 1 to map[index].areas do begin {temporary highlight the region}
    with map[index] do begin
     x1 := memw[seg(data^):ofs(data^)+(b2-1)*8];
     y1 := memw[seg(data^):ofs(data^)+(b2-1)*8+2];
     x2 := memw[seg(data^):ofs(data^)+(b2-1)*8+4];
     y2 := memw[seg(data^):ofs(data^)+(b2-1)*8+6];
    end;
    y := y1;
    for x := x1 to x2 do testdraw(x,y);
    y := y2;
    for x := x1 to x2 do testdraw(x,y);
    x := x1;
    for y := y1 to y2 do testdraw(x,y);
    x := x2;
    for y := y1 to y2 do testdraw(x,y);
   end;
   repeat {convert temporary highlighting to nice spreaded}
    x1 := -1;
    for y := 0 to 199 do for x := 0 to 319 do if mem[segA000:longint(y)*320+x] = 255 then begin
     x1 := x;
     y1 := y;
     x := 319; {this is a bit dirty way to cancel two loops inside themselves}
     y := 199;
    end;
    if x1 = -1 then break;
    b := 1;
    x := x1;
    y := y1;
    repeat
     all := true;
     if all and (mem[segA000:longint(y)*320+x+1] = 255) then begin
      all := false;
      inc(x);
     end;
     if all and (mem[segA000:longint(y)*320+x-1] = 255) then begin
      all := false;
      dec(x);
     end;
     if all and (mem[segA000:longint(y+1)*320+x] = 255) then begin
      all := false;
      inc(y);
     end;
     if all and (mem[segA000:longint(y-1)*320+x] = 255) then begin
      all := false;
      dec(y);
     end;
     if all and (mem[segA000:longint(y+1)*320+x+1] = 255) then begin
      all := false;
      inc(x);
      inc(y);
     end;
     if all and (mem[segA000:longint(y-1)*320+x-1] = 255) then begin
      all := false;
      dec(x);
      dec(y);
     end;
     if all and (mem[segA000:longint(y+1)*320+x-1] = 255) then begin
      all := false;
      dec(x);
      inc(y);
     end;
     if all and (mem[segA000:longint(y-1)*320+x+1] = 255) then begin
      all := false;
      inc(x);
      dec(y);
     end;
     if not all then mem[segA000:longint(y)*320+x] := 240+b;
     inc(b);
     if b > 14 then b := 1;
    until all;
   until false;
   showmouse;
  end;
 until k = #27;
 setintvec($1C,addr(oldint1c)); {restore old 1Ch interrupt vector}
 asm
  xor ah,ah
  mov al,oldmode
  int 10h {restore old display mode}
 end;
end.