[Back to MISC SWAG index]  [Back to Main SWAG index]  [Original]

{Well, here it is, this is 1 of 2}

{
  MapEdit 4.1     Wolfenstein Map Editor

     Copyright (c) 1992  Bill Kirby
}

{$A+,B-,D+,E-,F-,G-,I+,L-,N-,O-,R-,S-,V-,X-}
{$M 16384,0,655360}
program mapedit;

uses crt,dos,graph,mouse; { mouse unit in MOUSE.SWG }

const MAP_X = 6;
      MAP_Y = 6;
      TEXTLOC = 460;

      GAMEPATH     : string = '.\';
      HEADFILENAME : string = 'maphead';
      MAPFILENAME  : string = 'maptemp';
      LEVELS       : word   = 10;
      GAME_VERSION : real   = 1.0;

type data_block = record
       size : word;
       data : pointer;
     end;

     level_type = record
       map,
       objects,
       other           : data_block;
       width,
       height          : word;
       name            : string[16];
     end;

     grid = array[0..63,0..63] of word;

     filltype = (solid,check);
     doortype = (horiz,vert);


var levelmap,
    objectmap    : grid;
    maps         : array[1..60] of level_type;

    show_objects,
    show_floor   : boolean;

    mapgraph,
    objgraph     : array[0..511] of string[4];
    mapnames,
    objnames     : array[0..511] of string[20];

    themouse  : resetrec;
    mouseloc  : locrec;

procedure waitforkey;
var key: char;
begin
  repeat until keypressed;
  key:= readkey;
  if key=#0 then key:= readkey;
end;

procedure getkey(var key: char; var control: boolean);
begin
  control:= false;
  key:= readkey;
  if key=#0 then
    begin
      control:= true;
      key:= readkey;
    end;
end;

procedure decorate(x,y,c: integer);
var i,j: integer;
begin
  setfillstyle(1,c);
  bar(x*7+MAP_X+2,y*7+MAP_Y+2,x*7+MAP_X+4,y*7+MAP_Y+4);
end;

procedure box(fill: filltype; x,y,c1,c2: integer; dec: boolean);
begin
  if fill=solid then
    setfillstyle(1,c1)
  else
    setfillstyle(9,c1);

  bar(x*7+MAP_X,y*7+MAP_Y,x*7+6+MAP_X,y*7+6+MAP_Y);
  if dec then decorate(x,y,c2);
end;

procedure outtext(x,y,color: integer; s: string);
begin
  setcolor(color);
  outtextxy(x*7+MAP_X,y*7+MAP_Y,s);
end;

function hex(x: word): string;
const digit : string[16] = '0123456789ABCDEF';
var temp : string[4];
    i    : integer;
begin
  temp:= '    ';
  for i:= 4 downto 1 do
    begin
      temp[i]:= digit[(x and $000f)+1];
      x:= x div 16;
    end;
  hex:= temp;
end;

function hexbyte(x: byte): string;
const digit : string[16] = '0123456789ABCDEF';
var temp : string[4];
    i    : integer;
begin
  temp:= '  ';
  for i:= 2 downto 1 do
    begin
      temp[i]:= digit[(x and $000f)+1];
      x:= x div 16;
    end;
  hexbyte:= temp;
end;

procedure doline(x,y,x2,y2: integer);
begin
  line(x+MAP_X,y+MAP_Y,x2+MAP_X,y2+MAP_Y);
end;

procedure dobar(x,y,x2,y2: integer);
begin
  bar(x+MAP_Y,y+MAP_Y,x2+MAP_X,y2+MAP_Y);
end;

procedure circle(x,y,c1,c2: integer);
const sprite : array[0..6,0..6] of byte =
                   ((0,0,1,1,1,0,0),
                    (0,1,1,1,1,1,0),
                    (1,1,1,2,1,1,1),
                    (1,1,2,2,2,1,1),
                    (1,1,1,2,1,1,1),
                    (0,1,1,1,1,1,0),
                    (0,0,1,1,1,0,0));
var i,j,c: integer;
begin
  for i:= 0 to 6 do
    for j:= 0 to 6 do
      begin
        case sprite[i,j] of
          0: c:=0;
          1: c:=c1;
          2: c:=c2;
        end;
        putpixel(x*7+MAP_X+i,y*7+MAP_Y+j,c);
      end;
end;

procedure door(dtype: doortype; x,y,color: integer);
begin
  case dtype of
    vert: begin
            setfillstyle(1,color);
            dobar(x*7+2,y*7,x*7+4,y*7+6);
          end;
    horiz : begin
              setfillstyle(1,color);
              dobar(x*7,y*7+2,x*7+6,y*7+4);
          end;
  end;
end;

function hexnibble(c: char): byte;
begin
  case c of
    '0'..'9': hexnibble:= ord(c)-ord('0');
    'a'..'f': hexnibble:= ord(c)-ord('a')+10;
    'A'..'F': hexnibble:= ord(c)-ord('A')+10;
    else hexnibble:= 0;
  end;
end;

procedure output(x,y: integer; data: string);
var size  : integer;
    temp  : string[4];
    c1,c2 : byte;
begin
  if data<>'0000' then
    begin
      temp:= data;
      c1:= hexnibble(temp[1]);
      c2:= hexnibble(temp[2]);
      case temp[3] of
        '0': outtext(x,y,c1,temp[4]);
        '1': box(solid,x,y,c1,c2,false);
        '2': box(check,x,y,c1,c2,false);
        '3': box(solid,x,y,c1,c2,true);
        '4': box(check,x,y,c1,c2,true);
        '5': circle(x,y,c1,c2);
        '6': door(horiz,x,y,c1);
        '7': door(vert,x,y,c1);
        '8': begin
               setfillstyle(1,c1);
               dobar(x*7,y*7,x*7+6,y*7+3);
               setfillstyle(1,c2);
               dobar(x*7,y*7+4,x*7+6,y*7+6);
              end;
        '9': putpixel(x*7+MAP_X+3,y*7+MAP_Y+3,c1);
        'a': begin setfillstyle(1,c1); dobar(x*7+2,y*7+1,x*7+4,y*7+5); end;
        'b': begin setfillstyle(1,c1); dobar(x*7+2,y*7+2,x*7+4,y*7+4); end;
        'c': begin setfillstyle(1,c1); dobar(x*7+1,y*7+1,x*7+5,y*7+5); end;
        'd': begin
               setcolor(c1);
               doline(x*7+1,y*7+1,x*7+5,y*7+5);
               doline(x*7+5,y*7+1,x*7+1,y*7+5);
             end;
        'e': begin
               setcolor(c1);
               rectangle(x*7+MAP_X,y*7+MAP_Y,x*7+MAP_X+6,y*7+MAP_Y+6);
             end;
        'f': case c2 of
              2: begin {east}
                   setcolor(c1);
                   doline(x*7,y*7+3,x*7+6,y*7+3);
                   doline(x*7+6,y*7+3,x*7+3,y*7);
                   doline(x*7+6,y*7+3,x*7+3,y*7+6);
                end;
              0: begin {north}
                   setcolor(c1);
                   doline(x*7+3,y*7+6,x*7+3,y*7);
                   doline(x*7+3,y*7,x*7,y*7+3);
                   doline(x*7+3,y*7,x*7+6,y*7+3);
                 end;
              6: begin {west}
                   setcolor(c1);
                   doline(x*7+6,y*7+3,x*7,y*7+3);
                   doline(x*7,y*7+3,x*7+3,y*7);
                   doline(x*7,y*7+3,x*7+3,y*7+6);
                 end;
              4: begin {south}
                   setcolor(c1);
                   doline(x*7+3,y*7,x*7+3,y*7+6);
                   doline(x*7+3,y*7+6,x*7,y*7+3);
                   doline(x*7+3,y*7+6,x*7+6,y*7+3);
                 end;
              1: begin {northeast}
                   setcolor(c1);
                   doline(x*7,y*7+6,x*7+6,y*7);
                   doline(x*7+6,y*7,x*7+3,y*7);
                   doline(x*7+6,y*7,x*7+6,y*7+3);
                 end;
              7: begin {northwest}
                   setcolor(c1);
                   doline(x*7+6,y*7+6,x*7,y*7);
                   doline(x*7,y*7,x*7+3,y*7);
                   doline(x*7,y*7,x*7,y*7+3);
                 end;
              3: begin {southeast}
                   setcolor(c1);
                   doline(x*7,y*7,x*7+6,y*7+6);
                   doline(x*7+6,y*7+6,x*7+3,y*7+6);
                   doline(x*7+6,y*7+6,x*7+6,y*7+3);
                 end;
              5: begin {southwest}
                   setcolor(c1);
                   doline(x*7+6,y*7,x*7,y*7+6);
                   doline(x*7,y*7+6,x*7+3,y*7+6);
                   doline(x*7,y*7+6,x*7,y*7+3);
                 end;

             end;
      end;
    end;
end;

procedure display_map;
var i,j: integer;
begin
  j:= 63;
  i:= 0;
  repeat
    setfillstyle(1,0);
    dobar(i*7,j*7,i*7+6,j*7+6);
    if show_floor then
      output(i,j,mapgraph[levelmap[i,j]])
    else
      if not (levelmap[i,j] in [$6a..$8f]) then
        output(i,j,mapgraph[levelmap[i,j]]);
    if show_objects then
      output(i,j,objgraph[objectmap[i,j]]);
    inc(i);
    if i=64 then
      begin
        i:= 0;
        dec(j);
      end;
  until (j<0) or keypressed;
end;

procedure read_levels;
var headfile,
    mapfile  : file;
    s,o,
    size     : word;
    idsig    : string[4];
    level    : integer;
    levelptr : longint;
    tempstr  : string[16];
    map_pointer,
    object_pointer,
    other_pointer    : longint;

begin
  idsig:= '    ';
  tempstr:= '                ';
  assign(headfile,GAMEPATH+HEADFILENAME);
  {$I-}
  reset(headfile,1);
  {$I+}
  if ioresult<>0 then
    begin
      writeln('error opening ',HEADFILENAME);
      halt(1);
    end;
  assign(mapfile,GAMEPATH+MAPFILENAME);
  {$I-}
  reset(mapfile,1);
  {$I+}
  if ioresult<>0 then
    begin
      writeln('error opening ',MAPFILENAME);
      halt(1);
    end;

  for level:= 1 to LEVELS do
    begin
      seek(headfile,2+(level-1)*4);
      blockread(headfile,levelptr,4);
      seek(mapfile,levelptr);
      with maps[level] do
        begin
          blockread(mapfile,map_pointer,4);
          blockread(mapfile,object_pointer,4);
          blockread(mapfile,other_pointer,4);
          blockread(mapfile,map.size,2);
          blockread(mapfile,objects.size,2);
          blockread(mapfile,other.size,2);
          blockread(mapfile,width,2);
          blockread(mapfile,height,2);
          name[0]:=#16;
          blockread(mapfile,name[1],16);
          if GAME_VERSION = 1.1 then
            blockread(mapfile,idsig[1],4);

          seek(mapfile,map_pointer);
          getmem(map.data,map.size);
          s:= seg(map.data^);
          o:= ofs(map.data^);
          blockread(mapfile,mem[s:o],map.size);

          seek(mapfile,object_pointer);
          getmem(objects.data,objects.size);
          s:= seg(objects.data^);
          o:= ofs(objects.data^);
          blockread(mapfile,mem[s:o],objects.size);

          seek(mapfile,other_pointer);
          getmem(other.data,other.size);
          s:= seg(other.data^);
          o:= ofs(other.data^);
          blockread(mapfile,mem[s:o],other.size);
          if GAME_VERSION = 1.0 then
            blockread(mapfile,idsig[1],4);
        end;
    end;
  close(mapfile);
  close(headfile);
end;

procedure write_levels;
var headfile,
    mapfile    : file;
    abcd,
    s,o,
    size     : word;
    idsig    : string[4];
    level    : integer;
    levelptr : longint;
    tempstr  : string[16];
    map_pointer,
    object_pointer,
    other_pointer    : longint;

begin
  abcd:= $abcd;
  idsig:= '!ID!';
  tempstr:= 'TED5v1.0';
  assign(headfile,GAMEPATH+HEADFILENAME);
  rewrite(headfile,1);
  assign(mapfile,GAMEPATH+MAPFILENAME);
  rewrite(mapfile,1);

  blockwrite(headfile,abcd,2);
  blockwrite(mapfile,tempstr[1],8);
  levelptr:= 8;

  for level:= 1 to LEVELS do
    begin
      with maps[level] do
        begin
          if GAME_VERSION = 1.1 then
            begin
              map_pointer:= levelptr;
              s:= seg(map.data^);
              o:= ofs(map.data^);
              blockwrite(mapfile,mem[s:o],map.size);
              inc(levelptr,map.size);

              object_pointer:= levelptr;
              s:= seg(objects.data^);
              o:= ofs(objects.data^);
              blockwrite(mapfile,mem[s:o],objects.size);
              inc(levelptr,objects.size);

              other_pointer:= levelptr;
              s:= seg(other.data^);
              o:= ofs(other.data^);
              blockwrite(mapfile,mem[s:o],other.size);
              inc(levelptr,other.size);

              blockwrite(headfile,levelptr,4);

              blockwrite(mapfile,map_pointer,4);
              blockwrite(mapfile,object_pointer,4);
              blockwrite(mapfile,other_pointer,4);
              blockwrite(mapfile,map.size,2);
              blockwrite(mapfile,objects.size,2);
              blockwrite(mapfile,other.size,2);
              blockwrite(mapfile,width,2);
              blockwrite(mapfile,height,2);
              name[0]:=#16;
              blockwrite(mapfile,name[1],16);
              inc(levelptr,38);
            end
          else
            begin
              blockwrite(headfile,levelptr,4);
              map_pointer:= levelptr+38;
              object_pointer:= map_pointer+map.size;
              other_pointer:= object_pointer+objects.size;

              blockwrite(mapfile,map_pointer,4);
              blockwrite(mapfile,object_pointer,4);
              blockwrite(mapfile,other_pointer,4);
              blockwrite(mapfile,map.size,2);
              blockwrite(mapfile,objects.size,2);
              blockwrite(mapfile,other.size,2);
              blockwrite(mapfile,width,2);
              blockwrite(mapfile,height,2);
              name[0]:=#16;
              blockwrite(mapfile,name[1],16);

              s:= seg(map.data^);
              o:= ofs(map.data^);
              blockwrite(mapfile,mem[s:o],map.size);
              s:= seg(objects.data^);
              o:= ofs(objects.data^);
              blockwrite(mapfile,mem[s:o],objects.size);
              s:= seg(other.data^);
              o:= ofs(other.data^);
              blockwrite(mapfile,mem[s:o],other.size);
              inc(levelptr,map.size+objects.size+other.size+38);
            end;
          blockwrite(mapfile,idsig[1],4);
          inc(levelptr,4);
        end;
    end;
  close(mapfile);
  close(headfile);
end;

procedure a7a8_expand(src: data_block; var dest: data_block);
var s,o,
    s2,o2,
    index,
    index2,
    size,
    length,
    data,
    newsize  : word;
    goback1  : byte;
    goback2  : word;
    i        : integer;

begin
  s:=seg(src.data^);
  o:=ofs(src.data^);
  index:=0;
  move(mem[s:o+index],dest.size,2); inc(index,2);
  getmem(dest.data,dest.size);
  s2:=seg(dest.data^);
  o2:=ofs(dest.data^);
  index2:=0;

  repeat
    move(mem[s:o+index],data,2); inc(index,2);
    case hi(data) of
      $a7: begin
             length:=lo(data);
             move(mem[s:o+index],goback1,1); inc(index,1);
             move(mem[s2:o2+index2-goback1*2],mem[s2:o2+index2],length*2);
             inc(index2,length*2);
           end;
      $a8: begin
             length:=lo(data);
             move(mem[s:o+index],goback2,2); inc(index,2);
             move(mem[s2:o2+goback2*2],mem[s2:o2+index2],length*2);
             inc(index2,length*2);
           end;
      else begin
             move(data,mem[s2:o2+index2],2);
             inc(index2,2);
           end;
    end;
  until index=src.size;
end;

procedure expand(d: data_block; var g: grid);
var i,x,y : integer;
    s,o,
    data,
    count : word;
    temp  : data_block;
begin
  if GAME_VERSION = 1.1 then
    a7a8_expand(d,temp)
  else
    temp:=d;

  x:= 0;
  y:= 0;
  s:= seg(temp.data^);
  o:= ofs(temp.data^);
  inc(o,2);
  while (y<64) do
    begin
      move(mem[s:o],data,2); inc(o,2);
      if data=$abcd then
        begin
          move(mem[s:o],count,2); inc(o,2);
          move(mem[s:o],data,2); inc(o,2);
          for i:= 1 to count do
            begin
              g[x,y]:= data;
              inc(x);
              if x=64 then
                begin
                  x:= 0;
                  inc(y);
                end;
            end;
        end
      else
        begin
          g[x,y]:= data;
          inc(x);
          if x=64 then
            begin
              x:= 0;
              inc(y);
            end;
        end;
    end;
  if GAME_VERSION=1.1 then
    freemem(temp.data,temp.size);
end;

procedure compress(g: grid; var d: data_block);
var temp     : pointer;
    size: word;
    abcd,
    s,o,
    olddata,
    data,
    nextdata,
    count    : word;
    x,y,i    : integer;
    temp2    : pointer;

begin
  abcd:= $abcd;
  x:= 0;
  y:= 0;
  getmem(temp,8194);
  s:= seg(temp^);
  o:= ofs(temp^);
  data:= $2000;
  move(data,mem[s:o],2);

  size:= 2;
  data:= g[0,0];
  while (y<64) do
    begin
      count:= 1;
      repeat
        inc(x);
        if x=64 then
          begin
            x:=0;
            inc(y);
          end;
        if y<64 then
          nextdata:= g[x,y];
        inc(count);
      until (nextdata<>data) or (y=64);
      dec(count);
      if count<3 then
        begin
          for i:= 1 to count do
            begin
              move(data,mem[s:o+size],2);
              inc(size,2);
            end;
        end
      else
        begin
          move(abcd,mem[s:o+size],2);
          inc(size,2);
          move(count,mem[s:o+size],2);
          inc(size,2);
          move(data,mem[s:o+size],2);
          inc(size,2);
        end;
      data:= nextdata;
    end;
  getmem(temp2,size);
  move(temp^,temp2^,size);
  freemem(temp,8194);
  if GAME_VERSION = 1.1 then
    begin
      getmem(temp,size+2);
      s:= seg(temp^);
      o:= ofs(temp^);
      move(size,mem[s:o],2);
      move(temp2^,mem[s:o+2],size);
      d.data:=temp;
      d.size:= size+2;
      freemem(temp2,size);
    end
  else
    begin
      d.data:= temp2;
      d.size:= size;
    end;
end;

procedure clear_level(n: integer);
var x,y: integer;
begin
   mhide;
   for x:= 0 to 63 do
     for y:= 0 to 63 do
       begin
         levelmap[x,y]:= $8c;
         objectmap[x,y]:= 0;
       end;
   for x:= 0 to 63 do
     begin
       levelmap[x,0]:= 1;
       levelmap[x,63]:= 1;
       levelmap[0,x]:= 1;
       levelmap[63,x]:= 1;
     end;
   display_map;
   mshow;
end;

function str_to_hex(s: string): word;
var temp : word;
    i    : integer;
begin
  temp:= 0;
  for i:= 1 to length(s) do
    begin
      temp:= temp * 16;
      case s[i] of
        '0'..'9': temp:= temp + ord(s[i])-ord('0');
        'a'..'f': temp:= temp + ord(s[i])-ord('a')+10;
        'A'..'F': temp:= temp + ord(s[i])-ord('A')+10;
      end;
    end;
  str_to_hex:= temp;
end;

procedure showlegend(which,start,n: integer);
var i,x,y: integer;
    save: boolean;
begin
  mhide;
  save:= show_objects;
  show_objects:= true;
  setfillstyle(1,0);
  bar(64*7+MAP_X+13,4,639-5,380-30);
  x:= 66;
  y:= 0;
  for i:= start to start+n-1 do
    begin
      if which=0 then
        begin
          output(x,y,mapgraph[i]);
          outtext(x+2,y,15,mapnames[i]);
        end
      else
        begin
          output(x,y,objgraph[i]);
          outtext(x+2,y,15,objnames[i]);
        end;
      inc(y,2);
    end;
  show_objects:= save;
  mshow;
end;

function inside(x1,y1,x2,y2,x,y: integer): boolean;
begin
  inside:= (x>=x1) and (x<=x2) and
           (y>=y1) and (y<=y2);
end;

procedure wait_for_mouserelease;
begin
  repeat
    mpos(mouseloc);
  until mouseloc.buttonstatus=0;
end;

procedure bevel(x1,y1,x2,y2,c1,c2,c3: integer);
begin
  setfillstyle(1,c1);
  bar(x1,y1,x2,y2);
  setcolor(c2);
  line(x1,y1,x2,y1);
  line(x1+1,y1+1,x2-1,y1+1);
  line(x2,y1,x2,y2);
  line(x2-1,y1,x2-1,y2-1);
  setcolor(c3);
  line(x1,y1+1,x1,y2);
  line(x1+1,y1+2,x1+1,y2);
  line(x1,y2,x2-1,y2);
  line(x1+1,y2-1,x2-2,y2-1);
end;

function upper(s: string): string;
var i: integer;
begin
  for i:=1 to length(s) do
    if s[i] in ['a'..'z'] then
      s[i]:=chr(ord(s[i])-ord('a')+ord('A'));
  upper:=s;
end;

procedure initialize;
var i: integer;
    infile: text;

    path : pathstr;
    dir  : dirstr;
    name : namestr;
    ext  : extstr;
    filename  : string;
    hexstr    : string[4];
    graphstr  : string[4];
    name20    : string[20];
    junk      : char;
    search    : searchrec;

begin
  filename:= GAMEPATH + HEADFILENAME + '.*';
  writeln('searching for ',filename);
  findfirst(filename,$ff,search);
  if doserror<>0 then
    begin
      writeln('Error opening ',HEADFILENAME,' file.');
      writeln;
      writeln('Be sure that you installed MAPEDIT in the directory where');
      writeln('Wolfenstein 3-D is installed.');
      halt(0);
    end
  else
    begin
      filename:= search.name;
      fsplit(filename,dir,name,ext);
      HEADFILENAME:= upper(HEADFILENAME+ext);
      if upper(ext)='.WL1' then
        begin
          LEVELS:=10;
          GAME_VERSION:=1.0;
          MAPFILENAME:='MAPTEMP'+ext;
          filename:=GAMEPATH+'MAPTEMP'+ext;
          findfirst(filename,$ff,search);
          if doserror<>0 then
            begin
              GAME_VERSION:=1.1;
              MAPFILENAME:='GAMEMAPS'+ext;
              filename:=GAMEPATH+'GAMEMAPS'+ext;
              findfirst(filename,$ff,search);
              if doserror<>0 then
                begin
                  writeln('Error opening GAMEMAPS or MAPTEMP file.');
                  halt(0);
                end;
            end;
        end;
      if (upper(ext)='.WL3') or (upper(ext)='.WL6') then
        begin
          GAME_VERSION:=1.1;
          if upper(ext)='.WL3' then
            LEVELS:= 30
          else
            LEVELS:= 60;
          MAPFILENAME:='GAMEMAPS'+ext;
          filename:=GAMEPATH+'GAMEMAPS'+ext;
          findfirst(filename,$ff,search);
          if doserror<>0 then
            begin
              writeln('Error opening GAMEMAPS file.');
              halt(0);
            end;
        end;
    end;

  for i:= 0 to 511 do
    begin
      mapnames[i]:= 'unknown '+hex(i);
      objnames[i]:= 'unknown '+hex(i);
      mapgraph[i]:= 'f010';
      objgraph[i]:= 'f010';
    end;
  assign(infile,'mapdata.def');
  reset(infile);
  while not eof(infile) do
    begin
      readln(infile,hexstr,junk,graphstr,junk,name20);
      mapnames[str_to_hex(hexstr)]:= name20;
      mapgraph[str_to_hex(hexstr)]:= graphstr;
    end;
  close(infile);

  assign(infile,'objdata.def');
  reset(infile);
  while not eof(infile) do
    begin
      readln(infile,hexstr,junk,graphstr,junk,name20);
      objnames[str_to_hex(hexstr)]:= name20;
      objgraph[str_to_hex(hexstr)]:= graphstr;
    end;
  close(infile);

end;

var gd,gm,
    i,j,x,y   : integer;
    infile    : text;
    level     : word;
    oldx,oldy : integer;
    done      : boolean;
    outstr,
    tempstr   : string;

    legendpos : integer;
    legendtype: integer;
    newj        : integer;
    currenttype,
    currentval: integer;

    oldj,oldi : integer;

    key       : char;
    control   : boolean;

begin
  clrscr;
  initialize;
  directvideo:=false;
  read_levels;

  gd:= vga;
  gm:= vgahi;
  initgraph(gd,gm,'');

  settextstyle(0,0,1);
  mreset(themouse);

  show_objects:= true;
  show_floor:= false;

  x:= port[$3da];
  port[$3c0]:= 0;

  setfillstyle(1,7);
  bar(0,0,64*7+MAP_X+4,64*7+MAP_Y+4);
  bar(64*7+MAP_X+9,0,639,380);
  setfillstyle(1,0);
  bar(2,2,64*7+MAP_X+2,64*7+MAP_Y+2);
  bar(64*7+MAP_X+11,2,637,380-28);
  bar(64*7+MAP_X+11,380-25,637,378);
  setcolor(15);
  outtextxy(64*7+MAP_X+15,380-16,' MAP  OBJ  UP  DOWN');
  setfillstyle(1,7);
  bar(64*7+MAP_X+11+043,380-25,64*7+MAP_X+11+044,378);
  bar(64*7+MAP_X+11+083,380-25,64*7+MAP_X+11+084,378);
  bar(64*7+MAP_X+11+113,380-25,64*7+MAP_X+11+114,378);

  legendpos:= 0;
  legendtype:= 0;
  currenttype:= 0;
  currentval:= 1;
  setfillstyle(1,0);

  bar(66*7+MAP_X,60*7+MAP_Y,637,61*7+MAP_Y);
  if currenttype=0 then
    begin
      output(66,60,mapgraph[currentval]);
      outtext(67,60,15,' - '+mapnames[currentval]);
    end
  else
    begin
      output(66,60,objgraph[currentval]);
      outtext(67,60,15,' - '+objnames[currentval]);
    end;

  showlegend(legendtype,legendpos,25);

  x:= port[$3da];
  port[$3c0]:= 32;
  mshow;
  level:=1;
  done:= false;
  repeat
    mhide;
    setfillstyle(1,0);
    bar(5,TEXTLOC,64*7-1+MAP_X,477);
    setcolor(15);
    outtextxy(5,TEXTLOC,maps[level].name);
    expand(maps[level].map,levelmap);
    expand(maps[level].objects,objectmap);
    display_map;
    mshow;
    oldx:= 0;
    oldy:= 0;
    key:= #0;
    repeat
      repeat
        mpos(mouseloc);
        x:= mouseloc.column;
        y:= mouseloc.row;
      until (oldx<>x) or (oldy<>y) or keypressed or
(mouseloc.buttonstatus<>0);      oldx:= x;
      oldy:= y;
      if (mouseloc.buttonstatus<>0) then
        begin
          if inside(MAP_X,MAP_Y,64*7+MAP_X-1,64*7+MAP_Y-1,x,y) then
            begin
              mhide;
              repeat
                i:= (x - MAP_X) div 7;
                j:= (y - MAP_Y) div 7;
                if currenttype=0 then
                  levelmap[i,j]:= currentval
                else
                  objectmap[i,j]:= currentval;
                setfillstyle(1,0);
                dobar(i*7,j*7,i*7+6,j*7+6);
                if show_floor then
                  output(i,j,mapgraph[levelmap[i,j]])
                else
                  if not (levelmap[i,j] in [$6a..$8f]) then
                    output(i,j,mapgraph[levelmap[i,j]]);
                if show_objects then
                  output(i,j,objgraph[objectmap[i,j]]);
                mpos(mouseloc);
                x:= mouseloc.column;
                y:= mouseloc.row;
              until (not inside(MAP_X,MAP_Y,64*7+MAP_X-1,64*7+MAP_Y-1,x,y)) or
                    (mouseloc.buttonstatus=0);
              mshow;
            end;
          if inside(464,355,506,378,x,y) then
            begin
              wait_for_mouserelease;
              legendpos:= 0;
              legendtype:= 0;
              showlegend(legendtype,legendpos,25);
            end;
          if inside(509,355,546,378,x,y) then
            begin
              wait_for_mouserelease;
              legendpos:= 0;
              legendtype:= 1;
              showlegend(legendtype,legendpos,25);
            end;
          if inside(549,355,576,378,x,y) then
            begin
              wait_for_mouserelease;
              dec(legendpos,25);
              if legendpos<0 then legendpos:= 0;
              showlegend(legendtype,legendpos,25);
            end;
          if inside(579,355,637,378,x,y) then
            begin
              wait_for_mouserelease;
              inc(legendpos,25);
              if (legendpos+25)>255 then legendpos:= 255-25;
              showlegend(legendtype,legendpos,25);
            end;
        end;
      if inside(464,2,637,350,x,y) then
        begin
          mhide;
          j:= (y-2) div 14;
          setcolor(15);
          rectangle(465,j*14+2+1,636,j*14+2+12);
          repeat
            mpos(mouseloc);
            newj:= (mouseloc.row-2) div 14;
            if mouseloc.buttonstatus<>0 then
              begin
                currenttype:= legendtype;
                currentval:= legendpos+j;
                setfillstyle(1,0);
                bar(66*7+MAP_X,60*7+MAP_Y,637,61*7+MAP_Y);
                if currenttype=0 then
                  begin
                    output(66,60,mapgraph[currentval]);
                    outtext(67,60,15,' - '+mapnames[currentval]);
                  end
                else
                  begin
                    output(66,60,objgraph[currentval]);
                    outtext(67,60,15,' - '+objnames[currentval]);
                  end;
              end;
          until (newj<>j) or (mouseloc.column<464) or keypressed;
          setcolor(0);
          rectangle(465,j*14+2+1,636,j*14+2+12);
          mshow;
        end;

      if inside(MAP_X,MAP_Y,64*7+MAP_X-1,64*7+MAP_Y-1,x,y) then
        begin
          i:= (x - MAP_X) div 7;
          j:= (y - MAP_Y) div 7;
          if (oldj<>j) or (oldi<>i) then
            begin
              outstr:= '(';
              str(i:2,tempstr);
              outstr:= outstr+tempstr+',';
              str(j:2,tempstr);
              outstr:= outstr+tempstr+')    map: '+hex(levelmap[i,j]);
              outstr:= outstr+' - '+mapnames[levelmap[i,j]];
              setfillstyle(1,0);
              setcolor(15);
              bar(100,TEXTLOC,64*7+MAP_X-1,479);
              outtextxy(100,TEXTLOC,outstr);
              outstr:= '        object: '+hex(objectmap[i,j])+' -
'+objnames[objectmap[i,j]];              outtextxy(100,TEXTLOC+10,outstr);
              oldj:= j;
              oldi:= i;
            end;
        end
      else
        begin
          mhide;
          setfillstyle(1,0);
          bar(100,TEXTLOC,360,479);
          mshow;
        end;

      if keypressed then
        begin
          control:= false;
          key:= readkey;
          if key=#0 then
            begin
              control:= true;
              key:= readkey;
            end;
          if control then
            case key of
              'H':
                begin
                  freemem(maps[level].map.data,maps[level].map.size);
                  freemem(maps[level].objects.data,maps[level].objects.size);
                  compress(levelmap,maps[level].map);
                  compress(objectmap,maps[level].objects);
                  inc(level);
                end;
              'P':
                begin
                  freemem(maps[level].map.data,maps[level].map.size);
                  freemem(maps[level].objects.data,maps[level].objects.size);
                  compress(levelmap,maps[level].map);
                  compress(objectmap,maps[level].objects);
                  dec(level);
                end;
            end
          else
            case key of
              'q','Q':
                   begin
                     done:= true;
                     freemem(maps[level].map.data,maps[level].map.size);

freemem(maps[level].objects.data,maps[level].objects.size);
compress(levelmap,maps[level].map);
compress(objectmap,maps[level].objects);                   end;
              'c','C': clear_level(level);
              'o','O': begin
                         mhide;
                         show_objects:= not show_objects;
                         display_map;
                         mshow;
                       end;
              'f','F': begin
                         mhide;
                         show_floor:= not show_floor;
                         display_map;
                         if legendtype=0 then
                           showlegend(legendtype,legendpos,25);
                         mshow;
                       end;
            end;
        end;
    until done or (key in ['P','H']);
    if level=0 then level:=LEVELS;
    if level=(LEVELS+1) then level:=1;
  until done;

  setfillstyle(1,0);
  bar(0,TEXTLOC,639,479);
  setcolor(15);
  outtextxy(0,TEXTLOC,' Save the current levels to disk? (Y/N) ');

  repeat
    repeat until keypressed;
    key:= readkey;
    if key=#0 then
      begin
        key:= readkey;
        key:= #0;
      end;
  until key in ['y','Y','n','N'];

  if key in ['y','Y'] then write_levels;
  textmode(co80);
  writeln('MapEdit 4.1                 Copyright (c) 1992  Bill Kirby');
  writeln;
  writeln('This program is intended to be for your personal use only.');
  writeln('Distribution of any modified maps may be construed as a ');
  writeln('copyright violation by Apogee/ID.');
  writeln;
end.

[Back to MISC SWAG index]  [Back to Main SWAG index]  [Original]