home *** CD-ROM | disk | FTP | other *** search
/ Action Ware 12: Heretic & Hexen / actionware12.iso / acware12 / utility / dm2conv.pas < prev    next >
Pascal/Delphi Source File  |  1995-05-24  |  45KB  |  1,548 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 v3.0 by Vincenzo Alcamo }
  4. { This program is Public Domain   }
  5. type
  6.   CHAR8 = array[1..8] of char;
  7.   WAD_HEADER = record
  8.     Sig   : longint;
  9.     Num   : longint;
  10.     Start : longint;
  11.   end;
  12.   WAD_ENTRY = record
  13.     Start : longint;
  14.     Size  : longint;
  15.     Name  : CHAR8;
  16.   end;
  17.   THING = record
  18.     XPos : integer;
  19.     YPos : integer;
  20.     Angle: integer;
  21.     Code : word;
  22.     Flags: word;
  23.   end;
  24.   SIDEDEF = record
  25.     XOffs,YOffs  : integer;
  26.     UpT,LoT,MidT : CHAR8;
  27.     Sector       : word;
  28.   end;
  29.   SECTOR = record
  30.     Y1,Y2          : integer;
  31.     Floor,Ceiling  : CHAR8;
  32.     Lum,Action,Tag : word;
  33.   end;
  34.   LINEDEF = record
  35.     V1,V2      : word;
  36.     Attr       : word;
  37.     Action,Tag : word;
  38.     RSide,LSide: word;
  39.   end;
  40.   GAMETYPE = (GT_DOOM,GT_DOOM2,GT_HERETIC);
  41.   ERRORS = (ERR_NONE,ERR_TOOSYM,ERR_ENDIF_NOIF,ERR_TOORESP,
  42.             ERR_NORESP,ERR_READRESP,ERR_NOLABEL,
  43.             ERR_BADEND,ERR_NOEQ,ERR_BADNUM,ERR_TOOREPN,
  44.             ERR_NOTHINGMODE,ERR_NOCOND,
  45.             ERR_LASTSYNTAX, {marks the last syntax error}
  46.             ERR_BADELSE,ERR_BADENDIF,
  47.             ERR_NOMEM,ERR_OPEN,ERR_READ,ERR_WRITE,ERR_TOOENTRY,ERR_PWAD);
  48.  
  49. const
  50.   IWAD_SIG = Ord('I')+(Ord('W')+(Ord('A')+Ord('D') shl 8) shl 8) shl 8;
  51.   PWAD_SIG = Ord('P')+(Ord('W')+(Ord('A')+Ord('D') shl 8) shl 8) shl 8;
  52.   N_THINGS = 'THINGS'#0#0;
  53.   N_SECTORS= 'SECTORS'#0;
  54.   N_SIDEDEFS='SIDEDEFS';
  55.   N_LINEDEFS='LINEDEFS';
  56.   NULL_NAME= #0#0#0#0#0#0#0#0;
  57.   BUFFSIZE = 65528; {biggest allocable block }
  58.   MAXENTRY = BUFFSIZE div sizeof(WAD_ENTRY);
  59.   MAXTHING = BUFFSIZE div sizeof(THING);
  60.   MAXSIDE  = BUFFSIZE div sizeof(SIDEDEF);
  61.   MAXSECT  = BUFFSIZE div sizeof(SECTOR);
  62.   MAXLINE  = BUFFSIZE div sizeof(LINEDEF);
  63.   MAXREPN  = 1024;  { maximum number of replace name}
  64.   MAXREPT  = 4096;  { maximum number of rep thing info }
  65.   MAXSYMS  = 1024;  { maximum space for symbol table }
  66.   MAXRESP  = 10;    { maximum number of nested response files }
  67.   MAXACTION= 256;   { maximum number of linedef/sector action to replace }
  68.   MAXOBJ   = 500;   { maximum number of object info }
  69.   REP_FLAG = $4000; { maximum value for thing id / flag }
  70.   REP_CONV = $2000; { flag for converted objects }
  71.   REP_ALL  = REP_FLAG+REP_CONV; {all objects}
  72.   REP_DEAF = $0008; { flag for DEAF object: defined by DOOM engine }
  73.   REP_MULTI= $0010; { flag for MULTI object: defined by DOOM engine }
  74.   REP_ZERO = $0020; { flag for ZERO object }
  75.   REP_RANGE= $8000; { flag for range expression}
  76.   REP_QIF  = $C000; { flag for question_mark }
  77.   REP_QELSE= $C100; { ?ELSE command }
  78.   REP_QEND = $C200; { ?END command }
  79.  
  80.   KEY_IFDEF = 'IFDEF';
  81.   KEY_IFNDEF= 'IFNDEF';
  82.   KEY_ELSE  = 'ELSE';
  83.   KEY_ENDIF = 'ENDIF';
  84.  
  85.   SYM_SOURCE = 'SOURCE';
  86.   SYM_DEST   = 'DEST';
  87.   SYM_HELP   = 'HELP';
  88.   SYM_SEED   = 'SEED';
  89.   SYM_FROM   = 'FROM';
  90.   SYM_TO     = 'TO';
  91.   SYM_REMAP  = 'REMAP';
  92.   SYM_ONCE   = 'ONCE';
  93.   SYM_MIX    = 'MIX';
  94.   SYM_DEBUG  = 'DEBUG';
  95.  
  96.   MUS2NAMES : array[1..32] of CHAR8 =  (
  97.     'D_RUNNIN','D_STALKS','D_COUNTD','D_BETWEE','D_DOOM'#0#0,
  98.     'D_THE_DA','D_SHAWN'#0,'D_DDTBLU','D_IN_CIT','D_DEAD'#0#0,
  99.     'D_STLKS2','D_THEDA2','D_DOOM2'#0,'D_DDTBL2','D_RUNNI2',
  100.     'D_DEAD2'#0,'D_STLKS3','D_ROMERO','D_SHAWN2','D_MESSAG',
  101.     'D_COUNT2','D_DDTBL3','D_AMPIE'#0,'D_THEDA3','D_ADRIAN',
  102.     'D_MESSG2','D_ROMER2','D_TENSE'#0,'D_SHAWN3','D_OPENIN',
  103.     'D_EVIL'#0#0,'D_ULTIMA');
  104.  
  105.  
  106. type
  107.   REPNAME = record
  108.     Before : CHAR8;
  109.     After  : CHAR8;
  110.   end;
  111.   REPACTION = record
  112.     After  : word;
  113.     Before : word;
  114.   end;
  115.   RESPONSE = record
  116.     RFile : text;
  117.     Name  : string;
  118.     IfLev : integer;
  119.     Line  : integer;
  120.   end;
  121.   S_GAMETYPE = set of GAMETYPE;
  122.   OBJINFO = record
  123.     Code   : word;
  124.     Radius : word;
  125.     Height : word;
  126.     Games  : S_GAMETYPE;
  127.     Name   : string[20];
  128.   end;
  129.   A_REPNAME = array[1..MAXREPN] of REPNAME;
  130.   A_BUFFER  = array[1..BUFFSIZE] of byte;
  131.   A_DIRLIST = array[1..MAXENTRY] of WAD_ENTRY;
  132.   A_THINGS  = array[1..MAXTHING] of THING;
  133.   A_SIDEDEFS= array[1..MAXSIDE] of SIDEDEF;
  134.   A_SECTORS = array[1..MAXSECT] of SECTOR;
  135.   A_LINEDEFS= array[1..MAXLINE] of LINEDEF;
  136.   A_REPLACE = array[1..MAXREPT] of word;
  137.   A_REPACTION=array[1..MAXACTION] of REPACTION;
  138.   A_OBJINFO = array[1..MAXOBJ] of OBJINFO;
  139.   SYMBOLSPACE=array[1..MAXSYMS] of char;
  140.  
  141. var
  142.   Buffer   : ^A_BUFFER;
  143.   Dirlist  : ^A_DIRLIST;
  144.   Things   : ^A_THINGS;
  145.   Sidedefs : ^A_SIDEDEFS;
  146.   Sectors  : ^A_SECTORS;
  147.   Linedefs : ^A_LINEDEFS;
  148.  
  149.   Symbols  : ^SYMBOLSPACE;
  150.  
  151.   RepThing : ^A_REPLACE;
  152.   RepText  : ^A_REPNAME;
  153.   RepFloor : ^A_REPNAME;
  154.   RepDirs  : ^A_REPNAME;
  155.   RepLAct  : ^A_REPACTION;
  156.   RepSAct  : ^A_REPACTION;
  157.   Objects  : ^A_OBJINFO;
  158.  
  159.   Resp    : array[1..MAXRESP] of RESPONSE;
  160.   RespLev : integer;
  161.  
  162.   SourceName : string;  {name of source file}
  163.   DestName   : string;  {name of destination file}
  164.   RandomSeed : longint; {seed for random number generator}
  165.  
  166.   Game1 : GAMETYPE; {type of source wad}
  167.   Game2 : GAMETYPE; {type of dest wad}
  168.  
  169. const
  170.   NRepThing: integer = 0; {number of replaces for each category}
  171.   NRepText : integer = 0;
  172.   NRepFloor: integer = 0;
  173.   NRepDirs : integer = 0;
  174.   NRepLAct : integer = 0;
  175.   NRepSAct : integer = 0;
  176.   NObjects : integer = 0;
  177.  
  178.   RemappedThing : word = 0; {various remap counters}
  179.   RemappedText  : word = 0;
  180.   RemappedFloor : word = 0;
  181.   RemappedDirs  : word = 0;
  182.   RemappedLAct  : word = 0;
  183.   RemappedSAct  : word = 0;
  184.   RemappedLev   : word = 0;
  185.   RemappedMus   : word = 0;
  186.  
  187.   Debug         : boolean = False;      {debug mode}
  188.  
  189.  
  190. {Return a right-padded string of N characters from a string}
  191. function StringN(s:String;n:Integer):String;
  192.   var i:Integer;
  193.   begin
  194.     StringN:=Copy(s,1,n);
  195.     StringN[0]:=Char(n);
  196.     for i:=Length(s)+1 to n do StringN[i]:=' ';
  197.   end;
  198.  
  199. {Converts string to uppercase}
  200. function Upper(s:String):String;
  201.   var i:Integer;
  202.   begin
  203.     Upper[0]:=s[0];
  204.     for i:=1 to Length(s) do Upper[i]:=UpCase(s[i]);
  205.   end;
  206.  
  207. {Add a suffix(extension) to a filename (only if the filename hasn't one)}
  208. function AddSuffix(s,n:String):String;
  209.   var i:Integer;
  210.   begin
  211.     i:=Length(s);
  212.     while i>0 do
  213.       if s[i]='.' then break
  214.       else dec(i);
  215.     if i>0 then AddSuffix:=s
  216.     else AddSuffix:=s+'.'+n;
  217.   end;
  218.  
  219. {Return the first word of a string}
  220. function GetWord(var s:string):string;
  221.   var i,j:integer;
  222.   begin
  223.     j:=1;
  224.     while (j<=length(s)) and (s[j]<=#32) do inc(j);
  225.     i:=j;
  226.     while (i<=length(s)) and (s[i]>#32) do inc(i);
  227.     GetWord:=Copy(s,j,i-j);
  228.     s:=Copy(s,i,255);
  229.   end;
  230.  
  231. {Add a long to a pointer}
  232. function AddPtr(p:pointer;l:longint):pointer;
  233.   begin
  234.     AddPtr:=pointer(longint(p)+l);
  235.   end;
  236.  
  237. {Return the value of a specified environment variable}
  238. {If name is '' the full path of the program is returned}
  239. function GetEnv(name:string):string; assembler;
  240.   asm
  241.     push ds
  242.     mov ds, PrefixSeg
  243.     mov ax, ds:[$2C]
  244.     mov ds, ax
  245.     xor si, si
  246.     cld
  247.     les di, name
  248.     xor dx, dx
  249.     mov dl, es:[di]
  250.     inc di
  251.     mov bx, di
  252. @@CICLO:
  253.     cmp byte ptr ds:[si], 0
  254.     je  @@FINE
  255.     mov di, bx
  256.     mov cx, dx
  257.     rep cmpsb
  258.     jne @@NEXT
  259.     lodsb
  260.     cmp al, '='
  261.     je  @@FOUND
  262. @@NEXT:
  263.     cmp dx, 0
  264.     je  @@ZERO
  265.     dec si
  266. @@ZERO:
  267.     lodsb
  268.     cmp al, 0
  269.     jne @@ZERO
  270.     jmp @@CICLO
  271. @@FINE:
  272.     cmp dx, 0
  273.     jne @@FOUND
  274.     add si, 3
  275. @@FOUND:
  276.     les di, @RESULT
  277.     push di
  278.     inc di
  279.     xor cx, cx
  280. @@COPY:
  281.     lodsb
  282.     stosb
  283.     inc cx
  284.     cmp al, 0
  285.     jne @@COPY
  286.     xchg ax, cx
  287.     dec ax
  288.     pop di
  289.     stosb
  290.     pop ds
  291.   end;
  292.  
  293. {Concat the exe path with the specified filename}
  294. function AsInEXEDir(s:string):string;
  295.   var t:string;
  296.       i:integer;
  297.   begin
  298.     t:=GetEnv('');
  299.     i:=length(t);
  300.     while (i>0) and (t[i]<>'\') and (t[i]<>'/') do dec(i);
  301.     t[0]:=chr(i);
  302.     i:=length(s);
  303.     while (i>0) and (s[i]<>'\') and (s[i]<>'/') do dec(i);
  304.     AsInEXEDir:=t+copy(s,i+1,255);
  305.   end;
  306.  
  307. procedure SyntaxHelp;
  308.   begin
  309.     if RespLev>0 then
  310.       writeln('(Line ',Resp[RespLev].Line,' in file ',Resp[RespLev].Name,')');
  311.   end;
  312.  
  313. var ErrStr:string;
  314. procedure MyHalt(err:ERRORS);
  315.   begin
  316.     if err<>ERR_NONE then write('ERROR: ');
  317.     case err of
  318.       ERR_NOMEM: writeln('Not enough memory!');
  319.       ERR_TOOSYM: writeln('Symbol table full!');
  320.       ERR_ENDIF_NOIF: writeln('ENDIF without IF');
  321.       ERR_TOORESP: writeln('Too many nested response files!');
  322.       ERR_NORESP: writeln('Cannot find response file!');
  323.       ERR_READRESP: writeln('Cannot read response file!');
  324.       ERR_NOLABEL: writeln('Label not found in response file!');
  325.       ERR_BADEND: writeln('Expression incorrectly terminated');
  326.       ERR_NOEQ: writeln('Missing ''='' in expression!');
  327.       ERR_BADNUM: writeln('Bad number in expression!');
  328.       ERR_NOTHINGMODE: writeln('Command not allowed outside THINGS section!');
  329.       ERR_NOCOND: writeln('No valid relational operator specified!');
  330.       ERR_BADELSE: writeln('Bad ?ELSE expression found!');
  331.       ERR_BADENDIF:writeln('Bad ?END expression found!');
  332.       ERR_TOOREPN: writeln('Replace table full!');
  333.       ERR_READ: writeln('Cannot read from file: ',SourceName);
  334.       ERR_WRITE: writeln('Cannot write to file: ',DestName);
  335.       ERR_OPEN: writeln('Cannot open file: ',ErrStr);
  336.       ERR_PWAD: writeln('File is not a valid WAD: ',SourceName);
  337.       ERR_TOOENTRY:writeln('Too many entries in file: ',SourceName);
  338.     end;
  339.     if (err>ERR_NONE) and (err<ERR_LASTSYNTAX) then SyntaxHelp;
  340.     Halt(ord(err));
  341.   end;
  342.  
  343. function MyHeapError(size:word):integer; far;
  344.   begin
  345.     if size<>0 then MyHalt(ERR_NOMEM);
  346.     MyHeapError:=1;
  347.   end;
  348.  
  349. procedure Initialize;
  350.   begin
  351.     RespLev:=0;
  352.     HeapError:=@MyHeapError;
  353.     New(RepText);
  354.     New(RepFloor);
  355.     New(RepDirs);
  356.     New(RepThing);
  357.     New(Buffer);
  358.     New(DirList);
  359.     New(RepLAct);
  360.     New(RepSAct);
  361.     New(Objects);
  362.     New(Symbols);
  363.     Symbols^[1]:=#0;
  364.     Things:=pointer(Buffer);
  365.     Linedefs:=pointer(Buffer);
  366.     Sidedefs:=pointer(Buffer);
  367.     Sectors:=pointer(Buffer);
  368.   end;
  369.  
  370. var SymbolName : ^string;
  371.     SymbolValue: ^string;
  372.     SymbolFound: boolean;
  373. function GetSymbol(name:string):string;
  374.   begin
  375.     SymbolName:=@Symbols^;
  376.     while SymbolName^<>'' do begin
  377.       SymbolValue:=AddPtr(SymbolName,length(SymbolName^)+1);
  378.       if SymbolName^=name then begin
  379.         GetSymbol:=SymbolValue^;
  380.         SymbolFound:=True;
  381.         exit;
  382.       end;
  383.       SymbolName:=AddPtr(SymbolValue,length(SymbolValue^)+1);
  384.     end;
  385.     SymbolFound:=False;
  386.     GetSymbol:=Upper(GetEnv(name));
  387.   end;
  388.  
  389. procedure SetSymbol(name,value:string);
  390.   begin
  391.     GetSymbol(name);
  392.     if SymbolFound then begin
  393.       SymbolValue:=AddPtr(SymbolValue,length(SymbolValue^)+1);
  394.       while SymbolValue^<>'' do begin
  395.         SymbolName^:=SymbolValue^;
  396.         SymbolValue:=AddPtr(SymbolValue,length(SymbolName^)+1);
  397.         SymbolName:=AddPtr(SymbolName,length(SymbolName^)+1);
  398.       end;
  399.     end;
  400.     if value<>'' then begin
  401.       if longint(SymbolName)+length(name)+length(value)+2>longint(Symbols)+sizeof(SYMBOLSPACE) then
  402.         MyHalt(ERR_TOOSYM);
  403.       SymbolName^:=name;
  404.       SymbolValue:=AddPtr(SymbolName,length(name)+1);
  405.       SymbolValue^:=value;
  406.       SymbolName:=AddPtr(SymbolValue,length(value)+1);
  407.     end;
  408.     SymbolName^:='';
  409.   end;
  410.  
  411. procedure Title;
  412.   begin
  413.     writeln('DM2CONV v3.0 by Vincenzo Alcamo (alcamo@arci01.bo.cnr.it) VERSION 950521');
  414.   end;
  415.  
  416. procedure Help;
  417.   begin
  418.     Title;
  419.     writeln('Interchange maps among DOOM, DOOM II and HERETIC.');
  420.     writeln;
  421.     writeln('Usage: DM2CONV <input> [output] [/symbol[=[value]]]... <@response>...');
  422.     writeln;
  423.     writeln('  input        name of wad file to convert');
  424.     writeln('  output       name of output file (if omitted, the source is overwritten)');
  425.     writeln('  symbol       symbol to define (/symbol=value) or undefine (/symbol=)');
  426.     writeln('  @response    name of response file');
  427.     writeln;
  428.     writeln('To convert levels from game_A to game_B use the appropriate response file,');
  429.     writeln('following this name convention: D=DOOM, D2=DOOM II, H=HERETIC.');
  430.     writeln('Example for DOOM to HERETIC conversion:  DM2CONV input output @:DTOH');
  431.     writeln('Example for DOOM II to DOOM conversion:  DM2CONV input output @:D2TOD');
  432.     writeln;
  433.     writeln('If you use the wads built by GFXMAKER you should define the GFX symbol.');
  434.     writeln('Example for HERETIC to DOOM conversion:  DM2CONV input output /GFX @:HTOD');
  435.     writeln;
  436.     writeln('Full instructions are contained inside DM2CONV.DOC: this file and the official');
  437.     writeln('response file DEFAULT.RSP are part of the DM2CONV distribution package.');
  438.     writeln('REMEMBER: DM2CONV is PUBLIC DOMAIN (or FREEWARE if you prefer).');
  439.   end;
  440.  
  441. function MyVal(s:string):integer;
  442.   var i,j:integer;
  443.   begin
  444.     Val(s,j,i);
  445.     if (i<>0) or (j>=REP_FLAG) or (j<0) then MyHalt(ERR_BADNUM);
  446.     MyVal:=j;
  447.   end;
  448.  
  449. procedure ParseSymbol(s:string);
  450.   var i:integer;
  451.   begin
  452.     if s='' then begin
  453.       SymbolName:=@Symbols^;
  454.       while SymbolName^<>'' do begin
  455.         SymbolValue:=AddPtr(SymbolName,length(SymbolName^)+1);
  456.         writeln(SymbolName^,'=',SymbolValue^);
  457.         SymbolName:=AddPtr(SymbolValue,length(SymbolValue^)+1);
  458.       end;
  459.     end
  460.     else begin
  461.       i:=1;
  462.       while (i<=length(s)) and (s[i]<>'=') do inc(i);
  463.       if i>length(s) then SetSymbol(s,s)
  464.       else SetSymbol(copy(s,1,i-1),copy(s,i+1,255));
  465.     end;
  466.   end;
  467.  
  468. function GetArgument:string;
  469.   var i:integer;
  470.       s:string;
  471.   begin
  472.     if eof(Resp[RespLev].RFile) then begin
  473.       close(Resp[RespLev].RFile);
  474.       dec(RespLev);
  475.       s:='';
  476.     end
  477.     else begin
  478.       readln(Resp[RespLev].RFile,s);
  479.       inc(Resp[RespLev].Line);
  480.       if ioresult<>0 then MyHalt(ERR_READRESP);
  481.       i:=1;
  482.       while (i<=length(s)) and (s[i]<=#32) do inc(i);
  483.       s:=copy(s,i,255);
  484.     end;
  485.     i:=1;
  486.     while i<=length(s) do begin
  487.       if s[i]=';' then s[0]:=chr(i-1);
  488.       inc(i);
  489.     end;
  490.     i:=length(s);
  491.     while (i>0) and (s[i]<=#32) do dec(i);
  492.     s[0]:=chr(i);
  493.     GetArgument:=s;
  494.   end;
  495.  
  496. function GetIdentifier(var s:string):string;
  497.   var i:integer;
  498.   begin
  499.     s:=s+#0;
  500.     i:=1;
  501.     while (s[i]='_') or ((s[i]>='0') and (s[i]<='9')) or ((s[i]>='A') and (s[i]<='Z')) do inc(i);
  502.     GetIdentifier:=Copy(s,1,i-1);
  503.     s:=Copy(s,i,length(s)-i);
  504.   end;
  505.  
  506. function CheckLevel(var s:string):word;
  507.   var i,j:word;
  508.   begin
  509.     j:=0;
  510.     if (length(s)>0) and (s[1]=':') then begin
  511.       i:=2;
  512.       while i<=length(s) do begin
  513.         case s[i] of
  514.           '0': j:=j or REP_ZERO;  {allow no skill flags}
  515.           '1': j:=j or 1;         {skill level 1-2}
  516.           '2': j:=j or 2;         {skill level 3}
  517.           '3': j:=j or 4;         {skill level 4-5}
  518.           'D': j:=j or REP_DEAF;  {deaf flag}
  519.           'M': j:=j or REP_MULTI; {multiplayer}
  520.           'O': j:=j or REP_FLAG;  {only objects not already converted}
  521.           'A': j:=j or REP_ALL;   {all objects}
  522.           'C': j:=j or REP_CONV;  {only converted objects}
  523.           else break;
  524.         end;
  525.         inc(i);
  526.       end;
  527.       s:=Copy(s,i,255);
  528.     end;
  529.     CheckLevel:=j;
  530.   end;
  531.  
  532. procedure ParseThing(var s:string);
  533.   var i,j,k: integer;
  534.       rnum : integer;
  535.       once : word;
  536.   procedure GetOnceFlag;
  537.     var t:string;
  538.         i,j:integer;
  539.     begin
  540.       t:=GetSymbol(SYM_ONCE);
  541.       if t='' then j:=0
  542.       else begin
  543.         val(t,j,i);
  544.         if i<>0 then j:=1;
  545.       end;
  546.       case j of
  547.         0: once:=REP_ALL;
  548.         2: once:=REP_CONV;
  549.         else once:=REP_FLAG;
  550.       end;
  551.     end;
  552.   function GetNum:word;
  553.     var t:string;
  554.         i,j,k,l:integer;
  555.     begin
  556.       s:=Copy(s,2,255);
  557.       t:=GetIdentifier(s);
  558.       if length(t)=0 then MyHalt(ERR_BADNUM);
  559.       if (t[1]>='0') and (t[1]<='9') then GetNum:=MyVal(t)
  560.       else begin
  561.         l:=0;
  562.         for i:=1 to NObjects do with Objects^[i] do begin
  563.           j:=1;
  564.           k:=1;
  565.           repeat
  566.             if Name[k]<=' ' then inc(k)
  567.             else if t[j]<>UpCase(Name[k]) then break
  568.             else begin
  569.               inc(j);
  570.               inc(k);
  571.             end;
  572.           until (j>length(t)) or (k>length(Name));
  573.           if (j>length(t)) and ((l=0) or (k>length(Name))) then l:=Code;
  574.         end;
  575.         if l=0 then MyHalt(ERR_BADNUM);
  576.         GetNum:=l;
  577.       end;
  578.     end;
  579.   procedure PutRep(i:word);
  580.     begin
  581.       inc(NRepThing);
  582.       if NRepThing>MAXREPT then MyHalt(ERR_TOOREPN);
  583.       RepThing^[NRepThing]:=i;
  584.     end;
  585.   begin
  586.     if s='?ELSE' then begin PutRep(REP_QELSE); exit; end;
  587.     if s='?END' then begin PutRep(REP_QEND); exit; end;
  588.     if s[1]='?' then begin
  589.       inc(NRepThing);
  590.       rnum:=NRepThing;
  591.       s[1]:=',';
  592.     end
  593.     else begin
  594.       rnum:=0;
  595.       s:=','+s;
  596.     end;
  597.     GetOnceFlag;
  598.     inc(s[0]);
  599.     s[length(s)]:=#21;  {#21 is a sentinel}
  600.     while s[1]=',' do begin
  601.       PutRep(GetNum);
  602.       j:=CheckLevel(s);
  603.       if s[1]='-' then begin
  604.         PutRep(REP_RANGE);
  605.         PutRep(GetNum);
  606.         j:=CheckLevel(s);
  607.       end;
  608.       if j and REP_ALL=0 then j:=j or once;
  609.       PutRep(j);
  610.     end;
  611.     if rnum>0 then begin
  612.       case s[1] of
  613.         '=': j:=0;                     { =  0 }
  614.         '<': if s[2]='>' then j:=1     { <> 1 }
  615.              else j:=2+ord(s[2]='=');  { <  2    <= 3}
  616.         '>': j:=4+ord(s[2]='=');       { >  4    >= 5}
  617.         else MyHalt(ERR_NOCOND);
  618.       end;
  619.       RepThing^[rnum]:=j+REP_QIF;
  620.       s:=Copy(s,2+(j and 1),255);
  621.       PutRep(REP_QIF+MyVal(GetIdentifier(s)));
  622.       if s[1]<>#21 then MyHalt(ERR_BADEND);
  623.       exit;
  624.     end;
  625.     if s[1]<>'=' then MyHalt(ERR_NOEQ);
  626.  
  627.     inc(NRepThing);
  628.     rnum:=NRepThing;
  629.     i:=0;
  630.     s[1]:=',';
  631.     while s[1]=',' do begin
  632.       PutRep(GetNum);
  633.       j:=0;
  634.       if s[1]='@' then begin
  635.         s:=Copy(s,2,255);
  636.         j:=MyVal(GetIdentifier(s));
  637.         if (s[1]>='#') and (s[1]<='&') then begin
  638.           inc(j,REP_FLAG); { percentual quantity }
  639.           s:=Copy(s,2,255);
  640.         end;
  641.       end;
  642.       PutRep(j);
  643.       PutRep(CheckLevel(s));
  644.       inc(i);
  645.     end;
  646.     RepThing^[rnum]:=REP_FLAG+i;
  647.     if (s[1]<>#21) or (i=0) then MyHalt(ERR_BADEND);
  648.   end;
  649.  
  650. procedure ParseName(s:string;i:integer;var table:A_REPNAME;var num:integer);
  651.   var r:REPNAME;
  652.       j:integer;
  653.   begin
  654.     FillChar(r,sizeof(r),0);
  655.     j:=1;
  656.     while (j<=8) and (j<i) do begin
  657.       r.Before[j]:=UpCase(s[j]);
  658.       inc(j);
  659.     end;
  660.     j:=1;
  661.     while (j<=8) and (i<length(s)) do begin
  662.       inc(i);
  663.       r.After[j]:=UpCase(s[i]);
  664.       inc(j);
  665.     end;
  666.     i:=1;
  667.     while (i<=num) and (table[i].Before<>r.Before) do inc(i);
  668.     if j=1 then begin {remove name}
  669.       if i<=num then begin
  670.         table[i]:=table[num];
  671.         dec(num);
  672.       end;
  673.     end
  674.     else begin {add name}
  675.       if i>num then begin
  676.         inc(num);
  677.         if num>MAXREPN then MyHalt(ERR_TOOREPN);
  678.       end;
  679.       table[i]:=r;
  680.     end;
  681.   end;
  682.  
  683. procedure ParseAction(s:string;var table:A_REPACTION;var num:integer);
  684.   var t   : string;
  685.       i,j : integer;
  686.       k   : word;
  687.   procedure PutAction;
  688.     begin
  689.       inc(num);
  690.       if num>MAXREPN then MyHalt(ERR_TOOREPN);
  691.       table[num].Before:=k;
  692.       inc(j);
  693.     end;
  694.   begin
  695.     j:=0;
  696.     s:=','+s;
  697.     while s[1]=',' do begin
  698.       s:=copy(s,2,255);
  699.       k:=MyVal(GetIdentifier(s));
  700.       PutAction;
  701.       if s[1]='-' then begin
  702.         s:=copy(s,2,255);
  703.         k:=MyVal(GetIdentifier(s));
  704.         inc(k,REP_RANGE);
  705.         PutAction;
  706.       end;
  707.     end;
  708.     if s[1]<>'=' then MyHalt(ERR_NOEQ);
  709.     s:=copy(s,2,255);
  710.     k:=MyVal(GetIdentifier(s));
  711.     if s<>'' then MyHalt(ERR_BADEND);
  712.     for i:=num-j+1 to num do table[i].After:=k;
  713.   end;
  714.  
  715. procedure ParseObject(s:string);
  716.   var obj : OBJINFO;
  717.       i   : integer;
  718.   begin
  719.     s:=s+#21;
  720.     obj.Code:=MyVal(GetIdentifier(s));
  721.     if s[1]<>'=' then MyHalt(ERR_NOEQ);
  722.     obj.Radius:=0;
  723.     obj.Height:=0;
  724.     obj.Games:=[];
  725.     if (s[2]='(') or (s[2]='[') then begin
  726.       s:=copy(s,3,255);
  727.       obj.Radius:=MyVal(GetIdentifier(s));
  728.       if s[1]=',' then begin
  729.         s:=copy(s,2,255);
  730.         obj.Radius:=MyVal(GetIdentifier(s));
  731.       end;
  732.       if (s[1]<>')') and (s[1]<>']') then MyHalt(ERR_BADEND);
  733.     end;
  734.     i:=2;
  735.     while (i<=length(s)) and (s[i]<>',') do begin
  736.       case upcase(s[i]) of
  737.         'D': if s[i+1]='2' then begin
  738.                Include(obj.Games,GT_DOOM2);
  739.                inc(i);
  740.              end
  741.              else Include(obj.Games,GT_DOOM);
  742.         'H': Include(obj.Games,GT_HERETIC);
  743.       end;
  744.       inc(i);
  745.     end;
  746.     if (i>length(s)) or (s[i]<>',') then MyHalt(ERR_BADEND);
  747.     obj.Name:=copy(s,i+1,length(s)-i-1);
  748.     if NObjects=MAXOBJ then MyHalt(ERR_TOOREPN);
  749.     inc(NObjects);
  750.     Objects^[NObjects]:=obj;
  751.   end;
  752.  
  753. procedure Parse;
  754.   type PARSE_TYPE = (PT_THING,PT_TEXTURE,PT_FLOOR,PT_LINEDEF,
  755.                      PT_SECTOR,PT_NAME,PT_OBJECT);
  756.   var
  757.     i,j     : integer;
  758.     s,t     : string;
  759.     index   : integer;
  760.     p_mode  : PARSE_TYPE;
  761.   begin
  762.     p_mode:=PT_THING;
  763.     RespLev:=0;
  764.     index:=1;
  765.     while index<=ParamCount do begin
  766.       if RespLev>0 then t:=GetArgument
  767.       else t:=ParamStr(index);
  768.       s:=Upper(GetWord(t));
  769.       if (s='') or (s[1]=':') then {DO NOTHING}
  770.       else if s[1]='@' then begin
  771.         if RespLev=MAXRESP then MyHalt(ERR_TOORESP)
  772.         else begin
  773.           s:=Copy(s,2,255);
  774.           i:=1;
  775.           while (i<=length(s)) and (s[i]<>':') do inc(i);
  776.           t:=copy(s,i,255);
  777.           s:=copy(s,1,i-1);
  778.           if s='' then
  779.             if RespLev>0 then s:=Resp[RespLev].Name
  780.             else s:='DEFAULT';
  781.           j:=RespLev+1;
  782.           Resp[j].IfLev:=0;
  783.           Resp[j].Line:=0;
  784.           assign(Resp[j].RFile,s);
  785.           FileMode:=0;
  786.           reset(Resp[j].RFile);
  787.           if ioresult<>0 then begin
  788.             s:=AddSuffix(s,'RSP');
  789.             assign(Resp[j].RFile,s);
  790.             reset(Resp[j].RFile);
  791.           end;
  792.           if ioresult<>0 then begin
  793.             s:=AsInEXEDir(s);
  794.             assign(Resp[j].RFile,s);
  795.             reset(Resp[j].RFile);
  796.           end;
  797.           if ioresult<>0 then MyHalt(ERR_NORESP);
  798.           Resp[j].Name:=s;
  799.           inc(RespLev);
  800.           if t<>'' then begin
  801.             i:=RespLev;
  802.             s:=GetArgument;
  803.             while (i=RespLev) and (Upper(GetWord(s))<>t) do s:=GetArgument;
  804.             if i<>RespLev then MyHalt(ERR_NOLABEL);
  805.           end;
  806.         end;
  807.       end
  808.       else if (s[1]='/') or (s[1]='-') then begin
  809.         while (s<>'') and ((s[1]='/') or (s[1]='-')) do begin
  810.            ParseSymbol(copy(s,2,255));
  811.            s:=Upper(GetWord(t));
  812.         end;
  813.       end
  814.       else if s[1]='[' then begin
  815.         t:=copy(s,2,3);
  816.         if t='THI' then p_mode:=PT_THING
  817.         else if t='TEX' then p_mode:=PT_TEXTURE
  818.         else if t='FLO' then p_mode:=PT_FLOOR
  819.         else if t='LIN' then p_mode:=PT_LINEDEF
  820.         else if t='SEC' then p_mode:=PT_SECTOR
  821.         else if t='NAM' then p_mode:=PT_NAME
  822.         else if t='OBJ' then p_mode:=PT_OBJECT
  823.         else begin
  824.           writeln('WARNING: Unknown section ',s);
  825.           SyntaxHelp;
  826.         end;
  827.       end
  828.       else begin
  829.         if s[1]='?' then i:=-1
  830.         else i:=Pos('=',s);
  831.         if i<>0 then begin
  832.           repeat
  833.             if s[1]<>'?' then begin
  834.               if i=0 then i:=Pos('=',s);
  835.               if i=0 then MyHalt(ERR_NOEQ);
  836.             end
  837.             else if p_mode<>PT_THING then MyHalt(ERR_NOTHINGMODE);
  838.             case p_mode of
  839.               PT_THING: ParseThing(s);
  840.               PT_TEXTURE: ParseName(s,i,RepText^,NRepText);
  841.               PT_FLOOR: ParseName(s,i,RepFloor^,NRepFloor);
  842.               PT_NAME: ParseName(s,i,RepDirs^,NRepDirs);
  843.               PT_LINEDEF: ParseAction(s,RepLAct^,NRepLAct);
  844.               PT_SECTOR: ParseAction(s,RepSAct^,NRepSAct);
  845.               PT_OBJECT: begin
  846.                    ParseObject(s+' '+t);
  847.                    t:='';
  848.                 end;
  849.             end;
  850.             s:=Upper(GetWord(t));
  851.             i:=0;
  852.           until (s='') or (s[1]=';');
  853.         end
  854.         else if RespLev>0 then begin
  855.           if (s=KEY_IFDEF) or (s=KEY_IFNDEF) then begin
  856.             i:=ord(s=KEY_IFDEF);
  857.             s:=Upper(GetWord(t));
  858.             inc(Resp[RespLev].IfLev);
  859.             if i<>ord(GetSymbol(s)<>'') then begin {condition false}
  860.               j:=Resp[RespLev].IfLev;
  861.               i:=RespLev;
  862.               while (i=RespLev) and (j<=Resp[RespLev].IfLev) do begin
  863.                 t:=GetArgument;
  864.                 s:=Upper(GetWord(t));
  865.                 if (s=KEY_IFDEF) or (s=KEY_IFNDEF) then inc(Resp[RespLev].IfLev)
  866.                 else if s=KEY_ENDIF then dec(Resp[RespLev].IfLev)
  867.                 else if (s=KEY_ELSE) and (j=Resp[RespLev].IfLev) then i:=0;
  868.               end;
  869.             end;
  870.           end
  871.           else if s=KEY_ELSE then begin
  872.             j:=Resp[RespLev].IfLev;
  873.             i:=RespLev;
  874.             while (i=RespLev) and (j<=Resp[RespLev].IfLev) do begin
  875.               t:=GetArgument;
  876.               s:=Upper(GetWord(t));
  877.               if (s=KEY_IFDEF) or (s=KEY_IFNDEF) then inc(Resp[RespLev].IfLev)
  878.               else if s=KEY_ENDIF then dec(Resp[RespLev].IfLev);
  879.             end;
  880.           end
  881.           else if s=KEY_ENDIF then begin
  882.             if Resp[RespLev].IfLev=0 then MyHalt(ERR_ENDIF_NOIF);
  883.             dec(Resp[RespLev].IfLev);
  884.           end
  885.           else if s='SET' then begin
  886.             repeat
  887.               ParseSymbol(Upper(GetWord(t)))
  888.             until t='';
  889.           end
  890.           else if s='RETURN' then begin
  891.             close(Resp[RespLev].RFile);
  892.             dec(RespLev);
  893.           end
  894.           else if s='ABORT' then MyHalt(ERR_NONE)
  895.           else if s='ECHO' then writeln(Copy(t,2,255))
  896.           else begin
  897.             writeln('WARNING: Unknown keyword ',s);
  898.             SyntaxHelp;
  899.           end;
  900.         end
  901.         else begin
  902.           if GetSymbol(SYM_SOURCE)='' then SetSymbol(SYM_SOURCE,s)
  903.           else if GetSymbol(SYM_DEST)='' then SetSymbol(SYM_DEST,s)
  904.           else begin
  905.             writeln('WARNING: Unknown keyword ',s);
  906.             SyntaxHelp;
  907.           end;
  908.         end;
  909.       end;
  910.  
  911.       if RespLev=0 then inc(index);
  912.     end;
  913.     SourceName:=GetSymbol(SYM_SOURCE);
  914.     DestName:=GetSymbol(SYM_DEST);
  915.     if SourceName<>'' then SourceName:=AddSuffix(SourceName,'WAD');
  916.     if DestName<>'' then DestName:=AddSuffix(DestName,'WAD');
  917.     Debug:=GetSymbol(SYM_DEBUG)<>'';
  918.   end;
  919.  
  920. procedure BlockR(var f:file;var dest;size:word);
  921.   begin
  922.     BlockRead(f,dest,size);
  923.     if ioresult<>0 then MyHalt(ERR_READ);
  924.   end;
  925.  
  926. procedure BlockW(var f:file;var dest;size:word);
  927.   begin
  928.     BlockWrite(f,dest,size);
  929.     if ioresult<>0 then MyHalt(ERR_WRITE);
  930.   end;
  931.  
  932. procedure FSeek(var f:file;p:longint);
  933.   begin
  934.     Seek(f,p);
  935.     if ioresult<>0 then MyHalt(ERR_READ);
  936.   end;
  937.  
  938. procedure CopyDest;
  939.   var a,b  : file;
  940.       l    : longint;
  941.       size : word;
  942.   begin
  943.     writeln('Copying source to destination');
  944.     Assign(a,SourceName);
  945.     FileMode:=0;  {open for read only}
  946.     ErrStr:=SourceName;
  947.     Reset(a,1);
  948.     if ioresult<>0 then MyHalt(ERR_OPEN);
  949.     Assign(b,DestName);
  950.     FileMode:=1;  {open for write only}
  951.     ErrStr:=DestName;
  952.     Rewrite(b,1);
  953.     if ioresult<>0 then MyHalt(ERR_OPEN);
  954.     l:=FileSize(a);
  955.     while l>0 do begin
  956.       if l>BUFFSIZE then size:=BUFFSIZE
  957.       else size:=l;
  958.       BlockR(a,buffer^,size);
  959.       BlockW(b,buffer^,size);
  960.       dec(l,size);
  961.     end;
  962.     Close(a);
  963.     Close(b);
  964.   end;
  965.  
  966. function RemapName(var table:A_REPNAME;var name:CHAR8;num:integer):integer; assembler;
  967.   asm
  968.     cld
  969.     les di, name
  970.     mov cx, 8
  971. @@LOOP:
  972.     mov al, es:[di]
  973.     cmp al, 0
  974.     je  @@FILLZERO
  975.     cmp al, 'a'
  976.     jb  @@STORE
  977.     cmp al, 'z'
  978.     ja  @@STORE
  979.     sub al, 32
  980. @@STORE:
  981.     stosb
  982.     loop @@LOOP
  983. @@FILLZERO:
  984.     rep stosb
  985. @@OK:
  986.     push ds
  987.     lds si, name
  988.     les di, table
  989.     mov cx, num
  990.     cld
  991.     lodsw
  992.     mov bx, [si]
  993.     mov dx, [si+2]
  994.     mov si, [si+4]
  995. @@CICLO:
  996.     scasw
  997.     jnz @@NEXT
  998.     cmp bx, es:[di]
  999.     jnz @@NEXT
  1000.     cmp dx, es:[di+2]
  1001.     jnz @@NEXT
  1002.     cmp si, es:[di+4]
  1003.     jnz @@NEXT
  1004.     mov ax, es
  1005.     mov ds, ax
  1006.     mov si, di
  1007.     add si, 6
  1008.     les di, name
  1009.     mov cx, 8
  1010.     rep movsb
  1011.     mov ax, 1
  1012.     jmp @@FINE
  1013. @@NEXT:
  1014.     add di, 14
  1015.     loop @@CICLO
  1016.     xor ax, ax
  1017. @@FINE:
  1018.     pop ds
  1019.   end;
  1020.  
  1021. function RemapNum(var table:A_REPACTION;var action:word;num:integer):integer; assembler;
  1022.   asm
  1023.     push ds
  1024.     les di, action
  1025.     mov bx, es:[di]
  1026.     lds si, table
  1027.     mov ax, num
  1028.     mov cx, ax
  1029.     add ax, ax
  1030.     add ax, ax
  1031.     add si, ax
  1032.     dec si
  1033.     dec si
  1034.     std
  1035. @@LOOP:
  1036.     lodsw
  1037.     cmp ax, REP_RANGE
  1038.     jb  @@NORANGE
  1039.     sub ax, REP_RANGE
  1040.     cmp ax, bx
  1041.     jb  @@NEXT
  1042.     lodsw
  1043.     lodsw
  1044.     dec cx
  1045.     cmp ax, bx
  1046.     jbe @@FOUND
  1047.     jmp @@NEXT
  1048. @@NORANGE:
  1049.     cmp ax, bx
  1050.     je  @@FOUND
  1051. @@NEXT:
  1052.     lodsw
  1053.     loop @@LOOP
  1054.     xor ax, ax
  1055.     jmp @@FINE
  1056. @@FOUND:
  1057.     les di, action
  1058.     movsw
  1059.     mov ax, 1
  1060. @@FINE:
  1061.     pop ds
  1062.   end;
  1063.  
  1064. procedure SetRandomSeed;
  1065.   var s:string;
  1066.       i:integer;
  1067.   begin
  1068.     s:=GetSymbol(SYM_SEED);
  1069.     RandomSeed:=0;
  1070.     if s=SYM_SEED then begin
  1071.       Randomize;
  1072.       RandomSeed:=RandSeed;
  1073.     end
  1074.     else if s<>'' then begin
  1075.       Val(s,RandomSeed,i);
  1076.       if i<>0 then RandomSeed:=0;
  1077.     end;
  1078.   end;
  1079.  
  1080. function LenNum(n:word):integer;
  1081.   begin
  1082.     if n<10 then LenNum:=1
  1083.     else if n<100 then LenNum:=2
  1084.     else if n<1000 then LenNum:=3
  1085.     else LenNum:=4;
  1086.   end;
  1087.  
  1088. var ThingIndex : array[1..MAXTHING] of integer;
  1089. procedure Choose(var max:integer;n,c,lev:integer);
  1090.   var i,j:integer;
  1091.   begin
  1092.     if n<max then begin
  1093.       for i:=1 to n do begin
  1094.         j:=Random(max)+1;
  1095.         with Things^[ThingIndex[j]] do begin
  1096.           Code:=c;
  1097.           if lev and (REP_ZERO+7)<>0 then Flags:=lev and 7;
  1098.           Flags:=Flags or REP_CONV or (lev and (REP_DEAF+REP_MULTI));
  1099.         end;
  1100.         ThingIndex[j]:=ThingIndex[max];
  1101.         dec(max);
  1102.       end;
  1103.       inc(RemappedThing,n);
  1104.     end
  1105.     else begin
  1106.       for i:=1 to max do with Things^[ThingIndex[i]] do begin
  1107.         Code:=c;
  1108.         if lev and (REP_ZERO+7)<>0 then Flags:=lev and 7;
  1109.         Flags:=Flags or REP_CONV or (lev and (REP_DEAF+REP_MULTI));
  1110.       end;
  1111.       inc(RemappedThing,max);
  1112.       max:=0;
  1113.     end;
  1114.   end;
  1115. procedure ReplaceThings(totobj:Integer);
  1116.   var repn   : integer;
  1117.       i,j,k,l: word;
  1118.       level  : word;
  1119.       once   : word;
  1120.       multi  : boolean;
  1121.       numobj : integer;
  1122.       amount : array[1..128] of word;
  1123.       numrep : integer;
  1124.       numabs : integer;
  1125.       iflev  : integer;
  1126.       runlev : integer;
  1127.       iflevs : array[0..16] of integer;
  1128.       condit : boolean;
  1129.       col    : integer;
  1130.   const glev : integer = 0;
  1131.   begin
  1132.     inc(glev);
  1133.     if debug then writeln('=== OBJECT CONVERSION, LEVEL ',glev);
  1134.     RandSeed:=RandomSeed;
  1135.     repn:=1;
  1136.     iflev:=0;
  1137.     runlev:=0;
  1138.     while repn<=NRepThing do begin
  1139.       numobj:=0;
  1140.       l:=RepThing^[repn];
  1141.       if l=REP_QELSE then begin
  1142.         inc(repn);
  1143.         if odd(iflev) or (iflev=0) then MyHalt(ERR_BADELSE);
  1144.         iflev:=iflev or 1;
  1145.         continue;
  1146.       end;
  1147.       if l=REP_QEND then begin
  1148.         inc(repn);
  1149.         if iflev<2 then MyHalt(ERR_BADENDIF);
  1150.         iflev:=iflevs[(iflev-2)div 2];
  1151.         if iflev<runlev then runlev:=iflev;
  1152.         continue;
  1153.       end;
  1154.       if l>=REP_QIF then inc(repn);
  1155.       if (runlev=iflev) and debug then begin
  1156.         write('SOURCE OBJECTS:          ');
  1157.         col:=1;
  1158.       end;
  1159.       while RepThing^[repn]<REP_FLAG do begin
  1160.         j:=RepThing^[repn];
  1161.         inc(repn);
  1162.         if RepThing^[repn] and REP_RANGE>0 then begin
  1163.           inc(repn);
  1164.           k:=RepThing^[repn];
  1165.           inc(repn);
  1166.         end
  1167.         else k:=j;
  1168.         once:=RepThing^[repn];
  1169.         inc(repn);
  1170.         level:=once and 7; {level 1 or 2 or 3}
  1171.         if level=0 then level:=7;
  1172.         multi:=once and REP_MULTI>0; {multiplayer flag}
  1173.         once:=once and REP_ALL;
  1174.         if runlev=iflev then begin
  1175.           if debug then begin
  1176.             if col<3 then write(#32#32)
  1177.             else writeln;
  1178.             col:=col mod 3+1;
  1179.             if j<>k then write('Objects #':18-LenNum(j)-LenNum(k),j,'-#',k)
  1180.             else begin
  1181.               i:=1;
  1182.               while (i<=NObjects) and ((Objects^[i].Code<>j) or not (Game1 in Objects^[i].Games)) do inc(i);
  1183.               if i<=NObjects then write(Objects^[i].Name:20)
  1184.               else write('Unknown object #':20-LenNum(j),j);
  1185.             end;
  1186.             numabs:=numobj;
  1187.           end;
  1188.           for i:=1 to totobj do with Things^[i] do
  1189.             if (Code>=j) and (Code<=k) and (Flags and level>0) and
  1190.                ((once=REP_ALL) or ((Flags xor once)and REP_CONV=0)) and
  1191.                (not multi or (Flags and REP_MULTI>0)) then begin
  1192.               inc(numobj);
  1193.               ThingIndex[numobj]:=i;
  1194.             end;
  1195.           if debug then begin
  1196.             numabs:=numobj-numabs;
  1197.             write('=',numabs,#32:4-LenNum(numabs));
  1198.           end;
  1199.         end;
  1200.       end;
  1201.       if (runlev=iflev) and debug then writeln;
  1202.       if l>=REP_QIF then begin
  1203.         i:=RepThing^[repn] and not REP_QIF;
  1204.         inc(repn);
  1205.         j:=iflev;
  1206.         iflevs[iflev div 2]:=iflev;
  1207.         iflev:=(iflev+2) and $FFFE;
  1208.         if runlev=j then begin
  1209.           l:=l and not REP_QIF;
  1210.           case l of
  1211.             0: condit:=numobj=i;
  1212.             1: condit:=numobj<>i;
  1213.             2: condit:=numobj<i;
  1214.             3: condit:=numobj<=i;
  1215.             4: condit:=numobj>i;
  1216.             5: condit:=numobj>=i;
  1217.           end;
  1218.           if debug then writeln('IF ',numobj,copy('= <>< <=> >=',l*2+1,2),i,condit:8);
  1219.           runlev:=iflev+1-ord(condit);
  1220.         end;
  1221.         continue;
  1222.       end;
  1223.  
  1224.       numrep:=RepThing^[repn]-REP_FLAG;
  1225.       inc(repn);
  1226.       if (numobj=0) or (numrep=0) then inc(repn,numrep*3)
  1227.       else begin
  1228.         numabs:=0;
  1229.         j:=repn+1;
  1230.         for i:=1 to numrep do begin
  1231.           k:=RepThing^[j];
  1232.           if k=0 then k:=REP_FLAG
  1233.           else begin
  1234.             if k>=REP_FLAG then k:=(longint(numobj)*(k-REP_FLAG)+50)div 100;
  1235.             inc(numabs,k);
  1236.           end;
  1237.           amount[i]:=k;
  1238.           inc(j,3);
  1239.         end;
  1240.  
  1241.         if numabs>numobj then begin
  1242.           k:=numobj;
  1243.           for i:=1 to numrep do begin
  1244.             j:=amount[i];
  1245.             if j<REP_FLAG then begin
  1246.               if numabs=0 then amount[i]:=0
  1247.               else amount[i]:=(longint(j)*k+numabs div 2)div numabs;
  1248.               dec(numabs,j);
  1249.               dec(k,amount[i]);
  1250.             end;
  1251.           end;
  1252.           numabs:=numobj;
  1253.         end;
  1254.  
  1255.         numabs:=numobj-numabs;
  1256.         j:=0;
  1257.         for i:=1 to numrep do if amount[i]>=REP_FLAG then inc(j);
  1258.         for i:=1 to numrep do if amount[i]>=REP_FLAG then begin
  1259.           amount[i]:=(numabs+j div 2)div j;
  1260.           dec(numabs,amount[i]);
  1261.           dec(j);
  1262.         end;
  1263.  
  1264.         if debug then begin
  1265.           write('CONVERTED OBJECTS:       ');
  1266.           col:=1;
  1267.         end;
  1268.         for i:=1 to numrep do begin
  1269.           j:=RepThing^[repn];
  1270.           if debug then begin
  1271.             if col<3 then write(#32#32)
  1272.             else writeln;
  1273.             col:=col mod 3+1;
  1274.             k:=1;
  1275.             while (k<=NObjects) and ((Objects^[k].Code<>j) or not (Game2 in Objects^[k].Games)) do inc(k);
  1276.             if k<=NObjects then write(Objects^[k].Name:20)
  1277.             else write('Unknown object #':20-LenNum(j),j);
  1278.             write('=',amount[i],#32:4-LenNum(amount[i]));
  1279.           end;
  1280.           Choose(numobj,amount[i],j,RepThing^[repn+2]);
  1281.           inc(repn,3);
  1282.         end;
  1283.         if debug then writeln;
  1284.       end;
  1285.     end;
  1286.     for i:=1 to totobj do with Things^[i] do Flags:=Flags and not REP_CONV;
  1287.   end;
  1288.  
  1289. function IdentifyGame(s:string;default:GAMETYPE):GAMETYPE;
  1290.   begin
  1291.     if (s='D') or (s='DOOM') then IdentifyGame:=GT_DOOM
  1292.     else if (s='D2') or (s='DOOM2') then IdentifyGame:=GT_DOOM2
  1293.     else if (s='H') or (s='HERETIC') then IdentifyGame:=GT_HERETIC
  1294.     else IdentifyGame:=default;
  1295.   end;
  1296.  
  1297. function RemapStatus:integer;
  1298.   var s:string;
  1299.       i,j:integer;
  1300.   begin
  1301.     s:=GetSymbol(SYM_REMAP);
  1302.     if s='' then RemapStatus:=0
  1303.     else begin
  1304.       val(s,i,j);
  1305.       if j<>0 then i:=1;
  1306.       RemapStatus:=i;
  1307.     end;
  1308.   end;
  1309.  
  1310. procedure SetMusicName(var d:WAD_ENTRY;j:integer);
  1311.   begin
  1312.     if (j>0) and (j<=99) then with d do case Game2 of
  1313.       GT_DOOM2: begin
  1314.           if j<=32 then Name:=MUS2NAMES[j]
  1315.           else begin
  1316.             Name:='D_MUSxy'#0;
  1317.             Name[6]:=chr(j div 10+48);
  1318.             Name[7]:=chr(j mod 10+48);
  1319.           end;
  1320.         end;
  1321.       GT_DOOM: begin
  1322.           Name:='D_ExMy'#0#0;
  1323.           Name[4]:=chr((j-1) div 9+49);
  1324.           Name[6]:=chr((j-1) mod 9+49);
  1325.         end;
  1326.       GT_HERETIC: begin
  1327.           Name:='MUS_ExMy';
  1328.           Name[6]:=chr((j-1) div 9+49);
  1329.           Name[8]:=chr((j-1) mod 9+49);
  1330.         end;
  1331.     end;
  1332.   end;
  1333.  
  1334. procedure Process;
  1335.   var f       : file;
  1336.       fpos    : longint;
  1337.       head    : WAD_HEADER;
  1338.       num     : integer;
  1339.       i,j,k,l : integer;
  1340.       save    : boolean;
  1341.       levpos  : array[1..99] of integer;
  1342.       levmap  : array[1..99] of integer;
  1343.       muspos  : array[1..99] of integer;
  1344.       remap   : integer;
  1345.       mix     : boolean;
  1346.   begin
  1347.     save:=False;
  1348.     mix:=GetSymbol(SYM_MIX)<>'';
  1349.     Game1:=IdentifyGame(GetSymbol(SYM_FROM),GT_DOOM);
  1350.     Game2:=IdentifyGame(GetSymbol(SYM_TO),GT_DOOM2);
  1351.     remap:=RemapStatus;
  1352.     SetRandomSeed;
  1353.     if DestName<>'' then begin
  1354.       CopyDest;
  1355.       SourceName:=DestName;
  1356.     end
  1357.     else DestName:=SourceName;
  1358.     Assign(f,DestName);
  1359.     FileMode:=2; {open for read/write}
  1360.     ErrStr:=DestName;
  1361.     Reset(f,1);
  1362.     if ioresult<>0 then MyHalt(ERR_OPEN);
  1363.     BlockR(f,head,sizeof(head));
  1364.     if (head.Sig<>PWAD_SIG) and (head.Sig<>IWAD_SIG) then MyHalt(ERR_PWAD);
  1365.     num:=head.Num;
  1366.     if num>MAXENTRY then MyHalt(ERR_TOOENTRY);
  1367.     FSeek(f,head.Start);
  1368.     BlockR(f,Dirlist^,num*sizeof(WAD_ENTRY));
  1369.  
  1370.     write('Processing with ');
  1371.     write('REMAP=');
  1372.     if remap=0 then write('OFF') else write('ON(',remap,')');
  1373.     write(',MIX=');
  1374.     if mix then write('ON') else write('OFF');
  1375.     writeln(',SEED=',RandSeed);
  1376.  
  1377.     for i:=1 to 99 do begin
  1378.       levmap[i]:=0;
  1379.       muspos[i]:=0;
  1380.     end;
  1381.     k:=0;
  1382.     for i:=1 to num do with Dirlist^[i] do begin
  1383.       if copy(Name,1,3)='MAP' then begin
  1384.         j:=(ord(name[4])-48)*10+ord(name[5])-48;
  1385.         if (j>0) and (j<=99) then begin
  1386.           levpos[j]:=i;
  1387.           levmap[j]:=j;
  1388.         end;
  1389.       end
  1390.       else if (Name[1]='E') and (Name[3]='M') and (Name[5]=#0) then begin
  1391.         j:=(ord(Name[2])-49)*9+ord(Name[4])-48;
  1392.         if (j>0) and (j<=99) then begin
  1393.           levpos[j]:=i;
  1394.           levmap[j]:=j;
  1395.         end;
  1396.       end
  1397.       else if copy(Name,1,3)='MUS' then begin
  1398.         if mix then begin inc(k);j:=k; end
  1399.         else j:=(ord(Name[6])-49)*9+ord(Name[8])-48;
  1400.         if (j>0) and (j<=99) then muspos[j]:=i;
  1401.       end
  1402.       else if copy(Name,1,5)='D_MUS' then begin
  1403.         if mix then begin inc(k);j:=k; end
  1404.         else j:=(ord(name[6])-48)*10+ord(name[7])-48;
  1405.         if (j>0) and (j<=99) then muspos[j]:=i;
  1406.       end
  1407.       else if (Name[1]='D') and (Name[2]='_') then begin
  1408.         if (Name[3]='E') and (Name[5]='M') then begin
  1409.           if mix then begin inc(k);j:=k; end
  1410.           else j:=(ord(Name[4])-49)*9+ord(Name[6])-48
  1411.         end
  1412.         else begin
  1413.           j:=32;
  1414.           while (j>0) and (MUS2NAMES[j]<>Name) do dec(j);
  1415.           if mix and (j>0) then begin inc(k);j:=k; end
  1416.         end;
  1417.         if (j>0) and (j<=99) then muspos[j]:=i;
  1418.       end;
  1419.     end;
  1420.     if remap>0 then
  1421.       for i:=1 to 99 do if levmap[i]>0 then begin
  1422.         levmap[i]:=remap;
  1423.         inc(remap);
  1424.       end;
  1425.     for i:=1 to 99 do if levmap[i]>0 then with Dirlist^[levpos[i]] do begin
  1426.       j:=levmap[i];
  1427.       case Game2 of
  1428.         GT_DOOM2: begin
  1429.             Name:='MAPxy'#0#0#0;
  1430.             Name[4]:=chr(j div 10+48);
  1431.             Name[5]:=chr(j mod 10+48);
  1432.           end;
  1433.         GT_DOOM,GT_HERETIC: begin
  1434.             Name:='ExMy'#0#0#0#0;
  1435.             Name[2]:=chr((j-1) div 9+49);
  1436.             Name[4]:=chr((j-1) mod 9+49);
  1437.           end;
  1438.       end;
  1439.       inc(RemappedLev);
  1440.       save:=True;
  1441.     end;
  1442.     if mix then begin {mix musics}
  1443.       Randomize;
  1444.       for i:=1 to k-1 do begin
  1445.         j:=Random(k-i)+i;
  1446.         l:=muspos[i];
  1447.         muspos[i]:=muspos[j];
  1448.         muspos[j]:=l;
  1449.       end;
  1450.       for i:=1 to k do begin
  1451.         SetMusicName(Dirlist^[muspos[i]],i);
  1452.         inc(RemappedMus);
  1453.         save:=True;
  1454.       end;
  1455.     end
  1456.     else for i:=1 to 99 do if muspos[i]>0 then begin
  1457.       SetMusicName(Dirlist^[muspos[i]],levmap[i]);
  1458.       inc(RemappedMus);
  1459.       save:=True;
  1460.     end;
  1461.  
  1462.     if NRepDirs>0 then begin
  1463.       for i:=1 to num do with Dirlist^[i] do
  1464.         inc(RemappedDirs,RemapName(RepDirs^,Name,NRepDirs));
  1465.     end;
  1466.  
  1467.     for i:=1 to num do with Dirlist^[i] do begin
  1468.       if (Name=N_LINEDEFS) and (NRepLAct>0) then begin
  1469.         FSeek(f,Start);
  1470.         k:=Size div sizeof(LINEDEF);
  1471.         while k>0 do begin
  1472.           fpos:=FilePos(f);
  1473.           l:=MAXLINE;
  1474.           if l>k then l:=k;
  1475.           BlockR(f,Linedefs^,l*sizeof(LINEDEF));
  1476.           for j:=1 to l do
  1477.             inc(RemappedLAct,RemapNum(RepLAct^,Linedefs^[j].Action,NRepLAct));
  1478.           FSeek(f,fpos);
  1479.           BlockW(f,Linedefs^,l*sizeof(LINEDEF));
  1480.           dec(k,l);
  1481.         end;
  1482.       end
  1483.       else if (Name=N_SECTORS) and (NRepSAct+NRepFloor>0) then begin
  1484.         FSeek(f,Start);
  1485.         k:=Size div sizeof(SECTOR);
  1486.         while k>0 do begin
  1487.           fpos:=FilePos(f);
  1488.           l:=MAXSECT;
  1489.           if l>k then l:=k;
  1490.           BlockR(f,Sectors^,l*sizeof(SECTOR));
  1491.           if NRepSAct>0 then
  1492.             for j:=1 to l do
  1493.               inc(RemappedSAct,RemapNum(RepSAct^,Sectors^[j].Action,NRepSAct));
  1494.           if NRepFloor>0 then
  1495.             for j:=1 to l do
  1496.               inc(RemappedFloor,RemapName(RepFloor^,Sectors^[j].Floor,NRepFloor)+
  1497.                   RemapName(RepFloor^,Sectors^[j].Ceiling,NRepFloor));
  1498.           FSeek(f,fpos);
  1499.           BlockW(f,Sectors^,l*sizeof(SECTOR));
  1500.           dec(k,l);
  1501.         end;
  1502.       end
  1503.       else if (Name=N_SIDEDEFS) and (NRepText>0) then begin
  1504.         FSeek(f,Start);
  1505.         k:=Size div sizeof(SIDEDEF);
  1506.         while k>0 do begin
  1507.           fpos:=FilePos(f);
  1508.           l:=MAXSIDE;
  1509.           if l>k then l:=k;
  1510.           BlockR(f,Sidedefs^,l*sizeof(SIDEDEF));
  1511.           for j:=1 to l do
  1512.             inc(RemappedText,RemapName(RepText^,Sidedefs^[j].UpT,NRepText)+
  1513.                 RemapName(RepText^,Sidedefs^[j].LoT,NRepText)+
  1514.                 RemapName(RepText^,Sidedefs^[j].MidT,NRepText));
  1515.           FSeek(f,fpos);
  1516.           BlockW(f,Sidedefs^,l*sizeof(SIDEDEF));
  1517.           dec(k,l);
  1518.         end;
  1519.       end
  1520.       else if (Name=N_THINGS) and (NRepThing>0) then begin
  1521.         FSeek(f,Start);
  1522.         k:=Size div sizeof(THING);
  1523.         BlockR(f,Things^,k*sizeof(THING));
  1524.         ReplaceThings(k);
  1525.         FSeek(f,Start);
  1526.         BlockW(f,Things^,k*sizeof(THING));
  1527.       end;
  1528.     end;
  1529.  
  1530.     if save or (RemappedDirs>0) then begin
  1531.       FSeek(f,head.Start);
  1532.       BlockW(f,Dirlist^,num*sizeof(WAD_ENTRY));
  1533.     end;
  1534.  
  1535.     Close(f);
  1536.     writeln('Remapped  LEVELS:',RemappedLev:4,'     MUSICS:',RemappedMus:4,
  1537.             '     TEXTURES:',RemappedText:4,'     FLOORS  :',RemappedFloor:4);
  1538.     writeln('          THINGS:',RemappedThing:4,'     NAMES :',RemappedDirs:4,
  1539.             '     LACTIONS:',RemappedLAct:4,'     SACTIONS:',RemappedSAct:4);
  1540.   end;
  1541.  
  1542. begin
  1543.   Initialize;
  1544.   Parse;
  1545.   if (SourceName='') or (GetSymbol(SYM_HELP)<>'') then Help
  1546.   else Process;
  1547. end.
  1548.