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