home *** CD-ROM | disk | FTP | other *** search
/ Tricks of the DOOM Programming Gurus / Tricks_of_the_Doom_Programming_Gurus.iso / bonus / utils / dm2conv / dm2conv.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-04  |  50.2 KB  |  1,798 lines
  1. {$A+,B-,D+,E+,F-,G+,I-,L+,N-,O-,P-,Q-,R-,S-,T-,V-,X+}
  2. {$M 16384,0,655360}
  3. { DM2CONV v1.7ß950304 by Vincenzo Alcamo }
  4. { This program is Public Domain   }
  5. type
  6.   shortname = array[1..3] of char;
  7.   dname = array[1..8] of char;
  8.   p_string = ^string;
  9.   obj = record
  10.     id : integer;
  11.     sname : shortname;
  12.     name : p_string
  13.   end;
  14.   errors = (ERR_OPENS,ERR_READS,ERR_OPEND,ERR_WRITED,ERR_PWAD,
  15.             ERR_TOOENTRY,ERR_TOOMAPS,ERR_NOMAPS,ERR_NOEQ,ERR_BADEND,
  16.             ERR_BADNUM,ERR_NOMEM,ERR_OPEN,ERR_READ);
  17.   header= record
  18.     Sig   : Longint;
  19.     Num   : Longint;
  20.     Start : Longint;
  21.   end;
  22.   entry = record
  23.     Start : Longint;
  24.     RSize : Longint;
  25.     Name  : dname;
  26.   end;
  27.   thing = record
  28.     xpos : integer;
  29.     ypos : integer;
  30.     angle: integer;
  31.     code : integer;
  32.     flags: integer;
  33.   end;
  34.   sidedef = record
  35.     x,y  : integer;
  36.     a,b,c: dname;
  37.     sect : integer;
  38.   end;
  39.   sector = record
  40.     y1,y2: integer;
  41.     a,b  : dname;
  42.     l,f,t: integer;
  43.   end;
  44.   repname = record
  45.     before : dname;
  46.     after  : dname;
  47.   end;
  48.   repname_array = array[1..1024] of repname;
  49.   p_repname_array = ^repname_array;
  50.  
  51.  
  52. const
  53.   show_list : boolean = false;
  54.   show_example: boolean = false;
  55.   show_help : boolean = false;
  56.   show_note : boolean = false;
  57.   nocheck   : boolean = false;
  58.   debug     : boolean = false;
  59.   ignore    : boolean = false;
  60.   do_texture: boolean = false; {remap wall textures}
  61.   do_floor  : boolean = false; {remap floor textures}
  62.   remapping : boolean = false; {remap levels}
  63.   heretic   : boolean = false; {heretic mode}
  64.   savedir   : boolean = false; {save directory entries}
  65.   no_conv   : boolean = false; {no conversion}
  66.   remap_lev : integer = 1;
  67.   remap_mus : integer = 0;
  68.   replaces  : integer = 0;
  69.   BUFFSIZE = 65528;
  70.   MAXENTRY = BUFFSIZE div sizeof(entry);
  71.   MAXTHING = BUFFSIZE div sizeof(thing);
  72.   MAXSIDES = BUFFSIZE div sizeof(sidedef);
  73.   MAXSECS  = BUFFSIZE div sizeof(sector);
  74.  
  75.   IWAD_SIG = Ord('I')+(Ord('W')+(Ord('A')+Ord('D') shl 8) shl 8) shl 8;
  76.   PWAD_SIG = Ord('P')+(Ord('W')+(Ord('A')+Ord('D') shl 8) shl 8) shl 8;
  77.   N_THINGS = 'THINGS'#0#0;
  78.   N_SECTORS= 'SECTORS'#0;
  79.   N_SIDEDEFS='SIDEDEFS';
  80.   NULL_NAME= #0#0#0#0#0#0#0#0;
  81.  
  82.   REP_PERCENT=16384;
  83.   MAXREP=4096;
  84.  
  85.   mnames : array[1..32] of dname =  (
  86.     'D_RUNNIN',
  87.     'D_STALKS',
  88.     'D_COUNTD',
  89.     'D_BETWEE',
  90.     'D_DOOM'#0#0,
  91.     'D_THE_DA',
  92.     'D_SHAWN'#0,
  93.     'D_DDTBLU',
  94.     'D_IN_CIT',
  95.     'D_DEAD'#0#0,
  96.     'D_STLKS2',
  97.     'D_THEDA2',
  98.     'D_DOOM2'#0,
  99.     'D_DDTBL2',
  100.     'D_RUNNI2',
  101.     'D_DEAD2'#0,
  102.     'D_STLKS3',
  103.     'D_ROMERO',
  104.     'D_SHAWN2',
  105.     'D_MESSAG',
  106.     'D_COUNT2',
  107.     'D_DDTBL3',
  108.     'D_AMPIE'#0,
  109.     'D_THEDA3',
  110.     'D_ADRIAN',
  111.     'D_MESSG2',
  112.     'D_ROMER2',
  113.     'D_TENSE'#0,
  114.     'D_SHAWN3',
  115.     'D_OPENIN',
  116.     'D_EVIL'#0#0,
  117.     'D_ULTIMA');
  118.  
  119. type
  120.   a_buffer = array[1..BUFFSIZE] of byte;
  121.   a_dirlist= array[1..MAXENTRY] of entry;
  122.   a_things = array[1..MAXTHING] of thing;
  123.   a_sidedefs=array[1..MAXSIDES] of sidedef;
  124.   a_sectors= array[1..MAXSECS] of sector;
  125.   a_replace= array[1..MAXREP] of word;
  126.  
  127. var
  128.   objects    : array[1..100] of obj;
  129.   replace    : a_replace;
  130.   replace2   : a_replace;
  131.   numobjects : integer;
  132.   source     : string;
  133.   dest       : string;
  134.   datafile   : string;
  135.   buffer     : ^a_buffer;
  136.   dirlist    : ^a_dirlist;
  137.   things     : ^a_things;
  138.   sidedefs   : ^a_sidedefs;
  139.   sectors    : ^a_sectors;
  140.   numentry   : integer;
  141.   maxside    : integer;
  142.  
  143.   reptexture : p_repname_array;
  144.   nreptexture: integer;
  145.   repfloor   : p_repname_array;
  146.   nrepfloor  : integer;
  147.   repdirs    : p_repname_array;
  148.   nrepdirs   : integer;
  149.  
  150.   repside    : word;
  151.   repfloo    : word;
  152.   repthing   : word;
  153.   replev     : word;
  154.  
  155. procedure adjust_name(var name:dname); assembler;
  156.   asm
  157.     cld
  158.     les di, name
  159.     mov cx, 8
  160.     mov al, 32
  161.     repne scasb
  162.     jnz @@FINE
  163.     xor ax, ax
  164.     dec di
  165.     inc cx
  166.     rep stosb
  167. @@FINE:
  168.   end;
  169.  
  170. procedure CopyTable(table:p_repname_array;source:p_repname_array;var num:integer);
  171.   var i,j,k:integer;
  172.       name:dname;
  173.   begin
  174.     i:=1;
  175.     j:=num;
  176.     while source^[i].before[1]<>#0 do begin
  177.       name:=source^[i].before;
  178.       adjust_name(name);
  179.       k:=1;
  180.       while (k<=j) and (table^[k].before<>name) do inc(k);
  181.       if (k>j) and (num<1024) then begin
  182.         inc(num);
  183.         table^[num].before:=name;
  184.         table^[num].after:=source^[num].after;
  185.         adjust_name(table^[num].after);
  186.       end;
  187.       inc(i);
  188.     end;
  189.   end;
  190.  
  191. function remap_name(table:p_repname_array;var name:dname;num:integer):integer; assembler;
  192.   asm
  193.     cld
  194.     les di, name
  195.     mov cx, 8
  196. @@LOOP:
  197.     mov al, es:[di]
  198.     cmp al, 0
  199.     je  @@FILLZERO
  200.     cmp al, 'a'
  201.     jb  @@STORE
  202.     cmp al, 'z'
  203.     ja  @@STORE
  204.     sub al, 32
  205. @@STORE:
  206.     stosb
  207.     loop @@LOOP
  208. @@FILLZERO:
  209.     rep stosb
  210. @@OK:
  211.     push ds
  212.     lds si, name
  213.     les di, table
  214.     mov cx, num
  215.     cld
  216.     lodsw
  217.     mov bx, [si]
  218.     mov dx, [si+2]
  219.     mov si, [si+4]
  220. @@CICLO:
  221.     scasw
  222.     jnz @@NEXT
  223.     cmp bx, es:[di]
  224.     jnz @@NEXT
  225.     cmp dx, es:[di+2]
  226.     jnz @@NEXT
  227.     cmp si, es:[di+4]
  228.     jnz @@NEXT
  229.     mov ax, es
  230.     mov ds, ax
  231.     mov si, di
  232.     add si, 6
  233.     les di, name
  234.     mov cx, 8
  235.     rep movsb
  236.     mov ax, 1
  237.     jmp @@FINE
  238. @@NEXT:
  239.     add di, 14
  240.     loop @@CICLO
  241.     xor ax, ax
  242. @@FINE:
  243.     pop ds
  244.   end;
  245.  
  246. procedure texture_table; assembler;
  247.   asm
  248.     {TABLE OF TEXTURE REPLACEMENTS FOR DOOM}
  249.     DB 'AASTINKYDOORSTOP'
  250.     DB 'ASHWALL ASHWALL2'
  251.     DB 'BLODGR1 PIPE6   '
  252.     DB 'BLODGR2 PIPE6   '
  253.     DB 'BLODGR3 PIPE6   '
  254.     DB 'BLODGR4 PIPE6   '
  255.     DB 'BRNBIGC MIDGRATE'
  256.     DB 'BRNBIGL MIDGRATE'
  257.     DB 'BRNBIGR MIDGRATE'
  258.     DB 'BRNPOIS2BROWN96 '
  259.     DB 'BROVINE BROWN1  '
  260.     DB 'BROWNWELBROWNHUG'
  261.     DB 'CEMPOIS CEMENT1 '
  262.     DB 'COMP2   COMPTALL'
  263.     DB 'COMPOHSOCOMPWERD'
  264.     DB 'COMPTILECOMPWERD'
  265.     DB 'COMPUTE1COMPSTA1'
  266.     DB 'COMPUTE2COMPTALL'
  267.     DB 'COMPUTE3COMPTALL'
  268.     DB 'DOORHI  TEKBRON2'
  269.     DB 'GRAYDANGGRAY5   '
  270.     DB 'ICKDOOR1DOOR1   '
  271.     DB 'ICKWALL6ICKWALL5'
  272.     DB 'LITE2   BROWN1  '
  273.     DB 'LITE4   LITE5   '
  274.     DB 'LITE96  BROWN96 '
  275.     DB 'LITEBLU2LITEBLU1'
  276.     DB 'LITEBLU3LITEBLU1'
  277.     DB 'LITEMET METAL1  '
  278.     DB 'LITERED DOORRED '
  279.     DB 'LITESTONSTONE2  '
  280.     DB 'MIDVINE1MIDGRATE'
  281.     DB 'MIDVINE2MIDGRATE'
  282.     DB 'NUKESLADSLADWALL'
  283.     DB 'PLANET1 COMPSTA2'
  284.     DB 'REDWALL1REDWALL '
  285.     DB 'SKINBORDSKINMET1'
  286.     DB 'SKINTEK1SKINMET2'
  287.     DB 'SKINTEK2SKINMET2'
  288.     DB 'SKULWAL3SKSPINE1'
  289.     DB 'SKULWALLSKSPINE1'
  290.     DB 'SLADRIP1SLADSKUL'
  291.     DB 'SLADRIP2SLADSKUL'
  292.     DB 'SLADRIP3SLADSKUL'
  293.     DB 'SP_DUDE3SP_DUDE4'
  294.     DB 'SP_DUDE6SP_DUDE4'
  295.     DB 'SP_ROCK2SP_ROCK1'
  296.     DB 'STARTAN1STARTAN2'
  297.     DB 'STONGARGSTONE3  '
  298.     DB 'STONPOISSTONE   '
  299.     DB 'TEKWALL2TEKWALL1'
  300.     DB 'TEKWALL3TEKWALL1'
  301.     DB 'TEKWALL5TEKWALL1'
  302.     DB 'WOODSKULWOODGARG'
  303.     DB 0
  304.   end;
  305.  
  306. procedure htexture_table; assembler;
  307.   asm
  308.     {TABLE OF TEXTURE REPLACEMENTS FOR HERETIC}
  309.     DB 'AASTINKYREDWALL '
  310.     DB 'ASHWALL SQPEB1  '
  311.     DB 'BIGDOOR1DOORSTON'
  312.     DB 'BIGDOOR2GRSKULL2'
  313.     DB 'BIGDOOR3GRSKULL3'
  314.     DB 'BIGDOOR4SKULLSB2'
  315.     DB 'BIGDOOR5DOORWOOD'
  316.     DB 'BIGDOOR6DOORWOOD'
  317.     DB 'BIGDOOR7SKULLSB2'
  318.     DB 'BLODGR1 SPINE2  '
  319.     DB 'BLODGR2 SPINE2  '
  320.     DB 'BLODGR3 SPINE2  '
  321.     DB 'BLODGR4 SPINE2  '
  322.     DB 'BLODRIP1SPINE2  '
  323.     DB 'BLODRIP2SPINE2  '
  324.     DB 'BLODRIP3SPINE2  '
  325.     DB 'BLODRIP4SPINE2  '
  326.     DB 'BRNBIGC WDGAT64 '
  327.     DB 'BRNBIGL WDGAT64 '
  328.     DB 'BRNBIGR WDGAT64 '
  329.     DB 'BRNPOIS SNDBLCKS'
  330.     DB 'BRNPOIS2SNDCHNKS'
  331.     DB 'BRNSMAL1WDGAT64 '
  332.     DB 'BRNSMAL2WDGAT64 '
  333.     DB 'BRNSMALCWDGAT64 '
  334.     DB 'BRNSMALLWDGAT64 '
  335.     DB 'BRNSMALRWDGAT64 '
  336.     DB 'BROVINE SNDCHNKS'
  337.     DB 'BROVINE2SNDBLCKS'
  338.     DB 'BROWN1  SNDCHNKS'
  339.     DB 'BROWN144SNDPLAIN'
  340.     DB 'BROWN96 SPINE1  '
  341.     DB 'BROWNGRNSNDBLCKS'
  342.     DB 'BROWNHUGSNDPLAIN'
  343.     DB 'BROWNPIPSPINE2  '
  344.     DB 'BROWNWELSNDPLAIN'
  345.     DB 'CEMENT1 GRSKULL1'
  346.     DB 'CEMENT2 GRSKULL1'
  347.     DB 'CEMENT3 GRSKULL1'
  348.     DB 'CEMENT4 GRSKULL1'
  349.     DB 'CEMENT5 GRSKULL1'
  350.     DB 'CEMENT6 GRSKULL1'
  351.     DB 'CEMPOIS GRSKULL1'
  352.     DB 'COMP2   TRISTON1'
  353.     DB 'COMPBLUESKULLSB1'
  354.     DB 'COMPOHSOSANDSQ2 '
  355.     DB 'COMPSPANSKULLSB1'
  356.     DB 'COMPSTA1SKULLSB1'
  357.     DB 'COMPSTA2SKULLSB1'
  358.     DB 'COMPTALLTRISTON1'
  359.     DB 'COMPTILETRISTON1'
  360.     DB 'COMPUTE1TRISTON1'
  361.     DB 'COMPUTE2TRISTON1'
  362.     DB 'COMPUTE3TRISTON1'
  363.     DB 'COMPWERDTRISTON1'
  364.     DB 'CRATE1  WOODWL  '
  365.     DB 'CRATE2  WOODWL  '
  366.     DB 'CRATELITWOODWL  '
  367.     DB 'CRATINY WOODWL  '
  368.     DB 'CRATWIDEWOODWL  '
  369.     DB 'DOOR1   DOOREXIT'
  370.     DB 'DOOR3   DOOREXIT'
  371.     DB 'DOORBLU DRIPWALL'
  372.     DB 'DOORBLU2DRIPWALL'
  373.     DB 'DOORHI  DOORWOOD'
  374.     DB 'DOORRED DRIPWALL'
  375.     DB 'DOORRED2DRIPWALL'
  376.     DB 'DOORSTOPMETL2   '
  377.     DB 'DOORTRAKMETL2   '
  378.     DB 'DOORYEL DRIPWALL'
  379.     DB 'DOORYEL2DRIPWALL'
  380.     DB 'EXITDOORDOOREXIT'
  381.     DB 'EXITSIGNSNDCHNKS'
  382.     DB 'EXITSTONGRSTNPB '
  383.     DB 'FIREBLU1RCKSNMUD'
  384.     DB 'FIREBLU2RCKSNMUD'
  385.     DB 'FIRELAV2REDWALL '
  386.     DB 'FIRELAV3REDWALL '
  387.     DB 'FIRELAVAREDWALL '
  388.     DB 'FIREMAG1REDWALL '
  389.     DB 'FIREMAG2REDWALL '
  390.     DB 'FIREMAG3REDWALL '
  391.     DB 'FIREWALAREDWALL '
  392.     DB 'FIREWALBREDWALL '
  393.     DB 'FIREWALLREDWALL '
  394.     DB 'GRAY1   SQPEB1  '
  395.     DB 'GRAY2   SQPEB1  '
  396.     DB 'GRAY4   SQPEB1  '
  397.     DB 'GRAY5   SQPEB1  '
  398.     DB 'GRAY7   SQPEB1  '
  399.     DB 'GRAYBIG SQPEB1  '
  400.     DB 'GRAYDANGSQPEB1  '
  401.     DB 'GRAYPOISSQPEB1  '
  402.     DB 'GRAYTALLSQPEB1  '
  403.     DB 'GRAYVINESQPEB1  '
  404.     DB 'GSTFONT1MOSSRCK1'
  405.     DB 'GSTFONT2MOSSRCK1'
  406.     DB 'GSTFONT3MOSSRCK1'
  407.     DB 'GSTGARG MOSSRCK1'
  408.     DB 'GSTLION MOSSRCK1'
  409.     DB 'GSTONE1 MOSSRCK1'
  410.     DB 'GSTONE2 MOSSRCK1'
  411.     DB 'GSTSATYRMOSSRCK1'
  412.     DB 'GSTVINE1MOSSRCK1'
  413.     DB 'GSTVINE2MOSSRCK1'
  414.     DB 'ICKDOOR1DOORSTON'
  415.     DB 'ICKWALL1CSTLRCK '
  416.     DB 'ICKWALL2CSTLRCK '
  417.     DB 'ICKWALL3CSTLRCK '
  418.     DB 'ICKWALL4CSTLRCK '
  419.     DB 'ICKWALL5CSTLRCK '
  420.     DB 'ICKWALL6CSTLRCK '
  421.     DB 'ICKWALL7CSTLRCK '
  422.     DB 'LITE2   SNDCHNKS'
  423.     DB 'LITE3   DRIPWALL'
  424.     DB 'LITE4   DRIPWALL'
  425.     DB 'LITE5   DRIPWALL'
  426.     DB 'LITE96  SPINE1  '
  427.     DB 'LITEBLU1DRIPWALL'
  428.     DB 'LITEBLU2DRIPWALL'
  429.     DB 'LITEBLU3DRIPWALL'
  430.     DB 'LITEBLU4DRIPWALL'
  431.     DB 'LITEMET SKULLSB1'
  432.     DB 'LITERED REDWALL '
  433.     DB 'LITESTONSQPEB1  '
  434.     DB 'MARBFAC2MOSSRCK1'
  435.     DB 'MARBFAC3MOSSRCK1'
  436.     DB 'MARBFACEMOSSRCK1'
  437.     DB 'MARBLE1 MOSSRCK1'
  438.     DB 'MARBLE2 MOSSRCK1'
  439.     DB 'MARBLE3 MOSSRCK1'
  440.     DB 'MARBLOD1MOSSRCK1'
  441.     DB 'METAL   RCKSNMUD'
  442.     DB 'METAL1  SKULLSB1'
  443.     DB 'MIDBRN1 WDGAT64 '
  444.     DB 'MIDGRATEWDGAT64 '
  445.     DB 'MIDVINE1WDGAT64 '
  446.     DB 'MIDVINE2WDGAT64 '
  447.     DB 'NUKE24  SNDPLAIN'
  448.     DB 'NUKEDGE1SNDPLAIN'
  449.     DB 'NUKEPOISSNDPLAIN'
  450.     DB 'NUKESLADSNDPLAIN'
  451.     DB 'PIPE1   SPINE2  '
  452.     DB 'PIPE2   SPINE2  '
  453.     DB 'PIPE4   SPINE2  '
  454.     DB 'PIPE6   SPINE2  '
  455.     DB 'PLANET1 METL1   '
  456.     DB 'PLAT1   GRSKULL1'
  457.     DB 'REDWALL REDWALL '
  458.     DB 'REDWALL1REDWALL '
  459.     DB 'ROCKRED1REDWALL '
  460.     DB 'ROCKRED2REDWALL '
  461.     DB 'ROCKRED3REDWALL '
  462.     DB 'SHAWN1  SQPEB1  '
  463.     DB 'SHAWN2  SQPEB1  '
  464.     DB 'SHAWN3  SQPEB1  '
  465.     DB 'SKIN2   REDWALL '
  466.     DB 'SKINBORDREDWALL '
  467.     DB 'SKINCUT CTYSTCI1'
  468.     DB 'SKINEDGEREDWALL '
  469.     DB 'SKINFACEREDWALL '
  470.     DB 'SKINLOW CTYSTCI2'
  471.     DB 'SKINMET1CTYSTCI4'
  472.     DB 'SKINMET2CTYSTCI1'
  473.     DB 'SKINSCABCTYSTCI2'
  474.     DB 'SKINSYMBCTYSTCI4'
  475.     DB 'SKINTEK1CTYSTCI1'
  476.     DB 'SKINTEK2CTYSTCI2'
  477.     DB 'SKSNAKE1RCKSNMUD'
  478.     DB 'SKSNAKE2RCKSNMUD'
  479.     DB 'SKSPINE1RCKSNMUD'
  480.     DB 'SKSPINE2RCKSNMUD'
  481.     DB 'SKULWAL3RCKSNMUD'
  482.     DB 'SKULWALLRCKSNMUD'
  483.     DB 'SKY1    SKY1    '
  484.     DB 'SKY2    SKY1    '
  485.     DB 'SKY3    SKY1    '
  486.     DB 'SLADPOISGRSTNPB '
  487.     DB 'SLADRIP1GRSTNPB '
  488.     DB 'SLADRIP2GRSTNPB '
  489.     DB 'SLADRIP3GRSTNPB '
  490.     DB 'SLADSKULGRSTNPB '
  491.     DB 'SLADWALLGRSTNPB '
  492.     DB 'SP_DUDE1SAINT1  '
  493.     DB 'SP_DUDE2SAINT1  '
  494.     DB 'SP_DUDE3SAINT1  '
  495.     DB 'SP_DUDE4SAINT1  '
  496.     DB 'SP_DUDE5SAINT1  '
  497.     DB 'SP_DUDE6SAINT1  '
  498.     DB 'SP_FACE1GRSKULL1'
  499.     DB 'SP_HOT1 REDWALL '
  500.     DB 'SP_ROCK1METL1   '
  501.     DB 'SP_ROCK2METL1   '
  502.     DB 'STARBR2 CTYSTUC1'
  503.     DB 'STARG1  CTYSTUC2'
  504.     DB 'STARG2  CTYSTUC3'
  505.     DB 'STARG3  CTYSTUC4'
  506.     DB 'STARGR1 CTYSTUC5'
  507.     DB 'STARGR2 CTYSTUC1'
  508.     DB 'STARTAN1CTYSTUC2'
  509.     DB 'STARTAN2CTYSTUC3'
  510.     DB 'STARTAN3CTYSTUC4'
  511.     DB 'STEP1   TMBSTON2'
  512.     DB 'STEP2   TMBSTON2'
  513.     DB 'STEP3   TMBSTON2'
  514.     DB 'STEP4   TMBSTON2'
  515.     DB 'STEP5   TMBSTON2'
  516.     DB 'STEP6   TMBSTON2'
  517.     DB 'STEPLAD1TMBSTON2'
  518.     DB 'STEPTOP TMBSTON2'
  519.     DB 'STONE   TRISTON1'
  520.     DB 'STONE2  TRISTON1'
  521.     DB 'STONE3  TRISTON1'
  522.     DB 'STONGARGTRISTON1'
  523.     DB 'STONPOISTRISTON1'
  524.     DB 'SUPPORT2DRIPWALL'
  525.     DB 'SUPPORT3DRIPWALL'
  526.     DB 'SW1BLUE SW1OFF  '
  527.     DB 'SW1BRCOMSW1OFF  '
  528.     DB 'SW1BRN1 SW1OFF  '
  529.     DB 'SW1BRN2 SW1OFF  '
  530.     DB 'SW1BRNGNSW1OFF  '
  531.     DB 'SW1BROWNSW1OFF  '
  532.     DB 'SW1CMT  SW1OFF  '
  533.     DB 'SW1COMM SW1OFF  '
  534.     DB 'SW1COMP SW1OFF  '
  535.     DB 'SW1DIRT SW1OFF  '
  536.     DB 'SW1EXIT SW1OFF  '
  537.     DB 'SW1GARG SW1OFF  '
  538.     DB 'SW1GRAY SW1OFF  '
  539.     DB 'SW1GRAY1SW1OFF  '
  540.     DB 'SW1GSTONSW1OFF  '
  541.     DB 'SW1HOT  SW1OFF  '
  542.     DB 'SW1LION SW1OFF  '
  543.     DB 'SW1METALSW1OFF  '
  544.     DB 'SW1PIPE SW1OFF  '
  545.     DB 'SW1SATYRSW1OFF  '
  546.     DB 'SW1SKIN SW1OFF  '
  547.     DB 'SW1SLAD SW1OFF  '
  548.     DB 'SW1STARGSW1OFF  '
  549.     DB 'SW1STON1SW1OFF  '
  550.     DB 'SW1STON2SW1OFF  '
  551.     DB 'SW1STONESW1OFF  '
  552.     DB 'SW1STRTNSW1OFF  '
  553.     DB 'SW1VINE SW1OFF  '
  554.     DB 'SW1WOOD SW1OFF  '
  555.     DB 'SW2BLUE SW1ON   '
  556.     DB 'SW2BRCOMSW1ON   '
  557.     DB 'SW2BRN1 SW1ON   '
  558.     DB 'SW2BRN2 SW1ON   '
  559.     DB 'SW2BRNGNSW1ON   '
  560.     DB 'SW2BROWNSW1ON   '
  561.     DB 'SW2CMT  SW1ON   '
  562.     DB 'SW2COMM SW1ON   '
  563.     DB 'SW2COMP SW1ON   '
  564.     DB 'SW2DIRT SW1ON   '
  565.     DB 'SW2EXIT SW1ON   '
  566.     DB 'SW2GARG SW1ON   '
  567.     DB 'SW2GRAY SW1ON   '
  568.     DB 'SW2GRAY1SW1ON   '
  569.     DB 'SW2GSTONSW1ON   '
  570.     DB 'SW2HOT  SW1ON   '
  571.     DB 'SW2LION SW1ON   '
  572.     DB 'SW2METALSW1ON   '
  573.     DB 'SW2PIPE SW1ON   '
  574.     DB 'SW2SATYRSW1ON   '
  575.     DB 'SW2SKIN SW1ON   '
  576.     DB 'SW2SLAD SW1ON   '
  577.     DB 'SW2STARGSW1ON   '
  578.     DB 'SW2STON1SW1ON   '
  579.     DB 'SW2STON2SW1ON   '
  580.     DB 'SW2STONESW1ON   '
  581.     DB 'SW2STRTNSW1ON   '
  582.     DB 'SW2VINE SW1ON   '
  583.     DB 'SW2WOOD SW1ON   '
  584.     DB 'TEKWALL1WOODWL  '
  585.     DB 'TEKWALL2WOODWL  '
  586.     DB 'TEKWALL3WOODWL  '
  587.     DB 'TEKWALL4WOODWL  '
  588.     DB 'TEKWALL5WOODWL  '
  589.     DB 'WOOD1   WOODWL  '
  590.     DB 'WOOD3   WOODWL  '
  591.     DB 'WOOD4   WOODWL  '
  592.     DB 'WOOD5   WOODWL  '
  593.     DB 'WOODGARGWOODWL  '
  594.     DB 'WOODSKULWOODWL  '
  595.     DB 0
  596.   end;
  597.  
  598. procedure hfloor_table; assembler;
  599.   asm
  600.     DB 'BLOOD1  FLTLAVA1'
  601.     DB 'BLOOD2  FLTLAVA1'
  602.     DB 'BLOOD3  FLTLAVA1'
  603.     DB 'CEIL1_1 FLOOR10 '
  604.     DB 'CEIL1_2 FLOOR11 '
  605.     DB 'CEIL1_3 FLOOR11 '
  606.     DB 'CEIL3_1 FLOOR17 '
  607.     DB 'CEIL3_2 FLOOR17 '
  608.     DB 'CEIL3_3 FLOOR17 '
  609.     DB 'CEIL3_4 FLOOR17 '
  610.     DB 'CEIL3_5 FLOOR00 '
  611.     DB 'CEIL3_6 FLOOR00 '
  612.     DB 'CEIL4_1 FLOOR16 '
  613.     DB 'CEIL4_2 FLOOR16 '
  614.     DB 'CEIL4_3 FLOOR16 '
  615.     DB 'CEIL5_1 FLOOR04 '
  616.     DB 'CEIL5_2 FLOOR04 '
  617.     DB 'COMP01  FLOOR04 '
  618.     DB 'CONS1_1 FLOOR08 '
  619.     DB 'CONS1_5 FLOOR08 '
  620.     DB 'CONS1_7 FLOOR08 '
  621.     DB 'CRATOP1 FLOOR30 '
  622.     DB 'CRATOP2 FLOOR30 '
  623.     DB 'DEM1_1  FLOOR19 '
  624.     DB 'DEM1_2  FLOOR19 '
  625.     DB 'DEM1_3  FLOOR19 '
  626.     DB 'DEM1_4  FLOOR19 '
  627.     DB 'DEM1_5  FLOOR19 '
  628.     DB 'DEM1_6  FLOOR19 '
  629.     DB 'FLAT1   FLOOR00 '
  630.     DB 'FLAT10  FLOOR01 '
  631.     DB 'FLAT14  FLOOR16 '
  632.     DB 'FLAT17  FLOOR03 '
  633.     DB 'FLAT18  FLOOR03 '
  634.     DB 'FLAT19  FLOOR03 '
  635.     DB 'FLAT1_1 FLOOR03 '
  636.     DB 'FLAT1_2 FLOOR03 '
  637.     DB 'FLAT1_3 FLOOR08 '
  638.     DB 'FLAT2   FLOOR11 '
  639.     DB 'FLAT20  FLOOR04 '
  640.     DB 'FLAT22  FLOOR05 '
  641.     DB 'FLAT23  FLOOR04 '
  642.     DB 'FLAT3   FLOOR04 '
  643.     DB 'FLAT4   FLOOR08 '
  644.     DB 'FLAT5   FLOOR06 '
  645.     DB 'FLAT5_1 FLOOR10 '
  646.     DB 'FLAT5_2 FLOOR25 '
  647.     DB 'FLAT5_3 FLOOR09 '
  648.     DB 'FLAT5_4 FLOOR04 '
  649.     DB 'FLAT5_5 FLOOR27 '
  650.     DB 'FLAT5_6 FLOOR06 '
  651.     DB 'FLAT5_7 FLOOR03 '
  652.     DB 'FLAT5_8 FLOOR03 '
  653.     DB 'FLAT8   FLOOR25 '
  654.     DB 'FLAT9   FLOOR04 '
  655.     DB 'FLOOR0_1FLOOR17 '
  656.     DB 'FLOOR0_2FLOOR27 '
  657.     DB 'FLOOR0_3FLOOR18 '
  658.     DB 'FLOOR0_5FLOOR04 '
  659.     DB 'FLOOR0_6FLOOR04 '
  660.     DB 'FLOOR0_7FLOOR04 '
  661.     DB 'FLOOR1_1FLOOR16 '
  662.     DB 'FLOOR1_6FLOOR09 '
  663.     DB 'FLOOR1_7FLOOR09 '
  664.     DB 'FLOOR3_3FLOOR18 '
  665.     DB 'FLOOR4_1FLOOR25 '
  666.     DB 'FLOOR4_5FLOOR25 '
  667.     DB 'FLOOR4_6FLOOR25 '
  668.     DB 'FLOOR4_8FLOOR00 '
  669.     DB 'FLOOR5_1FLOOR01 '
  670.     DB 'FLOOR5_2FLOOR17 '
  671.     DB 'FLOOR5_3FLOOR17 '
  672.     DB 'FLOOR5_4FLOOR10 '
  673.     DB 'FLOOR6_1FLOOR09 '
  674.     DB 'FLOOR6_2FLOOR03 '
  675.     DB 'FLOOR7_1FLOOR27 '
  676.     DB 'FLOOR7_2FLOOR19 '
  677.     DB 'FWATER1 FLTWAWA1'
  678.     DB 'FWATER2 FLTWAWA1'
  679.     DB 'FWATER3 FLTWAWA1'
  680.     DB 'FWATER4 FLTWAWA1'
  681.     DB 'GATE1   FLTTELE1'
  682.     DB 'GATE2   FLTTELE1'
  683.     DB 'GATE3   FLTTELE1'
  684.     DB 'GATE4   FLTTELE1'
  685.     DB 'LAVA1   FLTLAVA1'
  686.     DB 'LAVA2   FLTLAVA1'
  687.     DB 'LAVA3   FLTLAVA1'
  688.     DB 'LAVA4   FLTLAVA1'
  689.     DB 'MFLR8_1 FLOOR03 '
  690.     DB 'MFLR8_2 FLOOR17 '
  691.     DB 'MFLR8_3 FLOOR04 '
  692.     DB 'MFLR8_4 FLOOR05 '
  693.     DB 'NUKAGE1 FLTSLUD1'
  694.     DB 'NUKAGE2 FLTSLUD1'
  695.     DB 'NUKAGE3 FLTSLUD1'
  696.     DB 'SFLR6_1 FLOOR18 '
  697.     DB 'SFLR6_4 FLOOR18 '
  698.     DB 'SFLR7_1 FLOOR18 '
  699.     DB 'SFLR7_4 FLOOR18 '
  700.     DB 'STEP1   FLOOR19 '
  701.     DB 'STEP2   FLOOR19 '
  702.     DB 'TLITE6_1FLOOR06 '
  703.     DB 'TLITE6_4FLOOR06 '
  704.     DB 'TLITE6_5FLOOR06 '
  705.     DB 'TLITE6_6FLOOR06 '
  706.     DB 0
  707.   end;
  708.  
  709. procedure CreateTable; assembler;
  710.   asm
  711.     push ds
  712.     mov ax, SEG objects
  713.     mov es, ax
  714.     lea di, objects
  715.     lea si, @@TABLE
  716.     mov ax, cs
  717.     mov ds, ax
  718.     xor cx, cx
  719.     cld
  720. @@CICLO:
  721.     lodsb
  722.     cmp al, 0
  723.     je  @@STOP
  724.     xor dx, dx
  725. @@SPACE:
  726.     cmp al, 32
  727.     jne @@NUM
  728.     lodsb
  729.     jmp @@SPACE
  730. @@NUM:
  731.     mov bx, dx
  732.     add dx, dx
  733.     add dx, dx
  734.     add dx, bx
  735.     add dx, dx
  736.     and ax, 15
  737.     add dx, ax
  738.     lodsb
  739.     cmp al, 32
  740.     jne @@NUM
  741.     push ax
  742.     mov ax, dx
  743.     stosw
  744.     pop ax
  745.  
  746. @@SPACES:
  747.     cmp al, 32
  748.     jne @@SHORT
  749.     lodsb
  750.     jmp @@SPACES
  751. @@SHORT:
  752.     stosb
  753.     movsb
  754.     movsb
  755.     mov bx, si
  756.     inc si
  757. @@ZERO:
  758.     lodsb
  759.     cmp al, 0
  760.     jne @@ZERO
  761.     mov ax, si
  762.     sub ax, bx
  763.     dec ax
  764.     dec ax
  765.     mov ds:[bx], al
  766.     mov ax, bx
  767.     stosw
  768.     mov ax, cs
  769.     stosw
  770.     inc cx
  771.     jmp @@CICLO
  772. @@STOP:
  773.     pop ds
  774.     mov numobjects, cx
  775.     jmp @@FINE
  776. @@TABLE:
  777.     DB '2007 AMM Ammo Clip',0
  778.     DB '  68 ARA Arachnotron',0
  779.     DB '  64 ARC Archvile',0
  780.     DB '2015 ARM Armor Helmet',0
  781.     DB '  18 ARR Ethereal arrows',0
  782.     DB '  64 AXT Axe thrower',0
  783.     DB '   8 BAC Backpack',0
  784.     DB '   8 BAG Bag of Holding',0
  785.     DB '2048 BAM Box of Ammo',0
  786.     DB '2035 BAR Barrel',0
  787.     DB '2023 BER Berserk',0
  788.     DB '2006 BFG BFG9000',0
  789.     DB '2024 BLR Blur Sphere',0
  790.     DB '2019 BLU Blue Armor',0
  791.     DB '3003 BOH Baron of Hell',0
  792.     DB '2046 BRO Box of Rockets',0
  793.     DB '2049 BSH Box of Shells',0
  794.     DB '  70 BUR Burning Barrel',0
  795.     DB '3005 CAC Cacodemon',0
  796.     DB '2002 CHA Chaingun',0
  797.     DB '  65 CHD Chaingun Dude',0
  798.     DB '2005 CHS Chainsaw',0
  799.     DB '  54 CLO Claw orb',0
  800.     DB '2026 COM Computer Map',0
  801.     DB '2001 CRO Crossbow',0
  802.     DB '  16 CYB Cyberdemon',0
  803.     DB '3002 DEM Demon',0
  804.     DB '  11 DMS DM start',0
  805.     DB '  53 DRA Dragon claw',0
  806.     DB '2047 ENC Energy Cell',0
  807.     DB '  55 ENO Energy orb',0
  808.     DB '  17 ENP Energy Pack',0
  809.     DB '  82 FLA Quartz flask',0
  810.     DB '2005 GAU Gauntlets',0
  811.     DB '  12 GEO Crystal Geode',0
  812.     DB '2018 GRE Green Armor',0
  813.     DB '2014 HEA Health Potion',0
  814.     DB '  69 HEL Hell Knight',0
  815.     DB '  65 IAT Inv axe thrower',0
  816.     DB '3001 IMP Imp',0
  817.     DB '  69 IMU Invisible mummy',0
  818.     DB '2022 INV Invulnerability',0
  819.     DB '  46 ISM Inv sho mummy',0
  820.     DB '  72 KEN Commander Keen',0
  821.     DB '   6 LIC Iron Liche',0
  822.     DB '2045 LIG Light Goggles',0
  823.     DB '3006 LOS Lost Soul',0
  824.     DB '  67 MAN Mancubus',0
  825.     DB '  35 MAP Map scroll',0
  826.     DB '2012 MED Medikit',0
  827.     DB '  83 MEG Megasphere',0
  828.     DB '  30 MOR Morph Ovum',0
  829.     DB '  68 MUM Mummy',0
  830.     DB '  71 PAI Pain Elemental',0
  831.     DB '   1 PL1 Player 1 start',0
  832.     DB '   2 PL2 Player 2 start',0
  833.     DB '   3 PL3 Player 3 start',0
  834.     DB '   4 PL4 Player 4 start',0
  835.     DB '2004 PLA Plasma Gun',0
  836.     DB '  19 QUI Quiver',0
  837.     DB '2025 RAD Radiation Suit',0
  838.     DB '2010 RCK Rocket',0
  839.     DB '  66 RDE Flying demon',0
  840.     DB '  74 RES Red stars',0
  841.     DB '  66 REV Revenant',0
  842.     DB '  84 RIN Ring',0
  843.     DB '2003 ROC Rocket Launcher',0
  844.     DB '   5 RSD Shooting demon',0
  845.     DB '   9 SER Sergeant',0
  846.     DB '  75 SHA Shadowsphere',0
  847.     DB '2008 SHE Shells',0
  848.     DB '2001 SHO Shotgun',0
  849.     DB '  85 SIL Silver shield',0
  850.     DB '  45 SMU Shooting mummy',0
  851.     DB '2013 SOU Soul Sphere',0
  852.     DB '  58 SPE Spectre',0
  853.     DB '   7 SPI Spiderdemon',0
  854.     DB '2035 SPO Spore',0
  855.     DB '  82 SSH Super Shotgun',0
  856.     DB '  84 SSN SS Nazi',0
  857.     DB '  43 SSS Spore spaw spot',0
  858.     DB '2011 STI Stimpack',0
  859.     DB '  14 TEL Teleport exit',0
  860.     DB '  34 TIM Time bomb',0
  861.     DB '  86 TOM Tome of power',0
  862.     DB '  33 TOR Torch',0
  863.     DB '3004 TRO Trooper',0
  864.     DB '  81 VIA Crystal vial',0
  865.     DB '  10 WAN Wand Crystal',0
  866.     DB '  44 WBR Wooden Barrel',0
  867.     DB '  52 WHS White stars',0
  868.     DB '  83 WIN Wings of wrath',0
  869.     DB '  15 WIZ Wizard',0
  870.     DB 0
  871. @@FINE:
  872.   end;
  873.  
  874. {Return a right-padded string of N characters from a string}
  875. function StringN(s:String;n:Integer):String;
  876.   var i:Integer;
  877.   begin
  878.     StringN:=Copy(s,1,n);
  879.     StringN[0]:=Char(n);
  880.     for i:=Length(s)+1 to n do StringN[i]:=' ';
  881.   end;
  882.  
  883. {Converts string to uppercase}
  884. function Upper(s:String):String;
  885.   var i:Integer;
  886.   begin
  887.     Upper[0]:=s[0];
  888.     for i:=1 to Length(s) do Upper[i]:=UpCase(s[i]);
  889.   end;
  890.  
  891. {Add a suffix(extension) to a filename (only if the filename hasn't one)}
  892. function AddSuffix(s,n:String):String;
  893.   var i:Integer;
  894.   begin
  895.     i:=Length(s);
  896.     while i>0 do
  897.       if s[i]='.' then break
  898.       else dec(i);
  899.     if i>0 then AddSuffix:=s
  900.     else AddSuffix:=s+'.'+n;
  901.   end;
  902.  
  903. procedure Title;
  904.   begin
  905.     writeln('DM2CONV v1.7ß950304 by Vincenzo Alcamo (alcamo@arci01.bo.cnr.it)');
  906.   end;
  907.  
  908. procedure List;
  909.   var i,j:integer;
  910.   begin
  911.     Title;
  912.     writeln;
  913.     writeln('LIST OF KNOWN OBJECTS (DOOM/DOOM II/HERETIC)');
  914.     for i:=1 to numobjects do begin
  915.       if i mod 3=1 then writeln
  916.       else write('  ');
  917.       with objects[1+((i-1)div 3)+((i-1)mod 3)*((numobjects+2) div 3)] do
  918.         write(id:4,#32,sname,#32,StringN(name^,15));
  919.     end;
  920.     writeln;
  921.     writeln;
  922.     writeln('You can specify an object by its number, its shortname, its name');
  923.     writeln('or even an initial fragment of its name.');
  924.   end;
  925.  
  926. procedure More;
  927.   begin
  928.     Title;
  929.     writeln;
  930.     writeln('REPLACEMENT is an expression specifying object substitution:');
  931.     writeln('  {source[:lev]}={dest[@num][:lev]}');
  932.     writeln('source is the initial object, dest is the final object,');
  933.     writeln('num is the number of substitutions (absolute or percentual)');
  934.     writeln('lev specifies the difficulty-level flags of the object.');
  935.     writeln('You can specify more than one replacement.');
  936.     writeln;
  937.     writeln('Replacement expression examples:');
  938.     writeln;
  939.     writeln('DEM=IMP             all Demons become Imps');
  940.     writeln('DEM,IMP=LOS         all Demons and Imps become Lost Souls');
  941.     writeln('DEM=IMP@5           5 Demons become Imps');
  942.     writeln('DEM=IMP@50%         50% of Demons become Imps');
  943.     writeln('DEM=IMP@5,SER       5 Demons become Imps, the rest are Sergeants');
  944.     writeln('DEM=IMP DEM=TRO     No Demons remain for the second expression');
  945.     writeln('DEM:1=IMP           All demons that appers in level 1 become Imps');
  946.     writeln('DEM=IMP:123         All demons become Imps that appear in all levels');
  947.     writeln;
  948.     writeln('Requests greater than available objects are adjusted proportionally:');
  949.     writeln('DEM=IMP@5,TRO@15    If Demons are 9 -> IMP@25%,TRO@75%');
  950.     writeln;
  951.     writeln('You can substitute the % sign with #,$,& whichever you prefer.');
  952.   end;
  953.  
  954. procedure Help;
  955.   begin
  956.     Title;
  957.     writeln('Converts DOOM maps for use with DOOM II/HERETIC.');
  958.     writeln;
  959.     writeln('DM2CONV <input> [output] [/mapnum] [/M[=num]] [/DEBUG] [/IGNORE]');
  960.     writeln('        [/HERETIC] [/TEXTURE[=file]] [/FLOOR[=file]] [/NOCONV]');
  961.     writeln('        [/SEED[=num]] [/NOCHECK] [replacements].. [@response]...');
  962.     writeln('        [/R:name1=name2] [/R=file] [/LIST] [/EXAMPLES] [/NOTES]');
  963.     writeln;
  964.     writeln('input        name of DOOM wad file to convert ** REQUIRED **');
  965.     writeln('output       name of output file (if omitted, the input file is overwritten)');
  966.     writeln('/mapnum      number for the first level remapped (default: 1)');
  967.     writeln('/M[=num]     music remapping (num is the level for the first music)');
  968.     writeln('/DEBUG       display debug information');
  969.     writeln('/IGNORE      make replacements even if no level is remapped');
  970.     writeln('/HERETIC     DOOM->HERETIC conversion (used by HERETIC.RSP, see /NOTES)');
  971.     writeln('/TEXTURE     convert texture names  *** SEE DM2CONV.DOC ***');
  972.     writeln('/FLOOR       convert floor names (/HERETIC only)');
  973.     writeln('/SEED[=num]  random generator seed (default: 0, randomize if num is omitted)');
  974.     writeln('/NOCHECK     allow the use of object numbers not in list');
  975.     writeln('/R           renames directory entries');
  976.     writeln('/NOCONV      ignore conversion: useful for /R or object substitution');
  977.     writeln('@response    response file (text file with additional arguments)');
  978.     writeln('Use /LIST, /EXAMPLES, /NOTES to get further information (use MORE).');
  979.   end;
  980.  
  981. procedure Notes;
  982.   begin
  983.     Title;
  984.     writeln;
  985.     writeln('Notes about level remapping:');
  986.     writeln('- Level remapping is performed regardless of level name:');
  987.     writeln('  the first level found becomes MAP01 (and so on)');
  988.     writeln('- No other resources are remapped (eg: M_EPI?, etc...)');
  989.     writeln('- DM2CONV acts only in one way: keep a backup of your wads.');
  990.     writeln('- Secret levels are not remapped to the proper level: don''t use wads');
  991.     writeln('  with secret levels  or, at least, avoid entering a secret level.');
  992.     writeln;
  993.     writeln('Music remapping has 3 settings (none, /M, /M=num):');
  994.     writeln('1) no music is remapped.');
  995.     writeln('2) remap musics accordingly to remapped levels');
  996.     writeln('   D_E1M1 becomes D_RUNNIN only if E1M1 was remapped');
  997.     writeln('3) the first music found becomes the music for MAP num,');
  998.     writeln('   the second becomes the music for MAP num+1, and so on.');
  999.     writeln('For 2) and 3): the end-of-level music is also remapped.');
  1000.     writeln;
  1001.     writeln('DOOM II CONVERSION EXAMPLE:  DM2CONV input.wad output.wad @DOOM2.RSP');
  1002.     writeln('HERETIC CONVERSION EXAMPLE:  DM2CONV input.wad output.wad @HERETIC.RSP');
  1003.   end;
  1004.  
  1005. function GetWord(var s:string):string;
  1006.   var i:integer;
  1007.   begin
  1008.     s:=s+#0;
  1009.     i:=1;
  1010.     while ((s[i]>='0') and (s[i]<='9')) or ((s[i]>='A') and (s[i]<='Z')) do inc(i);
  1011.     GetWord:=Copy(s,1,i-1);
  1012.     s:=Copy(s,i,length(s)-i);
  1013.   end;
  1014.  
  1015. function GetNum(var s:string):integer;
  1016.   var i,j,k:integer;
  1017.   begin
  1018.     val(s,j,k);
  1019.     if k=0 then begin
  1020.       if nocheck and (j>0) and (j<16384) then begin
  1021.         GetNum:=j;
  1022.         exit;
  1023.       end;
  1024.       for i:=1 to numobjects do
  1025.         if objects[i].id=j then begin
  1026.           GetNum:=j;
  1027.           exit;
  1028.         end;
  1029.     end
  1030.     else begin
  1031.       for i:=1 to numobjects do
  1032.         if s=objects[i].sname then begin
  1033.           GetNum:=objects[i].id;
  1034.           exit;
  1035.         end;
  1036.       for i:=1 to numobjects do with objects[i] do begin
  1037.         j:=1;
  1038.         k:=1;
  1039.         repeat
  1040.           if name^[k]=' ' then inc(k)
  1041.           else if s[j]<>UpCase(name^[k]) then break
  1042.           else begin
  1043.             inc(j);
  1044.             inc(k);
  1045.           end;
  1046.         until (j>length(s)) or (k>length(name^));
  1047.         if j>length(s) then begin
  1048.           GetNum:=id;
  1049.           exit;
  1050.         end;
  1051.       end;
  1052.     end;
  1053.     GetNum:=0;
  1054.   end;
  1055.  
  1056. procedure noname(s:string);
  1057.   begin
  1058.     writeln('No object found for ',s);
  1059.     halt;
  1060.   end;
  1061.  
  1062. procedure myhalt(code:errors);
  1063.   begin
  1064.     case code of
  1065.       ERR_OPENS: writeln('Error opening: ',source);
  1066.       ERR_OPEND: writeln('Error opening: ',dest);
  1067.       ERR_READS: writeln('Error reading: ',source);
  1068.       ERR_WRITED:writeln('Error writing: ',dest);
  1069.       ERR_PWAD:  writeln('File is not a PWAD: ',source);
  1070.       ERR_TOOENTRY:writeln('Too many entries in file: ',source);
  1071.       ERR_TOOMAPS:writeln('Cannot remap after map 32');
  1072.       ERR_NOMAPS:writeln('No maps found in file: ',source);
  1073.       ERR_NOEQ:  writeln('Missing ''='' after list of source objects');
  1074.       ERR_BADEND:writeln('Expression incorrectly terminated');
  1075.       ERR_BADNUM:writeln('Bad number in expression');
  1076.       ERR_NOMEM: writeln('Not enough memory');
  1077.       ERR_OPEN:  writeln('Error opening: ',datafile);
  1078.       ERR_READ:  writeln('Error reading: ',datafile);
  1079.     end;
  1080.     halt(0);
  1081.   end;
  1082.  
  1083. procedure checkdatafile(table:p_repname_array;var num:integer;s:string);
  1084.   var f      :text;
  1085.       i      :integer;
  1086.       bef,aft:dname;
  1087.   function getname(var dest:dname):boolean;
  1088.     var j:integer;
  1089.         c:char;
  1090.     begin
  1091.       getname:=false;
  1092.       while (i<length(s)) and ((s[i]=' ') or (s[i]=#9)) do inc(i);
  1093.       if i<length(s) then
  1094.         case s[1] of
  1095.           '''',';','#','%','[':;
  1096.           else begin
  1097.             dest:=NULL_NAME;
  1098.             j:=8;
  1099.             c:=upcase(s[i]);
  1100.             while (j>0) and (i<=length(s)) and (
  1101.              ((c>='0') and (c<='9')) or (c='_') or
  1102.              ((c>='A') and (c<='Z')) ) do begin
  1103.               dec(j);
  1104.               dest[8-j]:=c;
  1105.               inc(i);
  1106.               c:=upcase(s[i]);
  1107.             end;
  1108.             if c='=' then inc(i);
  1109.             getname:=j<8;
  1110.           end
  1111.         end
  1112.     end;
  1113.   procedure insertname;
  1114.     var bef,aft:dname;
  1115.     begin
  1116.       if getname(bef) and getname(aft) then begin
  1117.         i:=1;
  1118.         while i<=num do
  1119.           if table^[i].before=bef then break
  1120.           else inc(i);
  1121.         if (i>num) and (num<1024) then inc(num);
  1122.         table^[i].before:=bef;
  1123.         table^[i].after:=aft;
  1124.       end;
  1125.     end;
  1126.   begin
  1127.     i:=1;
  1128.     while (i<=length(s)) and (s[i]<>':') and (s[i]<>'=') do inc(i);
  1129.     if i>=length(s) then exit;
  1130.     inc(i);
  1131.     if s[i-1]=':' then insertname
  1132.     else begin
  1133.       s:=copy(s,i,255);
  1134.       datafile:=s;
  1135.       writeln('Reading data file: ',s);
  1136.       assign(f,s);
  1137.       reset(f);
  1138.       if ioresult<>0 then myhalt(ERR_OPEN);
  1139.       while not eof(f) do begin
  1140.         readln(f,s);
  1141.         if ioresult<>0 then myhalt(ERR_READ);
  1142.         i:=1;
  1143.         insertname;
  1144.       end;
  1145.       close(f);
  1146.     end;
  1147.   end;
  1148.  
  1149. procedure Swappa(var h,k:integer);
  1150.   var i,l:integer;
  1151.   begin
  1152.     for i:=1 to 3 do begin
  1153.       l:=replace[k];
  1154.       replace[k]:=replace[h];
  1155.       replace[h]:=l;
  1156.       inc(k);
  1157.       inc(h);
  1158.     end;
  1159.   end;
  1160.  
  1161. function checklevel(var s:string):integer;
  1162.   var i,j:integer;
  1163.       t:string;
  1164.   begin
  1165.     j:=0;
  1166.     if (length(s)>1) and (s[1]=':') then begin
  1167.       s:=Copy(s,2,255);
  1168.       t:=GetWord(s);
  1169.       for i:=1 to length(t) do case t[i] of
  1170.         '1': j:=j or 1;  {skill level 1-2}
  1171.         '2': j:=j or 2;  {skill level 3}
  1172.         '3': j:=j or 4;  {skill level 4-5}
  1173.         'D': j:=j or 8;  {deaf flag}
  1174.         'M': j:=j or 16; {multiplayer}
  1175.       end;
  1176.     end;
  1177.     checklevel:=j;
  1178.   end;
  1179.  
  1180. procedure printlevel(i:integer);
  1181.   begin
  1182.     if i>0 then write(':');
  1183.     if (i and 1)=1 then write('1');
  1184.     if (i and 2)=2 then write('2');
  1185.     if (i and 4)=4 then write('3');
  1186.     if (i and 8)=8 then write('D');
  1187.     if (i and 16)=16 then write('M');
  1188.   end;
  1189.  
  1190. procedure Parse;
  1191.   var
  1192.     i,j,k,h : integer;
  1193.     s,t     : string;
  1194.     l       : longint;
  1195.     f       : boolean;
  1196.     repn    : integer;
  1197.     ri,rc,rs: integer;
  1198.     response: text;
  1199.     inresp  : boolean;
  1200.     respstr : string;
  1201.   function GetArgument:string;
  1202.     var i,j:integer;
  1203.     begin
  1204.       if respstr='' then begin
  1205.         if eof(response) then begin
  1206.           respstr:='';
  1207.           inresp:=false;
  1208.           close(response);
  1209.         end
  1210.         else begin
  1211.           Readln(response,respstr);
  1212.           if ioresult<>0 then begin
  1213.             writeln('Error reading from response file');
  1214.             respstr:='';
  1215.             inresp:=false;
  1216.             close(response);
  1217.           end;
  1218.           j:=1;
  1219.           for i:=1 to length(respstr) do
  1220.             case respstr[i] of
  1221.               #32,#9: if j>1 then begin
  1222.                         respstr[j]:=#32;
  1223.                         inc(j);
  1224.                       end;
  1225.               else begin
  1226.                 respstr[j]:=respstr[i];
  1227.                 inc(j);
  1228.               end;
  1229.             end;
  1230.           respstr[0]:=chr(j-1);
  1231.         end;
  1232.       end;
  1233.       case respstr[1] of
  1234.         '''',';','#','%','[': respstr:='';
  1235.       end;
  1236.       i:=1;
  1237.       while (i<=length(respstr)) and (respstr[i]<>#32) do inc(i);
  1238.       GetArgument:=Upper(Copy(respstr,1,i-1));
  1239.       respstr:=Copy(respstr,i+1,255);
  1240.     end;
  1241.   begin
  1242.     source:='';
  1243.     dest:='';
  1244.     RandSeed:=0;
  1245.     repn:=1;
  1246.     inresp:=false;
  1247.     i:=1;
  1248.     while i<=ParamCount do begin
  1249.       f:=not (show_help or show_example or show_list or show_note);
  1250.       if inresp then s:=GetArgument
  1251.       else s:=Upper(ParamStr(i));
  1252.       if s='' then {DO NOTHING}
  1253.       else if s[1]='@' then begin
  1254.         if inresp then writeln('Cannot use nested response file!')
  1255.         else begin
  1256.           respstr:='';
  1257.           assign(response,Copy(s,2,255));
  1258.           reset(response);
  1259.           if ioresult<>0 then writeln('Error opening response file.')
  1260.           else inresp:=true;
  1261.         end;
  1262.       end
  1263.       else if (s[1]='/') or (s[1]='-') then begin
  1264.         s:=Copy(s,2,255);
  1265.         if (s='HELP') or (s='?') or (s='H') then show_help:=f
  1266.         else if (s='NOCHECK') or (s='N') then nocheck:=True
  1267.         else if s='NOCONV' then no_conv:=True
  1268.         else if (s='LIST') or (s='L') then show_list:=f
  1269.         else if (Copy(s,1,7)='EXAMPLE') or (s='E') then show_example:=f
  1270.         else if Copy(s,1,4)='NOTE' then show_note:=f
  1271.         else if (s='DEBUG') or (s='D') then debug:=True
  1272.         else if (s='IGNORE') or (s='I') then ignore:=True
  1273.         else if s[1]='R' then checkdatafile(repdirs,nrepdirs,s)
  1274.         else if (copy(s,1,7)='TEXTURE') or (s[1]='T') then begin
  1275.           do_texture:=True;
  1276.           checkdatafile(reptexture,nreptexture,s);
  1277.         end
  1278.         else if (copy(s,1,5)='FLOOR') or (s[1]='F') then begin
  1279.           do_floor:=True;
  1280.           checkdatafile(repfloor,nrepfloor,s);
  1281.         end
  1282.         else if s='HERETIC' then heretic:=True
  1283.         else if Copy(s,1,4)='SEED' then begin
  1284.           s:=Copy(s,5,255);
  1285.           j:=0;
  1286.           if s[1]='=' then begin
  1287.             s:=Copy(s,2,255);
  1288.             Val(s,l,j);
  1289.             if j<>0 then writeln('Bad number for seed: ',s)
  1290.             else RandSeed:=l;
  1291.           end
  1292.           else Randomize;
  1293.           if j=0 then writeln('Seed for random generator is: ',RandSeed);
  1294.         end
  1295.         else if s[1]='M' then begin
  1296.           s:=Copy(s,2,255);
  1297.           if s[1]='=' then s:=Copy(s,2,255);
  1298.           if Length(s)>0 then begin
  1299.             Val(s,j,k);
  1300.             if (k<>0) or (j<1) or (j>32) then writeln('Bad number for music: ',s)
  1301.             else remap_mus:=j;
  1302.           end
  1303.           else remap_mus:=-1; {remap level&music}
  1304.         end
  1305.         else begin
  1306.           Val(s,j,k);
  1307.           if (k<>0) or (j<1) or (j>32) then writeln('Bad number for remap: ',s)
  1308.           else begin
  1309.             remap_lev:=j;
  1310.             remapping:=true;
  1311.             writeln('Remapping from level ',j);
  1312.           end;
  1313.         end
  1314.       end
  1315.       else begin
  1316.         k:=0;
  1317.         for j:=1 to length(s) do if s[j]='=' then k:=1;
  1318.         if k=0 then begin
  1319.           if source='' then source:=s
  1320.           else if dest='' then dest:=s
  1321.           else writeln('Extra parameter ignored: ',s);
  1322.         end
  1323.         else begin
  1324.           inc(replaces);
  1325.           if debug then writeln('Replacement ',replaces,': ',s);
  1326.           rs:=repn;
  1327.           s:=','+s+'';         {''=#21 is a sentinel}
  1328.           while s[1]=',' do begin
  1329.             s:=Copy(s,2,255);
  1330.             t:=GetWord(s);
  1331.             j:=GetNum(t);
  1332.             if j=0 then noname(t);
  1333.             replace[repn]:=j;
  1334.             inc(repn);
  1335.             replace[repn]:=checklevel(s);
  1336.             inc(repn);
  1337.           end;
  1338.           if s[1]<>'=' then myhalt(ERR_NOEQ);
  1339.           ri:=repn;
  1340.           inc(repn);
  1341.           rc:=0;
  1342.           s[1]:=',';
  1343.           while s[1]=',' do begin
  1344.             s:=Copy(s,2,255);
  1345.             t:=GetWord(s);
  1346.             j:=GetNum(t);
  1347.             if j=0 then noname(t);
  1348.             replace[repn]:=j;
  1349.             inc(repn);
  1350.             replace[repn]:=0;
  1351.             if s[1]='@' then begin
  1352.               s:=Copy(s,2,255);
  1353.               t:=GetWord(s);
  1354.               val(t,j,k);
  1355.               if (k<>0) or (j>=REP_PERCENT) or (j<=0) then myhalt(ERR_BADNUM);
  1356.               if (s[1]>='#') and (s[1]<='&') then begin
  1357.                 inc(j,REP_PERCENT);
  1358.                 s:=Copy(s,2,255);
  1359.               end;
  1360.               replace[repn]:=j;
  1361.             end;
  1362.             inc(repn);
  1363.             replace[repn]:=checklevel(s);
  1364.             inc(repn);
  1365.             inc(rc);
  1366.           end;
  1367.           if (s[1]<>'') or (rc=0) then myhalt(ERR_BADEND);
  1368.           replace[ri]:=REP_PERCENT+rc;
  1369.           k:=ri+1;
  1370.           h:=k;
  1371.           for j:=1 to rc do begin
  1372.             if (replace[h+1]>0) and (replace[h+1]<REP_PERCENT) then Swappa(h,k);
  1373.             inc(h,3);
  1374.           end;
  1375.           h:=k;
  1376.           for j:=1 to rc do begin
  1377.             if replace[h+1]>=REP_PERCENT then Swappa(h,k);
  1378.             inc(h,3);
  1379.           end;
  1380.           if debug then begin
  1381.             write('REPLACE');
  1382.             j:=rs;
  1383.             while j<ri do begin
  1384.               write(' ',replace[j]);
  1385.               printlevel(replace[j+1]);
  1386.               inc(j,2);
  1387.             end;
  1388.             write(' WITH');
  1389.             k:=ri+1;
  1390.             for j:=1 to rc do begin
  1391.               write(' ',replace[k]);
  1392.               if replace[k+1]>0 then
  1393.                 if replace[k+1]>=REP_PERCENT then write('@',replace[k+1]-REP_PERCENT,'%')
  1394.                 else write('@',replace[k+1]);
  1395.               printlevel(replace[k+2]);
  1396.               inc(k,3);
  1397.             end;
  1398.             writeln;
  1399.           end;
  1400.         end;
  1401.       end;
  1402.  
  1403.       if not inresp then inc(i);
  1404.     end;
  1405.     if not (show_example or show_list or show_note) and (source='') then show_help:=true;
  1406.     source:=AddSuffix(source,'WAD');
  1407.     if dest<>'' then dest:=AddSuffix(dest,'WAD');
  1408.   end;
  1409.  
  1410. procedure blockr(var f:file;var dest;size:word;var count:word);
  1411.   begin
  1412.     BlockRead(f,dest,size,count);
  1413.     if (ioresult<>0) or (size<>count) then myhalt(ERR_READS);
  1414.   end;
  1415.  
  1416. procedure blockw(var f:file;var dest;size:word;var count:word);
  1417.   begin
  1418.     BlockWrite(f,dest,size,count);
  1419.     if (ioresult<>0) or (size<>count) then myhalt(ERR_WRITED);
  1420.   end;
  1421.  
  1422. procedure CopyDest;
  1423.   var a,b     : file;
  1424.       l       : Longint;
  1425.       size,len: Word;
  1426.   begin
  1427.     writeln('Copying source to destination...');
  1428.     Assign(a,source);
  1429.     FileMode:=0;  {open for read only}
  1430.     Reset(a,1);
  1431.     FileMode:=2;  {open for read/write}
  1432.     if ioresult<>0 then myhalt(ERR_OPENS);
  1433.     Assign(b,dest);
  1434.     Rewrite(b,1);
  1435.     if ioresult<>0 then myhalt(ERR_OPEND);
  1436.     l:=FileSize(a);
  1437.     while l>0 do begin
  1438.       if l>BUFFSIZE then size:=BUFFSIZE
  1439.       else size:=l;
  1440.       BlockR(a,buffer^,size,len);
  1441.       BlockW(b,buffer^,size,len);
  1442.       dec(l,size);
  1443.     end;
  1444.     Close(a);
  1445.     Close(b);
  1446.   end;
  1447.  
  1448. procedure ReplaceThings(totobj:Integer);
  1449.   var index  : array[1..4000] of integer;
  1450.       numobj : integer;
  1451.       i,j,k,l: integer;
  1452.       repn,h : integer;
  1453.       numabs : integer;
  1454.       nabs   : integer;
  1455.       nrel   : integer;
  1456.       level  : integer;
  1457.       multi  : boolean;
  1458.       s      : string;
  1459.   procedure Choose(var max:integer;n,c,lev:integer);
  1460.     var i,j:integer;
  1461.     begin
  1462.       if n<max then begin
  1463.         for i:=1 to n do begin
  1464.           j:=Random(max)+1;
  1465.           with things^[index[j]] do begin
  1466.             inc(repthing);
  1467.             code:=c;
  1468.             if lev<>0 then flags:=lev;
  1469.           end;
  1470.           index[j]:=index[max];
  1471.           dec(max);
  1472.         end;
  1473.       end
  1474.       else begin
  1475.         for i:=1 to max do with things^[index[i]] do begin
  1476.           inc(repthing);
  1477.           code:=c;
  1478.           if lev<>0 then flags:=lev;
  1479.         end;
  1480.         max:=0;
  1481.       end;
  1482.     end;
  1483.   begin
  1484.     replace:=replace2;
  1485.     repn:=1;
  1486.     for i:=1 to replaces do begin
  1487.       if debug then write('REPLACEMENT=',i);
  1488.       numobj:=0;
  1489.       while replace[repn]<REP_PERCENT do begin
  1490.         j:=replace[repn];
  1491.         level:=replace[repn+1] and 7;  {level 1 or 2 or 3}
  1492.         if level=0 then level:=7;
  1493.         multi:=replace[repn+1]>=16;    {multiplayer flag}
  1494.         for k:=1 to totobj do with things^[k] do
  1495.           if (code=j) and (flags and level>0) and
  1496.              (not multi or (flags and 16=16)) then begin
  1497.             inc(numobj);
  1498.             index[numobj]:=k;
  1499.           end;
  1500.         inc(repn,2);
  1501.       end;
  1502.       if debug then write('  TOTAL OBJECTS=',numobj);
  1503.       nabs:=0;
  1504.       nrel:=replace[repn]-REP_PERCENT;
  1505.       inc(repn);
  1506.       if numobj=0 then begin
  1507.         if debug then writeln('   SKIPPED');
  1508.         inc(repn,nrel*3);
  1509.         continue;
  1510.       end;
  1511.       numabs:=0;
  1512.       j:=nrel;
  1513.       l:=repn+1;
  1514.       k:=1;
  1515.       while (k<=j) do begin
  1516.         if replace[l]=0 then replace[l]:=REP_PERCENT
  1517.         else begin
  1518.           if replace[l]>=REP_PERCENT then
  1519.             replace[l]:=(longint(numobj)*(replace[l]-REP_PERCENT)+50)div 100;
  1520.           inc(numabs,replace[l]);
  1521.           inc(nabs);
  1522.           dec(nrel);
  1523.         end;
  1524.         inc(k);
  1525.         inc(l,3);
  1526.       end;
  1527.       if numabs>numobj then begin
  1528.         l:=repn+1;
  1529.         k:=numobj;
  1530.         for j:=1 to nabs do begin
  1531.           h:=replace[l];
  1532.           replace[l]:=(longint(h)*k+numabs div 2)div numabs;
  1533.           dec(numabs,h);
  1534.           dec(k,replace[l]);
  1535.           inc(l,3);
  1536.         end;
  1537.         numabs:=numobj;
  1538.       end;
  1539.       l:=repn+nabs*3+1;
  1540.       numabs:=numobj-numabs;
  1541.       while nrel>0 do begin
  1542.         j:=(numabs+nrel div 2) div nrel;
  1543.         replace[l]:=j;
  1544.         dec(numabs,j);
  1545.         inc(l,3);
  1546.         dec(nrel);
  1547.         inc(nabs);
  1548.       end;
  1549.       for j:=1 to nabs do begin
  1550.         if debug then begin
  1551.           if j mod 4=1 then writeln
  1552.           else write(#32);
  1553.           k:=numobjects;
  1554.           h:=replace[repn];
  1555.           while (k>0) and (objects[k].id<>h) do dec(k);
  1556.           if k<>0 then s:=objects[k].name^
  1557.           else begin
  1558.             Str(h,s);
  1559.             s:='Unknown #'+s;
  1560.           end;
  1561.           write(s:15,'=');
  1562.           Str(replace[repn+1],s);
  1563.           write(StringN(s,3));
  1564.         end;
  1565.         Choose(numobj,replace[repn+1],replace[repn],replace[repn+2]);
  1566.         inc(repn,3);
  1567.       end;
  1568.       if debug then writeln;
  1569.     end;
  1570.   end;
  1571.  
  1572. procedure Plural(n:integer;s:string);
  1573.   begin
  1574.     write(' ',n,' ',s);
  1575.     if n<>1 then write('s');
  1576.   end;
  1577.  
  1578. procedure Process;
  1579.   var f    : file;
  1580.       head : header;
  1581.       size : word;
  1582.       i,j,k: integer;
  1583.       l    : integer;
  1584.       numt : integer;
  1585.       fpos : longint;
  1586.       rlev : array[1..27] of integer;
  1587.   begin
  1588.     replace2:=replace;
  1589.     repside:=0;
  1590.     repfloo:=0;
  1591.     repthing:=0;
  1592.     replev:=0;
  1593.     for i:=1 to 27 do rlev[i]:=0;
  1594.     if dest<>'' then CopyDest
  1595.     else dest:=source;
  1596.     source:=dest;
  1597.     Assign(f,dest);
  1598.     Reset(f,1);
  1599.     if ioresult<>0 then myhalt(ERR_OPEND);
  1600.     BlockR(f,head,sizeof(header),size);
  1601.     if head.sig<>PWAD_SIG then myhalt(ERR_PWAD);
  1602.     numentry:=head.num;
  1603.     if numentry>MAXENTRY then myhalt(ERR_TOOENTRY);
  1604.     Seek(f,head.start);
  1605.     if ioresult<>0 then myhalt(ERR_READS);
  1606.     BlockR(f,dirlist^,numentry*sizeof(entry),size);
  1607.  
  1608.     if not no_conv then begin
  1609.       for i:=1 to numentry do with dirlist^[i] do begin
  1610.         if not heretic and (name[1]='S') and (name[2]='K') and (name[3]='Y') and
  1611.            (name[4]>='1') and (name[4]<='3') and (name[5]=#0) then begin
  1612.           {remap sky resources}
  1613.           j:=ord(name[4]);
  1614.           name:='RSKYx'#0#0#0;
  1615.           name[5]:=chr(j);
  1616.           savedir:=true;
  1617.         end;
  1618.         if (name[1]='E') and (name[3]='M') then
  1619.          if heretic then begin
  1620.            j:=(ord(name[2])-49)*9+ord(name[4])-48;
  1621.            if remapping then begin
  1622.              if remap_lev>27 then myhalt(ERR_TOOMAPS);
  1623.              rlev[j]:=remap_lev;
  1624.              name[2]:=chr((remap_lev-1) div 9+49);
  1625.              name[4]:=chr((remap_lev-1) mod 9+49);
  1626.              inc(remap_lev);
  1627.              savedir:=true;
  1628.            end
  1629.            else rlev[j]:=j;
  1630.            inc(replev);
  1631.          end
  1632.          else begin
  1633.           if remap_lev>32 then myhalt(ERR_TOOMAPS);
  1634.           rlev[(ord(name[2])-49)*9+ord(name[4])-48]:=remap_lev;
  1635.           name[1]:='M';
  1636.           name[2]:='A';
  1637.           name[3]:='P';
  1638.           name[4]:=chr(remap_lev div 10+48);
  1639.           name[5]:=chr(remap_lev mod 10+48);
  1640.           inc(remap_lev);
  1641.           inc(replev);
  1642.           savedir:=true;
  1643.         end;
  1644.       end;
  1645.       j:=0;
  1646.       if remap_mus<>0 then
  1647.         for i:=1 to numentry do with dirlist^[i] do
  1648.           if (name[1]='D') and (name[2]='_') then
  1649.             if name='D_INTER'#0 then begin
  1650.               if heretic then name:='MUS_INTR'
  1651.               else name:='D_DM2INT';
  1652.               savedir:=true;
  1653.             end
  1654.             else if (name[3]='E') and (name[5]='M') then
  1655.               if remap_mus>0 then begin
  1656.                 if heretic then begin
  1657.                   if remap_mus>27 then myhalt(ERR_TOOMAPS);
  1658.                   k:=remap_mus-1;
  1659.                   name:='MUS_ExMy';
  1660.                   name[6]:=chr(k div 9+49);
  1661.                   name[8]:=chr(k mod 9+49);
  1662.                 end
  1663.                 else begin
  1664.                   if remap_mus>32 then myhalt(ERR_TOOMAPS);
  1665.                   name:=mnames[remap_mus];
  1666.                 end;
  1667.                 inc(remap_mus);
  1668.                 inc(j);
  1669.                 savedir:=true;
  1670.               end
  1671.               else begin
  1672.                 if heretic then begin
  1673.                   k:=rlev[(ord(name[4])-49)*9+ord(name[6])-48]-1;
  1674.                   if k>=0 then begin
  1675.                     name:='MUS_ExMy';
  1676.                     name[6]:=chr(k div 9+49);
  1677.                     name[8]:=chr(k mod 9+49);
  1678.                     savedir:=true;
  1679.                   end
  1680.                 end
  1681.                 else begin
  1682.                   k:=rlev[(ord(name[4])-49)*9+ord(name[6])-48];
  1683.                   if k>0 then begin
  1684.                     name:=mnames[k];
  1685.                     savedir:=true;
  1686.                   end;
  1687.                 end;
  1688.               end;
  1689.     end; {no_conv}
  1690.  
  1691.     if nrepdirs>0 then
  1692.       for i:=1 to numentry do with dirlist^[i] do
  1693.         savedir:=remap_name(repdirs,name,nrepdirs)>0;
  1694.  
  1695.     if savedir then begin
  1696.       Seek(f,head.start);
  1697.       if ioresult<>0 then myhalt(ERR_WRITED);
  1698.       BlockW(f,dirlist^,numentry*sizeof(entry),size);
  1699.     end;
  1700.     if (replev=0) and (j=0) and not ignore then myhalt(ERR_NOMAPS);
  1701.     numt:=MAXENTRY+1;
  1702.     for i:=numentry downto 1 do
  1703.       if ((replaces>0) and (dirlist^[i].Name=N_THINGS)) or
  1704.          (do_texture and (dirlist^[i].Name=N_SIDEDEFS)) or
  1705.          (do_floor and heretic and (dirlist^[i].Name=N_SECTORS)) then begin
  1706.         dec(numt);
  1707.         dirlist^[numt]:=dirlist^[i];
  1708.       end;
  1709.     if numt<=MAXENTRY then begin
  1710.       writeln('Processing REPLACEMENTS...');
  1711.       maxside:=(longint(numt-1)*sizeof(entry))div sizeof(sidedef);
  1712.       for i:=numt to MAXENTRY do with dirlist^[i] do begin
  1713.         Seek(f,start);
  1714.         if ioresult<>0 then myhalt(ERR_READS);
  1715.         if name=N_SIDEDEFS then begin
  1716.           k:=rsize div sizeof(sidedef);
  1717.           while k>0 do begin
  1718.             j:=maxside;
  1719.             if j>k then j:=k;
  1720.             fpos:=FilePos(f);
  1721.             BlockR(f,sidedefs^,j*sizeof(sidedef),size);
  1722.             for l:=1 to j do with sidedefs^[l] do
  1723.               inc(repside,remap_name(reptexture,a,nreptexture)+
  1724.                           remap_name(reptexture,b,nreptexture)+
  1725.                           remap_name(reptexture,c,nreptexture));
  1726.             Seek(f,fpos);
  1727.             if ioresult<>0 then myhalt(ERR_WRITED);
  1728.             BlockW(f,sidedefs^,j*sizeof(sidedef),size);
  1729.             dec(k,j);
  1730.           end;
  1731.         end
  1732.         else if name=N_THINGS then begin
  1733.           BlockR(f,things^,rsize,size);
  1734.           ReplaceThings(rsize div sizeof(thing));
  1735.           Seek(f,start);
  1736.           if ioresult<>0 then myhalt(ERR_WRITED);
  1737.           BlockW(f,things^,rsize,size);
  1738.         end
  1739.         else if name=N_SECTORS then begin
  1740.           BlockR(f,sectors^,rsize,size);
  1741.           for j:=1 to rsize div sizeof(sector) do with sectors^[j] do
  1742.             inc(repfloo,remap_name(repfloor,a,nrepfloor)+
  1743.                         remap_name(repfloor,b,nrepfloor));
  1744.           Seek(f,start);
  1745.           if ioresult<>0 then myhalt(ERR_WRITED);
  1746.           BlockW(f,sectors^,rsize,size);
  1747.         end;
  1748.       end;
  1749.     end;
  1750.     Close(f);
  1751.     write('OK, Remapped:');
  1752.     Plural(replev,'level');
  1753.     write(',');
  1754.     Plural(repside,'texture');
  1755.     write(',');
  1756.     if heretic then begin
  1757.       Plural(repfloo,'floor');
  1758.       write(',');
  1759.     end;
  1760.     Plural(repthing,'object');
  1761.     writeln('.');
  1762.   end;
  1763.  
  1764. function HeapCheck(size:Word):Integer; far;
  1765.   begin
  1766.     HeapCheck:=1;
  1767.   end;
  1768.  
  1769. begin
  1770.   HeapError:=@HeapCheck;
  1771.   new(reptexture);
  1772.   new(repfloor);
  1773.   new(repdirs);
  1774.   new(buffer);
  1775.   if (reptexture=nil) or (repfloor=nil) or (repdirs=nil) or
  1776.      (buffer=nil) then myhalt(ERR_NOMEM);
  1777.   dirlist:=pointer(buffer);
  1778.   sidedefs:=pointer(buffer);
  1779.   sectors:=pointer(buffer);
  1780.   things:=pointer(buffer);
  1781.  
  1782.   nreptexture:=0;
  1783.   nrepfloor:=0;
  1784.   nrepdirs:=0;
  1785.   CreateTable;
  1786.   Parse;
  1787.   if heretic then begin
  1788.     CopyTable(reptexture,@htexture_table,nreptexture);
  1789.     CopyTable(repfloor,@hfloor_table,nrepfloor);
  1790.   end
  1791.   else CopyTable(reptexture,@texture_table,nreptexture);
  1792.   if show_help then Help
  1793.   else if show_list then List
  1794.   else if show_example then More
  1795.   else if show_note then Notes
  1796.   else Process;
  1797. end.
  1798.