{$A+,B-,D+,E+,F-,G+,I-,L+,N-,O-,P-,Q-,R-,S-,T-,V-,X+}
{$M 16384,0,655360}
{ DM2CONV v1.6á 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,ERR_NOMEM,ERR_OPEN,ERR_READ);
  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;
  sector = record
    y1,y2: integer;
    a,b  : dname;
    l,f,t: integer;
  end;
  repname = record
    before : dname;
    after  : dname;
  end;
  repname_array = array[1..1024] of repname;
  p_repname_array = ^repname_array;


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 wall textures}
  do_floor  : boolean = false; {remap floor textures}
  remapping : boolean = false; {remap levels}
  heretic   : boolean = false; {heretic mode}
  savedir   : boolean = false; {save directory entries}
  no_conv   : boolean = false; {no conversion}
  remap_lev : integer = 1;
  remap_mus : integer = 0;
  replaces  : integer = 0;
  BUFFSIZE = 60000;
  MAXENTRY = BUFFSIZE div sizeof(entry);
  MAXTHING = BUFFSIZE div sizeof(thing);
  MAXSIDES = BUFFSIZE div sizeof(sidedef);
  MAXSECS  = BUFFSIZE div sizeof(sector);

  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';
  NULL_NAME= #0#0#0#0#0#0#0#0;

  REP_PERCENT=16384;
  MAXREP=1024;

  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;
  datafile   : 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;
  sectors    : array[1..MAXSECS] of sector absolute buffer;
  numentry   : integer;
  maxside    : integer;

  reptexture : p_repname_array;
  nreptexture: integer;
  repfloor   : p_repname_array;
  nrepfloor  : integer;
  repdirs    : p_repname_array;
  nrepdirs   : integer;

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

procedure adjust_name(var name:dname); assembler;
  asm
    cld
    les di, name
    mov cx, 8
    mov al, 32
    repne scasb
    jnz @@FINE
    xor ax, ax
    dec di
    inc cx
    rep stosb
@@FINE:
  end;

procedure CopyTable(table:p_repname_array;source:p_repname_array;var num:integer);
  var i,j,k:integer;
      name:dname;
  begin
    i:=1;
    j:=num;
    while source^[i].before[1]<>#0 do begin
      name:=source^[i].before;
      adjust_name(name);
      k:=1;
      while (k<=j) and (table^[k].before<>name) do inc(k);
      if (k>j) and (num<1024) then begin
        inc(num);
        table^[num].before:=name;
        table^[num].after:=source^[num].after;
        adjust_name(table^[num].after);
      end;
      inc(i);
    end;
  end;

function remap_name(table:p_repname_array;var name:dname;num:integer):integer; assembler;
  asm
    cld
    les di, name
    mov cx, 8
    mov al, 0
    repne scasb
    jnz @@OK
    dec di
    inc cx
    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;

procedure texture_table; assembler;
  asm
    {TABLE OF TEXTURE REPLACEMENTS FOR DOOM}
    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
  end;

procedure htexture_table; assembler;
  asm
    {TABLE OF TEXTURE REPLACEMENTS FOR HERETIC}
    DB 'AASTINKYREDWALL '
    DB 'ASHWALL SQPEB1  '
    DB 'BIGDOOR1DOORSTON'
    DB 'BIGDOOR2GRSKULL2'
    DB 'BIGDOOR3GRSKULL3'
    DB 'BIGDOOR4SKULLSB2'
    DB 'BIGDOOR5DOORWOOD'
    DB 'BIGDOOR6DOORWOOD'
    DB 'BIGDOOR7SKULLSB2'
    DB 'BLODGR1 SPINE2  '
    DB 'BLODGR2 SPINE2  '
    DB 'BLODGR3 SPINE2  '
    DB 'BLODGR4 SPINE2  '
    DB 'BLODRIP1SPINE2  '
    DB 'BLODRIP2SPINE2  '
    DB 'BLODRIP3SPINE2  '
    DB 'BLODRIP4SPINE2  '
    DB 'BRNBIGC WDGAT64 '
    DB 'BRNBIGL WDGAT64 '
    DB 'BRNBIGR WDGAT64 '
    DB 'BRNPOIS SNDBLCKS'
    DB 'BRNPOIS2SNDCHNKS'
    DB 'BRNSMAL1WDGAT64 '
    DB 'BRNSMAL2WDGAT64 '
    DB 'BRNSMALCWDGAT64 '
    DB 'BRNSMALLWDGAT64 '
    DB 'BRNSMALRWDGAT64 '
    DB 'BROVINE SNDCHNKS'
    DB 'BROVINE2SNDBLCKS'
    DB 'BROWN1  SNDCHNKS'
    DB 'BROWN144SNDPLAIN'
    DB 'BROWN96 SPINE1  '
    DB 'BROWNGRNSNDBLCKS'
    DB 'BROWNHUGSNDPLAIN'
    DB 'BROWNPIPSPINE2  '
    DB 'BROWNWELSNDPLAIN'
    DB 'CEMENT1 GRSKULL1'
    DB 'CEMENT2 GRSKULL1'
    DB 'CEMENT3 GRSKULL1'
    DB 'CEMENT4 GRSKULL1'
    DB 'CEMENT5 GRSKULL1'
    DB 'CEMENT6 GRSKULL1'
    DB 'CEMPOIS GRSKULL1'
    DB 'COMP2   TRISTON1'
    DB 'COMPBLUESKULLSB1'
    DB 'COMPOHSOSANDSQ2 '
    DB 'COMPSPANSKULLSB1'
    DB 'COMPSTA1SKULLSB1'
    DB 'COMPSTA2SKULLSB1'
    DB 'COMPTALLTRISTON1'
    DB 'COMPTILETRISTON1'
    DB 'COMPUTE1TRISTON1'
    DB 'COMPUTE2TRISTON1'
    DB 'COMPUTE3TRISTON1'
    DB 'COMPWERDTRISTON1'
    DB 'CRATE1  WOODWL  '
    DB 'CRATE2  WOODWL  '
    DB 'CRATELITWOODWL  '
    DB 'CRATINY WOODWL  '
    DB 'CRATWIDEWOODWL  '
    DB 'DOOR1   DOOREXIT'
    DB 'DOOR3   DOOREXIT'
    DB 'DOORBLU DRIPWALL'
    DB 'DOORBLU2DRIPWALL'
    DB 'DOORHI  DOORWOOD'
    DB 'DOORRED DRIPWALL'
    DB 'DOORRED2DRIPWALL'
    DB 'DOORSTOPMETL2   '
    DB 'DOORTRAKMETL2   '
    DB 'DOORYEL DRIPWALL'
    DB 'DOORYEL2DRIPWALL'
    DB 'EXITDOORDOOREXIT'
    DB 'EXITSIGNSNDCHNKS'
    DB 'EXITSTONGRSTNPB '
    DB 'FIREBLU1RCKSNMUD'
    DB 'FIREBLU2RCKSNMUD'
    DB 'FIRELAV2REDWALL '
    DB 'FIRELAV3REDWALL '
    DB 'FIRELAVAREDWALL '
    DB 'FIREMAG1REDWALL '
    DB 'FIREMAG2REDWALL '
    DB 'FIREMAG3REDWALL '
    DB 'FIREWALAREDWALL '
    DB 'FIREWALBREDWALL '
    DB 'FIREWALLREDWALL '
    DB 'GRAY1   SQPEB1  '
    DB 'GRAY2   SQPEB1  '
    DB 'GRAY4   SQPEB1  '
    DB 'GRAY5   SQPEB1  '
    DB 'GRAY7   SQPEB1  '
    DB 'GRAYBIG SQPEB1  '
    DB 'GRAYDANGSQPEB1  '
    DB 'GRAYPOISSQPEB1  '
    DB 'GRAYTALLSQPEB1  '
    DB 'GRAYVINESQPEB1  '
    DB 'GSTFONT1MOSSRCK1'
    DB 'GSTFONT2MOSSRCK1'
    DB 'GSTFONT3MOSSRCK1'
    DB 'GSTGARG MOSSRCK1'
    DB 'GSTLION MOSSRCK1'
    DB 'GSTONE1 MOSSRCK1'
    DB 'GSTONE2 MOSSRCK1'
    DB 'GSTSATYRMOSSRCK1'
    DB 'GSTVINE1MOSSRCK1'
    DB 'GSTVINE2MOSSRCK1'
    DB 'ICKDOOR1DOORSTON'
    DB 'ICKWALL1CSTLRCK '
    DB 'ICKWALL2CSTLRCK '
    DB 'ICKWALL3CSTLRCK '
    DB 'ICKWALL4CSTLRCK '
    DB 'ICKWALL5CSTLRCK '
    DB 'ICKWALL6CSTLRCK '
    DB 'ICKWALL7CSTLRCK '
    DB 'LITE2   SNDCHNKS'
    DB 'LITE3   DRIPWALL'
    DB 'LITE4   DRIPWALL'
    DB 'LITE5   DRIPWALL'
    DB 'LITE96  SPINE1  '
    DB 'LITEBLU1DRIPWALL'
    DB 'LITEBLU2DRIPWALL'
    DB 'LITEBLU3DRIPWALL'
    DB 'LITEBLU4DRIPWALL'
    DB 'LITEMET SKULLSB1'
    DB 'LITERED REDWALL '
    DB 'LITESTONSQPEB1  '
    DB 'MARBFAC2MOSSRCK1'
    DB 'MARBFAC3MOSSRCK1'
    DB 'MARBFACEMOSSRCK1'
    DB 'MARBLE1 MOSSRCK1'
    DB 'MARBLE2 MOSSRCK1'
    DB 'MARBLE3 MOSSRCK1'
    DB 'MARBLOD1MOSSRCK1'
    DB 'METAL   RCKSNMUD'
    DB 'METAL1  SKULLSB1'
    DB 'MIDBRN1 WDGAT64 '
    DB 'MIDGRATEWDGAT64 '
    DB 'MIDVINE1WDGAT64 '
    DB 'MIDVINE2WDGAT64 '
    DB 'NUKE24  SNDPLAIN'
    DB 'NUKEDGE1SNDPLAIN'
    DB 'NUKEPOISSNDPLAIN'
    DB 'NUKESLADSNDPLAIN'
    DB 'PIPE1   SPINE2  '
    DB 'PIPE2   SPINE2  '
    DB 'PIPE4   SPINE2  '
    DB 'PIPE6   SPINE2  '
    DB 'PLANET1 METL1   '
    DB 'PLAT1   GRSKULL1'
    DB 'REDWALL REDWALL '
    DB 'REDWALL1REDWALL '
    DB 'ROCKRED1REDWALL '
    DB 'ROCKRED2REDWALL '
    DB 'ROCKRED3REDWALL '
    DB 'SHAWN1  SQPEB1  '
    DB 'SHAWN2  SQPEB1  '
    DB 'SHAWN3  SQPEB1  '
    DB 'SKIN2   REDWALL '
    DB 'SKINBORDREDWALL '
    DB 'SKINCUT CTYSTCI1'
    DB 'SKINEDGEREDWALL '
    DB 'SKINFACEREDWALL '
    DB 'SKINLOW CTYSTCI2'
    DB 'SKINMET1CTYSTCI4'
    DB 'SKINMET2CTYSTCI1'
    DB 'SKINSCABCTYSTCI2'
    DB 'SKINSYMBCTYSTCI4'
    DB 'SKINTEK1CTYSTCI1'
    DB 'SKINTEK2CTYSTCI2'
    DB 'SKSNAKE1RCKSNMUD'
    DB 'SKSNAKE2RCKSNMUD'
    DB 'SKSPINE1RCKSNMUD'
    DB 'SKSPINE2RCKSNMUD'
    DB 'SKULWAL3RCKSNMUD'
    DB 'SKULWALLRCKSNMUD'
    DB 'SKY1    SKY1    '
    DB 'SKY2    SKY1    '
    DB 'SKY3    SKY1    '
    DB 'SLADPOISGRSTNPB '
    DB 'SLADRIP1GRSTNPB '
    DB 'SLADRIP2GRSTNPB '
    DB 'SLADRIP3GRSTNPB '
    DB 'SLADSKULGRSTNPB '
    DB 'SLADWALLGRSTNPB '
    DB 'SP_DUDE1SAINT1  '
    DB 'SP_DUDE2SAINT1  '
    DB 'SP_DUDE3SAINT1  '
    DB 'SP_DUDE4SAINT1  '
    DB 'SP_DUDE5SAINT1  '
    DB 'SP_DUDE6SAINT1  '
    DB 'SP_FACE1GRSKULL1'
    DB 'SP_HOT1 REDWALL '
    DB 'SP_ROCK1METL1   '
    DB 'SP_ROCK2METL1   '
    DB 'STARBR2 CTYSTUC1'
    DB 'STARG1  CTYSTUC2'
    DB 'STARG2  CTYSTUC3'
    DB 'STARG3  CTYSTUC4'
    DB 'STARGR1 CTYSTUC5'
    DB 'STARGR2 CTYSTUC1'
    DB 'STARTAN1CTYSTUC2'
    DB 'STARTAN2CTYSTUC3'
    DB 'STARTAN3CTYSTUC4'
    DB 'STEP1   TMBSTON2'
    DB 'STEP2   TMBSTON2'
    DB 'STEP3   TMBSTON2'
    DB 'STEP4   TMBSTON2'
    DB 'STEP5   TMBSTON2'
    DB 'STEP6   TMBSTON2'
    DB 'STEPLAD1TMBSTON2'
    DB 'STEPTOP TMBSTON2'
    DB 'STONE   TRISTON1'
    DB 'STONE2  TRISTON1'
    DB 'STONE3  TRISTON1'
    DB 'STONGARGTRISTON1'
    DB 'STONPOISTRISTON1'
    DB 'SUPPORT2DRIPWALL'
    DB 'SUPPORT3DRIPWALL'
    DB 'SW1BLUE SW1OFF  '
    DB 'SW1BRCOMSW1OFF  '
    DB 'SW1BRN1 SW1OFF  '
    DB 'SW1BRN2 SW1OFF  '
    DB 'SW1BRNGNSW1OFF  '
    DB 'SW1BROWNSW1OFF  '
    DB 'SW1CMT  SW1OFF  '
    DB 'SW1COMM SW1OFF  '
    DB 'SW1COMP SW1OFF  '
    DB 'SW1DIRT SW1OFF  '
    DB 'SW1EXIT SW1OFF  '
    DB 'SW1GARG SW1OFF  '
    DB 'SW1GRAY SW1OFF  '
    DB 'SW1GRAY1SW1OFF  '
    DB 'SW1GSTONSW1OFF  '
    DB 'SW1HOT  SW1OFF  '
    DB 'SW1LION SW1OFF  '
    DB 'SW1METALSW1OFF  '
    DB 'SW1PIPE SW1OFF  '
    DB 'SW1SATYRSW1OFF  '
    DB 'SW1SKIN SW1OFF  '
    DB 'SW1SLAD SW1OFF  '
    DB 'SW1STARGSW1OFF  '
    DB 'SW1STON1SW1OFF  '
    DB 'SW1STON2SW1OFF  '
    DB 'SW1STONESW1OFF  '
    DB 'SW1STRTNSW1OFF  '
    DB 'SW1VINE SW1OFF  '
    DB 'SW1WOOD SW1OFF  '
    DB 'SW2BLUE SW1ON   '
    DB 'SW2BRCOMSW1ON   '
    DB 'SW2BRN1 SW1ON   '
    DB 'SW2BRN2 SW1ON   '
    DB 'SW2BRNGNSW1ON   '
    DB 'SW2BROWNSW1ON   '
    DB 'SW2CMT  SW1ON   '
    DB 'SW2COMM SW1ON   '
    DB 'SW2COMP SW1ON   '
    DB 'SW2DIRT SW1ON   '
    DB 'SW2EXIT SW1ON   '
    DB 'SW2GARG SW1ON   '
    DB 'SW2GRAY SW1ON   '
    DB 'SW2GRAY1SW1ON   '
    DB 'SW2GSTONSW1ON   '
    DB 'SW2HOT  SW1ON   '
    DB 'SW2LION SW1ON   '
    DB 'SW2METALSW1ON   '
    DB 'SW2PIPE SW1ON   '
    DB 'SW2SATYRSW1ON   '
    DB 'SW2SKIN SW1ON   '
    DB 'SW2SLAD SW1ON   '
    DB 'SW2STARGSW1ON   '
    DB 'SW2STON1SW1ON   '
    DB 'SW2STON2SW1ON   '
    DB 'SW2STONESW1ON   '
    DB 'SW2STRTNSW1ON   '
    DB 'SW2VINE SW1ON   '
    DB 'SW2WOOD SW1ON   '
    DB 'TEKWALL1WOODWL  '
    DB 'TEKWALL2WOODWL  '
    DB 'TEKWALL3WOODWL  '
    DB 'TEKWALL4WOODWL  '
    DB 'TEKWALL5WOODWL  '
    DB 'WOOD1   WOODWL  '
    DB 'WOOD3   WOODWL  '
    DB 'WOOD4   WOODWL  '
    DB 'WOOD5   WOODWL  '
    DB 'WOODGARGWOODWL  '
    DB 'WOODSKULWOODWL  '
    DB 0
  end;

procedure hfloor_table; assembler;
  asm
    DB 'BLOOD1  FLTLAVA1'
    DB 'BLOOD2  FLTLAVA1'
    DB 'BLOOD3  FLTLAVA1'
    DB 'CEIL1_1 FLOOR10 '
    DB 'CEIL1_2 FLOOR11 '
    DB 'CEIL1_3 FLOOR11 '
    DB 'CEIL3_1 FLOOR17 '
    DB 'CEIL3_2 FLOOR17 '
    DB 'CEIL3_3 FLOOR17 '
    DB 'CEIL3_4 FLOOR17 '
    DB 'CEIL3_5 FLOOR00 '
    DB 'CEIL3_6 FLOOR00 '
    DB 'CEIL4_1 FLOOR16 '
    DB 'CEIL4_2 FLOOR16 '
    DB 'CEIL4_3 FLOOR16 '
    DB 'CEIL5_1 FLOOR04 '
    DB 'CEIL5_2 FLOOR04 '
    DB 'COMP01  FLOOR04 '
    DB 'CONS1_1 FLOOR08 '
    DB 'CONS1_5 FLOOR08 '
    DB 'CONS1_7 FLOOR08 '
    DB 'CRATOP1 FLOOR30 '
    DB 'CRATOP2 FLOOR30 '
    DB 'DEM1_1  FLOOR19 '
    DB 'DEM1_2  FLOOR19 '
    DB 'DEM1_3  FLOOR19 '
    DB 'DEM1_4  FLOOR19 '
    DB 'DEM1_5  FLOOR19 '
    DB 'DEM1_6  FLOOR19 '
    DB 'FLAT1   FLOOR00 '
    DB 'FLAT10  FLOOR01 '
    DB 'FLAT14  FLOOR16 '
    DB 'FLAT17  FLOOR03 '
    DB 'FLAT18  FLOOR03 '
    DB 'FLAT19  FLOOR03 '
    DB 'FLAT1_1 FLOOR03 '
    DB 'FLAT1_2 FLOOR03 '
    DB 'FLAT1_3 FLOOR08 '
    DB 'FLAT2   FLOOR11 '
    DB 'FLAT20  FLOOR04 '
    DB 'FLAT22  FLOOR05 '
    DB 'FLAT23  FLOOR04 '
    DB 'FLAT3   FLOOR04 '
    DB 'FLAT4   FLOOR08 '
    DB 'FLAT5   FLOOR06 '
    DB 'FLAT5_1 FLOOR10 '
    DB 'FLAT5_2 FLOOR25 '
    DB 'FLAT5_3 FLOOR09 '
    DB 'FLAT5_4 FLOOR04 '
    DB 'FLAT5_5 FLOOR27 '
    DB 'FLAT5_6 FLOOR06 '
    DB 'FLAT5_7 FLOOR03 '
    DB 'FLAT5_8 FLOOR03 '
    DB 'FLAT8   FLOOR25 '
    DB 'FLAT9   FLOOR04 '
    DB 'FLOOR0_1FLOOR17 '
    DB 'FLOOR0_2FLOOR27 '
    DB 'FLOOR0_3FLOOR18 '
    DB 'FLOOR0_5FLOOR04 '
    DB 'FLOOR0_6FLOOR04 '
    DB 'FLOOR0_7FLOOR04 '
    DB 'FLOOR1_1FLOOR16 '
    DB 'FLOOR1_6FLOOR09 '
    DB 'FLOOR1_7FLOOR09 '
    DB 'FLOOR3_3FLOOR18 '
    DB 'FLOOR4_1FLOOR25 '
    DB 'FLOOR4_5FLOOR25 '
    DB 'FLOOR4_6FLOOR25 '
    DB 'FLOOR4_8FLOOR00 '
    DB 'FLOOR5_1FLOOR01 '
    DB 'FLOOR5_2FLOOR17 '
    DB 'FLOOR5_3FLOOR17 '
    DB 'FLOOR5_4FLOOR10 '
    DB 'FLOOR6_1FLOOR09 '
    DB 'FLOOR6_2FLOOR03 '
    DB 'FLOOR7_1FLOOR27 '
    DB 'FLOOR7_2FLOOR19 '
    DB 'FWATER1 FLTWAWA1'
    DB 'FWATER2 FLTWAWA1'
    DB 'FWATER3 FLTWAWA1'
    DB 'FWATER4 FLTWAWA1'
    DB 'GATE1   FLTTELE1'
    DB 'GATE2   FLTTELE1'
    DB 'GATE3   FLTTELE1'
    DB 'GATE4   FLTTELE1'
    DB 'LAVA1   FLTLAVA1'
    DB 'LAVA2   FLTLAVA1'
    DB 'LAVA3   FLTLAVA1'
    DB 'LAVA4   FLTLAVA1'
    DB 'MFLR8_1 FLOOR03 '
    DB 'MFLR8_2 FLOOR17 '
    DB 'MFLR8_3 FLOOR04 '
    DB 'MFLR8_4 FLOOR05 '
    DB 'NUKAGE1 FLTSLUD1'
    DB 'NUKAGE2 FLTSLUD1'
    DB 'NUKAGE3 FLTSLUD1'
    DB 'SFLR6_1 FLOOR18 '
    DB 'SFLR6_4 FLOOR18 '
    DB 'SFLR7_1 FLOOR18 '
    DB 'SFLR7_4 FLOOR18 '
    DB 'STEP1   FLOOR19 '
    DB 'STEP2   FLOOR19 '
    DB 'TLITE6_1FLOOR06 '
    DB 'TLITE6_4FLOOR06 '
    DB 'TLITE6_5FLOOR06 '
    DB 'TLITE6_6FLOOR06 '
    DB 0
  end;

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;

{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.6á 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[:lev]}={dest[@num][:lev]}');
    writeln('source is the initial object, dest is the final object,');
    writeln('num is the number of substitutions (absolute or percentual)');
    writeln('lev specifies the difficulty-level flags of the object.');
    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('DEM:1=IMP           All demons that appers in level 1 become Imps');
    writeln('DEM=IMP:123         All demons become Imps that appear in all levels');
    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 DOOM II/HERETIC.');
    writeln;
    writeln('DM2CONV <input> [output] [/mapnum] [/M[=num]] [/DEBUG] [/IGNORE]');
    writeln('        [/HERETIC] [/TEXTURE[=file]] [/FLOOR[=file]] [/NOCONV]');
    writeln('        [/SEED[=num]] [/NOCHECK] [replacements].. [@response]...');
    writeln('        [/R:name1=name2] [/R=file] [/LIST] [/EXAMPLES] [/NOTES]');
    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('/DEBUG       display debug information');
    writeln('/IGNORE      make replacements even if no level is remapped');
    writeln('/HERETIC     DOOM->HERETIC conversion');
    writeln('/TEXTURE     convert texture names  *** SEE DM2CONV.DOC ***');
    writeln('/FLOOR       convert floor names (/HERETIC only)');
    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('/R           renames directory entries');
    writeln('/NOCONV      ignore conversion: useful for /R or object substitution');
    writeln('@response    response file (text file with additional arguments)');
    writeln('Use /LIST, /EXAMPLES, /NOTES to get further 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+#0;
    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);
      ERR_OPEND: writeln('Error opening: ',dest);
      ERR_READS: writeln('Error reading: ',source);
      ERR_WRITED:writeln('Error writing: ',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');
      ERR_NOMEM: writeln('Not enough memory');
      ERR_OPEN:  writeln('Error opening: ',datafile);
      ERR_READ:  writeln('Error reading: ',datafile);
    end;
    halt(0);
  end;

procedure checkdatafile(table:p_repname_array;var num:integer;s:string);
  var f      :text;
      i      :integer;
      bef,aft:dname;
  function getname(var dest:dname):boolean;
    var j:integer;
        c:char;
    begin
      getname:=false;
      while (i<length(s)) and ((s[i]=' ') or (s[i]=#9)) do inc(i);
      if i<length(s) then
        case s[1] of
          '''',';','#','%','[':;
          else begin
            dest:=NULL_NAME;
            j:=8;
            c:=upcase(s[i]);
            while (j>0) and (i<=length(s)) and (
             ((c>='0') and (c<='9')) or (c='_') or
             ((c>='A') and (c<='Z')) ) do begin
              dec(j);
              dest[8-j]:=c;
              inc(i);
              c:=upcase(s[i]);
            end;
            if c='=' then inc(i);
            getname:=j<8;
          end
        end
    end;
  procedure insertname;
    var bef,aft:dname;
    begin
      if getname(bef) and getname(aft) then begin
        i:=1;
        while i<=num do
          if table^[i].before=bef then break
          else inc(i);
        if (i>num) and (num<1024) then inc(num);
        table^[i].before:=bef;
        table^[i].after:=aft;
      end;
    end;
  begin
    i:=1;
    while (i<=length(s)) and (s[i]<>':') and (s[i]<>'=') do inc(i);
    if i>=length(s) then exit;
    inc(i);
    if s[i-1]=':' then insertname
    else begin
      s:=copy(s,i,255);
      datafile:=s;
      writeln('Reading data file: ',s);
      assign(f,s);
      reset(f);
      if ioresult<>0 then myhalt(ERR_OPEN);
      while not eof(f) do begin
        readln(f,s);
        if ioresult<>0 then myhalt(ERR_READ);
        i:=1;
        insertname;
      end;
      close(f);
    end;
  end;

procedure Swappa(var h,k:integer);
  var i,l:integer;
  begin
    for i:=1 to 3 do begin
      l:=replace[k];
      replace[k]:=replace[h];
      replace[h]:=l;
      inc(k);
      inc(h);
    end;
  end;

function checklevel(var s:string):integer;
  var i,j:integer;
      t:string;
  begin
    j:=0;
    if (length(s)>1) and (s[1]=':') then begin
      s:=Copy(s,2,255);
      t:=GetWord(s);
      for i:=1 to length(t) do case t[i] of
        '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 8;  {deaf flag}
        'M': j:=j or 16; {multiplayer}
      end;
    end;
    checklevel:=j;
  end;

procedure printlevel(i:integer);
  begin
    if i>0 then write(':');
    if (i and 1)=1 then write('1');
    if (i and 2)=2 then write('2');
    if (i and 4)=4 then write('3');
    if (i and 8)=8 then write('D');
    if (i and 16)=16 then write('M');
  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='NOCONV' then no_conv:=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[1]='R' then checkdatafile(repdirs,nrepdirs,s)
        else if (copy(s,1,7)='TEXTURE') or (s[1]='T') then begin
          do_texture:=True;
          checkdatafile(reptexture,nreptexture,s);
        end
        else if (copy(s,1,5)='FLOOR') or (s[1]='F') then begin
          do_floor:=True;
          checkdatafile(repfloor,nrepfloor,s);
        end
        else if s='HERETIC' then heretic:=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;
            remapping:=true;
            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+'';         {''=#21 is a sentinel}
          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]:=checklevel(s);
            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);
            replace[repn]:=checklevel(s);
            inc(repn);
            inc(rc);
          end;
          if (s[1]<>'') or (rc=0) then myhalt(ERR_BADEND);
          replace[ri]:=REP_PERCENT+rc;
          k:=ri+1;
          h:=k;
          for j:=1 to rc do begin
            if (replace[h+1]>0) and (replace[h+1]<REP_PERCENT) then Swappa(h,k);
            inc(h,3);
          end;
          h:=k;
          for j:=1 to rc do begin
            if replace[h+1]>=REP_PERCENT then Swappa(h,k);
            inc(h,3);
          end;
          if debug then begin
            write('REPLACE');
            j:=rs;
            while j<ri do begin
              write(' ',replace[j]);
              printlevel(replace[j+1]);
              inc(j,2);
            end;
            write(' WITH');
            k:=ri+1;
            for j:=1 to rc do begin
              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]);
              printlevel(replace[k+2]);
              inc(k,3);
            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 blockr(var f:file;var dest;size:word;var count:word);
  begin
    BlockRead(f,dest,size,count);
    if (ioresult<>0) or (size<>count) then myhalt(ERR_READS);
  end;

procedure blockw(var f:file;var dest;size:word;var count:word);
  begin
    BlockWrite(f,dest,size,count);
    if (ioresult<>0) or (size<>count) then myhalt(ERR_WRITED);
  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;
      BlockR(a,buffer,size,len);
      BlockW(b,buffer,size,len);
      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;
      level  : integer;
      multi  : boolean;
      s      : string;
  procedure Choose(var max:integer;n,c,lev: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
            inc(repthing);
            code:=c;
            if lev<>0 then flags:=lev;
          end;
          index[j]:=index[max];
          dec(max);
        end;
      end
      else begin
        for i:=1 to max do with things[index[i]] do begin
          inc(repthing);
          code:=c;
          if lev<>0 then flags:=lev;
        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];
        level:=replace[repn+1] and 7;  {level 1 or 2 or 3}
        if level=0 then level:=7;
        multi:=replace[repn+1]>=16;    {multiplayer flag}
        for k:=1 to totobj do with things[k] do
          if (code=j) and (flags and level>0) and
             (not multi or (flags and 16=16)) then begin
            inc(numobj);
            index[numobj]:=k;
          end;
        inc(repn,2);
      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*3);
        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,3);
      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,3);
        end;
        numabs:=numobj;
      end;
      l:=repn+nabs*3+1;
      numabs:=numobj-numabs;
      while nrel>0 do begin
        j:=(numabs+nrel div 2) div nrel;
        replace[l]:=j;
        dec(numabs,j);
        inc(l,3);
        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],replace[repn+2]);
        inc(repn,3);
      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 : word;
      i,j,k: integer;
      l    : integer;
      numt : integer;
      fpos : longint;
      rlev : array[1..27] of integer;
  begin
    repside:=0;
    repfloo:=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);
    BlockR(f,head,sizeof(header),size);
    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);
    BlockR(f,dirlist,numentry*sizeof(entry),size);

    if not no_conv then begin
      for i:=1 to numentry do with dirlist[i] do begin
        if not heretic and (name[1]='S') and (name[2]='K') and (name[3]='Y') and
           (name[4]>='1') and (name[4]<='3') and (name[5]=#0) then begin
          {remap sky resources}
          j:=ord(name[4]);
          name:='RSKYx'#0#0#0;
          name[5]:=chr(j);
          savedir:=true;
        end;
        if (name[1]='E') and (name[3]='M') then
         if heretic then begin
           j:=(ord(name[2])-49)*9+ord(name[4])-48;
           if remapping then begin
             if remap_lev>27 then myhalt(ERR_TOOMAPS);
             rlev[j]:=remap_lev;
             name[2]:=chr((remap_lev-1) div 9+49);
             name[4]:=chr((remap_lev-1) mod 9+49);
             inc(remap_lev);
             savedir:=true;
           end
           else rlev[j]:=j;
           inc(replev);
         end
         else 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);
          savedir:=true;
        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 begin
              if heretic then name:='MUS_INTR'
              else name:='D_DM2INT';
              savedir:=true;
            end
            else if (name[3]='E') and (name[5]='M') then
              if remap_mus>0 then begin
                if heretic then begin
                  if remap_mus>27 then myhalt(ERR_TOOMAPS);
                  k:=remap_mus-1;
                  name:='MUS_ExMy';
                  name[6]:=chr(k div 9+49);
                  name[8]:=chr(k mod 9+49);
                end
                else begin
                  if remap_mus>32 then myhalt(ERR_TOOMAPS);
                  name:=mnames[remap_mus];
                end;
                inc(remap_mus);
                inc(j);
                savedir:=true;
              end
              else begin
                if heretic then begin
                  k:=rlev[(ord(name[4])-49)*9+ord(name[6])-48]-1;
                  if k>=0 then begin
                    name:='MUS_ExMy';
                    name[6]:=chr(k div 9+49);
                    name[8]:=chr(k mod 9+49);
                    savedir:=true;
                  end
                end
                else begin
                  k:=rlev[(ord(name[4])-49)*9+ord(name[6])-48];
                  if k>0 then begin
                    name:=mnames[k];
                    savedir:=true;
                  end;
                end;
              end;
    end; {no_conv}

    if nrepdirs>0 then
      for i:=1 to numentry do with dirlist[i] do
        savedir:=remap_name(repdirs,name,nrepdirs)>0;

    if savedir then begin
      Seek(f,head.start);
      if ioresult<>0 then myhalt(ERR_WRITED);
      BlockW(f,dirlist,numentry*sizeof(entry),size);
    end;
    if (replev=0) and (j=0) and not ignore then myhalt(ERR_NOMAPS);
    numt:=MAXENTRY+1;
    for i:=numentry downto 1 do
      if ((replaces>0) and (dirlist[i].Name=N_THINGS)) or
         (do_texture and (dirlist[i].Name=N_SIDEDEFS)) or
         (do_floor and heretic and (dirlist[i].Name=N_SECTORS)) 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=N_SIDEDEFS then begin
          k:=rsize div sizeof(sidedef);
          while k>0 do begin
            j:=maxside;
            if j>k then j:=k;
            fpos:=FilePos(f);
            BlockR(f,sidedefs,j*sizeof(sidedef),size);
            for l:=1 to j do with sidedefs[l] do
              inc(repside,remap_name(reptexture,a,nreptexture)+
                          remap_name(reptexture,b,nreptexture)+
                          remap_name(reptexture,c,nreptexture));
            Seek(f,fpos);
            if ioresult<>0 then myhalt(ERR_WRITED);
            BlockW(f,sidedefs,j*sizeof(sidedef),size);
            dec(k,j);
          end;
        end
        else if name=N_THINGS then begin
          BlockR(f,things,rsize,size);
          ReplaceThings(rsize div sizeof(thing));
          Seek(f,start);
          if ioresult<>0 then myhalt(ERR_WRITED);
          BlockW(f,things,rsize,size);
        end
        else if name=N_SECTORS then begin
          BlockR(f,sectors,rsize,size);
          for j:=1 to rsize div sizeof(sector) do with sectors[j] do
            inc(repfloo,remap_name(repfloor,a,nrepfloor)+
                        remap_name(repfloor,b,nrepfloor));
          Seek(f,start);
          if ioresult<>0 then myhalt(ERR_WRITED);
          BlockW(f,sectors,rsize,size);
        end;
      end;
    end;
    Close(f);
    write('OK, Remapped:');
    Plural(replev,'level');
    write(',');
    Plural(repside,'texture');
    write(',');
    if heretic then begin
      Plural(repfloo,'floor');
      write(',');
    end;
    Plural(repthing,'object');
    writeln('.');
  end;

function HeapCheck(size:Word):Integer; far;
  begin
    HeapCheck:=1;
  end;

begin
  HeapError:=@HeapCheck;
  new(reptexture);
  new(repfloor);
  new(repdirs);
  if (reptexture=nil) or (repfloor=nil) or (repdirs=nil) then myhalt(ERR_NOMEM);
  nreptexture:=0;
  nrepfloor:=0;
  nrepdirs:=0;
  CreateTable;
  Parse;
  if heretic then begin
    CopyTable(reptexture,@htexture_table,nreptexture);
    CopyTable(repfloor,@hfloor_table,nrepfloor);
  end
  else CopyTable(reptexture,@texture_table,nreptexture);
  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.