Contributor: BILL KIRBY
{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 000ドルf)+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 000ドルf)+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 [6ドルa..8ドルf]) 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 ioresult0 then
begin
writeln('error opening ',HEADFILENAME);
halt(1);
end;
assign(mapfile,GAMEPATH+MAPFILENAME);
{$I-}
reset(mapfile,1);
{$I+}
if ioresult0 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 (nextdatadata) 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]:= 8ドルc; 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 doserror0 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 doserror0 then
begin
GAME_VERSION:=1.1;
MAPFILENAME:='GAMEMAPS'+ext;
filename:=GAMEPATH+'GAMEMAPS'+ext;
findfirst(filename,$ff,search);
if doserror0 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 doserror0 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[3ドルda];
port[3ドルc0]:= 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[3ドルda];
port[3ドルc0]:= 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 (oldxx) or (oldyy) or keypressed or
(mouseloc.buttonstatus0); oldx:= x;
oldy:= y;
if (mouseloc.buttonstatus0) 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 [6ドルa..8ドルf]) 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.buttonstatus0 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 (newjj) 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 (oldjj) or (oldii) 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.