{$A+,B-,D+,E+,F-,G+,I-,L+,N-,O-,P-,Q-,R-,S-,T-,V-,X+}
{$M 16384,0,655360}
{ DM2CONV v1.2 by Vincenzo Alcamo }
{ This program is Public Domain   }
type
  shortname = array[1..3] of char;
  dname = array[1..8] of char;
  p_string = ^string;
  obj = record
    id : integer;
    sname : shortname;
    name : p_string
  end;
  errors = (ERR_OPENS,ERR_READS,ERR_OPEND,ERR_WRITED,ERR_PWAD,
            ERR_TOOENTRY,ERR_TOOMAPS,ERR_NOMAPS,ERR_NOEQ,ERR_BADEND,
            ERR_BADNUM);
  header= record
    Sig   : Longint;
    Num   : Longint;
    Start : Longint;
  end;
  entry = record
    Start : Longint;
    RSize : Longint;
    Name  : dname;
  end;
  thing = record
    xpos : integer;
    ypos : integer;
    angle: integer;
    code : integer;
    flags: integer;
  end;
  sidedef = record
    x,y  : integer;
    a,b,c: dname;
    sect : integer;
  end;

const
  show_list : boolean = false;
  show_example: boolean = false;
  show_help : boolean = false;
  show_note : boolean = false;
  nocheck   : boolean = false;
  debug     : boolean = false;
  ignore    : boolean = false;
  do_texture: boolean = false;
  remap_lev : integer = 1;
  remap_mus : integer = 0;
  replaces  : integer = 0;
  BUFFSIZE = 62000;
  MAXENTRY = BUFFSIZE div sizeof(entry);
  MAXTHING = BUFFSIZE div sizeof(thing);
  MAXSIDES = BUFFSIZE div sizeof(sidedef);
  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;

  REP_PERCENT=16384;
  MAXREP=250;

  mnames : array[1..32] of dname =  (
    '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');

var
  objects    : array[1..55] of obj;
  replace    : array[1..MAXREP] of word;
  numobjects : integer;
  source     : string;
  dest       : string;
  buffer     : array[1..BUFFSIZE] of byte;
  dirlist    : array[1..MAXENTRY] of entry absolute buffer;
  things     : array[1..MAXTHING] of thing absolute buffer;
  sidedefs   : array[1..MAXSIDES] of sidedef absolute buffer;
  numentry   : integer;
  maxside    : integer;

  repside    : word;
  repthing   : word;
  replev     : word;

procedure CreateTable; assembler;
  asm
    push ds
    mov ax, SEG objects
    mov es, ax
    lea di, objects
    lea si, @@TABLE
    mov ax, cs
    mov ds, ax
    xor cx, cx
    cld
@@CICLO:
    lodsb
    cmp al, 0
    je  @@STOP
    xor dx, dx
@@NUM:
    mov bx, dx
    add dx, dx
    add dx, dx
    add dx, bx
    add dx, dx
    and ax, 15
    add dx, ax
    lodsb
    cmp al, 32
    jne @@NUM
    push ax
    mov ax, dx
    stosw
    pop ax

@@SPACES:
    cmp al, 32
    jne @@SHORT
    lodsb
    jmp @@SPACES
@@SHORT:
    stosb
    movsb
    movsb
    mov bx, si
    inc si
@@ZERO:
    lodsb
    cmp al, 0
    jne @@ZERO
    mov ax, si
    sub ax, bx
    dec ax
    dec ax
    mov ds:[bx], al
    mov ax, bx
    stosw
    mov ax, cs
    stosw
    inc cx
    jmp @@CICLO
@@STOP:
    pop ds
    mov numobjects, cx
    jmp @@FINE
@@TABLE:
    DB '2007 AMM Ammo Clip',0
    DB '68   ARA Arachnotron',0
    DB '64   ARC Archvile',0
    DB '2015 ARM Armor Helmet',0
    DB '8    BAC Backpack',0
    DB '2048 BAM Box of Ammo',0
    DB '2035 BAR Barrel',0
    DB '2023 BER Berserk',0
    DB '2006 BFG BFG9000',0
    DB '2024 BLR Blur Sphere',0
    DB '2019 BLU Blue Armor',0
    DB '3003 BOH Baron of Hell',0
    DB '2046 BRO Box of Rockets',0
    DB '2049 BSH Box of Shells',0
    DB '70   BUR Burning Barrel',0
    DB '3005 CAC Cacodemon',0
    DB '2002 CHA Chaingun',0
    DB '65   CHD Chaingun Dude',0
    DB '2005 CHS Chainsaw',0
    DB '2026 COM Computer Map',0
    DB '16   CYB Cyberdemon',0
    DB '3002 DEM Demon',0
    DB '2047 ENC Energy Cell',0
    DB '17   ENP Energy Pack',0
    DB '2018 GRE Green Armor',0
    DB '2014 HEA Health Potion',0
    DB '69   HEL Hell Knight',0
    DB '3001 IMP Imp',0
    DB '2022 INV Invulnerability',0
    DB '72   KEN Commander Keen',0
    DB '2045 LIG Light Goggles',0
    DB '3006 LOS Lost Soul',0
    DB '67   MAN Mancubus',0
    DB '2012 MED Medikit',0
    DB '83   MEG Megasphere',0
    DB '71   PAI Pain Elemental',0
    DB '2004 PLA Plasma Gun',0
    DB '2025 RAD Radiation Suit',0
    DB '2010 RCK Rocket',0
    DB '66   REV Revenant',0
    DB '2003 ROC Rocket Launcher',0
    DB '9    SER Sergeant',0
    DB '2008 SHE Shells',0
    DB '2001 SHO Shotgun',0
    DB '2013 SOU Soul Sphere',0
    DB '58   SPE Spectre',0
    DB '7    SPI Spiderdemon',0
    DB '82   SSH Super Shotgun',0
    DB '84   SSN SS Nazi',0
    DB '2011 STI Stimpack',0
    DB '3004 TRO Trooper',0
    DB 0
@@FINE:
  end;

const processed : byte = 0;
var   numtexture : integer;
procedure Convert(num:integer); assembler;
  asm
    cmp processed, 0
    jne @@DOSEARCH
    inc processed
    lea si, @@TABLE
    xor ax, ax
    mov dx, si
@@CICP:
    inc si
    mov al, cs:[si]
    cmp al, 0
    je  @@FINEP
    cmp al, 32
    jne @@CICP
    mov cs:[si], ah
    jmp @@CICP
@@FINEP:
    mov ax, si
    sub ax, dx
    shr ax, 4
    mov numtexture, ax
    jmp @@FINE
@@DOSEARCH:
    mov cx, num
    lea si, sidedefs
    mov ax, cs
    mov es, ax
@@AGAIN:
    add si, 4
    call @@FIND
    call @@FIND
    call @@FIND
    add si, 2
    loop @@AGAIN
    jmp @@FINE
@@FIND:
    push cx
    push bp
    lea di, @@TABLE
    lodsw
    mov dx, ax
    lodsw
    mov bp, ax
    lodsw
    mov bx, ax
    lodsw
    mov cx, numtexture
@@CICLO:
    cmp dx, es:[di]
    jne @@NEXT
    cmp bp, es:[di+2]
    jne @@NEXT
    cmp bx, es:[di+4]
    jne @@NEXT
    cmp ax, es:[di+6]
    jne @@NEXT
    mov ax, es:[di+8]
    mov [si-8], ax
    mov ax, es:[di+10]
    mov [si-6], ax
    mov ax, es:[di+12]
    mov [si-4], ax
    mov ax, es:[di+14]
    mov [si-2], ax
    inc repside
    jmp @@FOUND
@@NEXT:
    add di, 16
    loop @@CICLO
@@FOUND:
    pop bp
    pop cx
    ret
@@TABLE:
    {TABLE OF TEXTURE REPLACEMENTS}
    DB 'AASTINKYDOORSTOP'
    DB 'ASHWALL ASHWALL2'
    DB 'BLODGR1 PIPE6   '
    DB 'BLODGR2 PIPE6   '
    DB 'BLODGR3 PIPE6   '
    DB 'BLODGR4 PIPE6   '
    DB 'BRNBIGC MIDGRATE'
    DB 'BRNBIGL MIDGRATE'
    DB 'BRNBIGR MIDGRATE'
    DB 'BRNPOIS2BROWN96 '
    DB 'BROVINE BROWN1  '
    DB 'BROWNWELBROWNHUG'
    DB 'CEMPOIS CEMENT1 '
    DB 'COMP2   COMPTALL'
    DB 'COMPOHSOCOMPWERD'
    DB 'COMPTILECOMPWERD'
    DB 'COMPUTE1COMPSTA1'
    DB 'COMPUTE2COMPTALL'
    DB 'COMPUTE3COMPTALL'
    DB 'DOORHI  TEKBRON2'
    DB 'GRAYDANGGRAY5   '
    DB 'ICKDOOR1DOOR1   '
    DB 'ICKWALL6ICKWALL5'
    DB 'LITE2   BROWN1  '
    DB 'LITE4   LITE5   '
    DB 'LITE96  BROWN96 '
    DB 'LITEBLU2LITEBLU1'
    DB 'LITEBLU3LITEBLU1'
    DB 'LITEMET METAL1  '
    DB 'LITERED DOORRED '
    DB 'LITESTONSTONE2  '
    DB 'MIDVINE1MIDGRATE'
    DB 'MIDVINE2MIDGRATE'
    DB 'NUKESLADSLADWALL'
    DB 'PLANET1 COMPSTA2'
    DB 'REDWALL1REDWALL '
    DB 'SKINBORDSKINMET1'
    DB 'SKINTEK1SKINMET2'
    DB 'SKINTEK2SKINMET2'
    DB 'SKULWAL3SKSPINE1'
    DB 'SKULWALLSKSPINE1'
    DB 'SLADRIP1SLADSKUL'
    DB 'SLADRIP2SLADSKUL'
    DB 'SLADRIP3SLADSKUL'
    DB 'SP_DUDE3SP_DUDE4'
    DB 'SP_DUDE6SP_DUDE4'
    DB 'SP_ROCK2SP_ROCK1'
    DB 'STARTAN1STARTAN2'
    DB 'STONGARGSTONE3  '
    DB 'STONPOISSTONE   '
    DB 'TEKWALL2TEKWALL1'
    DB 'TEKWALL3TEKWALL1'
    DB 'TEKWALL5TEKWALL1'
    DB 'WOODSKULWOODGARG'
    DB 0
@@FINE:
  end;

{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;

procedure Title;
  begin
    writeln('DM2CONV v1.2 by Vincenzo Alcamo (alcamo@arci01.bo.cnr.it)');
  end;

procedure List;
  var i,j:integer;
  begin
    Title;
    writeln;
    writeln('LIST OF KNOWN OBJECTS');
    for i:=1 to numobjects do begin
      if i mod 3=1 then writeln
      else write('  ');
      with objects[1+((i-1)div 3)+((i-1)mod 3)*((numobjects+2) div 3)] do
        write(id:4,#32,sname,#32,StringN(name^,15));
    end;
    writeln;
    writeln;
    writeln('You can specify an object by its number, its shortname, its name');
    writeln('or even an initial fragment of its name.');
  end;

procedure More;
  begin
    Title;
    writeln;
    writeln('REPLACEMENT is an expression specifying object substitution:');
    writeln('  {source}={dest[@num]}');
    writeln('source is the initial object, dest is the final object,');
    writeln('num is the number of substitutions (absolute or percentual)');
    writeln('You can specify more than one replacement.');
    writeln;
    writeln('Replacement expression examples:');
    writeln;
    writeln('DEM=IMP             all Demons become Imps');
    writeln('DEM,IMP=LOS         all Demons and Imps become Lost Souls');
    writeln('DEM=IMP@5           5 Demons become Imps');
    writeln('DEM=IMP@50%         50% of Demons become Imps');
    writeln('DEM=IMP@5,SER       5 Demons become Imps, the rest are Sergeants');
    writeln('DEM=IMP DEM=TRO     No Demons remain for the second expression');
    writeln;
    writeln('Requests greater than available objects are adjusted proportionally:');
    writeln('DEM=IMP@5,TRO@15    If Demons are 9 -> IMP@25%,TRO@75%');
    writeln;
    writeln('You can substitute the % sign with #,$,& whichever you prefer.');
    writeln;
  end;

procedure Help;
  begin
    Title;
    writeln('Converts DOOM maps for use with DOOM2.');
    writeln;
    writeln('DM2CONV <input> [output] [/mapnum] [/M[=num]] [/TEXTURE] [/DEBUG]');
    writeln('        [/IGNORE] [/SEED[=num]] [/NOCHECK] [replacements]..');
    writeln('        [/LIST] [/EXAMPLES] [/NOTES] [@response]..');
    writeln;
    writeln('input        name of DOOM wad file to convert ** REQUIRED **');
    writeln('output       name of output file (if omitted, the input file is overwritten)');
    writeln('/mapnum      number for the first level remapped (default: 1)');
    writeln('/M[=num]     music remapping (num is the level for the first music)');
    writeln('/TEXTURE     convert texture names  *** SEE DM2CONV.TXT ***');
    writeln('/DEBUG       display debug information');
    writeln('/IGNORE      make replacements even if no level is remapped');
    writeln('/SEED[=num]  random generator seed (default: 0, randomize if num is omitted)');
    writeln('/NOCHECK     allow the use of object numbers not in list');
    writeln('/LIST        display the list of known objects');
    writeln('/EXAMPLES    display replacements examples');
    writeln('/NOTES       special notes about this program  *** READ THIS ***');
    writeln('@response    response file (text file with additional arguments)');
    writeln;
    writeln('Use /EXAMPLES, /NOTES, /LIST for additional information.');
  end;

procedure Notes;
  begin
    Title;
    writeln;
    writeln('Notes about level remapping:');
    writeln('- Level remapping is performed regardless of level name:');
    writeln('  the first level found becomes MAP01 (and so on)');
    writeln('- No other resources are remapped (eg: M_EPI?, etc...)');
    writeln('- DM2CONV acts only in one way: keep a backup of your wads.');
    writeln('- Secret levels are not remapped to the proper level: don''t use wads');
    writeln('  with secret levels  or, at least, avoid entering a secret level.');
    writeln;
    writeln('Music remapping has 3 settings (none, /M, /M=num):');
    writeln('1) no music is remapped.');
    writeln('2) remap musics accordingly to remapped levels');
    writeln('   D_E1M1 becomes D_RUNNIN only if E1M1 was remapped');
    writeln('3) the first music found becomes the music for MAP num,');
    writeln('   the second becomes the music for MAP num+1, and so on.');
    writeln('For 2) and 3): the end-of-level music is also remapped.');
  end;

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

function GetNum(var s:string):integer;
  var i,j,k:integer;
  begin
    val(s,j,k);
    if k=0 then begin
      if nocheck and (j>0) and (j<16384) then begin
        GetNum:=j;
        exit;
      end;
      for i:=1 to numobjects do
        if objects[i].id=j then begin
          GetNum:=j;
          exit;
        end;
    end
    else begin
      for i:=1 to numobjects do
        if s=objects[i].sname then begin
          GetNum:=objects[i].id;
          exit;
        end;
      for i:=1 to numobjects do with objects[i] do begin
        j:=1;
        k:=1;
        repeat
          if name^[k]=' ' then inc(k)
          else if s[j]<>UpCase(name^[k]) then break
          else begin
            inc(j);
            inc(k);
          end;
        until (j>length(s)) or (k>length(name^));
        if j>length(s) then begin
          GetNum:=id;
          exit;
        end;
      end;
    end;
    GetNum:=0;
  end;

procedure noname(s:string);
  begin
    writeln('No object found for ',s);
    halt;
  end;

procedure myhalt(code:errors);
  begin
    case code of
      ERR_OPENS: writeln('Error opening source: ',source);
      ERR_OPEND: writeln('Error opening destination: ',dest);
      ERR_READS: writeln('Error reading source: ',source);
      ERR_WRITED:writeln('Error writing destination: ',dest);
      ERR_PWAD:  writeln('File is not a PWAD: ',source);
      ERR_TOOENTRY:writeln('Too many entries in file: ',source);
      ERR_TOOMAPS:writeln('Cannot remap after map 32');
      ERR_NOMAPS:writeln('No maps found in file: ',source);
      ERR_NOEQ:  writeln('Missing ''='' after list of source objects');
      ERR_BADEND:writeln('Expression incorrectly terminated');
      ERR_BADNUM:writeln('Bad number in expression');
    end;
    halt(0);
  end;

procedure Swappa(var h,k:integer);
  var l:integer;
  begin
    l:=replace[k];
    replace[k]:=replace[h];
    replace[h]:=l;
    inc(k);
    inc(h);
    l:=replace[k];
    replace[k]:=replace[h];
    replace[h]:=l;
    inc(k);
    inc(h);
  end;

procedure Parse;
  var
    i,j,k,h : integer;
    s,t     : string;
    l       : longint;
    f       : boolean;
    repn    : integer;
    ri,rc,rs: integer;
    response: text;
    inresp  : boolean;
    respstr : string;
  function GetArgument:string;
    var i,j:integer;
    begin
      if respstr='' then begin
        if eof(response) then begin
          respstr:='';
          inresp:=false;
          close(response);
        end
        else begin
          Readln(response,respstr);
          if ioresult<>0 then begin
            writeln('Error reading from response file');
            respstr:='';
            inresp:=false;
            close(response);
          end;
          j:=1;
          for i:=1 to length(respstr) do
            case respstr[i] of
              #32,#9: if j>1 then begin
                        respstr[j]:=#32;
                        inc(j);
                      end;
              else begin
                respstr[j]:=respstr[i];
                inc(j);
              end;
            end;
          respstr[0]:=chr(j-1);
        end;
      end;
      case respstr[1] of
        '''',';','#','%': respstr:='';
      end;
      i:=1;
      while (i<=length(respstr)) and (respstr[i]<>#32) do inc(i);
      GetArgument:=Upper(Copy(respstr,1,i-1));
      respstr:=Copy(respstr,i+1,255);
    end;
  begin
    source:='';
    dest:='';
    RandSeed:=0;
    repn:=1;
    inresp:=false;
    i:=1;
    while i<=ParamCount do begin
      f:=not (show_help or show_example or show_list or show_note);
      if inresp then s:=GetArgument
      else s:=Upper(ParamStr(i));
      if s='' then {DO NOTHING}
      else if s[1]='@' then begin
        if inresp then writeln('Cannot use nested response file!')
        else begin
          respstr:='';
          assign(response,Copy(s,2,255));
          reset(response);
          if ioresult<>0 then writeln('Error opening response file.')
          else inresp:=true;
        end;
      end
      else if (s[1]='/') or (s[1]='-') then begin
        s:=Copy(s,2,255);
        if (s='HELP') or (s='?') or (s='H') then show_help:=f
        else if (s='NOCHECK') or (s='N') then nocheck:=True
        else if (s='LIST') or (s='L') then show_list:=f
        else if (Copy(s,1,7)='EXAMPLE') or (s='E') then show_example:=f
        else if Copy(s,1,4)='NOTE' then show_note:=f
        else if (s='DEBUG') or (s='D') then debug:=True
        else if (s='IGNORE') or (s='I') then ignore:=True
        else if (s='TEXTURE') or (s='T') then do_texture:=True
        else if Copy(s,1,4)='SEED' then begin
          s:=Copy(s,5,255);
          j:=0;
          if s[1]='=' then begin
            s:=Copy(s,2,255);
            Val(s,l,j);
            if j<>0 then writeln('Bad number for seed: ',s)
            else RandSeed:=l;
          end
          else Randomize;
          if j=0 then writeln('Seed for random generator is: ',RandSeed);
        end
        else if s[1]='M' then begin
          s:=Copy(s,2,255);
          if s[1]='=' then s:=Copy(s,2,255);
          if Length(s)>0 then begin
            Val(s,j,k);
            if (k<>0) or (j<1) or (j>32) then writeln('Bad number for music: ',s)
            else remap_mus:=j;
          end
          else remap_mus:=-1; {remap level&music}
        end
        else begin
          Val(s,j,k);
          if (k<>0) or (j<1) or (j>32) then writeln('Bad number for remap: ',s)
          else begin
            remap_lev:=j;
            writeln('Remapping from level ',j);
          end;
        end
      end
      else begin
        k:=0;
        for j:=1 to length(s) do if s[j]='=' then k:=1;
        if k=0 then begin
          if source='' then source:=s
          else if dest='' then dest:=s
          else writeln('Extra parameter ignored: ',s);
        end
        else begin
          inc(replaces);
          if debug then writeln('Replacement ',replaces,': ',s);
          rs:=repn;
          s:=','+s+'';
          while s[1]=',' do begin
            s:=Copy(s,2,255);
            t:=GetWord(s);
            j:=GetNum(t);
            if j=0 then noname(t);
            replace[repn]:=j;
            inc(repn);
          end;
          if s[1]<>'=' then myhalt(ERR_NOEQ);
          ri:=repn;
          inc(repn);
          rc:=0;
          s[1]:=',';
          while s[1]=',' do begin
            s:=Copy(s,2,255);
            t:=GetWord(s);
            j:=GetNum(t);
            if j=0 then noname(t);
            replace[repn]:=j;
            inc(repn);
            replace[repn]:=0;
            if s[1]='@' then begin
              s:=Copy(s,2,255);
              t:=GetWord(s);
              val(t,j,k);
              if (k<>0) or (j>=REP_PERCENT) or (j<=0) then myhalt(ERR_BADNUM);
              if (s[1]>='#') and (s[1]<='&') then begin
                inc(j,REP_PERCENT);
                s:=Copy(s,2,255);
              end;
              replace[repn]:=j;
            end;
            inc(repn);
            inc(rc);
          end;
          if (s[1]<>'') or (rc=0) then myhalt(ERR_BADEND);
          replace[ri]:=REP_PERCENT+rc;
          k:=ri+1;
          for j:=1 to rc do begin
            h:=ri+j*2-1;
            if (replace[h+1]>0) and (replace[h+1]<REP_PERCENT) then Swappa(h,k);
          end;
          for j:=1 to rc do begin
            h:=ri+j*2-1;
            if replace[h+1]>=REP_PERCENT then Swappa(h,k);
          end;
          if debug then begin
            write('REPLACE');
            for j:=rs to ri-1 do write(' ',replace[j]);
            write(' WITH');
            for j:=1 to rc do begin
              k:=ri+j*2-1;
              write(' ',replace[k]);
              if replace[k+1]>0 then
                if replace[k+1]>=REP_PERCENT then write('@',replace[k+1]-REP_PERCENT,'%')
                else write('@',replace[k+1]);
            end;
            writeln;
          end;
        end;
      end;

      if not inresp then inc(i);
    end;
    if not (show_example or show_list or show_note) and (source='') then show_help:=true;
    source:=AddSuffix(source,'WAD');
    if dest<>'' then dest:=AddSuffix(dest,'WAD');
  end;

procedure CopyDest;
  var a,b     : file;
      l       : Longint;
      size,len: Word;
  begin
    writeln('Copying source to destination...');
    Assign(a,source);
    FileMode:=0;  {open for read only}
    Reset(a,1);
    FileMode:=2;  {open for read/write}
    if ioresult<>0 then myhalt(ERR_OPENS);
    Assign(b,dest);
    Rewrite(b,1);
    if ioresult<>0 then myhalt(ERR_OPEND);
    l:=FileSize(a);
    while l>0 do begin
      if l>BUFFSIZE then size:=BUFFSIZE
      else size:=l;
      BlockRead(a,buffer,size,len);
      if (ioresult<>0) or (size<>len) then myhalt(ERR_READS);
      BlockWrite(b,buffer,size,len);
      if (ioresult<>0) or (size<>len) then myhalt(ERR_WRITED);
      dec(l,size);
    end;
    Close(a);
    Close(b);
  end;

procedure ReplaceThings(totobj:Integer);
  var index  : array[1..4000] of integer;
      numobj : integer;
      i,j,k,l: integer;
      repn,h : integer;
      numabs : integer;
      nabs   : integer;
      nrel   : integer;
      s      : string;
  procedure Choose(var max:integer;n,c:integer);
    var i,j:integer;
    begin
      if n<max then begin
        for i:=1 to n do begin
          j:=Random(max)+1;
          with things[index[j]] do begin
            if code<>c then inc(repthing);
            code:=c;
          end;
          index[j]:=index[max];
          dec(max);
        end;
      end
      else begin
        for i:=1 to max do with things[index[i]] do begin
          if code<>c then inc(repthing);
          code:=c;
        end;
        max:=0;
      end;
    end;
  begin
    repn:=1;
    for i:=1 to replaces do begin
      if debug then write('REPLACEMENT=',i);
      numobj:=0;
      while replace[repn]<REP_PERCENT do begin
        j:=replace[repn];
        for k:=1 to totobj do
          if things[k].code=j then begin
            inc(numobj);
            index[numobj]:=k;
          end;
        inc(repn);
      end;
      if debug then write('  TOTAL OBJECTS=',numobj);
      nabs:=0;
      nrel:=replace[repn]-REP_PERCENT;
      inc(repn);
      if numobj=0 then begin
        if debug then writeln('   SKIPPED');
        inc(repn,nrel+nrel);
        continue;
      end;
      numabs:=0;
      j:=nrel;
      l:=repn+1;
      k:=1;
      while (k<=j) do begin
        if replace[l]=0 then replace[l]:=REP_PERCENT
        else begin
          if replace[l]>=REP_PERCENT then
            replace[l]:=(longint(numobj)*(replace[l]-REP_PERCENT)+50)div 100;
          inc(numabs,replace[l]);
          inc(nabs);
          dec(nrel);
        end;
        inc(k);
        inc(l,2);
      end;
      if numabs>numobj then begin
        l:=repn+1;
        k:=numobj;
        for j:=1 to nabs do begin
          h:=replace[l];
          replace[l]:=(longint(h)*k+numabs div 2)div numabs;
          dec(numabs,h);
          dec(k,replace[l]);
          inc(l,2);
        end;
        numabs:=numobj;
      end;
      l:=repn+nabs*2+1;
      numabs:=numobj-numabs;
      while nrel>0 do begin
        j:=(numabs+nrel div 2) div nrel;
        replace[l]:=j;
        dec(numabs,j);
        inc(l,2);
        dec(nrel);
        inc(nabs);
      end;
      for j:=1 to nabs do begin
        if debug then begin
          if j mod 4=1 then writeln
          else write(#32);
          k:=numobjects;
          h:=replace[repn];
          while (k>0) and (objects[k].id<>h) do dec(k);
          if k<>0 then s:=objects[k].name^
          else begin
            Str(h,s);
            s:='Unknown #'+s;
          end;
          write(s:15,'=');
          Str(replace[repn+1],s);
          write(StringN(s,3));
        end;
        Choose(numobj,replace[repn+1],replace[repn]);
        inc(repn,2);
      end;
      if debug then writeln;
    end;
  end;

procedure Plural(n:integer;s:string);
  begin
    write(' ',n,' ',s);
    if n<>1 then write('s');
  end;

procedure Process;
  var f    : file;
      head : header;
      size : integer;
      i,j,k: integer;
      numt : integer;
      fpos : longint;
      rlev : array[1..27] of integer;
  begin
    repside:=0;
    repthing:=0;
    replev:=0;
    for i:=1 to 27 do rlev[i]:=0;
    if dest<>'' then CopyDest
    else dest:=source;
    source:=dest;
    Assign(f,dest);
    Reset(f,1);
    if ioresult<>0 then myhalt(ERR_OPEND);
    BlockRead(f,head,sizeof(header),size);
    if (ioresult<>0) or (size<>sizeof(header)) then myhalt(ERR_READS);
    if head.sig<>PWAD_SIG then myhalt(ERR_PWAD);
    numentry:=head.num;
    if numentry>MAXENTRY then myhalt(ERR_TOOENTRY);
    Seek(f,head.start);
    if ioresult<>0 then myhalt(ERR_READS);
    BlockRead(f,dirlist,numentry*sizeof(entry),size);
    if (ioresult<>0) or (size<>numentry*sizeof(entry)) then myhalt(ERR_READS);
    for i:=1 to numentry do with dirlist[i] do begin
      if (name[1]='E') and (name[3]='M') then begin
        if remap_lev>32 then myhalt(ERR_TOOMAPS);
        rlev[(ord(name[2])-49)*9+ord(name[4])-48]:=remap_lev;
        name[1]:='M';
        name[2]:='A';
        name[3]:='P';
        name[4]:=chr(remap_lev div 10+48);
        name[5]:=chr(remap_lev mod 10+48);
        inc(remap_lev);
        inc(replev);
      end;
    end;
    j:=0;
    if remap_mus<>0 then
      for i:=1 to numentry do with dirlist[i] do
        if (name[1]='D') and (name[2]='_') then
          if name='D_INTER'#0 then name:='D_DM2INT'
          else if (name[3]='E') and (name[5]='M') then
            if remap_mus>0 then begin
              if remap_mus>32 then myhalt(ERR_TOOMAPS);
              name:=mnames[remap_mus];
              inc(remap_mus);
              inc(j);
            end
            else begin
              k:=rlev[(ord(name[4])-49)*9+ord(name[6])-48];
              if k>0 then name:=mnames[k];
            end;

    if (replev=0) and (j=0) and not ignore then myhalt(ERR_NOMAPS);
    Seek(f,head.start);
    if ioresult<>0 then myhalt(ERR_WRITED);
    BlockWrite(f,dirlist,numentry*sizeof(entry),size);
    if (ioresult<>0) or (size<>numentry*sizeof(entry)) then myhalt(ERR_WRITED);
    numt:=MAXENTRY+1;
    for i:=numentry downto 1 do
      if ((replaces>0) and (dirlist[i].Name='THINGS'#0#0)) or
         (do_texture and (dirlist[i].Name='SIDEDEFS')) then begin
        dec(numt);
        dirlist[numt]:=dirlist[i];
      end;
    if numt<=MAXENTRY then begin
      writeln('Processing REPLACEMENTS...');
      maxside:=(longint(numt-1)*sizeof(entry))div sizeof(sidedef);
      for i:=numt to MAXENTRY do with dirlist[i] do begin
        Seek(f,start);
        if ioresult<>0 then myhalt(ERR_READS);
        if name='SIDEDEFS' then begin
          k:=rsize div sizeof(sidedef);
          while k>0 do begin
            j:=maxside;
            if j>k then j:=k;
            fpos:=FilePos(f);
            BlockRead(f,sidedefs,j*sizeof(sidedef),size);
            if (ioresult<>0) or (size<>j*sizeof(sidedef)) then myhalt(ERR_READS);
            Convert(j);
            Seek(f,fpos);
            if ioresult<>0 then myhalt(ERR_WRITED);
            BlockWrite(f,sidedefs,j*sizeof(sidedef),size);
            if (ioresult<>0) or (size<>j*sizeof(sidedef)) then myhalt(ERR_WRITED);
            dec(k,j);
          end;
        end
        else begin
          BlockRead(f,things,rsize,size);
          if (ioresult<>0) or (size<>rsize) then myhalt(ERR_READS);
          ReplaceThings(rsize div sizeof(thing));
          Seek(f,start);
          if ioresult<>0 then myhalt(ERR_WRITED);
          BlockWrite(f,things,rsize,size);
          if (ioresult<>0) or (size<>rsize) then myhalt(ERR_WRITED);
        end;
      end;
    end;
    Close(f);
    write('Operation completed: converted');
    Plural(replev,'level');
    write(',');
    Plural(repside,'texture');
    write(',');
    Plural(repthing,'object');
    writeln('.');
  end;

begin
  CreateTable;
  Convert(0);
  Parse;
  if show_help then Help
  else if show_list then List
  else if show_example then More
  else if show_note then Notes
  else Process;
end.