home *** CD-ROM | disk | FTP | other *** search
/ Dominator / DOMINATOR.ISO / dos / utils / wolf3d-d / mapedit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-08-06  |  30.5 KB  |  1,165 lines
  1. {
  2.   MapEdit 4.1     Wolfenstein Map Editor
  3.  
  4.      Copyright (c) 1992  Bill Kirby
  5. }
  6.  
  7. {$A+,B-,D+,E-,F-,G-,I+,L-,N-,O-,R-,S-,V-,X-}
  8. {$M 16384,0,655360}
  9. program mapedit;
  10.  
  11. uses crt,dos,graph,mouse;
  12.  
  13. const MAP_X = 6;
  14.       MAP_Y = 6;
  15.       TEXTLOC = 460;
  16.  
  17.       GAMEPATH     : string = '.\';
  18.       HEADFILENAME : string = 'maphead';
  19.       MAPFILENAME  : string = 'maptemp';
  20.       LEVELS       : word   = 10;
  21.       GAME_VERSION : real   = 1.0;
  22.  
  23. type data_block = record
  24.        size : word;
  25.        data : pointer;
  26.      end;
  27.  
  28.      level_type = record
  29.        map,
  30.        objects,
  31.        other           : data_block;
  32.        width,
  33.        height          : word;
  34.        name            : string[16];
  35.      end;
  36.  
  37.      grid = array[0..63,0..63] of word;
  38.  
  39.      filltype = (solid,check);
  40.      doortype = (horiz,vert);
  41.  
  42.  
  43. var levelmap,
  44.     objectmap    : grid;
  45.     maps         : array[1..60] of level_type;
  46.  
  47.     show_objects,
  48.     show_floor   : boolean;
  49.  
  50.     mapgraph,
  51.     objgraph     : array[0..511] of string[4];
  52.     mapnames,
  53.     objnames     : array[0..511] of string[20];
  54.  
  55.     themouse  : resetrec;
  56.     mouseloc  : locrec;
  57.  
  58. procedure waitforkey;
  59. var key: char;
  60. begin
  61.   repeat until keypressed;
  62.   key:= readkey;
  63.   if key=#0 then key:= readkey;
  64. end;
  65.  
  66. procedure getkey(var key: char; var control: boolean);
  67. begin
  68.   control:= false;
  69.   key:= readkey;
  70.   if key=#0 then
  71.     begin
  72.       control:= true;
  73.       key:= readkey;
  74.     end;
  75. end;
  76.  
  77. procedure decorate(x,y,c: integer);
  78. var i,j: integer;
  79. begin
  80.   setfillstyle(1,c);
  81.   bar(x*7+MAP_X+2,y*7+MAP_Y+2,x*7+MAP_X+4,y*7+MAP_Y+4);
  82. end;
  83.  
  84. procedure box(fill: filltype; x,y,c1,c2: integer; dec: boolean);
  85. begin
  86.   if fill=solid then
  87.     setfillstyle(1,c1)
  88.   else
  89.     setfillstyle(9,c1);
  90.  
  91.   bar(x*7+MAP_X,y*7+MAP_Y,x*7+6+MAP_X,y*7+6+MAP_Y);
  92.   if dec then decorate(x,y,c2);
  93. end;
  94.  
  95. procedure outtext(x,y,color: integer; s: string);
  96. begin
  97.   setcolor(color);
  98.   outtextxy(x*7+MAP_X,y*7+MAP_Y,s);
  99. end;
  100.  
  101. function hex(x: word): string;
  102. const digit : string[16] = '0123456789ABCDEF';
  103. var temp : string[4];
  104.     i    : integer;
  105. begin
  106.   temp:= '    ';
  107.   for i:= 4 downto 1 do
  108.     begin
  109.       temp[i]:= digit[(x and $000f)+1];
  110.       x:= x div 16;
  111.     end;
  112.   hex:= temp;
  113. end;
  114.  
  115. function hexbyte(x: byte): string;
  116. const digit : string[16] = '0123456789ABCDEF';
  117. var temp : string[4];
  118.     i    : integer;
  119. begin
  120.   temp:= '  ';
  121.   for i:= 2 downto 1 do
  122.     begin
  123.       temp[i]:= digit[(x and $000f)+1];
  124.       x:= x div 16;
  125.     end;
  126.   hexbyte:= temp;
  127. end;
  128.  
  129. procedure doline(x,y,x2,y2: integer);
  130. begin
  131.   line(x+MAP_X,y+MAP_Y,x2+MAP_X,y2+MAP_Y);
  132. end;
  133.  
  134. procedure dobar(x,y,x2,y2: integer);
  135. begin
  136.   bar(x+MAP_Y,y+MAP_Y,x2+MAP_X,y2+MAP_Y);
  137. end;
  138.  
  139. procedure circle(x,y,c1,c2: integer);
  140. const sprite : array[0..6,0..6] of byte =
  141.                    ((0,0,1,1,1,0,0),
  142.                     (0,1,1,1,1,1,0),
  143.                     (1,1,1,2,1,1,1),
  144.                     (1,1,2,2,2,1,1),
  145.                     (1,1,1,2,1,1,1),
  146.                     (0,1,1,1,1,1,0),
  147.                     (0,0,1,1,1,0,0));
  148. var i,j,c: integer;
  149. begin
  150.   for i:= 0 to 6 do
  151.     for j:= 0 to 6 do
  152.       begin
  153.         case sprite[i,j] of
  154.           0: c:=0;
  155.           1: c:=c1;
  156.           2: c:=c2;
  157.         end;
  158.         putpixel(x*7+MAP_X+i,y*7+MAP_Y+j,c);
  159.       end;
  160. end;
  161.  
  162. procedure door(dtype: doortype; x,y,color: integer);
  163. begin
  164.   case dtype of
  165.     vert: begin
  166.             setfillstyle(1,color);
  167.             dobar(x*7+2,y*7,x*7+4,y*7+6);
  168.           end;
  169.     horiz : begin
  170.               setfillstyle(1,color);
  171.               dobar(x*7,y*7+2,x*7+6,y*7+4);
  172.           end;
  173.   end;
  174. end;
  175.  
  176. function hexnibble(c: char): byte;
  177. begin
  178.   case c of
  179.     '0'..'9': hexnibble:= ord(c)-ord('0');
  180.     'a'..'f': hexnibble:= ord(c)-ord('a')+10;
  181.     'A'..'F': hexnibble:= ord(c)-ord('A')+10;
  182.     else hexnibble:= 0;
  183.   end;
  184. end;
  185.  
  186. procedure output(x,y: integer; data: string);
  187. var size  : integer;
  188.     temp  : string[4];
  189.     c1,c2 : byte;
  190. begin
  191.   if data<>'0000' then
  192.     begin
  193.       temp:= data;
  194.       c1:= hexnibble(temp[1]);
  195.       c2:= hexnibble(temp[2]);
  196.       case temp[3] of
  197.         '0': outtext(x,y,c1,temp[4]);
  198.         '1': box(solid,x,y,c1,c2,false);
  199.         '2': box(check,x,y,c1,c2,false);
  200.         '3': box(solid,x,y,c1,c2,true);
  201.         '4': box(check,x,y,c1,c2,true);
  202.         '5': circle(x,y,c1,c2);
  203.         '6': door(horiz,x,y,c1);
  204.         '7': door(vert,x,y,c1);
  205.         '8': begin
  206.                setfillstyle(1,c1);
  207.                dobar(x*7,y*7,x*7+6,y*7+3);
  208.                setfillstyle(1,c2);
  209.                dobar(x*7,y*7+4,x*7+6,y*7+6);
  210.               end;
  211.         '9': putpixel(x*7+MAP_X+3,y*7+MAP_Y+3,c1);
  212.         'a': begin setfillstyle(1,c1); dobar(x*7+2,y*7+1,x*7+4,y*7+5); end;
  213.         'b': begin setfillstyle(1,c1); dobar(x*7+2,y*7+2,x*7+4,y*7+4); end;
  214.         'c': begin setfillstyle(1,c1); dobar(x*7+1,y*7+1,x*7+5,y*7+5); end;
  215.         'd': begin
  216.                setcolor(c1);
  217.                doline(x*7+1,y*7+1,x*7+5,y*7+5);
  218.                doline(x*7+5,y*7+1,x*7+1,y*7+5);
  219.              end;
  220.         'e': begin
  221.                setcolor(c1);
  222.                rectangle(x*7+MAP_X,y*7+MAP_Y,x*7+MAP_X+6,y*7+MAP_Y+6);
  223.              end;
  224.         'f': case c2 of
  225.               2: begin {east}
  226.                    setcolor(c1);
  227.                    doline(x*7,y*7+3,x*7+6,y*7+3);
  228.                    doline(x*7+6,y*7+3,x*7+3,y*7);
  229.                    doline(x*7+6,y*7+3,x*7+3,y*7+6);
  230.                 end;
  231.               0: begin {north}
  232.                    setcolor(c1);
  233.                    doline(x*7+3,y*7+6,x*7+3,y*7);
  234.                    doline(x*7+3,y*7,x*7,y*7+3);
  235.                    doline(x*7+3,y*7,x*7+6,y*7+3);
  236.                  end;
  237.               6: begin {west}
  238.                    setcolor(c1);
  239.                    doline(x*7+6,y*7+3,x*7,y*7+3);
  240.                    doline(x*7,y*7+3,x*7+3,y*7);
  241.                    doline(x*7,y*7+3,x*7+3,y*7+6);
  242.                  end;
  243.               4: begin {south}
  244.                    setcolor(c1);
  245.                    doline(x*7+3,y*7,x*7+3,y*7+6);
  246.                    doline(x*7+3,y*7+6,x*7,y*7+3);
  247.                    doline(x*7+3,y*7+6,x*7+6,y*7+3);
  248.                  end;
  249.               1: begin {northeast}
  250.                    setcolor(c1);
  251.                    doline(x*7,y*7+6,x*7+6,y*7);
  252.                    doline(x*7+6,y*7,x*7+3,y*7);
  253.                    doline(x*7+6,y*7,x*7+6,y*7+3);
  254.                  end;
  255.               7: begin {northwest}
  256.                    setcolor(c1);
  257.                    doline(x*7+6,y*7+6,x*7,y*7);
  258.                    doline(x*7,y*7,x*7+3,y*7);
  259.                    doline(x*7,y*7,x*7,y*7+3);
  260.                  end;
  261.               3: begin {southeast}
  262.                    setcolor(c1);
  263.                    doline(x*7,y*7,x*7+6,y*7+6);
  264.                    doline(x*7+6,y*7+6,x*7+3,y*7+6);
  265.                    doline(x*7+6,y*7+6,x*7+6,y*7+3);
  266.                  end;
  267.               5: begin {southwest}
  268.                    setcolor(c1);
  269.                    doline(x*7+6,y*7,x*7,y*7+6);
  270.                    doline(x*7,y*7+6,x*7+3,y*7+6);
  271.                    doline(x*7,y*7+6,x*7,y*7+3);
  272.                  end;
  273.  
  274.              end;
  275.       end;
  276.     end;
  277. end;
  278.  
  279. procedure display_map;
  280. var i,j: integer;
  281. begin
  282.   j:= 63;
  283.   i:= 0;
  284.   repeat
  285.     setfillstyle(1,0);
  286.     dobar(i*7,j*7,i*7+6,j*7+6);
  287.     if show_floor then
  288.       output(i,j,mapgraph[levelmap[i,j]])
  289.     else
  290.       if not (levelmap[i,j] in [$6a..$8f]) then
  291.         output(i,j,mapgraph[levelmap[i,j]]);
  292.     if show_objects then
  293.       output(i,j,objgraph[objectmap[i,j]]);
  294.     inc(i);
  295.     if i=64 then
  296.       begin
  297.         i:= 0;
  298.         dec(j);
  299.       end;
  300.   until (j<0) or keypressed;
  301. end;
  302.  
  303. procedure read_levels;
  304. var headfile,
  305.     mapfile  : file;
  306.     s,o,
  307.     size     : word;
  308.     idsig    : string[4];
  309.     level    : integer;
  310.     levelptr : longint;
  311.     tempstr  : string[16];
  312.     map_pointer,
  313.     object_pointer,
  314.     other_pointer    : longint;
  315.  
  316. begin
  317.   idsig:= '    ';
  318.   tempstr:= '                ';
  319.   assign(headfile,GAMEPATH+HEADFILENAME);
  320.   {$I-}
  321.   reset(headfile,1);
  322.   {$I+}
  323.   if ioresult<>0 then
  324.     begin
  325.       writeln('error opening ',HEADFILENAME);
  326.       halt(1);
  327.     end;
  328.   assign(mapfile,GAMEPATH+MAPFILENAME);
  329.   {$I-}
  330.   reset(mapfile,1);
  331.   {$I+}
  332.   if ioresult<>0 then
  333.     begin
  334.       writeln('error opening ',MAPFILENAME);
  335.       halt(1);
  336.     end;
  337.  
  338.   for level:= 1 to LEVELS do
  339.     begin
  340.       seek(headfile,2+(level-1)*4);
  341.       blockread(headfile,levelptr,4);
  342.       seek(mapfile,levelptr);
  343.       with maps[level] do
  344.         begin
  345.           blockread(mapfile,map_pointer,4);
  346.           blockread(mapfile,object_pointer,4);
  347.           blockread(mapfile,other_pointer,4);
  348.           blockread(mapfile,map.size,2);
  349.           blockread(mapfile,objects.size,2);
  350.           blockread(mapfile,other.size,2);
  351.           blockread(mapfile,width,2);
  352.           blockread(mapfile,height,2);
  353.           name[0]:=#16;
  354.           blockread(mapfile,name[1],16);
  355.           if GAME_VERSION = 1.1 then
  356.             blockread(mapfile,idsig[1],4);
  357.  
  358.           seek(mapfile,map_pointer);
  359.           getmem(map.data,map.size);
  360.           s:= seg(map.data^);
  361.           o:= ofs(map.data^);
  362.           blockread(mapfile,mem[s:o],map.size);
  363.  
  364.           seek(mapfile,object_pointer);
  365.           getmem(objects.data,objects.size);
  366.           s:= seg(objects.data^);
  367.           o:= ofs(objects.data^);
  368.           blockread(mapfile,mem[s:o],objects.size);
  369.  
  370.           seek(mapfile,other_pointer);
  371.           getmem(other.data,other.size);
  372.           s:= seg(other.data^);
  373.           o:= ofs(other.data^);
  374.           blockread(mapfile,mem[s:o],other.size);
  375.           if GAME_VERSION = 1.0 then
  376.             blockread(mapfile,idsig[1],4);
  377.         end;
  378.     end;
  379.   close(mapfile);
  380.   close(headfile);
  381. end;
  382.  
  383. procedure write_levels;
  384. var headfile,
  385.     mapfile    : file;
  386.     abcd,
  387.     s,o,
  388.     size     : word;
  389.     idsig    : string[4];
  390.     level    : integer;
  391.     levelptr : longint;
  392.     tempstr  : string[16];
  393.     map_pointer,
  394.     object_pointer,
  395.     other_pointer    : longint;
  396.  
  397. begin
  398.   abcd:= $abcd;
  399.   idsig:= '!ID!';
  400.   tempstr:= 'TED5v1.0';
  401.   assign(headfile,GAMEPATH+HEADFILENAME);
  402.   rewrite(headfile,1);
  403.   assign(mapfile,GAMEPATH+MAPFILENAME);
  404.   rewrite(mapfile,1);
  405.  
  406.   blockwrite(headfile,abcd,2);
  407.   blockwrite(mapfile,tempstr[1],8);
  408.   levelptr:= 8;
  409.  
  410.   for level:= 1 to LEVELS do
  411.     begin
  412.       with maps[level] do
  413.         begin
  414.           if GAME_VERSION = 1.1 then
  415.             begin
  416.               map_pointer:= levelptr;
  417.               s:= seg(map.data^);
  418.               o:= ofs(map.data^);
  419.               blockwrite(mapfile,mem[s:o],map.size);
  420.               inc(levelptr,map.size);
  421.  
  422.               object_pointer:= levelptr;
  423.               s:= seg(objects.data^);
  424.               o:= ofs(objects.data^);
  425.               blockwrite(mapfile,mem[s:o],objects.size);
  426.               inc(levelptr,objects.size);
  427.  
  428.               other_pointer:= levelptr;
  429.               s:= seg(other.data^);
  430.               o:= ofs(other.data^);
  431.               blockwrite(mapfile,mem[s:o],other.size);
  432.               inc(levelptr,other.size);
  433.  
  434.               blockwrite(headfile,levelptr,4);
  435.  
  436.               blockwrite(mapfile,map_pointer,4);
  437.               blockwrite(mapfile,object_pointer,4);
  438.               blockwrite(mapfile,other_pointer,4);
  439.               blockwrite(mapfile,map.size,2);
  440.               blockwrite(mapfile,objects.size,2);
  441.               blockwrite(mapfile,other.size,2);
  442.               blockwrite(mapfile,width,2);
  443.               blockwrite(mapfile,height,2);
  444.               name[0]:=#16;
  445.               blockwrite(mapfile,name[1],16);
  446.               inc(levelptr,38);
  447.             end
  448.           else
  449.             begin
  450.               blockwrite(headfile,levelptr,4);
  451.               map_pointer:= levelptr+38;
  452.               object_pointer:= map_pointer+map.size;
  453.               other_pointer:= object_pointer+objects.size;
  454.  
  455.               blockwrite(mapfile,map_pointer,4);
  456.               blockwrite(mapfile,object_pointer,4);
  457.               blockwrite(mapfile,other_pointer,4);
  458.               blockwrite(mapfile,map.size,2);
  459.               blockwrite(mapfile,objects.size,2);
  460.               blockwrite(mapfile,other.size,2);
  461.               blockwrite(mapfile,width,2);
  462.               blockwrite(mapfile,height,2);
  463.               name[0]:=#16;
  464.               blockwrite(mapfile,name[1],16);
  465.  
  466.               s:= seg(map.data^);
  467.               o:= ofs(map.data^);
  468.               blockwrite(mapfile,mem[s:o],map.size);
  469.               s:= seg(objects.data^);
  470.               o:= ofs(objects.data^);
  471.               blockwrite(mapfile,mem[s:o],objects.size);
  472.               s:= seg(other.data^);
  473.               o:= ofs(other.data^);
  474.               blockwrite(mapfile,mem[s:o],other.size);
  475.               inc(levelptr,map.size+objects.size+other.size+38);
  476.             end;
  477.           blockwrite(mapfile,idsig[1],4);
  478.           inc(levelptr,4);
  479.         end;
  480.     end;
  481.   close(mapfile);
  482.   close(headfile);
  483. end;
  484.  
  485. procedure a7a8_expand(src: data_block; var dest: data_block);
  486. var s,o,
  487.     s2,o2,
  488.     index,
  489.     index2,
  490.     size,
  491.     length,
  492.     data,
  493.     newsize  : word;
  494.     goback1  : byte;
  495.     goback2  : word;
  496.     i        : integer;
  497.  
  498. begin
  499.   s:=seg(src.data^);
  500.   o:=ofs(src.data^);
  501.   index:=0;
  502.   move(mem[s:o+index],dest.size,2); inc(index,2);
  503.   getmem(dest.data,dest.size);
  504.   s2:=seg(dest.data^);
  505.   o2:=ofs(dest.data^);
  506.   index2:=0;
  507.  
  508.   repeat
  509.     move(mem[s:o+index],data,2); inc(index,2);
  510.     case hi(data) of
  511.       $a7: begin
  512.              length:=lo(data);
  513.              move(mem[s:o+index],goback1,1); inc(index,1);
  514.              move(mem[s2:o2+index2-goback1*2],mem[s2:o2+index2],length*2);
  515.              inc(index2,length*2);
  516.            end;
  517.       $a8: begin
  518.              length:=lo(data);
  519.              move(mem[s:o+index],goback2,2); inc(index,2);
  520.              move(mem[s2:o2+goback2*2],mem[s2:o2+index2],length*2);
  521.              inc(index2,length*2);
  522.            end;
  523.       else begin
  524.              move(data,mem[s2:o2+index2],2);
  525.              inc(index2,2);
  526.            end;
  527.     end;
  528.   until index=src.size;
  529. end;
  530.  
  531. procedure expand(d: data_block; var g: grid);
  532. var i,x,y : integer;
  533.     s,o,
  534.     data,
  535.     count : word;
  536.     temp  : data_block;
  537. begin
  538.   if GAME_VERSION = 1.1 then
  539.     a7a8_expand(d,temp)
  540.   else
  541.     temp:=d;
  542.  
  543.   x:= 0;
  544.   y:= 0;
  545.   s:= seg(temp.data^);
  546.   o:= ofs(temp.data^);
  547.   inc(o,2);
  548.   while (y<64) do
  549.     begin
  550.       move(mem[s:o],data,2); inc(o,2);
  551.       if data=$abcd then
  552.         begin
  553.           move(mem[s:o],count,2); inc(o,2);
  554.           move(mem[s:o],data,2); inc(o,2);
  555.           for i:= 1 to count do
  556.             begin
  557.               g[x,y]:= data;
  558.               inc(x);
  559.               if x=64 then
  560.                 begin
  561.                   x:= 0;
  562.                   inc(y);
  563.                 end;
  564.             end;
  565.         end
  566.       else
  567.         begin
  568.           g[x,y]:= data;
  569.           inc(x);
  570.           if x=64 then
  571.             begin
  572.               x:= 0;
  573.               inc(y);
  574.             end;
  575.         end;
  576.     end;
  577.   if GAME_VERSION=1.1 then
  578.     freemem(temp.data,temp.size);
  579. end;
  580.  
  581. procedure compress(g: grid; var d: data_block);
  582. var temp     : pointer;
  583.     size: word;
  584.     abcd,
  585.     s,o,
  586.     olddata,
  587.     data,
  588.     nextdata,
  589.     count    : word;
  590.     x,y,i    : integer;
  591.     temp2    : pointer;
  592.  
  593. begin
  594.   abcd:= $abcd;
  595.   x:= 0;
  596.   y:= 0;
  597.   getmem(temp,8194);
  598.   s:= seg(temp^);
  599.   o:= ofs(temp^);
  600.   data:= $2000;
  601.   move(data,mem[s:o],2);
  602.  
  603.   size:= 2;
  604.   data:= g[0,0];
  605.   while (y<64) do
  606.     begin
  607.       count:= 1;
  608.       repeat
  609.         inc(x);
  610.         if x=64 then
  611.           begin
  612.             x:=0;
  613.             inc(y);
  614.           end;
  615.         if y<64 then
  616.           nextdata:= g[x,y];
  617.         inc(count);
  618.       until (nextdata<>data) or (y=64);
  619.       dec(count);
  620.       if count<3 then
  621.         begin
  622.           for i:= 1 to count do
  623.             begin
  624.               move(data,mem[s:o+size],2);
  625.               inc(size,2);
  626.             end;
  627.         end
  628.       else
  629.         begin
  630.           move(abcd,mem[s:o+size],2);
  631.           inc(size,2);
  632.           move(count,mem[s:o+size],2);
  633.           inc(size,2);
  634.           move(data,mem[s:o+size],2);
  635.           inc(size,2);
  636.         end;
  637.       data:= nextdata;
  638.     end;
  639.   getmem(temp2,size);
  640.   move(temp^,temp2^,size);
  641.   freemem(temp,8194);
  642.   if GAME_VERSION = 1.1 then
  643.     begin
  644.       getmem(temp,size+2);
  645.       s:= seg(temp^);
  646.       o:= ofs(temp^);
  647.       move(size,mem[s:o],2);
  648.       move(temp2^,mem[s:o+2],size);
  649.       d.data:=temp;
  650.       d.size:= size+2;
  651.       freemem(temp2,size);
  652.     end
  653.   else
  654.     begin
  655.       d.data:= temp2;
  656.       d.size:= size;
  657.     end;
  658. end;
  659.  
  660. procedure clear_level(n: integer);
  661. var x,y: integer;
  662. begin
  663.    mhide;
  664.    for x:= 0 to 63 do
  665.      for y:= 0 to 63 do
  666.        begin
  667.          levelmap[x,y]:= $8c;
  668.          objectmap[x,y]:= 0;
  669.        end;
  670.    for x:= 0 to 63 do
  671.      begin
  672.        levelmap[x,0]:= 1;
  673.        levelmap[x,63]:= 1;
  674.        levelmap[0,x]:= 1;
  675.        levelmap[63,x]:= 1;
  676.      end;
  677.    display_map;
  678.    mshow;
  679. end;
  680.  
  681. function str_to_hex(s: string): word;
  682. var temp : word;
  683.     i    : integer;
  684. begin
  685.   temp:= 0;
  686.   for i:= 1 to length(s) do
  687.     begin
  688.       temp:= temp * 16;
  689.       case s[i] of
  690.         '0'..'9': temp:= temp + ord(s[i])-ord('0');
  691.         'a'..'f': temp:= temp + ord(s[i])-ord('a')+10;
  692.         'A'..'F': temp:= temp + ord(s[i])-ord('A')+10;
  693.       end;
  694.     end;
  695.   str_to_hex:= temp;
  696. end;
  697.  
  698. procedure showlegend(which,start,n: integer);
  699. var i,x,y: integer;
  700.     save: boolean;
  701. begin
  702.   mhide;
  703.   save:= show_objects;
  704.   show_objects:= true;
  705.   setfillstyle(1,0);
  706.   bar(64*7+MAP_X+13,4,639-5,380-30);
  707.   x:= 66;
  708.   y:= 0;
  709.   for i:= start to start+n-1 do
  710.     begin
  711.       if which=0 then
  712.         begin
  713.           output(x,y,mapgraph[i]);
  714.           outtext(x+2,y,15,mapnames[i]);
  715.         end
  716.       else
  717.         begin
  718.           output(x,y,objgraph[i]);
  719.           outtext(x+2,y,15,objnames[i]);
  720.         end;
  721.       inc(y,2);
  722.     end;
  723.   show_objects:= save;
  724.   mshow;
  725. end;
  726.  
  727. function inside(x1,y1,x2,y2,x,y: integer): boolean;
  728. begin
  729.   inside:= (x>=x1) and (x<=x2) and
  730.            (y>=y1) and (y<=y2);
  731. end;
  732.  
  733. procedure wait_for_mouserelease;
  734. begin
  735.   repeat
  736.     mpos(mouseloc);
  737.   until mouseloc.buttonstatus=0;
  738. end;
  739.  
  740. procedure bevel(x1,y1,x2,y2,c1,c2,c3: integer);
  741. begin
  742.   setfillstyle(1,c1);
  743.   bar(x1,y1,x2,y2);
  744.   setcolor(c2);
  745.   line(x1,y1,x2,y1);
  746.   line(x1+1,y1+1,x2-1,y1+1);
  747.   line(x2,y1,x2,y2);
  748.   line(x2-1,y1,x2-1,y2-1);
  749.   setcolor(c3);
  750.   line(x1,y1+1,x1,y2);
  751.   line(x1+1,y1+2,x1+1,y2);
  752.   line(x1,y2,x2-1,y2);
  753.   line(x1+1,y2-1,x2-2,y2-1);
  754. end;
  755.  
  756. function upper(s: string): string;
  757. var i: integer;
  758. begin
  759.   for i:=1 to length(s) do
  760.     if s[i] in ['a'..'z'] then
  761.       s[i]:=chr(ord(s[i])-ord('a')+ord('A'));
  762.   upper:=s;
  763. end;
  764.  
  765. procedure initialize;
  766. var i: integer;
  767.     infile: text;
  768.  
  769.     path : pathstr;
  770.     dir  : dirstr;
  771.     name : namestr;
  772.     ext  : extstr;
  773.     filename  : string;
  774.     hexstr    : string[4];
  775.     graphstr  : string[4];
  776.     name20    : string[20];
  777.     junk      : char;
  778.     search    : searchrec;
  779.  
  780. begin
  781.   filename:= GAMEPATH + HEADFILENAME + '.*';
  782.   writeln('searching for ',filename);
  783.   findfirst(filename,$ff,search);
  784.   if doserror<>0 then
  785.     begin
  786.       writeln('Error opening ',HEADFILENAME,' file.');
  787.       writeln;
  788.       writeln('Be sure that you installed MAPEDIT in the directory where');
  789.       writeln('Wolfenstein 3-D is installed.');
  790.       halt(0);
  791.     end
  792.   else
  793.     begin
  794.       filename:= search.name;
  795.       fsplit(filename,dir,name,ext);
  796.       HEADFILENAME:= upper(HEADFILENAME+ext);
  797.       if upper(ext)='.WL1' then
  798.         begin
  799.           LEVELS:=10;
  800.           GAME_VERSION:=1.0;
  801.           MAPFILENAME:='MAPTEMP'+ext;
  802.           filename:=GAMEPATH+'MAPTEMP'+ext;
  803.           findfirst(filename,$ff,search);
  804.           if doserror<>0 then
  805.             begin
  806.               GAME_VERSION:=1.1;
  807.               MAPFILENAME:='GAMEMAPS'+ext;
  808.               filename:=GAMEPATH+'GAMEMAPS'+ext;
  809.               findfirst(filename,$ff,search);
  810.               if doserror<>0 then
  811.                 begin
  812.                   writeln('Error opening GAMEMAPS or MAPTEMP file.');
  813.                   halt(0);
  814.                 end;
  815.             end;
  816.         end;
  817.       if (upper(ext)='.WL3') or (upper(ext)='.WL6') then
  818.         begin
  819.           GAME_VERSION:=1.1;
  820.           if upper(ext)='.WL3' then
  821.             LEVELS:= 30
  822.           else
  823.             LEVELS:= 60;
  824.           MAPFILENAME:='GAMEMAPS'+ext;
  825.           filename:=GAMEPATH+'GAMEMAPS'+ext;
  826.           findfirst(filename,$ff,search);
  827.           if doserror<>0 then
  828.             begin
  829.               writeln('Error opening GAMEMAPS file.');
  830.               halt(0);
  831.             end;
  832.         end;
  833.     end;
  834.  
  835.   for i:= 0 to 511 do
  836.     begin
  837.       mapnames[i]:= 'unknown '+hex(i);
  838.       objnames[i]:= 'unknown '+hex(i);
  839.       mapgraph[i]:= 'f010';
  840.       objgraph[i]:= 'f010';
  841.     end;
  842.   assign(infile,'mapdata.def');
  843.   reset(infile);
  844.   while not eof(infile) do
  845.     begin
  846.       readln(infile,hexstr,junk,graphstr,junk,name20);
  847.       mapnames[str_to_hex(hexstr)]:= name20;
  848.       mapgraph[str_to_hex(hexstr)]:= graphstr;
  849.     end;
  850.   close(infile);
  851.  
  852.   assign(infile,'objdata.def');
  853.   reset(infile);
  854.   while not eof(infile) do
  855.     begin
  856.       readln(infile,hexstr,junk,graphstr,junk,name20);
  857.       objnames[str_to_hex(hexstr)]:= name20;
  858.       objgraph[str_to_hex(hexstr)]:= graphstr;
  859.     end;
  860.   close(infile);
  861.  
  862. end;
  863.  
  864. var gd,gm,
  865.     i,j,x,y   : integer;
  866.     infile    : text;
  867.     level     : word;
  868.     oldx,oldy : integer;
  869.     done      : boolean;
  870.     outstr,
  871.     tempstr   : string;
  872.  
  873.     legendpos : integer;
  874.     legendtype: integer;
  875.     newj        : integer;
  876.     currenttype,
  877.     currentval: integer;
  878.  
  879.     oldj,oldi : integer;
  880.  
  881.     key       : char;
  882.     control   : boolean;
  883.  
  884. begin
  885.   clrscr;
  886.   initialize;
  887.   directvideo:=false;
  888.   read_levels;
  889.  
  890.   gd:= vga;
  891.   gm:= vgahi;
  892.   initgraph(gd,gm,'');
  893.  
  894.   settextstyle(0,0,1);
  895.   mreset(themouse);
  896.  
  897.   show_objects:= true;
  898.   show_floor:= false;
  899.  
  900.   x:= port[$3da];
  901.   port[$3c0]:= 0;
  902.  
  903.   setfillstyle(1,7);
  904.   bar(0,0,64*7+MAP_X+4,64*7+MAP_Y+4);
  905.   bar(64*7+MAP_X+9,0,639,380);
  906.   setfillstyle(1,0);
  907.   bar(2,2,64*7+MAP_X+2,64*7+MAP_Y+2);
  908.   bar(64*7+MAP_X+11,2,637,380-28);
  909.   bar(64*7+MAP_X+11,380-25,637,378);
  910.   setcolor(15);
  911.   outtextxy(64*7+MAP_X+15,380-16,' MAP  OBJ  UP  DOWN');
  912.   setfillstyle(1,7);
  913.   bar(64*7+MAP_X+11+043,380-25,64*7+MAP_X+11+044,378);
  914.   bar(64*7+MAP_X+11+083,380-25,64*7+MAP_X+11+084,378);
  915.   bar(64*7+MAP_X+11+113,380-25,64*7+MAP_X+11+114,378);
  916.  
  917.   legendpos:= 0;
  918.   legendtype:= 0;
  919.   currenttype:= 0;
  920.   currentval:= 1;
  921.   setfillstyle(1,0);
  922.  
  923.   bar(66*7+MAP_X,60*7+MAP_Y,637,61*7+MAP_Y);
  924.   if currenttype=0 then
  925.     begin
  926.       output(66,60,mapgraph[currentval]);
  927.       outtext(67,60,15,' - '+mapnames[currentval]);
  928.     end
  929.   else
  930.     begin
  931.       output(66,60,objgraph[currentval]);
  932.       outtext(67,60,15,' - '+objnames[currentval]);
  933.     end;
  934.  
  935.   showlegend(legendtype,legendpos,25);
  936.  
  937.   x:= port[$3da];
  938.   port[$3c0]:= 32;
  939.   mshow;
  940.   level:=1;
  941.   done:= false;
  942.   repeat
  943.     mhide;
  944.     setfillstyle(1,0);
  945.     bar(5,TEXTLOC,64*7-1+MAP_X,477);
  946.     setcolor(15);
  947.     outtextxy(5,TEXTLOC,maps[level].name);
  948.     expand(maps[level].map,levelmap);
  949.     expand(maps[level].objects,objectmap);
  950.     display_map;
  951.     mshow;
  952.     oldx:= 0;
  953.     oldy:= 0;
  954.     key:= #0;
  955.     repeat
  956.       repeat
  957.         mpos(mouseloc);
  958.         x:= mouseloc.column;
  959.         y:= mouseloc.row;
  960.       until (oldx<>x) or (oldy<>y) or keypressed or (mouseloc.buttonstatus<>0);
  961.       oldx:= x;
  962.       oldy:= y;
  963.       if (mouseloc.buttonstatus<>0) then
  964.         begin
  965.           if inside(MAP_X,MAP_Y,64*7+MAP_X-1,64*7+MAP_Y-1,x,y) then
  966.             begin
  967.               mhide;
  968.               repeat
  969.                 i:= (x - MAP_X) div 7;
  970.                 j:= (y - MAP_Y) div 7;
  971.                 if currenttype=0 then
  972.                   levelmap[i,j]:= currentval
  973.                 else
  974.                   objectmap[i,j]:= currentval;
  975.                 setfillstyle(1,0);
  976.                 dobar(i*7,j*7,i*7+6,j*7+6);
  977.                 if show_floor then
  978.                   output(i,j,mapgraph[levelmap[i,j]])
  979.                 else
  980.                   if not (levelmap[i,j] in [$6a..$8f]) then
  981.                     output(i,j,mapgraph[levelmap[i,j]]);
  982.                 if show_objects then
  983.                   output(i,j,objgraph[objectmap[i,j]]);
  984.                 mpos(mouseloc);
  985.                 x:= mouseloc.column;
  986.                 y:= mouseloc.row;
  987.               until (not inside(MAP_X,MAP_Y,64*7+MAP_X-1,64*7+MAP_Y-1,x,y)) or
  988.                     (mouseloc.buttonstatus=0);
  989.               mshow;
  990.             end;
  991.           if inside(464,355,506,378,x,y) then
  992.             begin
  993.               wait_for_mouserelease;
  994.               legendpos:= 0;
  995.               legendtype:= 0;
  996.               showlegend(legendtype,legendpos,25);
  997.             end;
  998.           if inside(509,355,546,378,x,y) then
  999.             begin
  1000.               wait_for_mouserelease;
  1001.               legendpos:= 0;
  1002.               legendtype:= 1;
  1003.               showlegend(legendtype,legendpos,25);
  1004.             end;
  1005.           if inside(549,355,576,378,x,y) then
  1006.             begin
  1007.               wait_for_mouserelease;
  1008.               dec(legendpos,25);
  1009.               if legendpos<0 then legendpos:= 0;
  1010.               showlegend(legendtype,legendpos,25);
  1011.             end;
  1012.           if inside(579,355,637,378,x,y) then
  1013.             begin
  1014.               wait_for_mouserelease;
  1015.               inc(legendpos,25);
  1016.               if (legendpos+25)>255 then legendpos:= 255-25;
  1017.               showlegend(legendtype,legendpos,25);
  1018.             end;
  1019.         end;
  1020.       if inside(464,2,637,350,x,y) then
  1021.         begin
  1022.           mhide;
  1023.           j:= (y-2) div 14;
  1024.           setcolor(15);
  1025.           rectangle(465,j*14+2+1,636,j*14+2+12);
  1026.           repeat
  1027.             mpos(mouseloc);
  1028.             newj:= (mouseloc.row-2) div 14;
  1029.             if mouseloc.buttonstatus<>0 then
  1030.               begin
  1031.                 currenttype:= legendtype;
  1032.                 currentval:= legendpos+j;
  1033.                 setfillstyle(1,0);
  1034.                 bar(66*7+MAP_X,60*7+MAP_Y,637,61*7+MAP_Y);
  1035.                 if currenttype=0 then
  1036.                   begin
  1037.                     output(66,60,mapgraph[currentval]);
  1038.                     outtext(67,60,15,' - '+mapnames[currentval]);
  1039.                   end
  1040.                 else
  1041.                   begin
  1042.                     output(66,60,objgraph[currentval]);
  1043.                     outtext(67,60,15,' - '+objnames[currentval]);
  1044.                   end;
  1045.               end;
  1046.           until (newj<>j) or (mouseloc.column<464) or keypressed;
  1047.           setcolor(0);
  1048.           rectangle(465,j*14+2+1,636,j*14+2+12);
  1049.           mshow;
  1050.         end;
  1051.  
  1052.       if inside(MAP_X,MAP_Y,64*7+MAP_X-1,64*7+MAP_Y-1,x,y) then
  1053.         begin
  1054.           i:= (x - MAP_X) div 7;
  1055.           j:= (y - MAP_Y) div 7;
  1056.           if (oldj<>j) or (oldi<>i) then
  1057.             begin
  1058.               outstr:= '(';
  1059.               str(i:2,tempstr);
  1060.               outstr:= outstr+tempstr+',';
  1061.               str(j:2,tempstr);
  1062.               outstr:= outstr+tempstr+')    map: '+hex(levelmap[i,j]);
  1063.               outstr:= outstr+' - '+mapnames[levelmap[i,j]];
  1064.               setfillstyle(1,0);
  1065.               setcolor(15);
  1066.               bar(100,TEXTLOC,64*7+MAP_X-1,479);
  1067.               outtextxy(100,TEXTLOC,outstr);
  1068.               outstr:= '        object: '+hex(objectmap[i,j])+' - '+objnames[objectmap[i,j]];
  1069.               outtextxy(100,TEXTLOC+10,outstr);
  1070.               oldj:= j;
  1071.               oldi:= i;
  1072.             end;
  1073.         end
  1074.       else
  1075.         begin
  1076.           mhide;
  1077.           setfillstyle(1,0);
  1078.           bar(100,TEXTLOC,360,479);
  1079.           mshow;
  1080.         end;
  1081.  
  1082.       if keypressed then
  1083.         begin
  1084.           control:= false;
  1085.           key:= readkey;
  1086.           if key=#0 then
  1087.             begin
  1088.               control:= true;
  1089.               key:= readkey;
  1090.             end;
  1091.           if control then
  1092.             case key of
  1093.               'H':
  1094.                 begin
  1095.                   freemem(maps[level].map.data,maps[level].map.size);
  1096.                   freemem(maps[level].objects.data,maps[level].objects.size);
  1097.                   compress(levelmap,maps[level].map);
  1098.                   compress(objectmap,maps[level].objects);
  1099.                   inc(level);
  1100.                 end;
  1101.               'P':
  1102.                 begin
  1103.                   freemem(maps[level].map.data,maps[level].map.size);
  1104.                   freemem(maps[level].objects.data,maps[level].objects.size);
  1105.                   compress(levelmap,maps[level].map);
  1106.                   compress(objectmap,maps[level].objects);
  1107.                   dec(level);
  1108.                 end;
  1109.             end
  1110.           else
  1111.             case key of
  1112.               'q','Q':
  1113.                    begin
  1114.                      done:= true;
  1115.                      freemem(maps[level].map.data,maps[level].map.size);
  1116.                      freemem(maps[level].objects.data,maps[level].objects.size);
  1117.                      compress(levelmap,maps[level].map);
  1118.                      compress(objectmap,maps[level].objects);
  1119.                    end;
  1120.               'c','C': clear_level(level);
  1121.               'o','O': begin
  1122.                          mhide;
  1123.                          show_objects:= not show_objects;
  1124.                          display_map;
  1125.                          mshow;
  1126.                        end;
  1127.               'f','F': begin
  1128.                          mhide;
  1129.                          show_floor:= not show_floor;
  1130.                          display_map;
  1131.                          if legendtype=0 then
  1132.                            showlegend(legendtype,legendpos,25);
  1133.                          mshow;
  1134.                        end;
  1135.             end;
  1136.         end;
  1137.     until done or (key in ['P','H']);
  1138.     if level=0 then level:=LEVELS;
  1139.     if level=(LEVELS+1) then level:=1;
  1140.   until done;
  1141.  
  1142.   setfillstyle(1,0);
  1143.   bar(0,TEXTLOC,639,479);
  1144.   setcolor(15);
  1145.   outtextxy(0,TEXTLOC,' Save the current levels to disk? (Y/N) ');
  1146.  
  1147.   repeat
  1148.     repeat until keypressed;
  1149.     key:= readkey;
  1150.     if key=#0 then
  1151.       begin
  1152.         key:= readkey;
  1153.         key:= #0;
  1154.       end;
  1155.   until key in ['y','Y','n','N'];
  1156.  
  1157.   if key in ['y','Y'] then write_levels;
  1158.   textmode(co80);
  1159.   writeln('MapEdit 4.1                 Copyright (c) 1992  Bill Kirby');
  1160.   writeln;
  1161.   writeln('This program is intended to be for your personal use only.');
  1162.   writeln('Distribution of any modified maps may be construed as a ');
  1163.   writeln('copyright violation by Apogee/ID.');
  1164.   writeln;
  1165. end.