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