hexdecl.pas

{This has some of the more "lowlevel" HEX things. Probably
 the only source file worth keeping anything from :-).
}
unit hexdecl;
{$g-,o-,n-,e-,l-,y-,d-,x+,t-,v-,q-,r-,s-}
{$ifdef debug}{$d+,y+,l+}
{$else}{$d-,y-,l-}{$endif}

INTERFACE

uses crt,utils,strings,streams,objects;

const
  { Typed number constants. Can be changed using the INI file. }
  textcol:byte=23;

{ HEXEN identification stuff }
  _VERHEXEN:byte=$ff;        { 0=V1.0, 1=V1.1, FF=autodetect }
  _HEX10CRC=$32d27bdf;       { HEXEN 1.0 32-bit CRC }
  _HEX11CRC=$bbc55df2;       { HEXEN 1.1 32-bit CRC }

  tofs:longint=0; numthings:word=0; { things  }
  sofs:longint=0; numsnames:word=0; { sprites }
  fofs:longint=0; numframes:word=0; { frames  }
  nofs:longint=0; numsounds:word=0; { noises  }
  wofs:longint=0; numweapns:word=0; { weapons }

  { thing,sprite,frame,noise,weapon }
  HEXENOFS:array[0..2,1..5]of longint=
  (($c1cd0,$a8bbc,$ae7f0,$cd4d4,$cc104),
   ($bfcc4,$a7428,$ac57c,$cb28c,$ca0fc),
   (0,0,0,0,0));
  { things,snames,frames,noises,weapons }
  HEXENNUM:array[0..2,1..5]of longint=
  ((397,300,2824,244,15),
   (397,300,2845,244,15),
   (0,0,0,0,0));

{ weapon names }
  wnames:array[0..15]of string[13]=
  ('gauntlets','mace','wand','pig(1)',
   'axe','serpent staff','frost shards','pig(2)',
   'hammer','firestorm','arc of death','pig(3)',
   'quietus','wraithverge','bloodscourge','pig(4)');
{ misc. stuff }
  patch_string:string[15]='HEX patch file'#26;

{ size of crunched screens }
  siz1=2113;                 { bitfields 1  }
  siz2=2144;                 { bitfields 2  }
  siz3=2415;                 { frame table  }
  siz4=1550;                 { help screen  }
  siz5=577;                  { misc screen  }

type
{
  Guide to the thing entry fields:
  the starting character usually tells you what
  kind of entry it is. if it starts with f_
  it's a frame, with s_ it's a sound, else
  it probably belongs under the misc category ;)
}
  tchar4=array[1..4]of char; { used for sprite names }
  tthing=record              { hexen thing structure }
    tid:longint;             { thing map ID          }
    f_initial:longint;       { initial frame         }
    hitp:longint;            { hit points/health     }
    f_moving:longint;        { first moving frame    }
    s_alert:longint;         { alert sound (wakeup)  }
    reac:longint;            { reaction time         }
    s_attack:longint;        { attacking sound       }
    f_injury:longint;        { injury frame (hurt)   }
    painc:longint;           { pain chance           }
    s_pain:longint;          { pain sound            }
    f_closeatt:longint;      { close attack frame    }
    f_faratt:longint;        { far attack frame      }
    f_burning:longint;       { burning frame         }
    f_death:longint;         { death frame           }
    f_exploding:longint;     { exploding death frame }
    s_death:longint;         { death sound           }
    speed:longint;           { speed  (div 65536)    }
    width:longint;           { width  (div 65536)    }
    height:longint;          { height (div 65536)    }
    mass:longint;            { mass of monster       }
    misdam:longint;          { missile damage        }
    s_action:longint;        { action(wander?) sound }
    bit1:longint;            { normal bitfield       }
    bit2:longint;            { extended bit field    }
  end;
  tframe=record
    snum:longint;            { sprite number/group      }
    ssub:longint;            { sprite sub/number        }
    sdur:longint;            { duration of frame (tics) }
    codep:longint;           { code pointer...Kinda :-) }
    next:longint;            { next frame in animation  }
    fz1,fz2:longint;         { two zero longints...???  }
  end;
  tsound=record
    name:array[0..59]of char;{ LONG name of the sound. Must be
                               converted with the SNDINFO lump }
    filler:array[0..7]of char;{ ???                     }
  end;
  tweapn=record
    ammot :longint;          { ammo type???      }
    select:longint;          { select frame      }
    desel :longint;          { deselect frame    }
    bobf  :longint;          { bobbing frame     }
    shootf:longint;          { shooting frame    }
    firef :longint;          { firing frame      }
    empty :longint;          { empty?            }
  end;
{
  gauntlets,mace,wand,pig
  axe,serpent staff,frost shards,pig
  hammer,firestorm,arc of death,pig
  quietus,wraithverge,bloodscourge,pig
}

  pthing=^tthing;
  pchar4=^tchar4;
  pframe=^tframe;
  psound=^tsound;
  pweapn=^tweapn;

procedure uncrunch(var addr1,addr2; blklen:word);


{Okay, I ran into heavy memory problems when writing HEX.
Don't know if it's because hexen has more data than doom,
or just that I suck(ed?) terribly at programming. Anyway,
I had to resort to EMS (first), which generally sucks (EMS
is the worst crap on earth). Then I finally got some XMS
code, but XMS (and EMS) aren't exactly easy to use under
DOS. So I wrote these wrappers, and...argh. It sucks.
With a 32bit (or 64bit) compiler, there would be NO problems,
and you could just malloc() the structures directly, instead
of this gaddomn sheit.
}
{ stream initializing/loading }
function  stream_init(var s:pXMSstream):boolean;
procedure stream_done(var s:pXMSstream);
function  stream_load(var s:pXMSstream;const fn:string):boolean;
function  stream_save(var s:pXMSstream;const fn:string):boolean;
{ stream get object functions }
function  stream_getthing(var s:pXMSstream;num:longint):pthing;
function  stream_getsname(var s:pXMSstream;num:longint):pchar4;
function  stream_getframe(var s:pXMSstream;num:longint):pframe;
function  stream_getsound(var s:pXMSstream;num:longint):psound;
function  stream_getweapn(var s:pXMSstream;num:longint):pweapn;
{ stream put object functions }
procedure stream_putthing(var s:pXMSstream;num:longint;t:tthing);
procedure stream_putsname(var s:pXMSstream;num:longint;t:tchar4);
procedure stream_putframe(var s:pXMSstream;num:longint;t:tframe);
procedure stream_putsound(var s:pXMSstream;num:longint;t:tsound);
procedure stream_putweapn(var s:pXMSstream;num:longint;t:tweapn);
{ .HP patch file loading & saving}
function  stream_loadpatch(var s:pXMSstream;const fn:string):boolean;
function  stream_savepatch(var s:pXMSstream;const fn,ofn:string):boolean;

{ EXTERNAL PROCEDURES (crunched pics, don't run).
This is the only way to get external data linked
with a pascal program. Don't be fooled by the "procedure".
Trust me, they're not :-) }
procedure _thing1;
procedure _thing2;
procedure _frame;
procedure _help;
procedure _misc;
{ EXTERNAL PROCEDURES END }

var
  stream1,stream2:pXMSstream;
  buf:pBufStream;

  thing,thing2:pthing;
  sname,sname2:pchar4;
  frame,frame2:pframe;
  sound,sound2:psound;
  weapn,weapn2:pweapn;

IMPLEMENTATION

procedure _thing1; external;  {$l res\thing1.obj}
procedure _thing2; external;  {$l res\thing2.obj}
procedure _frame;  external;  {$l res\frame.obj}
procedure _help;   external;  {$l res\help.obj}
procedure _misc;   external;  {$l res\misc.obj}

procedure uncrunch(var addr1,addr2; blklen:word); assembler;
asm                          { uncrunch TheDraw crunched image }
  push ds
  lds si,[addr1]
  les di,[addr2]
  mov cx,[blklen]
  jcxz @@done
  mov dx,di
  xor ax,ax
  cld
@@loopa:
  lodsb
  cmp al,32
  jc @@foreground
  stosw
@@next:
  loop @@loopa
  jmp @@done
@@foreground:
  cmp al,16
  jnc @@background
  and ah,0f0h
  or ah,al
  jmp @@next
@@background:
  cmp al,24
  jz @@nextline
  jnc @@flashbittoggle
  sub al,16; add al,al
  add al,al; add al,al
  add al,al; and ah,8fh
  or ah,al; jmp @@next
@@nextline: add dx,160; mov di,dx; jmp @@next
@@flashbittoggle:
  cmp al,27; jc @@multioutput
  jnz @@next; xor ah,128; jmp @@next
@@multioutput:
  cmp al,25; mov bx,cx
  lodsb; mov cl,al
  mov al,32; jz @@startoutput
  lodsb; dec bx
@@startoutput:
  xor ch,ch; inc cx
  rep stosw; mov cx,bx
  dec cx; loopnz @@loopa
@@done: pop ds
end;

function stream_init(var s:pXMSstream):boolean;
var l:longint;
begin
  stream_init:=false;
  l:=longint(numthings)*sizeof(tthing);
  inc(l,longint(numsnames)*sizeof(tchar4));
  inc(l,longint(numframes)*sizeof(tframe));
  inc(l,longint(numsounds)*sizeof(tsound));
  inc(l,longint(numweapns)*sizeof(tweapn));
  new(s,init(l,l));
  if(s^.status<>stOk)then dispose(s,done)else stream_init:=true;
end;

procedure stream_done(var s:pXMSstream);
begin
  if(s=nil)then exit;
  dispose(s,done);
  s:=nil;
end;

function stream_load(var s:pXMSstream;const fn:string):boolean;
var cnt:word;
begin
  stream_load:=false;
  if not(fex(fn))then exit;
  s^.seek(0);
  new(buf,init(fn,stOpen,64000));
  if(buf^.getsize<(nofs+(longint(numsounds)*sizeof(tsound))))then
  begin
    dispose(buf,done);
    exit;
  end;
  if(buf^.status<>stOk)then
  begin
    dispose(buf,done);
    exit;
  end;
  buf^.seek(tofs);
  for cnt:=0 to numthings do
  begin
    buf^.read(thing^,sizeof(tthing));
    s^.write(thing^,sizeof(tthing));
    if(buf^.status<>stok)then begin dispose(buf,done); exit; end;
    if(s^.status<>stok)then begin dispose(buf,done); exit; end;
  end;
  buf^.seek(sofs);
  for cnt:=1 to numsnames do
  begin
    buf^.read(sname^,sizeof(tchar4));
    s^.write(sname^,sizeof(tchar4));
    buf^.read(sname^,sizeof(tchar4));
    if(buf^.status<>stok)then begin dispose(buf,done); exit; end;
    if(s^.status<>stok)then begin dispose(buf,done); exit; end;
  end;
  buf^.seek(fofs);
  for cnt:=0 to numframes do
  begin
    buf^.read(frame^,sizeof(tframe));
    s^.write(frame^,sizeof(tframe));
    if(buf^.status<>stok)then begin dispose(buf,done); exit; end;
    if(s^.status<>stok)then begin dispose(buf,done); exit; end;
  end;
  buf^.seek(nofs);
  for cnt:=1 to numsounds do
  begin
    buf^.read(sound^,sizeof(tsound));
    s^.write(sound^,sizeof(tsound));
    if(buf^.status<>stok)then begin dispose(buf,done); exit; end;
    if(s^.status<>stok)then begin dispose(buf,done); exit; end;
  end;
  buf^.seek(wofs);
  for cnt:=0 to numweapns do
  begin
    buf^.read(weapn^,sizeof(tweapn));
    s^.write(weapn^,sizeof(tweapn));
    if(buf^.status<>stok)then begin dispose(buf,done); exit; end;
    if(s^.status<>stok)then begin dispose(buf,done); exit; end;
  end;
  dispose(buf,done);
  stream_load:=true;
end;

function stream_save(var s:pXMSstream;const fn:string):boolean;
var cnt:word;
begin
  stream_save:=false;
  if not(fex(fn))then exit;
  s^.seek(0);
  new(buf,init(fn,stOpen,64000));
  if(buf^.getsize<(nofs+(longint(numsounds)*sizeof(tsound))))then
  begin
    dispose(buf,done);
    exit;
  end;
  if(buf^.status<>stOk)then
  begin
    dispose(buf,done);
    exit;
  end;
  buf^.seek(tofs);
  for cnt:=0 to numthings do
  begin
    s^.read(thing^,sizeof(tthing));
    buf^.write(thing^,sizeof(tthing));
    if(buf^.status<>stok)then
    begin
      dispose(buf,done);
      exit;
    end;
    if(s^.status<>stok)then exit;
  end;
  buf^.seek(sofs);
  for cnt:=1 to numsnames do
  begin
    s^.read(sname^,sizeof(tchar4));
    buf^.write(sname^,sizeof(tchar4));
    buf^.seek(buf^.getpos+sizeof(tchar4));
    if(buf^.status<>stok)then
    begin
      dispose(buf,done);
      exit;
    end;
    if(s^.status<>stok)then exit;
  end;
  buf^.seek(fofs);
  for cnt:=0 to numframes do
  begin
    s^.read(frame^,sizeof(tframe));
    buf^.write(frame^,sizeof(tframe));
    if(buf^.status<>stok)then
    begin
      dispose(buf,done);
      exit;
    end;
    if(s^.status<>stok)then exit;
  end;
  buf^.seek(nofs);
  for cnt:=1 to numsounds do
  begin
    s^.read(sound^,sizeof(tsound));
    buf^.write(sound^,sizeof(tsound));
    if(buf^.status<>stok)then
    begin
      dispose(buf,done);
      exit;
    end;
    if(s^.status<>stok)then exit;
  end;
  buf^.seek(wofs);
  for cnt:=0 to numweapns do
  begin
    s^.read(weapn^,sizeof(tweapn));
    buf^.write(weapn^,sizeof(tweapn));
    if(buf^.status<>stok)then
    begin
      dispose(buf,done);
      exit;
    end;
    if(s^.status<>stok)then exit;
  end;
  dispose(buf,done);
  stream_save:=true;
end;

function  stream_getthing(var s:pXMSstream;num:longint):pthing;
begin
  s^.seek(longint(num)*sizeof(tthing));
  s^.read(thing^,sizeof(tthing));
  stream_getthing:=thing;
end;

function stream_getsname(var s:pXMSstream;num:longint):pchar4;
begin
  s^.seek((longint(numthings+1)*sizeof(tthing))+
          (longint(num)*sizeof(tchar4)));
  s^.read(sname^,sizeof(tchar4));
  stream_getsname:=sname;
end;

function stream_getframe(var s:pXMSstream;num:longint):pframe;
begin
  s^.seek((longint(numthings+1)*sizeof(tthing))+
          (longint(numsnames)*sizeof(tchar4))+
          (longint(num)*sizeof(tframe)));
  s^.read(frame^,sizeof(tframe));
  stream_getframe:=frame;
end;

function stream_getsound(var s:pXMSstream;num:longint):psound;
begin
  s^.seek((longint(numthings+1)*sizeof(tthing))+
          (longint(numsnames)*sizeof(tchar4))+
          (longint(numframes+1)*sizeof(tframe))+
          (longint(num)*sizeof(tsound)));
  s^.read(sound^,sizeof(tsound));
  stream_getsound:=sound;
end;

function stream_getweapn(var s:pXMSstream;num:longint):pweapn;
begin
  s^.seek((longint(numthings+1)*sizeof(tthing))+
          (longint(numsnames)*sizeof(tchar4))+
          (longint(numframes+1)*sizeof(tframe))+
          (longint(numsounds)*sizeof(tsound))+
          (longint(num)*sizeof(tweapn)));
  s^.read(weapn^,sizeof(tweapn));
  stream_getweapn:=weapn;
end;

procedure stream_putthing(var s:pXMSstream;num:longint;t:tthing);
begin
  s^.seek(longint(num)*sizeof(tthing));
  s^.write(t,sizeof(tthing));
end;

procedure stream_putsname(var s:pXMSstream;num:longint;t:tchar4);
begin
  s^.seek((longint(numthings+1)*sizeof(tthing))+
          (longint(num)*sizeof(tchar4)));
  s^.write(t,sizeof(tchar4));
end;

procedure stream_putframe(var s:pXMSstream;num:longint;t:tframe);
begin
  s^.seek((longint(numthings+1)*sizeof(tthing))+
          (longint(numsnames)*sizeof(tchar4))+
          (longint(num)*sizeof(tframe)));
  s^.write(t,sizeof(tframe));
end;

procedure stream_putsound(var s:pXMSstream;num:longint;t:tsound);
begin
  s^.seek((longint(numthings+1)*sizeof(tthing))+
          (longint(numsnames)*sizeof(tchar4))+
          (longint(numframes+1)*sizeof(tframe))+
          (longint(num)*sizeof(tsound)));
  s^.write(t,sizeof(tsound));
end;

procedure stream_putweapn(var s:pXMSstream;num:longint;t:tweapn);
begin
  s^.seek((longint(numthings+1)*sizeof(tthing))+
          (longint(numsnames)*sizeof(tchar4))+
          (longint(numframes+1)*sizeof(tframe))+
	  (longint(numsounds)*sizeof(tsound))+
          (longint(num)*sizeof(tweapn)));
  s^.write(t,sizeof(t));
end;

function stream_loadpatch(var s:pXMSstream;const fn:string):boolean;
var
  c,x,n:word;
  _s:string;
begin
  _s:='';
  stream_loadpatch:=false;
  new(buf,init(fn,stOpenRead,64000));
  if(buf^.status<>stOk)then begin dispose(buf,done); exit; end;
  buf^.read(_s[1],15); _s[0]:=#15;
  if(_s<>patch_string)or(buf^.status<>stOk)then
  begin
    dispose(buf,done);
    exit;
  end;
  { load the things }
  buf^.read(n,2);
  for c:=1 to n do
  begin
    buf^.read(x,2);
    buf^.read(thing^,sizeof(tthing));
    if(buf^.status<>stOk)then
    begin
      dispose(buf,done);
      exit;
    end;
    s^.seek(x*sizeof(tthing));
    s^.write(thing^,sizeof(tthing));
    if(s^.status<>stOk)then
    begin
      dispose(buf,done);
      exit;
    end;
  end;
  { load the frames }
  buf^.read(n,2);
  for c:=1 to n do
  begin
    buf^.read(x,2);
    buf^.read(frame^,sizeof(tframe));
    if(buf^.status<>stOk)then
    begin
      dispose(buf,done);
      exit;
    end;
    s^.seek((longint(numthings)*sizeof(tthing))+
            (longint(n)*sizeof(tframe)));
    s^.write(frame^,sizeof(tframe));
    if(s^.status<>stOk)then
    begin
      dispose(buf,done);
      exit;
    end;
  end;
  { load the weapons ;-) }
  buf^.read(n,2);
  for c:=1 to n do
  begin
    buf^.read(x,2);
    buf^.read(weapn^,sizeof(tweapn));
    if(buf^.status<>stOk)then
    begin
      dispose(buf,done);
      exit;
    end;
    s^.seek((longint(numthings+1)*sizeof(tthing))+
            (longint(numsnames)*sizeof(tchar4))+
            (longint(numframes+1)*sizeof(tframe))+
            (longint(numsounds)*sizeof(tsound))+
            (longint(x)*sizeof(tweapn)));
    s^.write(weapn^,sizeof(tweapn));
    if(s^.status<>stOk)then
    begin
      dispose(buf,done);
      exit;
    end;
  end;
  dispose(buf,done);
  stream_loadpatch:=true;
end;

function stream_savepatch(var s:pXMSstream;const fn,ofn:string):boolean;
var
  c,x,n:word;
  _s:string;
begin
  stream_savepatch:=false;
  _s:='HEX patch file'#26;
  if not(stream_init(stream2))then exit;
  if not(stream_load(stream2,ofn))then
  begin
    stream_done(stream2);
    exit;
  end;
  new(buf,init(fn,stCreate,64000));
  if(buf^.status<>stOk)then
  begin
    stream_done(stream2);
    exit;
  end;
  buf^.write(_s[1],ord(_s[0]));
{ save the things }
  n:=0; s^.seek(0); stream2^.seek(0);
  for c:=1 to(numthings)do
  begin
    s^.read(thing^,sizeof(tthing));
    stream2^.read(thing2^,sizeof(tthing));
    if not(comp(thing^,thing2^,sizeof(tthing)))then inc(n);
  end;
  buf^.write(n,2); n:=0; s^.seek(0); stream2^.seek(0);
  for c:=1 to(numthings)do
  begin
    s^.read(thing^,sizeof(tthing));
    stream2^.read(thing2^,sizeof(tthing));
    if not(comp(thing^,thing2^,sizeof(tthing)))then
    begin
      buf^.write(n,2);
      buf^.write(thing^,sizeof(tthing));
    end;
    inc(n);
  end;
{ save the frames }
  n:=0; s^.seek(longint(numthings)*sizeof(tthing));
  stream2^.seek(longint(numthings)*sizeof(tthing));
  for c:=1 to(numframes)do
  begin
    s^.read(frame^,sizeof(tframe));
    stream2^.read(frame2^,sizeof(tframe));
    if not(comp(frame^,frame2^,sizeof(tframe)))then inc(n);
  end;
  buf^.write(n,2); n:=0;
  s^.seek(longint(numthings)*sizeof(tthing));
  stream2^.seek(longint(numthings)*sizeof(tthing));
  for c:=1 to(numframes)do
  begin
    s^.read(frame^,sizeof(tframe));
    stream2^.read(frame2^,sizeof(tframe));
    if not(comp(frame^,frame2^,sizeof(tframe)))then
    begin
      buf^.write(n,2);
      buf^.write(frame^,sizeof(tframe));
    end;
    inc(n);
  end;
{ save the weapons table }
  n:=0;
  s^.seek((longint(numthings+1)*sizeof(tthing))+
          (longint(numsnames)*sizeof(tchar4))+
          (longint(numframes+1)*sizeof(tframe))+
          (longint(numsounds)*sizeof(tsound)));
  stream2^.seek((longint(numthings+1)*sizeof(tthing))+
          (longint(numsnames)*sizeof(tchar4))+
          (longint(numframes+1)*sizeof(tframe))+
          (longint(numsounds)*sizeof(tsound)));
  for c:=0 to(numWeapns)do
  begin
    s^.read(weapn^,sizeof(tweapn));
    stream2^.read(weapn2^,sizeof(tweapn));
    if not(comp(weapn^,weapn2^,sizeof(tweapn)))then inc(n);
  end;
  buf^.write(n,2); n:=0;
  s^.seek((longint(numthings+1)*sizeof(tthing))+
          (longint(numsnames)*sizeof(tchar4))+
          (longint(numframes+1)*sizeof(tframe))+
          (longint(numsounds)*sizeof(tsound)));
  stream2^.seek((longint(numthings+1)*sizeof(tthing))+
          (longint(numsnames)*sizeof(tchar4))+
          (longint(numframes+1)*sizeof(tframe))+
          (longint(numsounds)*sizeof(tsound)));
  for c:=0 to(numWeapns)do
  begin
    s^.read(weapn^,sizeof(tweapn));
    stream2^.read(weapn2^,sizeof(tweapn));
    if not(comp(weapn^,weapn2^,sizeof(tweapn)))then
    begin
      buf^.write(n,2);
      buf^.write(weapn^,sizeof(tweapn));
    end;
    inc(n);
  end;
  dispose(buf,done);
  stream_done(stream2);
  stream_savepatch:=true;
end;

begin
  numthings:=HEXENNUM[0,1];
  numsnames:=HEXENNUM[0,2];
  numframes:=HEXENNUM[0,3];
  numsounds:=HEXENNUM[0,4];
  numweapns:=HEXENNUM[0,5];

  tofs:=HEXENOFS[0,1];
  sofs:=HEXENOFS[0,2];
  fofs:=HEXENOFS[0,3];
  nofs:=HEXENOFS[0,4];
  wofs:=HEXENOFS[0,5];

  new(thing); new(thing2);
  new(sname); new(sname2);
  new(frame); new(frame2);
  new(sound); new(sound2);
  new(weapn); new(weapn2);
end.