hex.pas

{The main program that "wraps it all together". Doesn't
 do much, except initing some stuff and reading the ini
 file and...well, stuff.

 Btw, the INI file handling is REALLY damn ugly.
}
program HEXen_hack_editor;
{$g+,o-,n+,e-,x+,t-,v-,q-,r-,s-,f-,i-,a-}

{-$define debug}
{$ifdef debug}{$d+,y+,l+}
{$else}{$d-,y-,l-}{$endif}
{$DEFINE RELEASE}       { disable beta stuff/enable CRC check }
{$DEFINE FANCYPIC}      { scroller-on-pic versus normal pic   }

uses
  dos,objects,
  hexunit,hexdecl,
  utils,xlat,crc,
  ini,cmdline,
  vocdecl,pcx
{$IFDEF RELEASE}
  ,runCRC
{$ENDIF}
  ;

const inipath:string[7]='HEX.INI';
type
  tpalette=array[0..767]of byte;
  paletteptr=^tpalette;
var
  txtfile:text;
  line,dummy:string;
  inilink:ini.plink;
  bigBadCrc:longint;
  diagMode:boolean;
  cnt:byte;

{ ***** "ini file" procedures ***** }
procedure _oldexe(fn:string);  far;
begin
  if not(utils.fex(fn))then error('OLDEXE not found',true);
  oldexe:=fn;
end;

procedure _wadfile(fn:string); far;
begin
  if not(utils.fex(fn))then error('WADFILE not found',true);
  wadfile:=fn;
end;

procedure _hackexe(fn:string); far;
var a,b:pBufStream; ch:char;
begin
  if not(utils.fex(fn))then
  begin
    writeln('hacked exe ',fn,' not found!');
    writeln('do you want the original hexen.exe');
    writeln('copied to ',fn,'?');
    write('[Y/N] >');
    repeat
      ch:=upcase(crt.readkey);
    until(ch in ['Y','N']); writeln(ch);
    if(ch='N')then halt;
    new(a,init(oldexe,stOpen,64000));
    new(b,init(fn,stCreate,64000));

    if(a^.status<>stOk)or(b^.status<>stOk)then
    begin
      writeln('error creating copy streams.');
      dispose(a,done); dispose(b,done);
      halt;
    end;
    b^.copyFrom(a^,a^.getsize);
    dispose(a,done);
    dispose(b,done);
    writeln(#13#10,'File copied, no errors.');
  end;
  hackexe:=fn;
end;

procedure _tnfile(fn:string);  far;
begin
  tnfile:=fn;
end;

procedure _sndfile(fn:string);  far;
begin
  sndfile:=fn;
end;

procedure _s_saver(fn:string); far;
begin
  s_saver:=fn;
end;

procedure _comcom(fn:string);  far;
begin
  comcom:=fn;
end;

procedure _qfile(fn:string); far;
begin
  q_file:=fn;
end;

procedure _nosound(parm:string); far;
begin
  translate(parm,lower);
  if not((parm='true')or(parm='false'))then
     error('Must be "true" or "false"',true);
  nosound:=parm='true';
end;

procedure _ssract(parm:string); far;
begin
  translate(parm,lower);
  if not((parm='true')or(parm='false'))then
     error('Must be "true" or "false"',true);
  ssr_act:=parm='true';
end;

procedure _ssrtime(parm:string); far;
var tmp:word;
begin
  tmp:=utils.str2word(parm);
  if(tmp=0)then error('Invalid numeric value',true);
  ssr_time:=tmp;
end;

procedure _cmdline(arg:string); far;
var cnt:byte;
begin
  cnt:=1;
  repeat
    if(arg[cnt+1] in ['-','0'..'9'])then
    begin
      insert(' ',arg,cnt+1);
      inc(cnt);
    end;
    inc(cnt);
  until(cnt=utils.slen(arg));
  hexunit.cmdline:=arg;
end;

procedure _titlepic(arg:string); far;
var tmp:word;
begin
  tmp:=utils.str2word(arg);
  show_pic:=(tmp>0);
end;

procedure _hexenver(arg:string); far;
begin
  case(arg[1])of
    '0':_VERHEXEN:=0;
    '1':_VERHEXEN:=1;
    '2':_VERHEXEN:=2;
    else begin
      writeln('Unknown hexen version specified...Autoscanning');
    end;
  end;
end;

{ really boring "slave work" stuff follows:
  this is so the techy users of HEX with big
  problemos can set up various stuff themselves.
  The routines expect their paremeters as
  'offset,number'. The routines accepts both
  hex and dec, and hex can be written as pascal,
  C or assembler style (prefix $,prefix 0x,appended h).
}

function str2num(s:string):longint;
begin
  { this function is actually okay }
  translate(s,lower);
  if(copy(s,1,2)='0x')then
  begin
    delete(s,1,1); s[1]:='$';
  end;
  if(s[slen(s)]='h')then
  begin
    delete(s,slen(s),1);
    insert('$',s,1);
  end;
  str2num:=str2long(s);
end;

function getTok(s:string;w:boolean):longint;
begin
  case(w)of
    false:getTok:=str2num(copy(s,1,pos(',',s)-1));
    true:getTok:=str2num(copy(s,pos(',',s)+1,255));
  end;
end;

procedure _usecustom(arg:string); far;
begin
  translate(arg,lower);
  if not((arg='true')or(arg='false'))then
     error('Must be "true" or "false"',true);
  useCustom:=arg='true';
  if(useCustom)then
  begin
    writeln('WARNING: ***custom offsets/numbers used!***');
    _VERHEXEN:=2;
  end;
end;

procedure _things(arg:string); far;
begin
  if(useCustom)then
  begin
    if(pos(',',arg)=0)then error('invalid line. Check readme.txt',true);
    hexenOfs[_VERHEXEN,1]:=getTok(arg,false);
    hexenNum[_VERHEXEN,1]:=getTok(arg,true);
  end;
end;

procedure _sprites(arg:string); far;
begin
  if(useCustom)then
  begin
    if(pos(',',arg)=0)then error('invalid line. Check readme.txt',true);
    hexenOfs[_VERHEXEN,2]:=getTok(arg,false);
    hexenNum[_VERHEXEN,2]:=getTok(arg,true);
  end;
end;

procedure _frames(arg:string); far;
begin
  if(useCustom)then
  begin
    if(pos(',',arg)=0)then error('invalid line. Check readme.txt',true);
    hexenOfs[_VERHEXEN,3]:=getTok(arg,false);
    hexenNum[_VERHEXEN,3]:=getTok(arg,true);
  end;
end;

procedure _noises(arg:string); far;
begin
  if(useCustom)then
  begin
    if(pos(',',arg)=0)then error('invalid line. Check readme.txt',true);
    hexenOfs[_VERHEXEN,4]:=getTok(arg,false);
    hexenNum[_VERHEXEN,4]:=getTok(arg,true);
  end;
end;

procedure _weapons(arg:string); far;
begin
  if(useCustom)then
  begin
    if(pos(',',arg)=0)then error('invalid line. Check readme.txt',true);
    hexenOfs[_VERHEXEN,5]:=getTok(arg,false);
    hexenNum[_VERHEXEN,5]:=getTok(arg,true);
  end;
end;

{ SB stuff }

procedure _sbPort(arg:string); far;
begin
  sbPort:=str2num(arg);
end;

procedure _sbIrq(arg:string); far;
begin
  sbIrq:=str2num(arg);
end;

procedure _sbDma(arg:string); far;
begin
  sbDma:=str2num(arg);
end;

{ *****                       ***** }

{$IFDEF FANCYPIC}
procedure _hexfnt; external; {$L res\hexfnt.obj}

procedure showpic(fn:string);
var
  sprite,sprite2:pointer;
  pscr:pointer; wscr:word;

  pal:array[0..767]of byte;
  sx,sy,x,x2:word;
  dir:boolean;

procedure grabit;
const
  bits  :array[0..7]of byte=(128,64,32,16,8,4,2,1);
  coltab:array[0..7]of byte=(210,211,212,213,214,215,216,217);
  scrt  :string = 'HEX 0.84 final'; {uh, this should somehow be taken from HEX.DEF...}
var
  fseg,fofs:word;
  col,i,c,cp:byte;
begin
  fseg:=seg(_hexfnt); fofs:=ofs(_hexfnt);
  sx:=8*length(scrt); sy:=8;
  getmem(sprite,sx*sy); fillchar(sprite^,sx*sy,0);
  getmem(sprite2,sx*sy);fillchar(sprite2^,sx*sy,0);
  for c:=0 to length(scrt)-1 do
  begin
    for i:=0 to 7 do
      for cp:=0 to 7 do
      begin
        if(mem[fseg:fofs+(ord(scrt[c+1])*8)+i]and bits[cp]<>0)then
          col:=coltab[i] else col:=0;
        mem[$A000:(i*320)+(c*8)+cp]:=col;
      end;
  end;
  gru.grabsprite(0,0,$A000,sx-1,sy-1,sprite^);
end;
var y:word;
begin
  grabit;
  asm mov ax,13h; int 10h end;

  getmem(pscr,64000); wscr:=seg(pscr^); gru.clear386(wscr,0);
  load_pcx(fn,pal,wscr); setpcxpal(pal);

  x2:=320-sx; x:=x2;
  dir:=false;
  repeat
    y:=round(15+(sin(x/5.4))*7);
    gru.grabsprite(x,y,wscr,sx-1,sy-1,sprite2^);
    gru.drawsprite(x,y,wscr,sx-1,sy-1,0,sprite^);
    gru.flip386(wscr,$A000);
    gru.vret;
    gru.drawsprite(x,y,wscr,sx-1,sy-1,255,sprite2^);

    case(dir)of
      false:if(x>0)then dec(x) else dir:=true;
      true:if(x<x2)then inc(x) else dir:=false;
    end;
  until crt.keypressed;
  asm xor ax,ax; int 16h; mov ax,3; int 10h end;
  freemem(sprite,sx*sy); freemem(sprite2,sx*sy);
  freemem(pscr,64000);
end;
{$ELSE}
procedure showpic(fn:string); assembler;
var pal:array[0..767]of byte;
asm
  { set 320x200x256 }
  mov  ax,13h
  int  10h
  { load in the PCX pic }
  les  di,fn
  push es
  push di
  lea  di,pal
  push ss
  push di
  push $A000
  call load_pcx
  { set the correct palette }
  mov  dx,968
  xor  ax,ax
  out  dx,al
  inc  dx
  mov  di,offset pal
  add  di,bp
  mov  cx,768
  @@b:
  mov  al,ss:[di]
  shr  al,2
  out  dx,al
  inc  di
  dec  cx
  jnz  @@b
  { wait for keystroke }
  xor ax,ax
  int 16h
  mov ax,3
  int 10h
end;
{$ENDIF}

label SOUND_STUFF_DONE;

begin
{$IFDEF RELEASE}
  runCRC_check;
{$ENDIF}
  close(output); assign(output,''); rewrite(output);
  fsplit(paramstr(0),hexdir,dummy,dummy);
{ Read in the INI FILE }
  assign(txtfile,concat(hexdir,inipath));
  {$i-} reset(txtfile); {$i+}
  if(ioresult<>0)then error(concat('could not open ',inipath),false);
  currentline:=0; halt_on_unknown:=true; ininame:=inipath;
  ini_ini(inilink);
  ini_add(inilink,'oldexe'  ,_oldexe);
  ini_add(inilink,'wadfile' ,_wadfile);
  ini_add(inilink,'hackexe' ,_hackexe);
  ini_add(inilink,'tnfile'  ,_tnfile);
  ini_add(inilink,'sndfile' ,_sndfile);
  ini_add(inilink,'s_saver' ,_s_saver);
  ini_add(inilink,'comcom'  ,_comcom);
  ini_add(inilink,'q_file'  ,_qfile);
  ini_add(inilink,'nosound',_nosound);
  ini_add(inilink,'ssr_act' ,_ssract);
  ini_add(inilink,'ssr_time',_ssrtime);
  ini_add(inilink,'cmdline', _cmdline);
  ini_add(inilink,'titlepic',_titlepic);
  ini_add(inilink,'hexenver',_hexenver);
  ini_add(inilink,'usecustom',_usecustom);
  ini_add(inilink,'things',_things);
  ini_add(inilink,'sprites',_sprites);
  ini_add(inilink,'frames',_frames);
  ini_add(inilink,'sounds',_noises);
  ini_add(inilink,'weapons',_weapons);
  ini_add(inilink,'sbport',_sbport);
  ini_add(inilink,'sbirq',_sbirq);
  ini_add(inilink,'sbdma',_sbdma);
  while not(eof(txtfile))do
  begin
    readln(txtfile,line);
    feed(inilink,line);
  end;
  close(txtfile);
{ writeln hexen version thingie }
  if(_VERHEXEN=$ff)then
  begin
    bigBadCrc:=crc32_file(oldexe);
    if(bigBadCrc=_HEX10CRC)then _VERHEXEN:=0 else
    if(bigBadCrc=_HEX11CRC)then _VERHEXEN:=1 else
      _VERHEXEN:=$ff;
  end;
  if(_VERHEXEN<>$ff)then
  begin
    case(_VERHEXEN)of
      0,1:writeln('hexen version 1.',_VERHEXEN,' (',oldexe,')')
      else writeln('unknown/custom hexen version');
    end;
  end else
  begin
    writeln('***Couldn''t determine HEXEN version. Defaulted to 1.0***');
    writeln('Start hex up in diagnostic mode (see readme.txt)');
    writeln('---');
  end;
  case(_VERHEXEN)of
    0,1,2:begin
      tofs:=HEXENOFS[_VERHEXEN,1];
      sofs:=HEXENOFS[_VERHEXEN,2];
      fofs:=HEXENOFS[_VERHEXEN,3];
      nofs:=HEXENOFS[_VERHEXEN,4];
      wofs:=HEXENOFS[_VERHEXEN,5];
      numthings:=HEXENNUM[_VERHEXEN,1];
      numsnames:=HEXENNUM[_VERHEXEN,2];
      numframes:=HEXENNUM[_VERHEXEN,3];
      numsounds:=HEXENNUM[_VERHEXEN,4];
      numweapns:=HEXENNUM[_VERHEXEN,5];
    end;
  end;
  { check the cmdline for overrides }
  if(cmdLine_fullFlagThere('NOPIC'))then show_pic:=false;
  if(cmdLine_fullFlagThere('DIAG'))then diagMode:=true else diagMode:=false;

  { diagnostics mode??? }
  if(diagMode)then
  begin
    writeln('------ DIAGNOSTIC MODE ------');
    writeln('-----------------------------');
    writeln('*** HEXEN RELATED VARS ***');
    writeln('       ³hexen 1.0 ³hexen 1.1 ³current ');
    writeln('ÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄ');
    writeln('T. OFS ³ ',hexlong(HEXENOFS[0,1]),' ³ ',hexlong(HEXENOFS[1,1]),' ³',hexlong(tofs));
    writeln('S. OFS ³ ',hexlong(HEXENOFS[0,2]),' ³ ',hexlong(HEXENOFS[1,2]),' ³',hexlong(sofs));
    writeln('F. OFS ³ ',hexlong(HEXENOFS[0,3]),' ³ ',hexlong(HEXENOFS[1,3]),' ³',hexlong(fofs));
    writeln('S. OFS ³ ',hexlong(HEXENOFS[0,4]),' ³ ',hexlong(HEXENOFS[1,4]),' ³',hexlong(nofs));
    writeln('W. OFS ³ ',hexlong(HEXENOFS[0,5]),' ³ ',hexlong(HEXENOFS[1,5]),' ³',hexlong(wofs));
    writeln('ÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄ');
    writeln('things ³ ',hexlong(HEXENNUM[0,1]),' ³ ',hexlong(HEXENNUM[1,1]),' ³',hexlong(numthings));
    writeln('snames ³ ',hexlong(HEXENNUM[0,2]),' ³ ',hexlong(HEXENNUM[1,2]),' ³',hexlong(numsnames));
    writeln('frames ³ ',hexlong(HEXENNUM[0,3]),' ³ ',hexlong(HEXENNUM[1,3]),' ³',hexlong(numframes));
    writeln('sounds ³ ',hexlong(HEXENNUM[0,4]),' ³ ',hexlong(HEXENNUM[1,4]),' ³',hexlong(numsounds));
    writeln('weapns ³ ',hexlong(HEXENNUM[0,5]),' ³ ',hexlong(HEXENNUM[1,5]),' ³',hexlong(numweapns));
    writeln('*** MISC ***');
    writeln('hex version ',version,', ',compiled);
    writeln('memavail:   ',memavail);
    writeln('CRC:        ',hexlong(bigBadCrc));
    writeln('*** FILES ***');
    writeln('oldexe:     ',oldexe);
    writeln('hackexe:    ',hackexe);
    writeln('wadfile:    ',wadfile);

    writeln('-----------------------------');
    writeln('-----------------------------');
    halt;
  end;

  if(nosound)then
  begin
    writeln('-nosound parameter specified');
    goto SOUND_STUFF_DONE; { A GOTO! }
  end;
  if(sbPort=0)and(sbIrq=0)and(sbDma=0)then
  begin
    line:='';
    if(envCount>1)then
    begin
      for cnt:=1 to envCount do
        if(pos('BLASTER',envStr(cnt))=1)then
        begin
          line:=envStr(cnt);
          break;
        end;
    end;
    if(line='')then
    begin
      writeln('Sound Blaster parms not set, setting to default');
      sbPort:=$220;
      sbIrq:=5;
      sbDma:=1;
    end else
    begin
      { parse stuff from blaster line }
      delete(line,1,8); translate(line,lower);
      write('using BLASTER env. var...');
      if(pos('a',line)>0)then sbPort:=str2long(concat('$',copy(line,pos('a',line)+1,3)));
      if(pos('i',line)>0)then sbIrq:=str2long(copy(line,pos('i',line)+1,1));
      if(pos('d',line)>0)then sbDma:=str2long(copy(line,pos('d',line)+1,1));
    end;
  end;

  write('SB at port ',hexword(sbPort),'h, irq ',sbIrq,', dma ',sbDma,': ');
  if(reset_dsp(sbPort))then
    writeln('found')else writeln('not found');

{ A LABEL! - seemed cleaner than a BIG "it not(nosound)then ..." block }
SOUND_STUFF_DONE:


{ Read in the THING NAMES. }
  write('Reading and sorting ',tnfile,'...');
  assign(txtfile,tnfile);
  {$i-} reset(txtfile); {$i+}
  if(ioresult<>0)then error(concat(' could not open ',tnfile,'.'),false);
  while not(eof(txtfile))do
  begin
    readln(txtfile,line);
    names.addsymb(names.symbol,line,false);
  end;
  close(txtfile);
  write('R');
  names.data_copy2(names.symbol,names.symbol2); write('C');
  names.data_sort(names.symbol2); writeln('S');
{ read in the sound stuff}
  write('reading ',sndfile,'...');
  assign(txtfile,sndfile);
  {$i-} reset(txtfile); {$i+}
  if(ioresult<>0)then error(concat(' could not open ',sndfile,'.'),false);
  while not(eof(txtfile))do
  begin
    readln(txtfile,line);
    dummy:=copy(line,pos('=',line)+1,255); delete(line,pos('=',line),255);
    link2.link_add(link2.snd,line,dummy);
  end;
  close(txtfile);
  writeln('done');
{ Show the intro-picture }
  if(show_pic)and(utils.fex(concat(hexdir,'hex.pcx')))then showpic(concat(hexdir,'hex.pcx'));
{ ...Misc... }
  getdir(0,startdir);
  fsplit(oldexe,hexendir,dummy,dummy);
  utils.rlast(hexendir,'\');

  writeln(defline);  { Writeln defline from "compiled.pas"    }
  writeln(compiled); { Writeln time/date of compilation       }
  randomize;         { so we get _random_ quotes...           }
  startupHex;        { - fire it up!                          }
end.