home *** CD-ROM | disk | FTP | other *** search
/ Ultimate DOOM Companion / PowersourceMultimedia-UltimateDOOMCompanion.iso / heretic / maped70.zip / MAPEDIT.PAS < prev    next >
Pascal/Delphi Source File  |  1993-06-19  |  62KB  |  2,113 lines
  1. {
  2.   MapEdit 7.0     Wolfenstein Map Editor
  3.  
  4.   ver 7.0 (Bryan Baker, Dave Huntoon - 6/93)
  5.       - Added options to only display certain level guards,
  6.           treasure, or ammo & food
  7.           These options are:
  8.             '1' - Level 1 Guards Only
  9.             '2' - Treasure and One-ups Only
  10.             '3' - Level 3 Guards Only
  11.             '4' - Level 4 Guards Only
  12.             '5' - Boss Guards Only
  13.             '6' - Ammo, Food, First Aid, and One-ups only
  14.       - Added filename prompt to Read and Write floor files
  15.       - Improved program startup and error display. Simplified
  16.           file opening logic.  This will make installation easier and
  17.           almost fool proof.
  18.       - Modified Legend to display only those items in the MAPDATA and
  19.           OBJDATA files and in the order read from the files.
  20.       - Minor bug fixes
  21.  
  22.  
  23.    ver 6.1 (Matt Gruson - 5/93 Contact on CompuServe @ 72360,2432 or
  24.                                                        73766,347
  25.                                           Prodigy    @ PTJT50A
  26.                                           GEnie      @ M.GRUSON
  27.  
  28.       - Allowed right mouse button to have it's own value.
  29.       - Allowed sepperate tracking of MAP and OBJ mode values for
  30.           the different mouse buttons.
  31.       - Holding down shift key while clicking on the map loads values.
  32.       - Spacebar toggles between MAP and OBJECT modes.
  33.       - Allowed PAGEUP and PAGEDOWN to scroll the legend display.
  34.       - Removed unused code for clarity.
  35.  
  36.    ver 6.0 (Dave Huntooon - 5/93)
  37.       - Added help display (and switch to toggle help / stats)
  38.       - Added Copy, Paste and Exchange procedures
  39.       - Added Write and Read procedures that will allow
  40.           exporting and importing floors via a file named
  41.           FLOOR.OUT
  42.       - Changed the Clear procedure to fill using the
  43.           currently selected map value
  44.       - minor fixes
  45.  
  46.    ver 5.0 (Bryan Baker - 4/93)
  47.       - Added display of critical map statistics to edit window:
  48.           Static Objects
  49.           Total Guards
  50.           Doors
  51.  
  52.           Level 1 Guards
  53.           Level 3 Guards
  54.           Level 4 Guards
  55.           Super   Guards
  56.  
  57.           Secret Doors
  58.           Treasure & Extra Lives
  59.  
  60.    ver 4.1a (Dave Huntoon)
  61.       - Adds ability to open Spear of Destiny (SOD) maps.
  62.       - Allows access to objects > 00FE.  Needed for SOD objects
  63.       - minor fix to completely clear text area below
  64.           the map display when the mouse is moved outside
  65.           of the map area.
  66.  
  67.    ver 4.1  Copyright (c) 1992  Bill Kirby
  68.  
  69.  
  70. }
  71.  
  72. {$A+,B-,D+,E-,F-,I+,L-,N-,O-,R-,S-,V-}
  73. {$M 16384,0,655360}
  74. program mapedit;
  75.  
  76. uses crt,dos,graph,mouse;
  77.  
  78. const MAP_X   = 6;
  79.       MAP_Y   = 6;
  80.       TEXTLOC = 458;
  81.  
  82.       GAMEPATH     : string = '.\';
  83.       LEVELS       : word   = 10;
  84.       GAME_VERSION : real   = 1.0;
  85.  
  86.       VERSION      : string = '7.0';
  87.  
  88.       KEYSTATADDR     = $417;
  89.       LEFTSHIFTMASK   = $01;
  90.       RIGHTSHIFTMASK  = $02;
  91.  
  92.       {Rev 6.1}
  93.       KEY_PGUP        = chr(73);
  94.       KEY_PGDN        = chr(81); {These should be CHARs, but since Borland
  95.                                   Pascal 7 can't evaluate CHAR constants in
  96.                                   case statements I had to do it the ugly way}
  97.  
  98. type data_block = record
  99.        size : word;
  100.        data : pointer;
  101.      end;
  102.  
  103.      level_type = record
  104.        map,
  105.        objects,
  106.        other    : data_block;
  107.        width,
  108.        height   : word;
  109.        name     : string[16];
  110.      end;
  111.  
  112.      grid = array[0..63,0..63] of word;
  113.  
  114.      filltype = (solid,check);
  115.      doortype = (horiz,vert);
  116.  
  117.  
  118. var levelmap,
  119.     objectmap : grid;
  120.     maps      : array[1..60] of level_type;
  121.  
  122.     show_objects,
  123.     show_floor,
  124.     guards_1,
  125.     guards_3,
  126.     guards_4,
  127.     guards_s,
  128.     treasure,
  129.     ammofood  : boolean;
  130.  
  131.     mapgraph,
  132.     objgraph  : array[0..300] of string[4];
  133.     mapnames,
  134.     objnames  : array[0..300] of string[20];
  135.  
  136.     legmapptr, legobjptr : array[0..300] of word;
  137.     mapcount, objcount   : integer;
  138.  
  139.     themouse     : resetrec;
  140.     mouseloc     : locrec;
  141.  
  142.     MAPFILENAME  : string [12];
  143.     HEADFILENAME : string [12];
  144.  
  145.     stats,
  146.     xfer,
  147.     copy,
  148.     excng    : boolean;
  149.     tempobj,
  150.     tempmap  : grid;
  151.  
  152.  
  153. procedure decorate(x, y, c: integer);
  154. var i, j: integer;
  155. begin
  156.   setfillstyle(1, c);
  157.   bar(x*7+MAP_X+2, y*7+MAP_Y+2, x*7+MAP_X+4, y*7+MAP_Y+4);
  158. end;
  159.  
  160.  
  161. procedure box(fill: filltype; x, y, c1, c2: integer; dec: boolean);
  162. begin
  163.   if fill=solid then
  164.     setfillstyle(1, c1)
  165.   else
  166.     setfillstyle(9, c1);
  167.  
  168.   bar(x*7+MAP_X, y*7+MAP_Y, x*7+6+MAP_X, y*7+6+MAP_Y);
  169.   if dec then decorate(x,y,c2);
  170. end;
  171.  
  172.  
  173. procedure outtext(x, y, color: integer; s: string);
  174. begin
  175.   setcolor(color);
  176.   outtextxy(x*7+MAP_X, y*7+MAP_Y, s);
  177. end;
  178.  
  179.  
  180. function hex(x: word): string;
  181. const digit : string[16] = '0123456789ABCDEF';
  182. var temp : string[4];
  183.     i    : integer;
  184. begin
  185.   temp := '    ';
  186.   for i := 4 downto 1 do
  187.     begin
  188.       temp[i] := digit[(x and $000f) + 1];
  189.       x := x div 16;
  190.     end;
  191.   hex := temp;
  192. end;
  193.  
  194.  
  195. function hexbyte(x: byte): string;
  196. const digit : string[16] = '0123456789ABCDEF';
  197. var temp : string[4];
  198.     i    : integer;
  199. begin
  200.   temp := '  ';
  201.   for i := 2 downto 1 do
  202.     begin
  203.       temp[i] := digit[(x and $000f) + 1];
  204.       x := x div 16;
  205.     end;
  206.   hexbyte := temp;
  207. end;
  208.  
  209.  
  210. procedure doline(x, y, x2, y2: integer);
  211. begin
  212.   line(x+MAP_X, y+MAP_Y, x2+MAP_X, y2+MAP_Y);
  213. end;
  214.  
  215.  
  216. procedure dobar(x, y, x2, y2: integer);
  217. begin
  218.   bar(x+MAP_Y, y+MAP_Y, x2+MAP_X, y2+MAP_Y);
  219. end;
  220.  
  221.  
  222. procedure circle(x, y, c1, c2: integer);
  223. const sprite : array[0..6,0..6] of byte =
  224.                        ((0,0,1,1,1,0,0),
  225.                         (0,1,1,1,1,1,0),
  226.                         (1,1,1,2,1,1,1),
  227.                         (1,1,2,2,2,1,1),
  228.                         (1,1,1,2,1,1,1),
  229.                         (0,1,1,1,1,1,0),
  230.                         (0,0,1,1,1,0,0));
  231. var i, j, c: integer;
  232. begin
  233.   for i := 0 to 6 do
  234.     for j := 0 to 6 do
  235.       begin
  236.         case sprite[i, j] of
  237.           0: c := 0;
  238.           1: c := c1;
  239.           2: c := c2;
  240.         end;
  241.         putpixel(x*7+MAP_X+i, y*7+MAP_Y+j, c);
  242.       end;
  243. end;
  244.  
  245.  
  246. procedure door(dtype: doortype; x, y, color: integer);
  247. begin
  248.   case dtype of
  249.     vert  : begin
  250.               setfillstyle(1, color);
  251.               dobar(x*7+2, y*7, x*7+4, y*7+6);
  252.             end;
  253.     horiz : begin
  254.               setfillstyle(1, color);
  255.               dobar(x*7, y*7+2, x*7+6, y*7+4);
  256.             end;
  257.   end;
  258. end;
  259.  
  260.  
  261. function hexnibble(c: char): byte;
  262. begin
  263.   case c of
  264.     '0'..'9': hexnibble := ord(c) - ord('0');
  265.     'a'..'f': hexnibble := ord(c) - ord('a') + 10;
  266.     'A'..'F': hexnibble := ord(c) - ord('A') + 10;
  267.     else hexnibble := 0;
  268.   end;
  269. end;
  270.  
  271.  
  272. procedure output(x, y: integer; data: string);
  273. var size   : integer;
  274.     temp   : string[4];
  275.     c1, c2 : byte;
  276. begin
  277.   if data<>'0000' then
  278.     begin
  279.       temp := data;
  280.       c1   := hexnibble(temp[1]);
  281.       c2   := hexnibble(temp[2]);
  282.       case temp[3] of
  283.         '0': outtext(x,  y, c1, temp[4]);
  284.         '1': box(solid,  x, y,  c1, c2, false);
  285.         '2': box(check,  x, y,  c1, c2, false);
  286.         '3': box(solid,  x, y,  c1, c2, true);
  287.         '4': box(check,  x, y,  c1, c2, true);
  288.         '5': circle(x,   y, c1, c2);
  289.         '6': door(horiz, x, y,  c1);
  290.         '7': door(vert,  x, y,  c1);
  291.         '8': begin
  292.                setfillstyle(1, c1);
  293.                dobar(x*7, y*7,   x*7+6, y*7+3);
  294.                setfillstyle(1, c2);
  295.                dobar(x*7, y*7+4, x*7+6, y*7+6);
  296.              end;
  297.         '9': putpixel(x*7+MAP_X+3, y*7+MAP_Y+3, c1);
  298.         'a': begin
  299.                setfillstyle(1, c1);
  300.                dobar(x*7+2, y*7+1, x*7+4, y*7+5);
  301.              end;
  302.         'b': begin
  303.                setfillstyle(1, c1);
  304.                dobar(x*7+2, y*7+2, x*7+4, y*7+4);
  305.              end;
  306.         'c': begin
  307.                setfillstyle(1, c1);
  308.                dobar(x*7+1, y*7+1, x*7+5, y*7+5);
  309.              end;
  310.         'd': begin
  311.                setcolor(c1);
  312.                doline(x*7+1, y*7+1, x*7+5, y*7+5);
  313.                doline(x*7+5, y*7+1, x*7+1, y*7+5);
  314.              end;
  315.         'e': begin
  316.                setcolor(c1);
  317.                rectangle(x*7+MAP_X, y*7+MAP_Y, x*7+MAP_X+6, y*7+MAP_Y+6);
  318.              end;
  319.         'f': case c2 of
  320.                2: begin {east}
  321.                     setcolor(c1);
  322.                     doline(x*7,   y*7+3, x*7+6, y*7+3);
  323.                     doline(x*7+6, y*7+3, x*7+3, y*7);
  324.                     doline(x*7+6, y*7+3, x*7+3, y*7+6);
  325.                   end;
  326.                0: begin {north}
  327.                     setcolor(c1);
  328.                     doline(x*7+3, y*7+6, x*7+3, y*7);
  329.                     doline(x*7+3, y*7,   x*7,   y*7+3);
  330.                     doline(x*7+3, y*7,   x*7+6, y*7+3);
  331.                   end;
  332.                6: begin {west}
  333.                     setcolor(c1);
  334.                     doline(x*7+6, y*7+3, x*7,   y*7+3);
  335.                     doline(x*7,   y*7+3, x*7+3, y*7);
  336.                     doline(x*7,   y*7+3, x*7+3, y*7+6);
  337.                   end;
  338.                4: begin {south}
  339.                     setcolor(c1);
  340.                     doline(x*7+3, y*7,   x*7+3, y*7+6);
  341.                     doline(x*7+3, y*7+6, x*7,   y*7+3);
  342.                     doline(x*7+3, y*7+6, x*7+6, y*7+3);
  343.                   end;
  344.                1: begin {northeast}
  345.                     setcolor(c1);
  346.                     doline(x*7,   y*7+6, x*7+6, y*7);
  347.                     doline(x*7+6, y*7,   x*7+3, y*7);
  348.                     doline(x*7+6, y*7,   x*7+6, y*7+3);
  349.                   end;
  350.                7: begin {northwest}
  351.                     setcolor(c1);
  352.                     doline(x*7+6, y*7+6, x*7,   y*7);
  353.                     doline(x*7,   y*7,   x*7+3, y*7);
  354.                     doline(x*7,   y*7,   x*7,   y*7+3);
  355.                   end;
  356.                3: begin {southeast}
  357.                     setcolor(c1);
  358.                     doline(x*7,   y*7,   x*7+6, y*7+6);
  359.                     doline(x*7+6, y*7+6, x*7+3, y*7+6);
  360.                     doline(x*7+6, y*7+6, x*7+6, y*7+3);
  361.                   end;
  362.                5: begin {southwest}
  363.                     setcolor(c1);
  364.                     doline(x*7+6, y*7,   x*7,   y*7+6);
  365.                     doline(x*7,   y*7+6, x*7+3, y*7+6);
  366.                     doline(x*7  , y*7+6, x*7,   y*7+3);
  367.                   end;
  368.              end;
  369.       end;
  370.     end;
  371. end;
  372.  
  373.  
  374. procedure display_map;
  375. var i, j     : integer;
  376.     disp_obj : word;
  377. begin
  378.   j := 63;
  379.   i := 0;
  380.   repeat
  381.     setfillstyle(1, 0);
  382.     dobar(i*7, j*7, i*7+6, j*7+6);
  383.     if show_floor then
  384.       output(i, j, mapgraph[levelmap[i,j]])      {Show everything}
  385.     else
  386.       if not (levelmap[i,j] in [$6a..$8f]) then
  387.         output(i,j,mapgraph[levelmap[i,j]]);     {Show walls & doors}
  388.     if show_objects then
  389.       begin                                      {Show objects}
  390.         disp_obj := objectmap[i,j];
  391.         if (guards_1 and (disp_obj in [$6c..$7c,$7c..$85,$8a..$8d,$d8..$df]))
  392.           then output(i, j, objgraph[disp_obj]);
  393.         if (guards_3 and (disp_obj in [$90..$9f,$a2..$a9,$ae..$b1,$ea..$f1]))
  394.           then output(i, j, objgraph[disp_obj]);
  395.         if (guards_4 and (disp_obj in [$b4..$c3,$c6..$cd,$d2..$d5]))
  396.           then output(i, j, objgraph[disp_obj]);
  397.         if (guards_4 and (disp_obj>$fb) and (disp_obj<$104))
  398.           then output(i, j, objgraph[disp_obj]);
  399.         if (guards_s and (disp_obj in [$c4,$c5,$d6,$d7,$e0..$e3,$6a,$6b,$8e,$8f,$a0,$a1,$b2,$b3,$7d]))
  400.           then output(i, j, objgraph[disp_obj]);
  401.         if (treasure and (disp_obj in [$34..$38]))
  402.           then output(i, j, objgraph[disp_obj]);
  403.         if (ammofood and (disp_obj in [$2f,$30..$33,$38,$48,$1d]))
  404.           then output(i, j, objgraph[disp_obj]);
  405.         if not(guards_1 or guards_3 or guards_4 or guards_s or treasure or ammofood)
  406.           then output(i, j, objgraph[disp_obj]);
  407.       end;
  408.     inc(i);
  409.     if i=64 then
  410.       begin
  411.         i := 0;
  412.         dec(j);
  413.       end;
  414.   until (j<0) or keypressed;
  415. end;
  416.  
  417.  
  418. procedure read_levels;
  419. var headfile,
  420.     mapfile  : file;
  421.     s,o,
  422.     size     : word;
  423.     idsig    : string[4];
  424.     level    : integer;
  425.     levelptr : longint;
  426.     tempstr  : string[16];
  427.     map_pointer,
  428.     object_pointer,
  429.     other_pointer    : longint;
  430.  
  431. begin
  432.   idsig   := '    ';
  433.   tempstr := '                ';
  434.   assign(headfile,GAMEPATH+HEADFILENAME);
  435.   {$I-} reset(headfile, 1); {$I+}
  436.   if ioresult<>0 then
  437.     begin
  438.       writeln('error opening ',HEADFILENAME);
  439.       halt(1);
  440.     end;
  441.   assign(mapfile,GAMEPATH+MAPFILENAME);
  442.   {$I-} reset(mapfile, 1); {$I+}
  443.   if ioresult<>0 then
  444.     begin
  445.       writeln('error opening ',MAPFILENAME);
  446.       halt(1);
  447.     end;
  448.  
  449.   for level:= 1 to LEVELS do
  450.     begin
  451.       seek(headfile, 2+(level-1)*4);
  452.       blockread(headfile, levelptr, 4);
  453.       seek(mapfile, levelptr);
  454.       with maps[level] do
  455.         begin
  456.           blockread(mapfile, map_pointer, 4);
  457.           blockread(mapfile, object_pointer, 4);
  458.           blockread(mapfile, other_pointer, 4);
  459.           blockread(mapfile, map.size, 2);
  460.           blockread(mapfile, objects.size, 2);
  461.           blockread(mapfile, other.size, 2);
  462.           blockread(mapfile, width, 2);
  463.           blockread(mapfile, height, 2);
  464.           name[0] := #16;
  465.           blockread(mapfile, name[1], 16);
  466.  
  467.           if GAME_VERSION=1.1 then
  468.             blockread(mapfile, idsig[1], 4);
  469.  
  470.           seek(mapfile, map_pointer);
  471.           getmem(map.data, map.size);
  472.           s := seg(map.data^);
  473.           o := ofs(map.data^);
  474.           blockread(mapfile, mem[s:o], map.size);
  475.  
  476.           seek(mapfile, object_pointer);
  477.           getmem(objects. data,objects.size);
  478.           s := seg(objects.data^);
  479.           o := ofs(objects.data^);
  480.           blockread(mapfile, mem[s:o], objects.size);
  481.  
  482.           seek(mapfile, other_pointer);
  483.           getmem(other.data, other.size);
  484.           s := seg(other.data^);
  485.           o := ofs(other.data^);
  486.           blockread(mapfile, mem[s:o], other.size);
  487.  
  488.           if GAME_VERSION=1.0 then
  489.             blockread(mapfile, idsig[1], 4);
  490.         end;
  491.     end;
  492.   close(mapfile);
  493.   close(headfile);
  494. end;
  495.  
  496.  
  497. procedure write_levels;
  498. var headfile,
  499.     mapfile  : file;
  500.     abcd,
  501.     s,o,
  502.     size     : word;
  503.     idsig    : string[4];
  504.     level    : integer;
  505.     levelptr : longint;
  506.     tempstr  : string[16];
  507.     map_pointer,
  508.     object_pointer,
  509.     other_pointer    : longint;
  510.  
  511. begin
  512.   abcd    := $abcd;
  513.   idsig   := '!ID!';
  514.   tempstr := 'TED5v1.0';
  515.   assign(headfile, GAMEPATH+HEADFILENAME);
  516.   rewrite(headfile, 1);
  517.   assign(mapfile, GAMEPATH+MAPFILENAME);
  518.   rewrite(mapfile, 1);
  519.  
  520.   blockwrite(headfile, abcd, 2);
  521.   blockwrite(mapfile, tempstr[1], 8);
  522.   levelptr := 8;
  523.  
  524.   for level:=1 to LEVELS do
  525.     begin
  526.       with maps[level] do
  527.         begin
  528.           if GAME_VERSION=1.1 then
  529.             begin
  530.               map_pointer := levelptr;
  531.               s := seg(map.data^);
  532.               o := ofs(map.data^);
  533.               blockwrite(mapfile, mem[s:o], map.size);
  534.               inc(levelptr, map.size);
  535.  
  536.               object_pointer := levelptr;
  537.               s := seg(objects.data^);
  538.               o := ofs(objects.data^);
  539.               blockwrite(mapfile, mem[s:o], objects.size);
  540.               inc(levelptr, objects.size);
  541.  
  542.               other_pointer := levelptr;
  543.               s := seg(other.data^);
  544.               o := ofs(other.data^);
  545.               blockwrite(mapfile, mem[s:o], other.size);
  546.               inc(levelptr, other.size);
  547.  
  548.               blockwrite(headfile, levelptr, 4);
  549.               blockwrite(mapfile, map_pointer, 4);
  550.               blockwrite(mapfile, object_pointer, 4);
  551.               blockwrite(mapfile, other_pointer, 4);
  552.               blockwrite(mapfile, map.size, 2);
  553.               blockwrite(mapfile, objects.size, 2);
  554.               blockwrite(mapfile, other.size, 2);
  555.               blockwrite(mapfile, width, 2);
  556.               blockwrite(mapfile, height, 2);
  557.               name[0] := #16;
  558.               blockwrite(mapfile, name[1], 16);
  559.               inc(levelptr, 38);
  560.             end
  561.           else
  562.             begin
  563.               blockwrite(headfile, levelptr, 4);
  564.               map_pointer    := levelptr+38;
  565.               object_pointer := map_pointer+map.size;
  566.               other_pointer  := object_pointer+objects.size;
  567.  
  568.               blockwrite(mapfile, map_pointer, 4);
  569.               blockwrite(mapfile, object_pointer, 4);
  570.               blockwrite(mapfile, other_pointer, 4);
  571.               blockwrite(mapfile, map.size, 2);
  572.               blockwrite(mapfile, objects.size, 2);
  573.               blockwrite(mapfile, other.size, 2);
  574.               blockwrite(mapfile, width, 2);
  575.               blockwrite(mapfile, height, 2);
  576.               name[0] := #16;
  577.               blockwrite(mapfile, name[1], 16);
  578.  
  579.               s := seg(map.data^);
  580.               o := ofs(map.data^);
  581.               blockwrite(mapfile, mem[s:o], map.size);
  582.               s := seg(objects.data^);
  583.               o := ofs(objects.data^);
  584.               blockwrite(mapfile, mem[s:o], objects.size);
  585.               s := seg(other.data^);
  586.               o := ofs(other.data^);
  587.               blockwrite(mapfile, mem[s:o], other.size);
  588.               inc(levelptr, map.size+objects.size+other.size+38);
  589.             end;
  590.           blockwrite(mapfile, idsig[1], 4);
  591.           inc(levelptr, 4);
  592.         end;
  593.     end;
  594.   close(mapfile);
  595.   close(headfile);
  596. end;
  597.  
  598.  
  599. procedure a7a8_expand(src: data_block; var dest: data_block);
  600. var s, o,
  601.     s2, o2,
  602.     index, index2,
  603.     size,
  604.     length,
  605.     data,
  606.     newsize  : word;
  607.     goback1  : byte;
  608.     goback2  : word;
  609.     i        : integer;
  610.  
  611. begin
  612.   s := seg(src.data^);
  613.   o := ofs(src.data^);
  614.   index := 0;
  615.   move(mem[s:o+index], dest.size, 2);
  616.   inc(index, 2);
  617.   getmem(dest.data, dest.size);
  618.   s2 := seg(dest.data^);
  619.   o2 := ofs(dest.data^);
  620.   index2 := 0;
  621.  
  622.   repeat
  623.     move(mem[s:o+index], data, 2);
  624.     inc(index, 2);
  625.     case hi(data) of
  626.       $a7: begin
  627.              length := lo(data);
  628.              move(mem[s:o+index], goback1, 1);
  629.              inc(index, 1);
  630.              move(mem[s2:o2+index2-goback1*2], mem[s2:o2+index2], length*2);
  631.              inc(index2,length*2);
  632.            end;
  633.       $a8: begin
  634.              length := lo(data);
  635.              move(mem[s:o+index], goback2, 2);
  636.              inc(index, 2);
  637.              move(mem[s2:o2+goback2*2], mem[s2:o2+index2], length*2);
  638.              inc(index2, length*2);
  639.            end;
  640.       else begin
  641.              move(data, mem[s2:o2+index2], 2);
  642.              inc(index2, 2);
  643.            end;
  644.     end;
  645.   until index=src.size;
  646. end;
  647.  
  648.  
  649. procedure expand(d: data_block; var g: grid);
  650. var i,x,y : integer;
  651.     s,o,
  652.     data,
  653.     count : word;
  654.     temp  : data_block;
  655.  
  656. begin
  657.   if GAME_VERSION = 1.1 then
  658.     a7a8_expand(d, temp)
  659.   else
  660.     temp := d;
  661.  
  662.   x := 0;
  663.   y := 0;
  664.   s := seg(temp.data^);
  665.   o := ofs(temp.data^);
  666.   inc(o, 2);
  667.   while (y<64) do
  668.     begin
  669.       move(mem[s:o], data, 2);
  670.       inc(o, 2);
  671.       if data=$abcd then
  672.         begin
  673.           move(mem[s:o], count, 2);
  674.           inc(o, 2);
  675.           move(mem[s:o], data, 2);
  676.           inc(o, 2);
  677.           for i:=1 to count do
  678.             begin
  679.               g[x,y] := data;
  680.               inc(x);
  681.               if x=64 then
  682.                 begin
  683.                   x := 0;
  684.                   inc(y);
  685.                 end;
  686.             end;
  687.         end
  688.       else
  689.         begin
  690.           g[x,y] := data;
  691.           inc(x);
  692.           if x=64 then
  693.             begin
  694.               x := 0;
  695.               inc(y);
  696.             end;
  697.         end;
  698.     end;
  699.   if GAME_VERSION=1.1 then
  700.     freemem(temp.data, temp.size);
  701. end;
  702.  
  703.  
  704. procedure compress(g: grid; var d: data_block);
  705. var temp  : pointer;
  706.     size  : word;
  707.     abcd,
  708.     s,o,
  709.     olddata,
  710.     data,
  711.     nextdata,
  712.     count : word;
  713.     x,y,i : integer;
  714.     temp2 : pointer;
  715.  
  716. begin
  717.   abcd := $abcd;
  718.   x    := 0;
  719.   y    := 0;
  720.   getmem(temp, 8194);
  721.   s := seg(temp^);
  722.   o := ofs(temp^);
  723.   data := $2000;
  724.   move(data, mem[s:o], 2);
  725.  
  726.   size := 2;
  727.   data := g[0,0];
  728.   while (y<64) do
  729.     begin
  730.       count := 1;
  731.       repeat
  732.         inc(x);
  733.         if x=64 then
  734.           begin
  735.             x :=0;
  736.             inc(y);
  737.           end;
  738.         if y<64 then
  739.           nextdata:= g[x,y];
  740.         inc(count);
  741.       until (nextdata<>data) or (y=64);
  742.       dec(count);
  743.       if count<3 then
  744.         begin
  745.           for i:= 1 to count do
  746.             begin
  747.               move(data, mem[s:o+size], 2);
  748.               inc(size, 2);
  749.             end;
  750.         end
  751.       else
  752.         begin
  753.           move(abcd, mem[s:o+size], 2);
  754.           inc(size, 2);
  755.           move(count, mem[s:o+size], 2);
  756.           inc(size, 2);
  757.           move(data, mem[s:o+size], 2);
  758.           inc(size, 2);
  759.         end;
  760.       data := nextdata;
  761.     end;
  762.   getmem(temp2, size);
  763.   move(temp^, temp2^, size);
  764.   freemem(temp, 8194);
  765.  
  766.   if GAME_VERSION=1.1 then
  767.     begin
  768.       getmem(temp, size+2);
  769.       s := seg(temp^);
  770.       o := ofs(temp^);
  771.       move(size, mem[s:o], 2);
  772.       move(temp2^, mem[s:o+2], size);
  773.       d.data := temp;
  774.       d.size := size+2;
  775.       freemem(temp2, size);
  776.     end
  777.   else
  778.     begin
  779.       d.data := temp2;
  780.       d.size := size;
  781.     end;
  782. end;
  783.  
  784.  
  785. procedure copy_level; { DGH 5/93 }
  786. begin
  787.    tempobj := objectmap;
  788.    tempmap := levelmap;
  789. end;
  790.  
  791.  
  792. procedure paste_level; { DGH 5/93 }
  793. begin
  794.        objectmap := tempobj;
  795.        levelmap  := tempmap;
  796. end;
  797.  
  798.  
  799. procedure exchange; { DGH 5/93 }
  800. var   i, j      : integer;
  801.       tempobj1,
  802.       tempmap1  : word;
  803. begin
  804.   for i:=0 to 63 do
  805.     for j:=0 to 63 do
  806.       begin
  807.         tempobj1  := objectmap[i,j];
  808.         tempmap1  := levelmap[i,j];
  809.         objectmap[i,j] := tempobj[i,j];
  810.         levelmap[i,j]  := tempmap[i,j];
  811.         tempobj[i,j]   := tempobj1;
  812.         tempmap[i,j]   := tempmap1;
  813.       end;
  814. end;
  815.  
  816.  
  817. procedure print_help;   {DGH 5/93 }
  818. var   StartX   : integer;
  819.       StartY   : integer;
  820.       DeltaY   : integer;
  821. begin
  822.    StartX := MAP_X+462;
  823.    StartY := MAP_Y+380;
  824.    DeltaY := 9;
  825.    setcolor(15);
  826.    setfillstyle(1,0);
  827.    bar(StartX, StartY, 639, 479);
  828.    outtextxy(StartX, StartY, 'O = Toggle Objects');
  829.    StartY := StartY + DeltaY;
  830.    outtextxy(StartX, StartY, 'F = Toggle Floor');
  831.    StartY := StartY + DeltaY;
  832.    outtextxy(StartX, StartY, 'C = Clear Floor');
  833.    StartY := StartY + DeltaY;
  834.    outtextxy(StartX, StartY, 'S = Toggle Stats/Help');
  835.    StartY := StartY + DeltaY;
  836.    if copy then setcolor(14) else setcolor(15);
  837.    outtextxy(StartX, StartY, 'M = Memorize Level');
  838.    StartY := StartY + DeltaY;
  839.    if (excng and copy) then setcolor(14);
  840.    if (excng and not copy) then setcolor (12);
  841.    if not excng then setcolor(15);
  842.    outtextxy(StartX, StartY, 'E = Exchange Level');
  843.    setcolor(15);
  844.    if (not copy and xfer) then setcolor(12);
  845.    if (copy and xfer) then setcolor(14);
  846.    StartY := StartY + DeltaY;
  847.    outtextxy(StartX, StartY, 'T = Transfer Level');
  848.    setcolor(15);
  849.    StartY := StartY + DeltaY;
  850.    outtextxy(startx, starty, 'R = Read floor file');
  851.    StartY := StartY + DeltaY;
  852.    outtextxy(startx, starty, 'W = Write floor file');
  853.    StartY := StartY + DeltaY;
  854.    outtextxy(startx, starty, 'SPACE = Toggle mode');
  855.    StartY := StartY + DeltaY;
  856.    outtextxy(StartX, StartY, 'Q = Quit');
  857.    delay(200);
  858. end;
  859.  
  860.  
  861. procedure print_version; { DGH 5/93 }
  862. begin
  863.   setfillstyle(1,0);
  864.   bar(180, TEXTLOC, 461, 479);
  865.   setcolor(12);
  866.   outtextxy(188, TEXTLOC, 'Mapedit v'+VERSION);
  867. end;
  868.  
  869.  
  870. procedure get_filename(var filename: string); { BDB 6/93 }
  871. var FnCount,
  872.     ExtCount,
  873.     TotalCount,
  874.     ColumnPtr  : integer;
  875.     key        : char;
  876.     Done       : boolean;
  877. begin
  878.   setfillstyle(1,0);
  879.   bar(MAP_X, MAP_Y, MAP_X+448, MAP_Y+448);
  880.   setcolor(15);
  881.   outtextxy(MAP_X, MAP_Y,'Enter filename:      (Press ESC to abort)');
  882.  
  883.   FnCount    := 0;
  884.   ExtCount   := -1;
  885.   TotalCount := 0;
  886.   filename   := '';
  887.   ColumnPtr  := MAP_X;
  888.   Done       := false;
  889.  
  890.   repeat
  891.     repeat
  892.       outtextxy(ColumnPtr, MAP_Y+10, #95);
  893.       repeat until keypressed;
  894.       setcolor(0);
  895.       outtextxy(ColumnPtr, MAP_Y+10, #219);
  896.       setcolor(15);
  897.       key := readkey;
  898.       if key=#0 then
  899.         begin
  900.           key := readkey;
  901.           key := #0;
  902.         end;
  903.     until key in ['0'..'9','A'..'Z','a'..'z', #08, #13, #27, #46];
  904.  
  905.     if ((key=#13) or (key=#27)) then Done := true  { CR or ESC }
  906.     else
  907.       begin
  908.         if (key=#08) then                              { Backspace }
  909.           begin
  910.             if TotalCount>0 then
  911.               begin
  912.                 delete(filename, TotalCount, 1);
  913.                 if ExtCount>=0 then ExtCount := ExtCount - 1
  914.                                else FnCount  := FnCount  - 1;
  915.                 ColumnPtr := ColumnPtr - 8;
  916.                 setcolor(0);
  917.                 outtextxy(ColumnPtr, MAP_Y+10, #219);
  918.                 setcolor(15);
  919.               end
  920.           end
  921.         else if TotalCount<12 then
  922.           if (((key=#46) and (ExtCount<0) and (FnCount>0))   or
  923.               ((key<>#46) and not((FnCount=8) and (ExtCount<0)) and (ExtCount<3)))
  924.             then begin
  925.               filename := filename + key;
  926.               outtextxy(ColumnPtr, MAP_Y+10, key);
  927.               ColumnPtr := ColumnPtr + 8;
  928.               if (key=#46) then ExtCount := ExtCount + 1
  929.               else if ExtCount >= 0 then ExtCount := ExtCount + 1
  930.                                     else FnCount  := FnCount  + 1;
  931.             end;
  932.         TotalCount := FnCount + ExtCount + 1;
  933.       end;
  934.  
  935.   until Done;
  936.   if key=#27 then filename := 'ABORT';
  937. end;
  938.  
  939.  
  940. procedure error_read(ecode : integer); { DGH 5/93 ; BDB 6/93 }
  941. var temp : string[3];
  942. begin
  943.   str(ecode, temp);
  944.   outtextxy(MAP_X, MAP_Y+50, 'Error reading floor file.');
  945. end;
  946.  
  947.  
  948. procedure error_write(ecode : integer); { DGH 5/93 ; BDB 6/93 }
  949. var temp : string[3];
  950. begin
  951.   str(ecode, temp);
  952.   outtextxy(MAP_X, MAP_Y+50, 'Error writing floor file.');
  953. end;
  954.  
  955.  
  956. procedure read_floor; { DGH 5/93 ; BDB 6/93 }
  957. var floor_file : file;
  958.     numread1   : word;
  959.     numread2   : word;
  960.     size       : word;
  961.     filename   : string[12];
  962.     key        : char;
  963.     ior        : integer;
  964.  
  965. begin
  966.   get_filename(filename);
  967.   if filename<>'ABORT' then
  968.     begin
  969.       size := sizeof(tempmap);
  970.       Assign(floor_file, filename);
  971.       {$I-} reset(floor_file,1); {$I+}
  972.       ior := ioresult;
  973.       if ior <> 0 then error_read(ior)
  974.       else
  975.         begin
  976.           blockread(floor_file, tempmap, sizeof(tempmap), numread1);
  977.           blockread(floor_file, tempobj, sizeof(tempmap), numread2);
  978.           if (numread1<>size) or (numread2<>size) then error_read(999)
  979.           else
  980.             begin
  981.               copy := true;
  982.               outtextxy(MAP_X, MAP_Y+50, 'Floor file read.  Use "E" or "T" command to insert.');
  983.             end;
  984.           close(floor_file);
  985.         end;
  986.       outtextxy(MAP_X, MAP_Y+70, 'Press any key to continue . . .');
  987.       repeat until keypressed;
  988.       key := readkey;
  989.     end;
  990.   print_help;
  991.   display_map;
  992. end;
  993.  
  994.  
  995. procedure write_floor; { DGH 5/93 ; BDB 6/93 }
  996. var floor_file : file;
  997.     numwrite1  : word;
  998.     numwrite2  : word;
  999.     size       : word;
  1000.     filename   : string[12];
  1001.     key        : char;
  1002.     ior        : integer;
  1003.  
  1004. begin
  1005.   get_filename(filename);
  1006.   if filename<>'ABORT' then
  1007.     begin
  1008.       size := sizeof(tempmap);
  1009.       Assign(floor_file, filename);
  1010.       {$I-} rewrite(floor_file,1); {$I+}
  1011.       ior := ioresult;
  1012.       if ior <> 0 then error_write(ior)
  1013.       else
  1014.         begin
  1015.           blockwrite(floor_file, levelmap,  sizeof(levelmap),  numwrite1);
  1016.           blockwrite(floor_file, objectmap, sizeof(objectmap), numwrite2);
  1017.           if (numwrite1<>size) or (numwrite2<>size) then error_write(999);
  1018.           close(floor_file);
  1019.           outtextxy(MAP_X, MAP_Y+50, 'Floor file written.');
  1020.         end;
  1021.       outtextxy(MAP_X, MAP_Y+70, 'Press any key to continue . . .');
  1022.       repeat until keypressed;
  1023.       key := readkey;
  1024.     end;
  1025.   display_map;
  1026. end;
  1027.  
  1028.  
  1029. procedure print_stats;       { BDB 4/93 }
  1030. var   i, j     : integer;
  1031.       Tempstr  : string;
  1032.       Statics  : integer;
  1033.       L1Guards : integer;
  1034.       L3Guards : integer;
  1035.       L4Guards : integer;
  1036.       SGuards  : integer;
  1037.       TGuards  : integer;
  1038.       Prizes   : integer;
  1039.       Doors    : integer;
  1040.       SecDoors : integer;
  1041.       StartX   : integer;
  1042.       StartY   : integer;
  1043.       DeltaY   : integer;
  1044. begin
  1045.   if stats then
  1046.     begin
  1047.       Statics  := 0;
  1048.       L1Guards := 0;
  1049.       L3Guards := 0;
  1050.       L4Guards := 0;
  1051.       SGuards  := 0;
  1052.       TGuards  := 0;
  1053.       Prizes   := 0;
  1054.       Doors    := 0;
  1055.       SecDoors := 0;
  1056.       StartX   := MAP_X+462;
  1057.       StartY   := MAP_Y+380;
  1058.       DeltaY   := 9;
  1059.  
  1060.       for i:=0 to 63 do
  1061.         for j:=0 to 63 do
  1062.           begin
  1063.             if objectmap[i,j] in [$17..$4a]
  1064.               then Statics  := Statics+1;
  1065.             if objectmap[i,j] in [$6c..$7c,$7e..$85,$8a..$8d,$d8..$df]
  1066.               then L1Guards := L1Guards+1;
  1067.             if objectmap[i,j] in [$90..$9f,$a2..$a9,$ae..$b1,$ea..$f1]
  1068.               then L3Guards := L3Guards+1;
  1069.             if objectmap[i,j] in [$b4..$c3,$c6..$cd,$d2..$d5]
  1070.               then L4Guards := L4Guards+1;
  1071.             if (objectmap[i,j]>$fb) and (objectmap[i,j]<$104)
  1072.               then L4Guards := L4Guards+1;
  1073.             if objectmap[i,j] in [$c4,$c5,$d6,$d7,$e0..$e3,$6a,$6b,$8e,$8f,$a0,$a1,$b2,$b3,$7d]
  1074.               then SGuards  := SGuards+1;
  1075.             if objectmap[i,j] in [$34..$38]
  1076.               then Prizes   := Prizes+1;
  1077.             if objectmap[i,j] = $62
  1078.               then SecDoors := SecDoors+1;
  1079.             if levelmap[i, j] in [$5a..$5f,$64..$65]
  1080.               then Doors    := Doors+1;
  1081.       end;
  1082.    TGuards := L1Guards + L3Guards + L4Guards + SGuards;
  1083.    setcolor(15);
  1084.    setfillstyle(1,0);
  1085.    bar(StartX, StartY, 639, 479);
  1086.  
  1087.    if Statics<400 then setcolor(15) else setcolor(12);
  1088.    str(Statics:4, Tempstr);
  1089.    outtextxy(StartX, StartY,Tempstr+'  Static Objects');
  1090.  
  1091.    if TGuards<150 then setcolor(15) else setcolor(12);
  1092.    StartY := StartY + DeltaY;
  1093.    str(TGuards:4, Tempstr);
  1094.    outtextxy(StartX, StartY,Tempstr+'  Total Guards  ');
  1095.  
  1096.    if Doors<65 then setcolor(15) else setcolor(12);
  1097.    StartY := StartY + DeltaY;
  1098.    str(Doors:4, Tempstr);
  1099.    outtextxy(StartX, StartY,Tempstr+'  Doors         ');
  1100.  
  1101.    if guards_1 then setcolor(14) else setcolor(7);
  1102.    StartY := StartY + DeltaY + 4;
  1103.    str(L1Guards:4, Tempstr);
  1104.    outtextxy(StartX, StartY,Tempstr+'  Level 1 Guards');
  1105.  
  1106.    if guards_3 then setcolor(14) else setcolor(7);
  1107.    StartY := StartY + DeltaY;
  1108.    str(L3Guards:4, Tempstr);
  1109.    outtextxy(StartX, StartY,Tempstr+'  Level 3 Guards');
  1110.  
  1111.    if guards_4 then setcolor(14) else setcolor(7);
  1112.    StartY := StartY + DeltaY;
  1113.    str(L4Guards:4, Tempstr);
  1114.    outtextxy(StartX, StartY,Tempstr+'  Level 4 Guards');
  1115.  
  1116.    if guards_s then setcolor(14) else setcolor(7);
  1117.    StartY := StartY + DeltaY;
  1118.    str(SGuards:4, Tempstr);
  1119.    outtextxy(StartX, StartY,Tempstr+'  Super   Guards');
  1120.  
  1121.    setcolor(7);
  1122.    StartY := StartY + DeltaY + 4;
  1123.    str(SecDoors:4, Tempstr);
  1124.    outtextxy(StartX, StartY,Tempstr+'  Secret Doors  ');
  1125.  
  1126.    if treasure then setcolor(14) else setcolor(7);
  1127.    StartY := StartY + DeltaY;
  1128.    str(Prizes:4, Tempstr);
  1129.    outtextxy(StartX, StartY,Tempstr+'  $$$ / One-ups ');
  1130.   end;
  1131. end;
  1132.  
  1133.  
  1134. procedure clear_level(n: integer);
  1135. var x,y: integer;
  1136. begin
  1137.   mhide;
  1138.   for x:=0 to 63 do
  1139.     for y:=0 to 63 do
  1140.       begin
  1141.         levelmap[x,y]  := n;
  1142.         objectmap[x,y] := 0;
  1143.       end;
  1144.   for x:=0 to 63 do
  1145.     begin
  1146.       levelmap[x,0]  := 1;
  1147.       levelmap[x,63] := 1;
  1148.       levelmap[0,x]  := 1;
  1149.       levelmap[63,x] := 1;
  1150.     end;
  1151.   display_map;
  1152.   print_stats;
  1153.   mshow;
  1154. end;
  1155.  
  1156.  
  1157. function str_to_hex(s: string): word;
  1158. var temp : word;
  1159.     i    : integer;
  1160. begin
  1161.   temp := 0;
  1162.   for i:=1 to length(s) do
  1163.     begin
  1164.       temp := temp * 16;
  1165.       case s[i] of
  1166.         '0'..'9': temp := temp + ord(s[i]) - ord('0');
  1167.         'a'..'f': temp := temp + ord(s[i]) - ord('a')+10;
  1168.         'A'..'F': temp := temp + ord(s[i]) - ord('A')+10;
  1169.       end;
  1170.     end;
  1171.   str_to_hex := temp;
  1172. end;
  1173.  
  1174.  
  1175. procedure showlegend(which, start, n: integer);
  1176. var i,x,y : integer;
  1177.     save  : boolean;
  1178. begin
  1179.   mhide;
  1180.   save := show_objects;
  1181.   show_objects := true;
  1182.   setfillstyle(1,0);
  1183.   bar(MAP_X+461, 4, 634, 350);
  1184.   x := 66;
  1185.   y := 0;
  1186.   for i:=start to start+n-1 do
  1187.     begin
  1188.       if which=0 then
  1189.         begin
  1190.           output(x, y, mapgraph[legmapptr[i]]);
  1191.           outtext(x+2, y, 15, mapnames[legmapptr[i]]);
  1192.         end
  1193.       else
  1194.         begin
  1195.           output(x, y, objgraph[legobjptr[i]]);
  1196.           outtext(x+2, y, 15, objnames[legobjptr[i]]);
  1197.         end;
  1198.       inc(y, 2);
  1199.     end;
  1200.   show_objects := save;
  1201.   mshow;
  1202. end;
  1203.  
  1204.  
  1205. function inside(x1, y1, x2, y2, x, y: integer): boolean;
  1206. begin
  1207.   inside := (x>=x1) and (x<=x2) and (y>=y1) and (y<=y2);
  1208. end;
  1209.  
  1210.  
  1211. procedure wait_for_mouserelease;
  1212. begin
  1213.   repeat
  1214.     mpos(mouseloc);
  1215.   until mouseloc.buttonstatus=0;
  1216. end;
  1217.  
  1218.  
  1219. procedure bevel(x1, y1, x2, y2, c1, c2, c3: integer);
  1220. begin
  1221.   setfillstyle(1,c1);
  1222.   bar(x1,    y1,   x2,   y2);
  1223.   setcolor(c2);
  1224.   line(x1,   y1,   x2,   y1);
  1225.   line(x1+1, y1+1, x2-1, y1+1);
  1226.   line(x2,   y1,   x2,   y2);
  1227.   line(x2-1, y1,   x2-1, y2-1);
  1228.   setcolor(c3);
  1229.   line(x1,   y1+1, x1,   y2);
  1230.   line(x1+1, y1+2, x1+1, y2);
  1231.   line(x1,   y2,   x2-1, y2);
  1232.   line(x1+1, y2-1, x2-2, y2-1);
  1233. end;
  1234.  
  1235.  
  1236. function upper(s: string): string;
  1237. var i: integer;
  1238. begin
  1239.   for i:=1 to length(s) do
  1240.     if s[i] in ['a'..'z'] then
  1241.       s[i] := chr(ord(s[i]) - ord('a') + ord('A'));
  1242.   upper := s;
  1243. end;
  1244.  
  1245.  
  1246. procedure initialize;
  1247. var i         : integer;
  1248.     infile    : text;
  1249.     path      : pathstr;
  1250.     dir       : dirstr;
  1251.     name      : namestr;
  1252.     ext       : extstr;
  1253.     filename  : string;
  1254.     hexstr    : string[4];
  1255.     graphstr  : string[4];
  1256.     name20    : string[20];
  1257.     junk      : char;
  1258.     search    : searchrec;
  1259.     map       : string[12];
  1260.     obj       : string[12];
  1261.     sod,
  1262.     wl1,
  1263.     wl6       : boolean;
  1264.  
  1265. begin
  1266.   writeln('MapEdit  Copyright (c) 1992  Bill Kirby');
  1267.   writeln('Version '+version);
  1268.   writeln;
  1269.   writeln('Modifications by   Dave Huntoon');
  1270.   writeln('                   Bryan Baker');
  1271.   writeln('                   Matt Gruson');
  1272.   writeln;
  1273.  
  1274.   MAPFILENAME := 'maptemp.wl1';
  1275.   filename    := GAMEPATH + MAPFILENAME ;
  1276.   findfirst(filename, $ff, search);
  1277.   if doserror=0 then
  1278.     writeln('Found --> '+MAPFILENAME);
  1279.   if doserror<>0 then
  1280.     begin
  1281.       MAPFILENAME := 'gamemaps.wl1';
  1282.       filename    := GAMEPATH + MAPFILENAME ;
  1283.       findfirst(filename, $ff, search);
  1284.       if doserror=0 then
  1285.         writeln('Found --> '+MAPFILENAME);
  1286.       if doserror<>0 then
  1287.         begin
  1288.           MAPFILENAME := 'gamemaps.wl3';
  1289.           filename    := GAMEPATH + MAPFILENAME ;
  1290.           findfirst(filename, $ff, search);
  1291.           if doserror=0 then
  1292.             writeln('Found --> '+MAPFILENAME);
  1293.           if doserror<>0 then
  1294.             begin
  1295.               MAPFILENAME := 'gamemaps.wl6';
  1296.               filename    := GAMEPATH + MAPFILENAME ;
  1297.               findfirst(filename, $ff, search);
  1298.               if doserror=0 then
  1299.                 writeln('Found --> '+MAPFILENAME);
  1300.               if doserror<>0 then
  1301.                 begin
  1302.                   MAPFILENAME := 'gamemaps.sod';
  1303.                   filename    := GAMEPATH + MAPFILENAME ;
  1304.                   findfirst(filename, $ff, search);
  1305.                   if doserror=0 then
  1306.                     writeln('Found --> '+MAPFILENAME);
  1307.                   if doserror<>0 then
  1308.                     begin
  1309.                       writeln('Error finding map file.');
  1310.                       writeln('  Read your documentation files.');
  1311.                       writeln;
  1312.                       writeln('Be sure that you installed MAPEDIT in the directory where');
  1313.                       writeln('Wolfenstein 3-D or Spear of Destiny is installed.');
  1314.                       halt(0);
  1315.                     end;
  1316.                 end;
  1317.             end;
  1318.         end;
  1319.     end;
  1320.  
  1321.   wl1 := false;
  1322.   wl6 := false;
  1323.   sod := false;
  1324.  
  1325.   filename := search.name;
  1326.   fsplit(filename, dir, name, ext);
  1327.   MAPFILENAME := upper(MAPFILENAME);
  1328.   if upper(ext)='.WL1' then
  1329.     begin
  1330.       LEVELS := 10;
  1331.       if upper(name)='MAPTEMP'
  1332.         then GAME_VERSION := 1.0
  1333.         else GAME_VERSION := 1.1;
  1334.       HEADFILENAME := 'maphead.wl1';
  1335.       wl1 := true;
  1336.     end;
  1337.   if upper(ext)='.WL3' then
  1338.     begin
  1339.       LEVELS := 30;
  1340.       GAME_VERSION :=1.1;
  1341.       HEADFILENAME := 'maphead.wl3';
  1342.       wl6 := true;
  1343.     end;
  1344.   if upper(ext)='.WL6' then
  1345.     begin
  1346.       LEVELS := 60;
  1347.       GAME_VERSION := 1.1;
  1348.       HEADFILENAME := 'maphead.wl6';
  1349.       wl6 := true;
  1350.     end;
  1351.   if upper(ext)='.SOD' then
  1352.     begin
  1353.       LEVELS := 21;
  1354.       GAME_VERSION := 1.1;
  1355.       HEADFILENAME := 'maphead.sod';
  1356.       sod := true;
  1357.     end;
  1358.  
  1359.   filename := GAMEPATH + HEADFILENAME ;
  1360.   findfirst(filename, $ff, search);
  1361.   if doserror=0 then
  1362.     writeln('Found --> '+HEADFILENAME);
  1363.   if doserror<>0 then
  1364.     begin
  1365.       writeln('Error finding MAPHEAD file -> '+ filename);
  1366.       halt(0);
  1367.     end;
  1368.  
  1369.   map := 'mapdata.def' ;
  1370.   obj := 'objdata.def' ;
  1371.   findfirst(map, $ff, search);
  1372.   if doserror=0 then
  1373.     begin
  1374.       writeln('Found --> '+map);
  1375.       findfirst(obj, $ff, search);
  1376.       if doserror=0 then
  1377.         writeln('Found --> '+obj);
  1378.       if doserror<>0 then
  1379.         begin
  1380.           writeln('Error finding --> '+obj);
  1381.           halt(0);
  1382.         end;
  1383.       end;
  1384.  
  1385.   if doserror<>0 then
  1386.     begin
  1387.       if wl1 then
  1388.         begin
  1389.           map := 'mapdata.wl1';
  1390.           obj := 'objdata.wl1';
  1391.         end;
  1392.       if wl6 then
  1393.         begin
  1394.           map := 'mapdata.wl6';
  1395.           obj := 'objdata.wl6';
  1396.         end;
  1397.       if sod then
  1398.         begin
  1399.           map := 'mapdata.sod';
  1400.           obj := 'objdata.sod';
  1401.         end;
  1402.       findfirst(map, $ff, search);
  1403.       if doserror=0 then
  1404.         writeln('Found --> '+map);
  1405.       if doserror<>0 then
  1406.         begin
  1407.           writeln('Error finding -->> '+map+ ' or mapdata.def.');
  1408.           halt(0);
  1409.         end;
  1410.       findfirst(obj, $ff, search);
  1411.       if doserror=0 then
  1412.         writeln('Found --> '+obj);
  1413.       if doserror <> 0 then
  1414.         begin
  1415.           writeln('Error finding --> '+obj);
  1416.           halt(0);
  1417.         end;
  1418.     end;
  1419.  
  1420.   if GAME_VERSION=1.0 then
  1421.     begin
  1422.       writeln('');
  1423.       writeln('***  WARNING  ***');
  1424.       writeln('');
  1425.       writeln('You are running a rather old version of Wolf-3D.');
  1426.       writeln('');
  1427.       writeln('This version supports only a limited number of map and object elements.');
  1428.       writeln('');
  1429.       writeln('You can upgrade to the latest shareware version at a nominal fee');
  1430.       writeln('by calling Apogee.  (You pay only shipping and handling.)');
  1431.       writeln('');
  1432.       writeln('');
  1433.       writeln('(Press any key to continue)');
  1434.       repeat until keypressed;
  1435.       junk := readkey;
  1436.     end;
  1437.  
  1438.   for i:= 0 to 300 do
  1439.     begin
  1440.       mapnames[i]  := 'unknown '+hex(i);
  1441.       objnames[i]  := 'unknown '+hex(i);
  1442.       mapgraph[i]  := 'f010';
  1443.       objgraph[i]  := 'f010';
  1444.       legmapptr[i] := 0;
  1445.       legobjptr[i] := 0;
  1446.     end;
  1447.  
  1448.   assign(infile, map);
  1449.   reset(infile);
  1450.  
  1451.   mapcount := -1;
  1452.   while not eof(infile) do
  1453.     begin
  1454.       readln(infile, hexstr, junk, graphstr, junk, name20);
  1455.       mapnames[str_to_hex(hexstr)] := name20;
  1456.       mapgraph[str_to_hex(hexstr)] := graphstr;
  1457.       mapcount := mapcount + 1;
  1458.       legmapptr[mapcount] := str_to_hex(hexstr);
  1459.     end;
  1460.   close(infile);
  1461.  
  1462.   assign(infile, obj);
  1463.   reset(infile);
  1464.  
  1465.   objcount := -1;
  1466.   while not eof(infile) do
  1467.     begin
  1468.       readln(infile, hexstr, junk, graphstr, junk, name20);
  1469.       objnames[str_to_hex(hexstr)] := name20;
  1470.       objgraph[str_to_hex(hexstr)] := graphstr;
  1471.       objcount := objcount + 1;
  1472.       legobjptr[objcount] := str_to_hex(hexstr);
  1473.     end;
  1474.   close(infile);
  1475.  
  1476. end;
  1477.  
  1478. {-------------------------------------------------}
  1479. {                                                 }
  1480. {VARs for procedure MAIN and associated procedures}
  1481. {                                                 }
  1482. {-------------------------------------------------}
  1483.  
  1484. var gd,gm,
  1485.     i,j,x,y   : integer;
  1486.     infile    : text;
  1487.     level     : word;
  1488.     oldx,oldy : integer;
  1489.     done      : boolean;
  1490.     outstr,
  1491.     tempstr   : string;
  1492.  
  1493.     legendpos : integer;
  1494.     legendtype: integer;
  1495.     newj      : integer;
  1496.  
  1497.     mode        : (map,obj);
  1498.     leftmapval  : integer;  {Value inserted by left button press  - MAP mode}
  1499.     rightmapval : integer;  {Value inserted by right button press - MAP mode}
  1500.     leftobjval  : integer;  {Value inserted by left button press  - OBJ mode}
  1501.     rightobjval : integer;  {Value inserted by right button press - OBJ mode}
  1502.  
  1503.     oldj,oldi : integer;
  1504.  
  1505.     key       : char;
  1506.     control   : boolean;
  1507.  
  1508.  
  1509. procedure showcurrentselection;
  1510. {
  1511.   Removed from inside code body for 6.1 to allow use in
  1512.   several places.  Writes the little 'currently selected
  1513.   attribute' note in the lower-left corner of the screen.
  1514. }
  1515. begin
  1516.   setfillstyle(1,0);
  1517.   bar(0, TEXTLOC+10, MAP_X+192, 479);
  1518.   if mode=map then
  1519.     begin
  1520.       output(0, 66, mapgraph[leftmapval]);
  1521.       outtext(1, 66, 15, ' '+mapnames[leftmapval]+' (MAP)');
  1522.     end
  1523.   else
  1524.     begin
  1525.       output(0, 66, objgraph[leftobjval]);
  1526.       outtext(1, 66, 15, ' '+objnames[leftobjval]+' (OBJ)');
  1527.     end;
  1528. end;
  1529.  
  1530.  
  1531. procedure process_buttons;
  1532. {
  1533.   Added for 6.1 to facilitate easier handling of new functions.
  1534. }
  1535. label done;
  1536. begin
  1537.   if (mem[0:keystataddr] and leftshiftmask>0) or
  1538.      (mem[0:keystataddr] and rightshiftmask>0) then
  1539.  
  1540. { User is holding down a shift key while clicking,
  1541.   so let him/her load an atttribute from the map   }
  1542.  
  1543.     begin
  1544.       if mouseloc.buttonstatus=leftbutton then  {Load if left button}
  1545.         if mode=map then
  1546.           begin
  1547.             leftmapval := levelmap[i,j];        {Load 'MAP' value}
  1548.             showcurrentselection;
  1549.           end
  1550.         else
  1551.           begin
  1552.             leftobjval := objectmap[i,j];       {Load 'OBJ' value}
  1553.             showcurrentselection;
  1554.           end
  1555.  
  1556.       else                                      {Load if right button}
  1557.         if mode=map then
  1558.           rightmapval := levelmap[i,j]          {Load 'MAP' value}
  1559.         else
  1560.           rightobjval := objectmap[i,j];        {Load 'OBJ' value}
  1561.       goto done;                                {Leave procedure}
  1562.     end;
  1563.  
  1564. { Falls through to here is no shift key held down }
  1565.  
  1566.   if mouseloc.buttonstatus=leftbutton then
  1567.     if mode=map then                            {Draw if left button}
  1568.       levelmap[i,j]  := leftmapval
  1569.     else
  1570.       objectmap[i,j] := leftobjval
  1571.   else                                          {Draw if right button}
  1572.     if mode=map then
  1573.       levelmap[i,j]  := rightmapval
  1574.     else
  1575.       objectmap[i,j] := rightobjval;
  1576.  
  1577. done: end;
  1578.  
  1579.  
  1580. procedure set_map_mode;         {Broken out from code body - ver 6.1}
  1581. begin;
  1582.   wait_for_mouserelease;
  1583.   legendpos  := 0;
  1584.   legendtype := 0;
  1585.   mode       := map;
  1586.   showlegend(legendtype, legendpos, 25);
  1587.   showcurrentselection;
  1588. end;
  1589.  
  1590.  
  1591. procedure set_object_mode;      {Broken out from code body - ver 6.1}
  1592. begin
  1593.   wait_for_mouserelease;
  1594.   legendpos  := 0;
  1595.   legendtype := 1;
  1596.   mode       := obj;
  1597.   showlegend(legendtype, legendpos, 25);
  1598.   showcurrentselection;
  1599. end;
  1600.  
  1601.  
  1602. procedure legend_up;            {Broken out from code body - ver 6.1}
  1603. begin
  1604.   wait_for_mouserelease;
  1605.   dec(legendpos, 25);
  1606.   if legendpos<0 then legendpos := 0;
  1607.   showlegend(legendtype, legendpos, 25);
  1608. end;
  1609.  
  1610. procedure legend_down;          {Broken out from code body - ver 6.1}
  1611. begin
  1612.   wait_for_mouserelease;
  1613.   inc(legendpos, 25);
  1614.   if legendtype=0 then
  1615.     begin
  1616.       if (legendpos+25)>mapcount then legendpos := mapcount-24;
  1617.     end
  1618.   else
  1619.     if (legendpos+25)>objcount then legendpos := objcount-24;
  1620.   showlegend(legendtype, legendpos, 25);
  1621. end;
  1622.  
  1623. {----------------------}
  1624. {                      }
  1625. {    MAIN CODE BODY    }
  1626. {                      }
  1627. {----------------------}
  1628.  
  1629. begin
  1630.   clrscr;
  1631.   initialize;
  1632.   directvideo := false;
  1633.   read_levels;
  1634.  
  1635.   gd := vga;
  1636.   gm := vgahi;
  1637.   initgraph(gd, gm, '');
  1638.  
  1639.   settextstyle(0,0,1);
  1640.   mreset(themouse);
  1641.  
  1642.   show_objects := true;
  1643.   show_floor   := false;
  1644.   guards_1     := false;
  1645.   guards_3     := false;
  1646.   guards_4     := false;
  1647.   guards_s     := false;
  1648.   treasure     := false;
  1649.   ammofood     := false;
  1650.   stats        := false;
  1651.   copy         := false;
  1652.   excng        := false;
  1653.   xfer         := false;
  1654.  
  1655.  
  1656.   x          := port[$3da];
  1657.   port[$3c0] := 0;
  1658.  
  1659.   setfillstyle(1,7);
  1660.   bar(0,         0,  MAP_X+452, MAP_Y+452);
  1661.   bar(MAP_X+457, 0,  639,       380);
  1662.  
  1663.   setfillstyle(1,0);
  1664.   bar(2,         2,  MAP_X+450, MAP_Y+450);
  1665.   bar(MAP_X+459, 2,  637,       352);
  1666.   bar(MAP_X+459, 355,637,       378);
  1667.  
  1668.   setcolor(15);
  1669.   outtextxy(MAP_X+463, 364, ' MAP  OBJ  UP  DOWN');
  1670.  
  1671.   setfillstyle(1,7);
  1672.   bar(MAP_X+502, 355, MAP_X+503, 378);
  1673.   bar(MAP_X+542, 355, MAP_X+543, 378);
  1674.   bar(MAP_X+572, 355, MAP_X+573, 378);
  1675.  
  1676.   legendpos   := 0;
  1677.   legendtype  := 0;
  1678.   mode        := map;
  1679.  
  1680.   leftmapval  :=1;       {Default values for buttons - ver 6.1}
  1681.   rightmapval :=0;
  1682.   leftobjval  :=0;
  1683.   rightobjval :=0;
  1684.  
  1685.   setfillstyle(1,0);
  1686.   bar(0, TEXTLOC+10, MAP_X+448, 479);
  1687.  
  1688.   if mode=map then
  1689.     begin
  1690.       output(0, 66, mapgraph[leftmapval]);
  1691.       outtext(1, 66, 15, ' '+mapnames[leftmapval]);
  1692.     end
  1693.   else
  1694.     begin
  1695.       output(0, 66, objgraph[leftmapval]);
  1696.       outtext(1, 66, 15, ' '+objnames[leftmapval]);
  1697.     end;
  1698.  
  1699.   showlegend(legendtype, legendpos, 25);
  1700.  
  1701.   x          := port[$3da];
  1702.   port[$3c0] := 32;
  1703.   mshow;
  1704.   level :=1;
  1705.   done  := false;
  1706.  
  1707.   setfillstyle(1,0);
  1708.   setcolor(15);
  1709.   print_help;
  1710.   print_version;
  1711.   showcurrentselection;
  1712.  
  1713. {-------------}
  1714. {             }
  1715. {  Main Loop  }
  1716. {             }
  1717. {-------------}
  1718.  
  1719.   repeat
  1720.     mhide;
  1721.     setfillstyle(1,0);
  1722.     bar(0, TEXTLOC, MAP_X+173 , TEXTLOC+9);
  1723.  
  1724.     setcolor(14);
  1725.     outtextxy(5, TEXTLOC, maps[level].name);
  1726.  
  1727.     setcolor(15);
  1728.     expand(maps[level].map, levelmap);
  1729.     expand(maps[level].objects, objectmap);
  1730.     display_map;
  1731.     print_stats;
  1732.     mshow;
  1733.     oldx := 0;
  1734.     oldy := 0;
  1735.     key  := #0;
  1736.  
  1737.     repeat
  1738.       repeat
  1739.         mpos(mouseloc);
  1740.         x := mouseloc.column;
  1741.         y := mouseloc.row;
  1742.       until (oldx<>x) or (oldy<>y) or keypressed or (mouseloc.buttonstatus<>0);
  1743.       oldx := x;
  1744.       oldy := y;
  1745.       if (mouseloc.buttonstatus<>0) then        {Mouse Button Pressed}
  1746.         begin
  1747.           if inside(MAP_X, MAP_Y, MAP_X+447, MAP_Y+447, x, y) then
  1748.             begin                      { If inside the map display }
  1749.               mhide;
  1750.               repeat
  1751.                 i := (x-MAP_X) div 7;
  1752.                 j := (y-MAP_Y) div 7;
  1753.                 process_buttons;              {Rev 6.1}
  1754.                 setfillstyle(1,0);
  1755.                 dobar(i*7, j*7, i*7+6, j*7+6);
  1756.                 if show_floor then
  1757.                   output(i, j, mapgraph[levelmap[i,j]])
  1758.                 else
  1759.                   if not (levelmap[i,j] in [$6a..$8f]) then
  1760.                     output(i, j, mapgraph[levelmap[i,j]]);
  1761.                 if show_objects then
  1762.                   output(i, j, objgraph[objectmap[i,j]]);
  1763.                 mpos(mouseloc);
  1764.                 x := mouseloc.column;
  1765.                 y := mouseloc.row;
  1766.               until (not inside(MAP_X, MAP_Y, MAP_X+447, MAP_Y+447, x, y)) or
  1767.                     (mouseloc.buttonstatus=0);
  1768.               mshow;
  1769.               print_stats;
  1770.             end;
  1771.           if inside(464, 355, 506, 378, x, y) then
  1772.              set_map_mode;                     {Inside MAP command box}
  1773.           if inside(509, 355, 546, 378, x, y) then
  1774.              set_object_mode;                  {Inside OBJ command box}
  1775.           if inside(549, 355, 576, 378, x, y) then
  1776.              legend_up;                        {Inside UP command box}
  1777.           if inside(579, 355, 637, 378, x, y) then
  1778.              legend_down;                      {Inside DOWN command box}
  1779.         end;
  1780.  
  1781.       if inside(464, 2, 637, 350, x, y) then
  1782.         begin                          { If inside the legend box }
  1783.           mhide;
  1784.           j := (y-2) div 14;
  1785.           setcolor(15);
  1786.           rectangle(465, j*14+3, 636, j*14+14);
  1787.           repeat
  1788.             mpos(mouseloc);
  1789.             newj := (mouseloc.row-2) div 14;
  1790.             if mouseloc.buttonstatus<>0 then
  1791.               begin { Set current value based on button pressed - ver 6.1 }
  1792.                 if mode=map then
  1793.                   if mouseloc.buttonstatus=leftbutton then
  1794.                     leftmapval  := legmapptr[legendpos+j]
  1795.                   else
  1796.                     rightmapval := legmapptr[legendpos+j]
  1797.                 else
  1798.                   if mouseloc.buttonstatus=leftbutton then
  1799.                     leftobjval  := legobjptr[legendpos+j]
  1800.                   else
  1801.                     rightobjval := legobjptr[legendpos+j];
  1802.                 showcurrentselection;
  1803.               end;
  1804.           until (newj<>j) or (mouseloc.column<464) or keypressed;
  1805.           setcolor(0);
  1806.           rectangle(465, j*14+3, 636, j*14+14);
  1807.           mshow;
  1808.         end;
  1809.  
  1810.       if inside(MAP_X, MAP_Y, MAP_X+447, MAP_Y+447, x, y) then
  1811.         begin                          { If inside the map display }
  1812.           i := (x-MAP_X) div 7;
  1813.           j := (y-MAP_Y) div 7;
  1814.           if (oldj<>j) or (oldi<>i) then
  1815.             begin
  1816.               outstr := '(';
  1817.               str(i:2, tempstr);
  1818.               outstr := outstr+tempstr+',';
  1819.               str(j:2, tempstr);
  1820.               outstr := outstr+tempstr+') MAP: '+mapnames[levelmap[i,j]];
  1821.               setfillstyle(1,0);
  1822.               setcolor(15);
  1823.               bar(188, TEXTLOC, MAP_X+448, 479);
  1824.               outtextxy(188, TEXTLOC, outstr);
  1825.               outstr := '        OBJ: '+objnames[objectmap[i,j]];
  1826.               outtextxy(188, TEXTLOC+10, outstr);
  1827.               oldj := j;
  1828.               oldi := i;
  1829.             end;
  1830.         end
  1831.       else
  1832.         begin
  1833.           mhide;
  1834.           setfillstyle(1,0);
  1835.           bar(188, TEXTLOC, MAP_X+448, 479);
  1836.           mshow;
  1837.         end;
  1838.  
  1839.       if keypressed then
  1840.         begin
  1841.           control := false;
  1842.           key     := readkey;
  1843.           if key=#0 then
  1844.             begin
  1845.               control := true;
  1846.               key     := readkey;
  1847.             end;
  1848.           if control then
  1849.             case key of
  1850.               'H': begin
  1851.                      freemem(maps[level].map.data, maps[level].map.size);
  1852.                      freemem(maps[level].objects.data, maps[level].objects.size);
  1853.                      compress(levelmap, maps[level].map);
  1854.                      compress(objectmap, maps[level].objects);
  1855.                      inc(level);
  1856.                    end;
  1857.               'P': begin
  1858.                      freemem(maps[level].map.data, maps[level].map.size);
  1859.                      freemem(maps[level].objects.data, maps[level].objects.size);
  1860.                      compress(levelmap, maps[level].map);
  1861.                      compress(objectmap, maps[level].objects);
  1862.                      dec(level);
  1863.                    end;
  1864.                                           {keyboard support - ver 6.1}
  1865.               key_pgup : legend_up;
  1866.               key_pgdn : legend_down;
  1867.  
  1868.             end
  1869.           else
  1870.             case key of
  1871.               'q','Q': begin
  1872.                          done := true;
  1873.                          freemem(maps[level].map.data, maps[level].map.size);
  1874.                          freemem(maps[level].objects.data, maps[level].objects.size);
  1875.                          compress(levelmap, maps[level].map);
  1876.                          compress(objectmap, maps[level].objects);
  1877.                        end;
  1878.               'c','C': begin
  1879.                          if mode = map then clear_level(leftmapval)
  1880.                          else clear_level($6c);
  1881.                        end;
  1882.               'o','O': begin
  1883.                          mhide;
  1884.                          show_objects := not show_objects;
  1885.                          display_map;
  1886.                          mshow;
  1887.                        end;
  1888.               'f','F': begin
  1889.                          mhide;
  1890.                          show_floor := not show_floor;
  1891.                          display_map;
  1892.                          if legendtype=0 then
  1893.                            showlegend(legendtype,legendpos,25);
  1894.                          mshow;
  1895.                        end;
  1896.                   '1': begin
  1897.                          mhide;
  1898.                          show_objects := true;
  1899.                          guards_1     := true;
  1900.                          guards_3     := false;
  1901.                          guards_4     := false;
  1902.                          guards_s     := false;
  1903.                          treasure     := false;
  1904.                          ammofood     := false;
  1905.                          stats        := true;
  1906.                          display_map;
  1907.                          print_stats;
  1908.                          mshow;
  1909.                        end;
  1910.                   '2': begin
  1911.                          mhide;
  1912.                          show_objects := true;
  1913.                          guards_1     := false;
  1914.                          guards_3     := false;
  1915.                          guards_4     := false;
  1916.                          guards_s     := false;
  1917.                          treasure     := true;
  1918.                          ammofood     := false;
  1919.                          stats        := true;
  1920.                          display_map;
  1921.                          print_stats;
  1922.                          mshow;
  1923.                        end;
  1924.                   '3': begin
  1925.                          mhide;
  1926.                          show_objects := true;
  1927.                          guards_1     := false;
  1928.                          guards_3     := true;
  1929.                          guards_4     := false;
  1930.                          guards_s     := false;
  1931.                          treasure     := false;
  1932.                          ammofood     := false;
  1933.                          stats        := true;
  1934.                          display_map;
  1935.                          print_stats;
  1936.                          mshow;
  1937.                        end;
  1938.                   '4': begin
  1939.                          mhide;
  1940.                          show_objects := true;
  1941.                          guards_1     := false;
  1942.                          guards_3     := false;
  1943.                          guards_4     := true;
  1944.                          guards_s     := false;
  1945.                          treasure     := false;
  1946.                          ammofood     := false;
  1947.                          stats        := true;
  1948.                          display_map;
  1949.                          print_stats;
  1950.                          mshow;
  1951.                        end;
  1952.                   '5': begin
  1953.                          mhide;
  1954.                          show_objects := true;
  1955.                          guards_1     := false;
  1956.                          guards_3     := false;
  1957.                          guards_4     := false;
  1958.                          guards_s     := true;
  1959.                          treasure     := false;
  1960.                          ammofood     := false;
  1961.                          stats        := true;
  1962.                          display_map;
  1963.                          print_stats;
  1964.                          mshow;
  1965.                        end;
  1966.                   '6': begin
  1967.                          mhide;
  1968.                          show_objects := true;
  1969.                          guards_1     := false;
  1970.                          guards_3     := false;
  1971.                          guards_4     := false;
  1972.                          guards_s     := false;
  1973.                          treasure     := false;
  1974.                          ammofood     := true;
  1975.                          stats        := true;
  1976.                          display_map;
  1977.                          print_stats;
  1978.                          mshow;
  1979.                        end;
  1980.               'A','a': begin
  1981.                          mhide;
  1982.                          show_objects := true;
  1983.                          guards_1     := false;
  1984.                          guards_3     := false;
  1985.                          guards_4     := false;
  1986.                          guards_s     := false;
  1987.                          treasure     := false;
  1988.                          ammofood     := false;
  1989.                          display_map;
  1990.                          print_stats;
  1991.                          mshow;
  1992.                        end;
  1993.               's','S': begin
  1994.                          mhide;
  1995.                          if (guards_1 or guards_3 or guards_4 or
  1996.                              guards_s or treasure or ammofood) then
  1997.                            begin
  1998.                              guards_1 := false;
  1999.                              guards_3 := false;
  2000.                              guards_4 := false;
  2001.                              guards_s := false;
  2002.                              treasure := false;
  2003.                              ammofood := false;
  2004.                              display_map;
  2005.                            end;
  2006.                          stats := not stats;
  2007.                          if stats then print_stats
  2008.                          else print_help;
  2009.                          mshow;
  2010.                        end;
  2011.               'm','M': begin
  2012.                          copy := true;
  2013.                          print_help;
  2014.                          copy_level;
  2015.                          if stats then print_stats;
  2016.                        end;
  2017.               'e','E': begin
  2018.                          mhide;
  2019.                          excng := true;
  2020.                          print_help;
  2021.                          if copy then
  2022.                            begin
  2023.                              exchange;
  2024.                              display_map;
  2025.                            end;
  2026.                          excng := false;
  2027.                          print_help;
  2028.                          if stats then print_stats;
  2029.                          mshow;
  2030.                        end;
  2031.               't','T': begin
  2032.                          mhide;
  2033.                          xfer := true;
  2034.                          print_help;
  2035.                          if copy then
  2036.                            begin
  2037.                              paste_level;
  2038.                              display_map;
  2039.                            end;
  2040.                          xfer := false;
  2041.                          print_help;
  2042.                          delay(200);
  2043.                          if stats then print_stats;
  2044.                          mshow;
  2045.                        end;
  2046.               'r','R': begin
  2047.                          mhide;
  2048.                          setfillstyle(1,0);
  2049.                          bar(180, TEXTLOC, 461, 479);
  2050.                          setcolor(15);
  2051.                          outtextxy(180, TEXTLOC, 'Reading Floor File');
  2052.                          read_floor;
  2053.                          setfillstyle(1,0);
  2054.                          bar(180, TEXTLOC, 461, 479);
  2055.                          if stats then print_stats;
  2056.                          mshow;
  2057.                        end;
  2058.               'w','W': begin
  2059.                          mhide;
  2060.                          setfillstyle(1,0);
  2061.                          bar(180, TEXTLOC, 461, 479);
  2062.                          setcolor(15);
  2063.                          outtextxy(180, TEXTLOC, 'Writing Floor File');
  2064.                          write_floor;
  2065.                          setfillstyle(1,0);
  2066.                          bar(180,TEXTLOC,461,479);
  2067.                          mshow;
  2068.                        end;
  2069.               'v','V': begin
  2070.                          print_version;
  2071.                        end;
  2072.                 ' '  : begin     {Space toggles mode MAP<->OBJ - ver 6.1}
  2073.                          if mode=map then
  2074.                            set_object_mode
  2075.                          else
  2076.                            set_map_mode;
  2077.                        end;
  2078.  
  2079.             end;
  2080.         end;
  2081.     until done or (key in ['P','H']);
  2082.     if level=0 then level := LEVELS;
  2083.     if level=(LEVELS+1) then level := 1;
  2084.   until done;
  2085.  
  2086.   setfillstyle(1,0);
  2087.   bar(0, TEXTLOC, 462, 479);
  2088.   setcolor(15);
  2089.   outtextxy(0, TEXTLOC,' Save the current levels to disk? (Y/N) ');
  2090.  
  2091.   repeat
  2092.     repeat until keypressed;
  2093.     key := readkey;
  2094.     if key=#0 then
  2095.       begin
  2096.         key := readkey;
  2097.         key := #0;
  2098.       end;
  2099.   until key in ['y','Y','n','N'];
  2100.  
  2101.   if key in ['y','Y'] then write_levels;
  2102.   textmode(co80);
  2103.   writeln('MapEdit 4.1                 Copyright (c) 1992  Bill Kirby');
  2104.   writeln;
  2105.   writeln('   Ver. '+VERSION+' Modification');
  2106.   writeln;
  2107.   writeln('This program is intended to be for your personal use only.');
  2108.   writeln('Distribution of any modified maps may be construed as a ');
  2109.   writeln('copyright violation by Apogee/ID.');
  2110.   writeln;
  2111.  
  2112. end.
  2113.