{$A+,B-,D+,E+,F-,G+,I-,L+,N-,O-,P-,Q-,R-,S-,T-,V-,X+}
{$M 16384,0,655360}
{ DM2CONV v3.1 by Vincenzo Alcamo }
{ This program is Public Domain   }
type
  CHAR8 = array[1..8] of char;
  WAD_HEADER = record
    Sig   : longint;
    Num   : longint;
    Start : longint;
  end;
  WAD_ENTRY = record
    Start : longint;
    Size  : longint;
    Name  : CHAR8;
  end;
  THING = record
    XPos : integer;
    YPos : integer;
    Angle: integer;
    Code : word;
    Flags: word;
  end;
  SIDEDEF = record
    XOffs,YOffs  : integer;
    UpT,LoT,MidT : CHAR8;
    Sector       : word;
  end;
  SECTOR = record
    Y1,Y2          : integer;
    Floor,Ceiling  : CHAR8;
    Lum,Action,Tag : word;
  end;
  LINEDEF = record
    V1,V2      : word;
    Attr       : word;
    Action,Tag : word;
    RSide,LSide: word;
  end;
  GAMETYPE = (GT_DOOM,GT_DOOM2,GT_HERETIC);
  ERRORS = (ERR_NONE,ERR_TOOSYM,ERR_ENDIF_NOIF,ERR_TOORESP,
            ERR_NORESP,ERR_READRESP,ERR_NOLABEL,
            ERR_BADEND,ERR_NOEQ,ERR_BADNUM,ERR_TOOREPN,
            ERR_NOTHINGMODE,ERR_NOCOND,
            ERR_LASTSYNTAX, {marks the last syntax error}
            ERR_BADELSE,ERR_BADENDIF,
            ERR_NOMEM,ERR_OPEN,ERR_READ,ERR_WRITE,ERR_TOOENTRY,ERR_PWAD);

const
  IWAD_SIG = Ord('I')+(Ord('W')+(Ord('A')+Ord('D') shl 8) shl 8) shl 8;
  PWAD_SIG = Ord('P')+(Ord('W')+(Ord('A')+Ord('D') shl 8) shl 8) shl 8;
  N_THINGS = 'THINGS'#0#0;
  N_SECTORS= 'SECTORS'#0;
  N_SIDEDEFS='SIDEDEFS';
  N_LINEDEFS='LINEDEFS';
  NULL_NAME= #0#0#0#0#0#0#0#0;
  BUFFSIZE = 65528; {biggest allocable block }
  MAXENTRY = BUFFSIZE div sizeof(WAD_ENTRY);
  MAXTHING = BUFFSIZE div sizeof(THING);
  MAXSIDE  = BUFFSIZE div sizeof(SIDEDEF);
  MAXSECT  = BUFFSIZE div sizeof(SECTOR);
  MAXLINE  = BUFFSIZE div sizeof(LINEDEF);
  MAXREPN  = 1024;  { maximum number of replace name}
  MAXREPT  = 4096;  { maximum number of rep thing info }
  MAXSYMS  = 1024;  { maximum space for symbol table }
  MAXRESP  = 10;    { maximum number of nested response files }
  MAXACTION= 256;   { maximum number of linedef/sector action to replace }
  MAXOBJ   = 500;   { maximum number of object info }
  REP_FLAG = $4000; { maximum value for thing id / flag }
  REP_MASK = $3FFF; { this mask removes things flags }
  REP_CONV = $2000; { flag for converted objects }
  REP_ALL  = REP_FLAG+REP_CONV; {all objects}
  REP_ADD  = $4000; { flag for adding an object instead of replacing }
  REP_DEAF = $0008; { flag for DEAF object: defined by DOOM engine }
  REP_MULTI= $0010; { flag for MULTI object: defined by DOOM engine }
  REP_ZERO = $0020; { flag for ZERO object }
  REP_RANGE= $8000; { flag for range expression}
  REP_QIF  = $C000; { flag for question_mark }
  REP_QELSE= $C100; { ?ELSE command }
  REP_QEND = $C200; { ?END command }
  OBJ_REMOVE = 0;   { thing id for removed objects }
  OBJ_MIX  = 9999;  { thing id for mixing objects }

  KEY_IFDEF = 'IFDEF';
  KEY_IFNDEF= 'IFNDEF';
  KEY_ELSE  = 'ELSE';
  KEY_ENDIF = 'ENDIF';

  SYM_SOURCE = 'SOURCE';
  SYM_DEST   = 'DEST';
  SYM_HELP   = 'HELP';
  SYM_SEED   = 'SEED';
  SYM_FROM   = 'FROM';
  SYM_TO     = 'TO';
  SYM_REMAP  = 'REMAP';
  SYM_ONCE   = 'ONCE';
  SYM_MIX    = 'MIX';
  SYM_DEBUG  = 'DEBUG';
  SYM_DM2CONV= 'DM2CONV';

  MUS2NAMES : array[1..32] of CHAR8 =  (
    'D_RUNNIN','D_STALKS','D_COUNTD','D_BETWEE','D_DOOM'#0#0,
    'D_THE_DA','D_SHAWN'#0,'D_DDTBLU','D_IN_CIT','D_DEAD'#0#0,
    'D_STLKS2','D_THEDA2','D_DOOM2'#0,'D_DDTBL2','D_RUNNI2',
    'D_DEAD2'#0,'D_STLKS3','D_ROMERO','D_SHAWN2','D_MESSAG',
    'D_COUNT2','D_DDTBL3','D_AMPIE'#0,'D_THEDA3','D_ADRIAN',
    'D_MESSG2','D_ROMER2','D_TENSE'#0,'D_SHAWN3','D_OPENIN',
    'D_EVIL'#0#0,'D_ULTIMA');


type
  REPNAME = record
    Before : CHAR8;
    After  : CHAR8;
  end;
  REPACTION = record
    After  : word;
    Before : word;
  end;
  RESPONSE = record
    RFile : text;
    Name  : string;
    IfLev : integer;
    Line  : integer;
  end;
  S_GAMETYPE = set of GAMETYPE;
  OBJINFO = record
    Code   : word;
    Radius : word;
    Height : word;
    Games  : S_GAMETYPE;
    Name   : string[20];
  end;
  A_REPNAME = array[1..MAXREPN] of REPNAME;
  A_BUFFER  = array[1..BUFFSIZE] of byte;
  A_DIRLIST = array[1..MAXENTRY] of WAD_ENTRY;
  A_THINGS  = array[1..MAXTHING] of THING;
  A_SIDEDEFS= array[1..MAXSIDE] of SIDEDEF;
  A_SECTORS = array[1..MAXSECT] of SECTOR;
  A_LINEDEFS= array[1..MAXLINE] of LINEDEF;
  A_REPLACE = array[1..MAXREPT] of word;
  A_REPACTION=array[1..MAXACTION] of REPACTION;
  A_OBJINFO = array[1..MAXOBJ] of OBJINFO;
  SYMBOLSPACE=array[1..MAXSYMS] of char;

var
  Buffer   : ^A_BUFFER;
  Dirlist  : ^A_DIRLIST;
  Things   : ^A_THINGS;
  Sidedefs : ^A_SIDEDEFS;
  Sectors  : ^A_SECTORS;
  Linedefs : ^A_LINEDEFS;

  Symbols  : ^SYMBOLSPACE;

  RepThing : ^A_REPLACE;
  RepText  : ^A_REPNAME;
  RepFloor : ^A_REPNAME;
  RepDirs  : ^A_REPNAME;
  RepLAct  : ^A_REPACTION;
  RepSAct  : ^A_REPACTION;
  Objects  : ^A_OBJINFO;

  Resp    : array[1..MAXRESP] of RESPONSE;
  RespLev : integer;

  SourceName : string;  {name of source file}
  DestName   : string;  {name of destination file}
  RandomSeed : longint; {seed for random number generator}

  Game1 : GAMETYPE; {type of source wad}
  Game2 : GAMETYPE; {type of dest wad}

const
  NRepThing: integer = 0; {number of replaces for each category}
  NRepText : integer = 0;
  NRepFloor: integer = 0;
  NRepDirs : integer = 0;
  NRepLAct : integer = 0;
  NRepSAct : integer = 0;
  NObjects : integer = 0;

  RemappedThing : word = 0; {various remap counters}
  RemappedText  : word = 0;
  RemappedFloor : word = 0;
  RemappedDirs  : word = 0;
  RemappedLAct  : word = 0;
  RemappedSAct  : word = 0;
  RemappedLev   : word = 0;
  RemappedMus   : word = 0;

  Debug         : boolean = False;      {debug mode}


{Return a right-padded string of N characters from a string}
function StringN(s:String;n:Integer):String;
  var i:Integer;
  begin
    StringN:=Copy(s,1,n);
    StringN[0]:=Char(n);
    for i:=Length(s)+1 to n do StringN[i]:=' ';
  end;

{Converts string to uppercase}
function Upper(s:String):String;
  var i:Integer;
  begin
    Upper[0]:=s[0];
    for i:=1 to Length(s) do Upper[i]:=UpCase(s[i]);
  end;

{Add a suffix(extension) to a filename (only if the filename hasn't one)}
function AddSuffix(s,n:String):String;
  var i:Integer;
  begin
    i:=Length(s);
    while i>0 do
      if s[i]='.' then break
      else dec(i);
    if i>0 then AddSuffix:=s
    else AddSuffix:=s+'.'+n;
  end;

{Return the first word of a string}
function GetWord(var s:string):string;
  var i,j:integer;
  begin
    j:=1;
    while (j<=length(s)) and (s[j]<=#32) do inc(j);
    i:=j;
    while (i<=length(s)) and (s[i]>#32) do inc(i);
    GetWord:=Copy(s,j,i-j);
    s:=Copy(s,i,255);
  end;

{Add a long to a pointer}
function AddPtr(p:pointer;l:longint):pointer;
  begin
    AddPtr:=pointer(longint(p)+l);
  end;

{Return the value of a specified environment variable}
{If name is '' the full path of the program is returned}
function GetEnv(name:string):string; assembler;
  asm
    push ds
    mov ds, PrefixSeg
    mov ax, ds:[$2C]
    mov ds, ax
    xor si, si
    cld
    les di, name
    xor dx, dx
    mov dl, es:[di]
    inc di
    mov bx, di
@@CICLO:
    cmp byte ptr ds:[si], 0
    je  @@FINE
    mov di, bx
    mov cx, dx
    rep cmpsb
    jne @@NEXT
    lodsb
    cmp al, '='
    je  @@FOUND
@@NEXT:
    cmp dx, 0
    je  @@ZERO
    dec si
@@ZERO:
    lodsb
    cmp al, 0
    jne @@ZERO
    jmp @@CICLO
@@FINE:
    cmp dx, 0
    jne @@FOUND
    add si, 3
@@FOUND:
    les di, @RESULT
    push di
    inc di
    xor cx, cx
@@COPY:
    lodsb
    stosb
    inc cx
    cmp al, 0
    jne @@COPY
    xchg ax, cx
    dec ax
    pop di
    stosb
    pop ds
  end;

{Concat the exe path with the specified filename}
function AsInEXEDir(s:string):string;
  var t:string;
      i:integer;
  begin
    t:=GetEnv('');
    i:=length(t);
    while (i>0) and (t[i]<>'\') and (t[i]<>'/') do dec(i);
    t[0]:=chr(i);
    i:=length(s);
    while (i>0) and (s[i]<>'\') and (s[i]<>'/') do dec(i);
    AsInEXEDir:=t+copy(s,i+1,255);
  end;

procedure SyntaxHelp;
  begin
    if RespLev>0 then
      writeln('(Line ',Resp[RespLev].Line,' in file ',Resp[RespLev].Name,')');
  end;

var ErrStr:string;
procedure MyHalt(err:ERRORS);
  begin
    if err<>ERR_NONE then write('ERROR: ');
    case err of
      ERR_NOMEM: writeln('Not enough memory!');
      ERR_TOOSYM: writeln('Symbol table full!');
      ERR_ENDIF_NOIF: writeln('ENDIF without IF');
      ERR_TOORESP: writeln('Too many nested response files!');
      ERR_NORESP: writeln('Cannot find response file!');
      ERR_READRESP: writeln('Cannot read response file!');
      ERR_NOLABEL: writeln('Label not found in response file!');
      ERR_BADEND: writeln('Expression incorrectly terminated');
      ERR_NOEQ: writeln('Missing ''='' in expression!');
      ERR_BADNUM: writeln('Bad number in expression!');
      ERR_NOTHINGMODE: writeln('Command not allowed outside THINGS section!');
      ERR_NOCOND: writeln('No valid relational operator specified!');
      ERR_BADELSE: writeln('Bad ?ELSE expression found!');
      ERR_BADENDIF:writeln('Bad ?END expression found!');
      ERR_TOOREPN: writeln('Replace table full!');
      ERR_READ: writeln('Cannot read from file: ',SourceName);
      ERR_WRITE: writeln('Cannot write to file: ',DestName);
      ERR_OPEN: writeln('Cannot open file: ',ErrStr);
      ERR_PWAD: writeln('File is not a valid WAD: ',SourceName);
      ERR_TOOENTRY:writeln('Too many entries in file: ',SourceName);
    end;
    if (err>ERR_NONE) and (err<ERR_LASTSYNTAX) then SyntaxHelp;
    Halt(ord(err));
  end;

function MyHeapError(size:word):integer; far;
  begin
    if size<>0 then MyHalt(ERR_NOMEM);
    MyHeapError:=1;
  end;

procedure Initialize;
  begin
    RespLev:=0;
    HeapError:=@MyHeapError;
    New(RepText);
    New(RepFloor);
    New(RepDirs);
    New(RepThing);
    New(Buffer);
    New(DirList);
    New(RepLAct);
    New(RepSAct);
    New(Objects);
    New(Symbols);
    Symbols^[1]:=#0;
    Things:=pointer(Buffer);
    Linedefs:=pointer(Buffer);
    Sidedefs:=pointer(Buffer);
    Sectors:=pointer(Buffer);
  end;

var SymbolName : ^string;
    SymbolValue: ^string;
    SymbolFound: boolean;
function GetSymbol(name:string):string;
  begin
    SymbolName:=@Symbols^;
    while SymbolName^<>'' do begin
      SymbolValue:=AddPtr(SymbolName,length(SymbolName^)+1);
      if SymbolName^=name then begin
        GetSymbol:=SymbolValue^;
        SymbolFound:=True;
        exit;
      end;
      SymbolName:=AddPtr(SymbolValue,length(SymbolValue^)+1);
    end;
    SymbolFound:=False;
    GetSymbol:=Upper(GetEnv(name));
  end;

procedure SetSymbol(name,value:string);
  begin
    GetSymbol(name);
    if SymbolFound then begin
      SymbolValue:=AddPtr(SymbolValue,length(SymbolValue^)+1);
      while SymbolValue^<>'' do begin
        SymbolName^:=SymbolValue^;
        SymbolValue:=AddPtr(SymbolValue,length(SymbolName^)+1);
        SymbolName:=AddPtr(SymbolName,length(SymbolName^)+1);
      end;
    end;
    if value<>'' then begin
      if longint(SymbolName)+length(name)+length(value)+2>longint(Symbols)+sizeof(SYMBOLSPACE) then
        MyHalt(ERR_TOOSYM);
      SymbolName^:=name;
      SymbolValue:=AddPtr(SymbolName,length(name)+1);
      SymbolValue^:=value;
      SymbolName:=AddPtr(SymbolValue,length(value)+1);
    end;
    SymbolName^:='';
  end;

procedure Title;
  begin
    writeln('DM2CONV v3.1 by Vincenzo Alcamo (alcamo@arci01.bo.cnr.it) VERSION 950722');
  end;

procedure Help;
  begin
    Title;
    writeln('Interchange maps among [ULTIMATE] DOOM, DOOM II and HERETIC.');
    writeln;
    writeln('Usage: DM2CONV <input> [output] [/symbol[=[value]]]... <@response>...');
    writeln;
    writeln('  input        name of wad file to convert');
    writeln('  output       name of output file (if omitted, the source is overwritten)');
    writeln('  symbol       symbol to define (/symbol=value) or undefine (/symbol=)');
    writeln('  @response    name of response file');
    writeln;
    writeln('To convert levels from game_A to game_B use the appropriate response file,');
    writeln('following this convention: D=DOOM, UD=ULTIMATE DOOM, D2=DOOM II, H=HERETIC.');
    writeln('Example for DOOM to HERETIC conversion:  DM2CONV input output @:DTOH');
    writeln('Example for DOOM II to DOOM conversion:  DM2CONV input output @:D2TOD');
    writeln;
    writeln('If you use the wads built by GFXMAKER you should define the GFX symbol.');
    writeln('Example for HERETIC to DOOM conversion:  DM2CONV input output /GFX @:HTOD');
    writeln;
    writeln('Full instructions are contained inside DM2CONV.DOC: this file and the official');
    writeln('response file DEFAULT.RSP are part of the DM2CONV distribution package.');
    writeln('REMEMBER: DM2CONV is PUBLIC DOMAIN (or FREEWARE if you prefer).');
  end;

function MyVal(s:string):integer;
  var i,j:integer;
  begin
    Val(s,j,i);
    if (i<>0) or (j>=REP_FLAG) or (j<0) then MyHalt(ERR_BADNUM);
    MyVal:=j;
  end;

procedure ParseSymbol(s:string);
  var i:integer;
  begin
    if s='' then begin
      SymbolName:=@Symbols^;
      while SymbolName^<>'' do begin
        SymbolValue:=AddPtr(SymbolName,length(SymbolName^)+1);
        writeln(SymbolName^,'=',SymbolValue^);
        SymbolName:=AddPtr(SymbolValue,length(SymbolValue^)+1);
      end;
    end
    else begin
      i:=1;
      while (i<=length(s)) and (s[i]<>'=') do inc(i);
      if i>length(s) then SetSymbol(s,s)
      else SetSymbol(copy(s,1,i-1),copy(s,i+1,255));
    end;
  end;

function GetArgument:string;
  var i:integer;
      s:string;
  begin
    if eof(Resp[RespLev].RFile) then begin
      close(Resp[RespLev].RFile);
      dec(RespLev);
      s:='';
    end
    else begin
      readln(Resp[RespLev].RFile,s);
      inc(Resp[RespLev].Line);
      if ioresult<>0 then MyHalt(ERR_READRESP);
      i:=1;
      while (i<=length(s)) and (s[i]<=#32) do inc(i);
      s:=copy(s,i,255);
    end;
    i:=1;
    while i<=length(s) do begin
      if s[i]=';' then s[0]:=chr(i-1);
      inc(i);
    end;
    i:=length(s);
    while (i>0) and (s[i]<=#32) do dec(i);
    s[0]:=chr(i);
    GetArgument:=s;
  end;

function GetIdentifier(var s:string):string;
  var i:integer;
  begin
    s:=s+#0;
    i:=1;
    while (s[i]='_') or ((s[i]>='0') and (s[i]<='9')) or ((s[i]>='A') and (s[i]<='Z')) do inc(i);
    GetIdentifier:=Copy(s,1,i-1);
    s:=Copy(s,i,length(s)-i);
  end;

function CheckLevel(var s:string):word;
  var i,j:word;
  begin
    j:=0;
    if (length(s)>0) and (s[1]=':') then begin
      i:=2;
      while i<=length(s) do begin
        case s[i] of
          '0': j:=j or REP_ZERO;  {allow no skill flags}
          '1': j:=j or 1;         {skill level 1-2}
          '2': j:=j or 2;         {skill level 3}
          '3': j:=j or 4;         {skill level 4-5}
          'D': j:=j or REP_DEAF;  {deaf flag}
          'M': j:=j or REP_MULTI; {multiplayer}
          'O': j:=j or REP_FLAG;  {only objects not already converted}
          'A': j:=j or REP_ALL;   {all objects}
          'C': j:=j or REP_CONV;  {only converted objects}
          else break;
        end;
        inc(i);
      end;
      s:=Copy(s,i,255);
    end;
    CheckLevel:=j;
  end;

procedure ParseThing(var s:string);
  var i,j,k: integer;
      rnum : integer;
      once : word;
  procedure GetOnceFlag;
    var t:string;
        i,j:integer;
    begin
      t:=GetSymbol(SYM_ONCE);
      if t='' then j:=0
      else begin
        val(t,j,i);
        if i<>0 then j:=1;
      end;
      case j of
        0: once:=REP_ALL;
        2: once:=REP_CONV;
        else once:=REP_FLAG;
      end;
    end;
  function GetNum:word;
    var t:string;
        i,j,k,l,flag:integer;
    begin
      s:=Copy(s,2,255);
      flag:=0;
      if s[1]='+' then begin
        flag:=REP_ADD;
        s:=Copy(s,2,255);
      end;
      t:=GetIdentifier(s);
      if length(t)=0 then MyHalt(ERR_BADNUM);
      if (t[1]>='0') and (t[1]<='9') then l:=MyVal(t)
      else begin
        l:=-1;
        for i:=1 to NObjects do with Objects^[i] do begin
          j:=1;
          k:=1;
          repeat
            if Name[k]<=' ' then inc(k)
            else if t[j]<>UpCase(Name[k]) then break
            else begin
              inc(j);
              inc(k);
            end;
          until (j>length(t)) or (k>length(Name));
          if (j>length(t)) and ((l=0) or (k>length(Name))) then l:=Code;
        end;
        if l<0 then MyHalt(ERR_BADNUM);
      end;
      GetNum:=l+flag;
    end;
  procedure PutRep(i:word);
    begin
      inc(NRepThing);
      if NRepThing>MAXREPT then MyHalt(ERR_TOOREPN);
      RepThing^[NRepThing]:=i;
    end;
  begin
    if s='?ELSE' then begin PutRep(REP_QELSE); exit; end;
    if s='?END' then begin PutRep(REP_QEND); exit; end;
    if s[1]='?' then begin
      inc(NRepThing);
      rnum:=NRepThing;
      s[1]:=',';
    end
    else begin
      rnum:=0;
      s:=','+s;
    end;
    GetOnceFlag;
    inc(s[0]);
    s[length(s)]:=#21;  {#21 is a sentinel}
    while s[1]=',' do begin
      PutRep(GetNum and REP_MASK);
      j:=CheckLevel(s);
      if s[1]='-' then begin
        PutRep(REP_RANGE);
        PutRep(GetNum and REP_MASK);
        j:=CheckLevel(s);
      end;
      if j and REP_ALL=0 then j:=j or once;
      PutRep(j);
    end;
    if rnum>0 then begin
      case s[1] of
        '=': j:=0;                     { =  0 }
        '<': if s[2]='>' then j:=1     { <> 1 }
             else j:=2+ord(s[2]='=');  { <  2    <= 3}
        '>': j:=4+ord(s[2]='=');       { >  4    >= 5}
        else MyHalt(ERR_NOCOND);
      end;
      RepThing^[rnum]:=j+REP_QIF;
      s:=Copy(s,2+(j and 1),255);
      PutRep(REP_QIF+MyVal(GetIdentifier(s)));
      if s[1]<>#21 then MyHalt(ERR_BADEND);
      exit;
    end;
    if s[1]<>'=' then MyHalt(ERR_NOEQ);

    inc(NRepThing);
    rnum:=NRepThing;
    i:=0;
    s[1]:=',';
    while s[1]=',' do begin
      PutRep(GetNum);
      j:=0;
      if s[1]='@' then begin
        s:=Copy(s,2,255);
        j:=MyVal(GetIdentifier(s));
        if (s[1]>='#') and (s[1]<='&') then begin
          inc(j,REP_FLAG); { percentual quantity }
          s:=Copy(s,2,255);
        end;
      end;
      PutRep(j);
      PutRep(CheckLevel(s));
      inc(i);
    end;
    RepThing^[rnum]:=REP_FLAG+i;
    if (s[1]<>#21) or (i=0) then MyHalt(ERR_BADEND);
  end;

procedure ParseName(s:string;i:integer;var table:A_REPNAME;var num:integer);
  var r:REPNAME;
      j:integer;
  begin
    FillChar(r,sizeof(r),0);
    j:=1;
    while (j<=8) and (j<i) do begin
      r.Before[j]:=UpCase(s[j]);
      inc(j);
    end;
    j:=1;
    while (j<=8) and (i<length(s)) do begin
      inc(i);
      r.After[j]:=UpCase(s[i]);
      inc(j);
    end;
    i:=1;
    while (i<=num) and (table[i].Before<>r.Before) do inc(i);
    if j=1 then begin {remove name}
      if i<=num then begin
        table[i]:=table[num];
        dec(num);
      end;
    end
    else begin {add name}
      if i>num then begin
        inc(num);
        if num>MAXREPN then MyHalt(ERR_TOOREPN);
      end;
      table[i]:=r;
    end;
  end;

procedure ParseAction(s:string;var table:A_REPACTION;var num:integer);
  var t   : string;
      i,j : integer;
      k   : word;
  procedure PutAction;
    begin
      inc(num);
      if num>MAXREPN then MyHalt(ERR_TOOREPN);
      table[num].Before:=k;
      inc(j);
    end;
  begin
    j:=0;
    s:=','+s;
    while s[1]=',' do begin
      s:=copy(s,2,255);
      k:=MyVal(GetIdentifier(s));
      PutAction;
      if s[1]='-' then begin
        s:=copy(s,2,255);
        k:=MyVal(GetIdentifier(s));
        inc(k,REP_RANGE);
        PutAction;
      end;
    end;
    if s[1]<>'=' then MyHalt(ERR_NOEQ);
    s:=copy(s,2,255);
    k:=MyVal(GetIdentifier(s));
    if s<>'' then MyHalt(ERR_BADEND);
    for i:=num-j+1 to num do table[i].After:=k;
  end;

procedure ParseObject(s:string);
  var obj : OBJINFO;
      i   : integer;
  begin
    s:=s+#21;
    obj.Code:=MyVal(GetIdentifier(s));
    if s[1]<>'=' then MyHalt(ERR_NOEQ);
    obj.Radius:=0;
    obj.Height:=0;
    obj.Games:=[];
    if (s[2]='(') or (s[2]='[') then begin
      s:=copy(s,3,255);
      obj.Radius:=MyVal(GetIdentifier(s));
      if s[1]=',' then begin
        s:=copy(s,2,255);
        obj.Radius:=MyVal(GetIdentifier(s));
      end;
      if (s[1]<>')') and (s[1]<>']') then MyHalt(ERR_BADEND);
    end;
    i:=2;
    while (i<=length(s)) and (s[i]<>',') do begin
      case upcase(s[i]) of
        'D': if s[i+1]='2' then begin
               Include(obj.Games,GT_DOOM2);
               inc(i);
             end
             else Include(obj.Games,GT_DOOM);
        'H': Include(obj.Games,GT_HERETIC);
      end;
      inc(i);
    end;
    if (i>length(s)) or (s[i]<>',') then MyHalt(ERR_BADEND);
    obj.Name:=copy(s,i+1,length(s)-i-1);
    if NObjects=MAXOBJ then MyHalt(ERR_TOOREPN);
    inc(NObjects);
    Objects^[NObjects]:=obj;
  end;

procedure Parse;
  type PARSE_TYPE = (PT_THING,PT_TEXTURE,PT_FLOOR,PT_LINEDEF,
                     PT_SECTOR,PT_NAME,PT_OBJECT);
  var
    i,j     : integer;
    s,t,env : string;
    index   : integer;
    p_mode  : PARSE_TYPE;
  begin
    p_mode:=PT_THING;
    RespLev:=0;
    index:=-1;
    env:=GetEnv(SYM_DM2CONV);
    while index<=ParamCount do begin
      if RespLev>0 then t:=GetArgument
      else if index<0 then begin
        t:=GetWord(env);
        if length(env)=0 then index:=0;
      end
      else begin
        inc(index);
        t:=ParamStr(index);
      end;
      s:=Upper(GetWord(t));
      if (s='') or (s[1]=':') then {DO NOTHING}
      else if s[1]='@' then begin
        if RespLev=MAXRESP then MyHalt(ERR_TOORESP)
        else begin
          s:=Copy(s,2,255);
          i:=3;
          if (length(s)<2) or (s[2]<>':') or (s[1]<'A') or (s[1]>'Z') then i:=1;
          while (i<=length(s)) and (s[i]<>':') do inc(i);
          t:=copy(s,i,255);
          s:=copy(s,1,i-1);
          if s='' then
            if RespLev>0 then s:=Resp[RespLev].Name
            else s:='DEFAULT';
          j:=RespLev+1;
          Resp[j].IfLev:=0;
          Resp[j].Line:=0;
          assign(Resp[j].RFile,s);
          FileMode:=0;
          reset(Resp[j].RFile);
          if ioresult<>0 then begin
            s:=AddSuffix(s,'RSP');
            assign(Resp[j].RFile,s);
            reset(Resp[j].RFile);
          end;
          if ioresult<>0 then begin
            s:=AsInEXEDir(s);
            assign(Resp[j].RFile,s);
            reset(Resp[j].RFile);
          end;
          if ioresult<>0 then MyHalt(ERR_NORESP);
          Resp[j].Name:=s;
          inc(RespLev);
          if t<>'' then begin
            i:=RespLev;
            s:=GetArgument;
            while (i=RespLev) and (Upper(GetWord(s))<>t) do s:=GetArgument;
            if i<>RespLev then MyHalt(ERR_NOLABEL);
          end;
        end;
      end
      else if (s[1]='/') or (s[1]='-') then begin
        while (s<>'') and ((s[1]='/') or (s[1]='-')) do begin
           ParseSymbol(copy(s,2,255));
           s:=Upper(GetWord(t));
        end;
      end
      else if s[1]='[' then begin
        t:=copy(s,2,3);
        if t='THI' then p_mode:=PT_THING
        else if t='TEX' then p_mode:=PT_TEXTURE
        else if t='FLO' then p_mode:=PT_FLOOR
        else if t='LIN' then p_mode:=PT_LINEDEF
        else if t='SEC' then p_mode:=PT_SECTOR
        else if t='NAM' then p_mode:=PT_NAME
        else if t='OBJ' then p_mode:=PT_OBJECT
        else begin
          writeln('WARNING: Unknown section ',s);
          SyntaxHelp;
        end;
      end
      else begin
        if s[1]='?' then i:=-1
        else i:=Pos('=',s);
        if i<>0 then begin
          repeat
            if s[1]<>'?' then begin
              if i=0 then i:=Pos('=',s);
              if i=0 then MyHalt(ERR_NOEQ);
            end
            else if p_mode<>PT_THING then MyHalt(ERR_NOTHINGMODE);
            case p_mode of
              PT_THING: ParseThing(s);
              PT_TEXTURE: ParseName(s,i,RepText^,NRepText);
              PT_FLOOR: ParseName(s,i,RepFloor^,NRepFloor);
              PT_NAME: ParseName(s,i,RepDirs^,NRepDirs);
              PT_LINEDEF: ParseAction(s,RepLAct^,NRepLAct);
              PT_SECTOR: ParseAction(s,RepSAct^,NRepSAct);
              PT_OBJECT: begin
                   ParseObject(s+' '+t);
                   t:='';
                end;
            end;
            s:=Upper(GetWord(t));
            i:=0;
          until (s='') or (s[1]=';');
        end
        else if RespLev>0 then begin
          if (s=KEY_IFDEF) or (s=KEY_IFNDEF) then begin
            i:=ord(s=KEY_IFDEF);
            s:=Upper(GetWord(t));
            inc(Resp[RespLev].IfLev);
            if i<>ord(GetSymbol(s)<>'') then begin {condition false}
              j:=Resp[RespLev].IfLev;
              i:=RespLev;
              while (i=RespLev) and (j<=Resp[RespLev].IfLev) do begin
                t:=GetArgument;
                s:=Upper(GetWord(t));
                if (s=KEY_IFDEF) or (s=KEY_IFNDEF) then inc(Resp[RespLev].IfLev)
                else if s=KEY_ENDIF then dec(Resp[RespLev].IfLev)
                else if (s=KEY_ELSE) and (j=Resp[RespLev].IfLev) then i:=0;
              end;
            end;
          end
          else if s=KEY_ELSE then begin
            j:=Resp[RespLev].IfLev;
            i:=RespLev;
            while (i=RespLev) and (j<=Resp[RespLev].IfLev) do begin
              t:=GetArgument;
              s:=Upper(GetWord(t));
              if (s=KEY_IFDEF) or (s=KEY_IFNDEF) then inc(Resp[RespLev].IfLev)
              else if s=KEY_ENDIF then dec(Resp[RespLev].IfLev);
            end;
          end
          else if s=KEY_ENDIF then begin
            if Resp[RespLev].IfLev=0 then MyHalt(ERR_ENDIF_NOIF);
            dec(Resp[RespLev].IfLev);
          end
          else if s='SET' then begin
            repeat
              ParseSymbol(Upper(GetWord(t)))
            until t='';
          end
          else if s='RETURN' then begin
            close(Resp[RespLev].RFile);
            dec(RespLev);
          end
          else if s='ABORT' then MyHalt(ERR_NONE)
          else if s='ECHO' then writeln(Copy(t,2,255))
          else begin
            writeln('WARNING: Unknown keyword ',s);
            SyntaxHelp;
          end;
        end
        else begin
          if GetSymbol(SYM_SOURCE)='' then SetSymbol(SYM_SOURCE,s)
          else if GetSymbol(SYM_DEST)='' then SetSymbol(SYM_DEST,s)
          else begin
            writeln('WARNING: Unknown keyword ',s);
            SyntaxHelp;
          end;
        end;
      end;
    end;
    SourceName:=GetSymbol(SYM_SOURCE);
    DestName:=GetSymbol(SYM_DEST);
    if SourceName<>'' then SourceName:=AddSuffix(SourceName,'WAD');
    if DestName<>'' then DestName:=AddSuffix(DestName,'WAD');
    Debug:=GetSymbol(SYM_DEBUG)<>'';
  end;

procedure BlockR(var f:file;var dest;size:word);
  begin
    BlockRead(f,dest,size);
    if ioresult<>0 then MyHalt(ERR_READ);
  end;

procedure BlockW(var f:file;var dest;size:word);
  begin
    BlockWrite(f,dest,size);
    if ioresult<>0 then MyHalt(ERR_WRITE);
  end;

procedure FSeek(var f:file;p:longint);
  begin
    Seek(f,p);
    if ioresult<>0 then MyHalt(ERR_READ);
  end;

procedure CopyDest;
  var a,b  : file;
      l    : longint;
      size : word;
  begin
    writeln('Copying source to destination');
    Assign(a,SourceName);
    FileMode:=0;  {open for read only}
    ErrStr:=SourceName;
    Reset(a,1);
    if ioresult<>0 then MyHalt(ERR_OPEN);
    Assign(b,DestName);
    FileMode:=1;  {open for write only}
    ErrStr:=DestName;
    Rewrite(b,1);
    if ioresult<>0 then MyHalt(ERR_OPEN);
    l:=FileSize(a);
    while l>0 do begin
      if l>BUFFSIZE then size:=BUFFSIZE
      else size:=l;
      BlockR(a,buffer^,size);
      BlockW(b,buffer^,size);
      dec(l,size);
    end;
    Close(a);
    Close(b);
  end;

function RemapName(var table:A_REPNAME;var name:CHAR8;num:integer):integer; assembler;
  asm
    cld
    les di, name
    mov cx, 8
@@LOOP:
    mov al, es:[di]
    cmp al, 0
    je  @@FILLZERO
    cmp al, 'a'
    jb  @@STORE
    cmp al, 'z'
    ja  @@STORE
    sub al, 32
@@STORE:
    stosb
    loop @@LOOP
@@FILLZERO:
    rep stosb
@@OK:
    push ds
    lds si, name
    les di, table
    mov cx, num
    cld
    lodsw
    mov bx, [si]
    mov dx, [si+2]
    mov si, [si+4]
@@CICLO:
    scasw
    jnz @@NEXT
    cmp bx, es:[di]
    jnz @@NEXT
    cmp dx, es:[di+2]
    jnz @@NEXT
    cmp si, es:[di+4]
    jnz @@NEXT
    mov ax, es
    mov ds, ax
    mov si, di
    add si, 6
    les di, name
    mov cx, 8
    rep movsb
    mov ax, 1
    jmp @@FINE
@@NEXT:
    add di, 14
    loop @@CICLO
    xor ax, ax
@@FINE:
    pop ds
  end;

function RemapNum(var table:A_REPACTION;var action:word;num:integer):integer; assembler;
  asm
    push ds
    les di, action
    mov bx, es:[di]
    lds si, table
    mov ax, num
    mov cx, ax
    add ax, ax
    add ax, ax
    add si, ax
    dec si
    dec si
    std
@@LOOP:
    lodsw
    cmp ax, REP_RANGE
    jb  @@NORANGE
    sub ax, REP_RANGE
    cmp ax, bx
    jb  @@NEXT
    lodsw
    lodsw
    dec cx
    cmp ax, bx
    jbe @@FOUND
    jmp @@NEXT
@@NORANGE:
    cmp ax, bx
    je  @@FOUND
@@NEXT:
    lodsw
    loop @@LOOP
    xor ax, ax
    jmp @@FINE
@@FOUND:
    les di, action
    movsw
    mov ax, 1
@@FINE:
    pop ds
  end;

procedure SetRandomSeed;
  var s:string;
      i:integer;
  begin
    s:=GetSymbol(SYM_SEED);
    RandomSeed:=0;
    if s=SYM_SEED then begin
      Randomize;
      RandomSeed:=RandSeed;
    end
    else if s<>'' then begin
      Val(s,RandomSeed,i);
      if i<>0 then RandomSeed:=0;
    end;
  end;

function LenNum(n:word):integer;
  begin
    if n<10 then LenNum:=1
    else if n<100 then LenNum:=2
    else if n<1000 then LenNum:=3
    else LenNum:=4;
  end;

var ThingIndex : array[1..MAXTHING] of integer;
    ThingNum   : integer;
procedure Choose(var max:integer;n,c,lev:integer);
  var i,j,k,l,m:integer;
      add:boolean;
  begin
    if n>max then n:=max;
    add:=(c and REP_ADD)>0;
    c:=c and REP_MASK;
    if c=OBJ_MIX then add:=False;
    l:=MAXTHING+1;
    if add and (c<>OBJ_REMOVE) then begin
      for i:=1 to ThingNum do if Things^[i].Code=OBJ_REMOVE then begin
        dec(l);
        ThingIndex[l]:=i;
      end;
    end;
    for i:=1 to n do begin
      j:=Random(max)+1;
      k:=ThingIndex[j];
      if c=OBJ_REMOVE then begin
        if not add then with Things^[k] do begin
          Code:=OBJ_REMOVE;
          Flags:=(Flags and (not 7)) or (lev and (REP_DEAF+REP_MULTI));
        end;
      end
      else if c=OBJ_MIX then begin
        m:=ThingIndex[max];
        l:=Things^[k].XPos;
        Things^[k].XPos:=Things^[m].XPos;
        Things^[m].XPos:=l;
        l:=Things^[k].YPos;
        Things^[k].YPos:=Things^[m].YPos;
        Things^[m].YPos:=l;
      end
      else begin
        if add then begin
          if l<=MAXTHING then begin
            k:=ThingIndex[l];
            inc(l);
            Things^[k]:=Things^[ThingIndex[j]];
          end
          else k:=0;
        end;
        if k>0 then with Things^[k] do begin
          Code:=c;
          if lev and (REP_ZERO+7)<>0 then Flags:=lev and 7;
          Flags:=Flags or REP_CONV or (lev and (REP_DEAF+REP_MULTI));
        end;
      end;
      ThingIndex[j]:=ThingIndex[max];
      dec(max);
    end;
    inc(RemappedThing,n);
  end;
procedure ReplaceThings(totobj:Integer);
  var repn   : integer;
      i,j,k,l: word;
      level  : word;
      once   : word;
      multi  : boolean;
      numobj : integer;
      amount : array[1..128] of word;
      numrep : integer;
      numabs : integer;
      iflev  : integer;
      runlev : integer;
      iflevs : array[0..16] of integer;
      condit : boolean;
      col    : integer;
  const glev : integer = 0;
  begin
    ThingNum:=totobj;
    inc(glev);
    if debug then writeln('=== OBJECT CONVERSION, LEVEL ',glev);
    RandSeed:=RandomSeed;
    repn:=1;
    iflev:=0;
    runlev:=0;
    while repn<=NRepThing do begin
      numobj:=0;
      l:=RepThing^[repn];
      if l=REP_QELSE then begin
        inc(repn);
        if odd(iflev) or (iflev=0) then MyHalt(ERR_BADELSE);
        iflev:=iflev or 1;
        continue;
      end;
      if l=REP_QEND then begin
        inc(repn);
        if iflev<2 then MyHalt(ERR_BADENDIF);
        iflev:=iflevs[(iflev-2)div 2];
        if iflev<runlev then runlev:=iflev;
        continue;
      end;
      if l>=REP_QIF then inc(repn);
      if (runlev=iflev) and debug then begin
        write('SOURCE OBJECTS:          ');
        col:=1;
      end;
      while RepThing^[repn]<REP_FLAG do begin
        j:=RepThing^[repn];
        inc(repn);
        if RepThing^[repn] and REP_RANGE>0 then begin
          inc(repn);
          k:=RepThing^[repn];
          inc(repn);
        end
        else k:=j;
        once:=RepThing^[repn];
        inc(repn);
        level:=once and 7; {level 1 or 2 or 3}
        if level=0 then level:=7;
        multi:=once and REP_MULTI>0; {multiplayer flag}
        once:=once and REP_ALL;
        if runlev=iflev then begin
          if debug then begin
            if col<3 then write(#32#32)
            else writeln;
            col:=col mod 3+1;
            if j<>k then write('Objects #':18-LenNum(j)-LenNum(k),j,'-#',k)
            else begin
              i:=1;
              while (i<=NObjects) and ((Objects^[i].Code<>j) or not (Game1 in Objects^[i].Games)) do inc(i);
              if i<=NObjects then write(Objects^[i].Name:20)
              else write('Unknown object #':20-LenNum(j),j);
            end;
            numabs:=numobj;
          end;
          for i:=1 to totobj do with Things^[i] do
            if (Code>=j) and (Code<=k) and ((Code=0) or (Flags and level>0)) and
               ((once=REP_ALL) or ((Flags xor once)and REP_CONV=0)) and
               (not multi or (Flags and REP_MULTI>0)) then begin
              inc(numobj);
              ThingIndex[numobj]:=i;
            end;
          if debug then begin
            numabs:=numobj-numabs;
            write('=',numabs,#32:4-LenNum(numabs));
          end;
        end;
      end;
      if (runlev=iflev) and debug then writeln;
      if l>=REP_QIF then begin
        i:=RepThing^[repn] and not REP_QIF;
        inc(repn);
        j:=iflev;
        iflevs[iflev div 2]:=iflev;
        iflev:=(iflev+2) and $FFFE;
        if runlev=j then begin
          l:=l and not REP_QIF;
          case l of
            0: condit:=numobj=i;
            1: condit:=numobj<>i;
            2: condit:=numobj<i;
            3: condit:=numobj<=i;
            4: condit:=numobj>i;
            5: condit:=numobj>=i;
          end;
          if debug then writeln('IF ',numobj,copy('= <>< <=> >=',l*2+1,2),i,condit:8);
          runlev:=iflev+1-ord(condit);
        end;
        continue;
      end;

      numrep:=RepThing^[repn]-REP_FLAG;
      inc(repn);
      if (numobj=0) or (numrep=0) then inc(repn,numrep*3)
      else begin
        numabs:=0;
        j:=repn+1;
        for i:=1 to numrep do begin
          k:=RepThing^[j];
          if k=0 then k:=REP_FLAG
          else begin
            if k>=REP_FLAG then k:=(longint(numobj)*(k-REP_FLAG)+50)div 100;
            inc(numabs,k);
          end;
          amount[i]:=k;
          inc(j,3);
        end;

        if numabs>numobj then begin
          k:=numobj;
          for i:=1 to numrep do begin
            j:=amount[i];
            if j<REP_FLAG then begin
              if numabs=0 then amount[i]:=0
              else amount[i]:=(longint(j)*k+numabs div 2)div numabs;
              dec(numabs,j);
              dec(k,amount[i]);
            end;
          end;
          numabs:=numobj;
        end;

        numabs:=numobj-numabs;
        j:=0;
        for i:=1 to numrep do if amount[i]>=REP_FLAG then inc(j);
        for i:=1 to numrep do if amount[i]>=REP_FLAG then begin
          amount[i]:=(numabs+j div 2)div j;
          dec(numabs,amount[i]);
          dec(j);
        end;

        if debug then begin
          write('CONVERTED OBJECTS:       ');
          col:=1;
        end;
        for i:=1 to numrep do begin
          Choose(numobj,amount[i],RepThing^[repn],RepThing^[repn+2]);
          if debug then begin
            j:=RepThing^[repn] and REP_MASK;
            if col<3 then write(#32#32)
            else writeln;
            col:=col mod 3+1;
            k:=1;
            while (k<=NObjects) and ((Objects^[k].Code<>j) or not (Game2 in Objects^[k].Games)) do inc(k);
            if k<=NObjects then write(Objects^[k].Name:20)
            else write('Unknown object #':20-LenNum(j),j);
            if RepThing^[repn] and REP_ADD>0 then write('+') else write('=');
            write(amount[i],#32:4-LenNum(amount[i]));
          end;
          inc(repn,3);
        end;
        if debug then writeln;
      end;
    end;
    for i:=1 to totobj do with Things^[i] do Flags:=Flags and not REP_CONV;
  end;

function IdentifyGame(s:string;default:GAMETYPE):GAMETYPE;
  begin
    if (s='D') or (s='DOOM') then IdentifyGame:=GT_DOOM
    else if (s='D2') or (s='DOOM2') then IdentifyGame:=GT_DOOM2
    else if (s='H') or (s='HERETIC') then IdentifyGame:=GT_HERETIC
    else IdentifyGame:=default;
  end;

function RemapStatus:integer;
  var s:string;
      i,j:integer;
  begin
    s:=GetSymbol(SYM_REMAP);
    if s='' then RemapStatus:=0
    else begin
      val(s,i,j);
      if j<>0 then i:=1;
      RemapStatus:=i;
    end;
  end;

procedure SetMusicName(var d:WAD_ENTRY;j:integer);
  begin
    if (j>0) and (j<=99) then with d do case Game2 of
      GT_DOOM2: begin
          if j<=32 then Name:=MUS2NAMES[j]
          else begin
            Name:='D_MUSxy'#0;
            Name[6]:=chr(j div 10+48);
            Name[7]:=chr(j mod 10+48);
          end;
        end;
      GT_DOOM: begin
          Name:='D_ExMy'#0#0;
          Name[4]:=chr((j-1) div 9+49);
          Name[6]:=chr((j-1) mod 9+49);
        end;
      GT_HERETIC: begin
          Name:='MUS_ExMy';
          Name[6]:=chr((j-1) div 9+49);
          Name[8]:=chr((j-1) mod 9+49);
        end;
    end;
  end;

procedure Process;
  var f       : file;
      fpos    : longint;
      head    : WAD_HEADER;
      num     : integer;
      i,j,k,l : integer;
      save    : boolean;
      levpos  : array[1..99] of integer;
      levmap  : array[1..99] of integer;
      muspos  : array[1..99] of integer;
      remap   : integer;
      mix     : boolean;
  begin
    save:=False;
    mix:=GetSymbol(SYM_MIX)<>'';
    Game1:=IdentifyGame(GetSymbol(SYM_FROM),GT_DOOM);
    Game2:=IdentifyGame(GetSymbol(SYM_TO),GT_DOOM2);
    remap:=RemapStatus;
    SetRandomSeed;
    if DestName<>'' then begin
      CopyDest;
      SourceName:=DestName;
    end
    else DestName:=SourceName;
    Assign(f,DestName);
    FileMode:=2; {open for read/write}
    ErrStr:=DestName;
    Reset(f,1);
    if ioresult<>0 then MyHalt(ERR_OPEN);
    BlockR(f,head,sizeof(head));
    if (head.Sig<>PWAD_SIG) and (head.Sig<>IWAD_SIG) then MyHalt(ERR_PWAD);
    num:=head.Num;
    if num>MAXENTRY then MyHalt(ERR_TOOENTRY);
    FSeek(f,head.Start);
    BlockR(f,Dirlist^,num*sizeof(WAD_ENTRY));

    write('Processing with ');
    write('REMAP=');
    if remap=0 then write('OFF') else write('ON(',remap,')');
    write(',MIX=');
    if mix then write('ON') else write('OFF');
    writeln(',SEED=',RandomSeed);

    for i:=1 to 99 do begin
      levmap[i]:=0;
      muspos[i]:=0;
    end;
    k:=0;
    for i:=1 to num do with Dirlist^[i] do begin
      if copy(Name,1,3)='MAP' then begin
        j:=(ord(name[4])-48)*10+ord(name[5])-48;
        if (j>0) and (j<=99) then begin
          levpos[j]:=i;
          levmap[j]:=j;
        end;
      end
      else if (Name[1]='E') and (Name[3]='M') and (Name[5]=#0) then begin
        j:=(ord(Name[2])-49)*9+ord(Name[4])-48;
        if (j>0) and (j<=99) then begin
          levpos[j]:=i;
          levmap[j]:=j;
        end;
      end
      else if copy(Name,1,3)='MUS' then begin
        if mix then begin inc(k);j:=k; end
        else j:=(ord(Name[6])-49)*9+ord(Name[8])-48;
        if (j>0) and (j<=99) then muspos[j]:=i;
      end
      else if copy(Name,1,5)='D_MUS' then begin
        if mix then begin inc(k);j:=k; end
        else j:=(ord(name[6])-48)*10+ord(name[7])-48;
        if (j>0) and (j<=99) then muspos[j]:=i;
      end
      else if (Name[1]='D') and (Name[2]='_') then begin
        if (Name[3]='E') and (Name[5]='M') then begin
          if mix then begin inc(k);j:=k; end
          else j:=(ord(Name[4])-49)*9+ord(Name[6])-48
        end
        else begin
          j:=32;
          while (j>0) and (MUS2NAMES[j]<>Name) do dec(j);
          if mix and (j>0) then begin inc(k);j:=k; end
        end;
        if (j>0) and (j<=99) then muspos[j]:=i;
      end;
    end;
    if remap>0 then
      for i:=1 to 99 do if levmap[i]>0 then begin
        levmap[i]:=remap;
        inc(remap);
      end;
    for i:=1 to 99 do if levmap[i]>0 then with Dirlist^[levpos[i]] do begin
      j:=levmap[i];
      case Game2 of
        GT_DOOM2: begin
            Name:='MAPxy'#0#0#0;
            Name[4]:=chr(j div 10+48);
            Name[5]:=chr(j mod 10+48);
          end;
        GT_DOOM,GT_HERETIC: begin
            Name:='ExMy'#0#0#0#0;
            Name[2]:=chr((j-1) div 9+49);
            Name[4]:=chr((j-1) mod 9+49);
          end;
      end;
      inc(RemappedLev);
      save:=True;
    end;
    if mix then begin {mix musics}
      Randomize;
      for i:=1 to k-1 do begin
        j:=Random(k-i)+i;
        l:=muspos[i];
        muspos[i]:=muspos[j];
        muspos[j]:=l;
      end;
      for i:=1 to k do begin
        SetMusicName(Dirlist^[muspos[i]],i);
        inc(RemappedMus);
        save:=True;
      end;
    end
    else for i:=1 to 99 do if muspos[i]>0 then begin
      SetMusicName(Dirlist^[muspos[i]],levmap[i]);
      inc(RemappedMus);
      save:=True;
    end;

    if NRepDirs>0 then begin
      for i:=1 to num do with Dirlist^[i] do
        inc(RemappedDirs,RemapName(RepDirs^,Name,NRepDirs));
    end;

    for i:=1 to num do with Dirlist^[i] do begin
      if (Name=N_LINEDEFS) and (NRepLAct>0) then begin
        FSeek(f,Start);
        k:=Size div sizeof(LINEDEF);
        while k>0 do begin
          fpos:=FilePos(f);
          l:=MAXLINE;
          if l>k then l:=k;
          BlockR(f,Linedefs^,l*sizeof(LINEDEF));
          for j:=1 to l do
            inc(RemappedLAct,RemapNum(RepLAct^,Linedefs^[j].Action,NRepLAct));
          FSeek(f,fpos);
          BlockW(f,Linedefs^,l*sizeof(LINEDEF));
          dec(k,l);
        end;
      end
      else if (Name=N_SECTORS) and (NRepSAct+NRepFloor>0) then begin
        FSeek(f,Start);
        k:=Size div sizeof(SECTOR);
        while k>0 do begin
          fpos:=FilePos(f);
          l:=MAXSECT;
          if l>k then l:=k;
          BlockR(f,Sectors^,l*sizeof(SECTOR));
          if NRepSAct>0 then
            for j:=1 to l do
              inc(RemappedSAct,RemapNum(RepSAct^,Sectors^[j].Action,NRepSAct));
          if NRepFloor>0 then
            for j:=1 to l do
              inc(RemappedFloor,RemapName(RepFloor^,Sectors^[j].Floor,NRepFloor)+
                  RemapName(RepFloor^,Sectors^[j].Ceiling,NRepFloor));
          FSeek(f,fpos);
          BlockW(f,Sectors^,l*sizeof(SECTOR));
          dec(k,l);
        end;
      end
      else if (Name=N_SIDEDEFS) and (NRepText>0) then begin
        FSeek(f,Start);
        k:=Size div sizeof(SIDEDEF);
        while k>0 do begin
          fpos:=FilePos(f);
          l:=MAXSIDE;
          if l>k then l:=k;
          BlockR(f,Sidedefs^,l*sizeof(SIDEDEF));
          for j:=1 to l do
            inc(RemappedText,RemapName(RepText^,Sidedefs^[j].UpT,NRepText)+
                RemapName(RepText^,Sidedefs^[j].LoT,NRepText)+
                RemapName(RepText^,Sidedefs^[j].MidT,NRepText));
          FSeek(f,fpos);
          BlockW(f,Sidedefs^,l*sizeof(SIDEDEF));
          dec(k,l);
        end;
      end
      else if (Name=N_THINGS) and (NRepThing>0) then begin
        FSeek(f,Start);
        k:=Size div sizeof(THING);
        BlockR(f,Things^,k*sizeof(THING));
        ReplaceThings(k);
        FSeek(f,Start);
        BlockW(f,Things^,k*sizeof(THING));
      end;
    end;

    if save or (RemappedDirs>0) then begin
      FSeek(f,head.Start);
      BlockW(f,Dirlist^,num*sizeof(WAD_ENTRY));
    end;

    Close(f);
    writeln('Remapped  LEVELS:',RemappedLev:4,'     MUSICS:',RemappedMus:4,
            '     TEXTURES:',RemappedText:4,'     FLOORS  :',RemappedFloor:4);
    writeln('          THINGS:',RemappedThing:4,'     NAMES :',RemappedDirs:4,
            '     LACTIONS:',RemappedLAct:4,'     SACTIONS:',RemappedSAct:4);
  end;

begin
  Initialize;
  Parse;
  if (SourceName='') or (GetSymbol(SYM_HELP)<>'') then Help
  else Process;
end.