hexunit.pas

unit hexunit;
{
  The unit that actually handles all of the stuff.
  Necesarry to put all this stuff in a unit to easily
  add new menus...Whatever :)

- it's been a *LONG* time since I touched this last.
  Quite creepy, I think.
}
{$g+,o-,n-,e-,x+,t-,v-,q-,r-,s-,i-,f+}
{$ifdef debug}
  {$d+,y+,l+}
{$else}
  {$d-,y-,l-}
{$endif}

INTERFACE

uses utils,mycrt,iface,txtwin,vocdecl,
     dos,hexdecl,bits,input,exec,filepick,
     names,link2,mailu,xlat,gru,doomu,strings;

const
  magictime=18.2;                   { tics*magictime=seconds         }
  magic=65536;                      { mul/div with proj. speeds      }
  maxname=18;                       { The largest "input" string     }
  maxnum=10;                        { The biggest number (digits)    }

  frameofs=7;                       { Frame editing offset on screen }
  frameonscreen=37;                 { Number of frames on screen     }

  c_inp=   (green     shl 4)+white; { Color for "get input" stuff    }
  c_att=   (lightgray shl 4)+white; { Color for "attention" message  }
  c_err=   (red       shl 4)+white; { Color for "error" message      }
  c_oki=   (cyan      shl 4)+white; { Color for "okay" message       }
  c_normal=(blue      shl 4)+white; { Color for normal text          }

  c_frame=(blue shl 4)+lightgray;
  {$i compiled.pas}
type
  namestr=string[maxname];
const
  { Typed string constants. Can be changed using the INI file.     }
  oldexe :string[70]='hexen.exe';     { unmodified HEXEN.EXE           }
  wadfile:string[70]='hexen.wad';     { unmodified HEXEN.WAD           }
  hackexe:string[70]='hexhack.exe';   { hacked HEXEN.EXE               }
  tnfile :string[70]='things.dat';    { thing names "dictionary" file. }
  sndfile:string[70]='sndinfo.dat';   { soundinfo file used for stuff  }
  comcom :string[70]='c:\command.com';{ path to COMMAND.COM            }
  cmdline:string[70]='-skill 3';      { hexen commandline              }
  q_file :string[70]='quotes.txt';    { exit-Quotes text file :-)      }
  s_saver:string[70]='sinus1';        { screen Saver.                  }
  ssr_time:word=30;                   { default 30 seconds activation  }
  ssr_act   :boolean=true;            { are the screensavers ative?    }
  show_pic  :boolean=true;            { show title pic if it's there   }
  show_quote:boolean=true;            { show quote on HEX exit         }
  usecustom :boolean=false;           { use custom offsets/numbers?    }
  nosound   :boolean=false;           { skip sound detection stuff?    }

  { Other typed constants. Maybe they can be changed some day? }
  patch_suffix:string[4]='.HP';

  s_1:namestr='Alert Sound';
  s_2:namestr='Attack Sound';
  s_3:namestr='Pain Sound';
  s_4:namestr='Death sound';
  s_5:namestr='Action sound';

  m_1:namestr='ID#';
  m_2:namestr='Hit Points';
  m_3:namestr='Speed';
  m_4:namestr='Width';
  m_5:namestr='Height';
  m_6:namestr='Missile damage';
  m_7:namestr='Reaction time';
  m_8:namestr='Pain chance';
  m_9:namestr='Mass';
  m_a:namestr='Bits1';
  m_b:namestr='Bits2';

  f_1:namestr='Initial frame';
  f_2:namestr='Moving frame';
  f_3:namestr='Injury frame';
  f_4:namestr='Close attack frame';
  f_5:namestr='Far attack frame';
  f_6:namestr='Death frame';
  f_7:namestr='Exploding frame';
  f_8:namestr='Burning frame';

  f_01:namestr='Sprite number';
  f_02:namestr='Sprite sub';
  f_03:namestr='Next frame';
  f_04:namestr='Duration';
  f_05:namestr='Code pointer';

  w_0:namestr='Ammo type';
  w_1:namestr='Ammo number';
  w_2:namestr='Deselect frame';
  w_3:namestr='Select frame';
  w_4:namestr='Bobbing frame';
  w_5:namestr='Shooting frame';
  w_6:namestr='Firing frame';

var
  hexdir:dirStr;             { The directory HEX resides in            }
  startdir:dirStr;           { The directory the user started HEX from }
  hexendir:dirStr;           { Will be calculated from "oldexe"        }
  timecnt:longint;           { Used for screensaver activation         }
  texty:pmail;               { TEXT file viewer                        }
  patchtmp,vtmp:pathStr;     { Str input temps                         }
  done:boolean;              { "does user want to quit?" boolean       }
  showscreen:boolean;        { "have to show edit screen?" boolean     }
  wadhnd:doomu.phandle;      { WAD file handle                         }

procedure startuphex;

IMPLEMENTATION

var oldexit:pointer;

const
  t_numwins=6;
  f_numwins=6;
  b_xorbarcol=16;
  g_xorbarcol=32;
type
  t_twintype=record
    x,y,l,num:byte;
  end;
  t_fwintype=record
    x,x2:byte;
  end;

  t_twindata=array[1..t_numwins]of t_twintype;
  t_fwindata=array[1..f_numwins]of t_fwintype;
  chset=set of char;
var
  t_windata:t_twindata;              { window limit coords for thing }
  f_windata:t_fwindata;              { window limit coords for frame }
  curbit,oldbit:boolean;             { Which set of bits is displayed}
  errcode:word;
  tY,wY:byte;                        { thing and weapon Y position   }
  oldthing,curthing:word;            { What thing number we are on   }
  oldframe,curframe:word;            { Frame stuff                   }
  oldweap,curweap:word;              { Misc editor stuff             }

  e_curwin:byte;                     { which thing window we are in  }
  f_curwin:byte;                     { which frame window we are in  }
  f_ypos:byte;                       { y position in frame table     }
  m_ypos:byte;                       { position in misc editor stuff }
  menuSelected:procedure;            { pointer to the selected menu  }

procedure hex_writestuff;
var txtfile:text; line:string;
begin
{ Read in the exit quotes. }
  assign(txtfile,q_file);
  {$i-} reset(txtfile); {$i+}
  if(ioresult=0)then    { The quotes.txt isn't really important. }
  begin
    while not(eof(txtfile))do
    begin
      readln(txtfile,line);
      names.addsymb(names.quotes,line,false);
    end;
    close(txtfile);
  end;
  writeln('That was HEX, a program by Sune Marcher <suneman@silkeborg.bib.dk>.');
  writeln;
  writeln('Sune says: ');
  writeln('"',names.num_getsymb(names.quotes,succ(random(names.num_entries(names.quotes)))),'"');
end;

procedure takecare_exit; far; { This is a "true" exit proc. }
begin
  asm mov ax,3; int 10h end; { change to 80x25. No, stupid me   }
  stream_done(stream1);      { is NOT setting it to the previous}
  donewad(wadhnd);           { video mode, I assume you LOVE 80x25.}
  exitproc:=oldexit;
  hex_writestuff;
end;

{
  editor procedures start...forwards to make stuff work
  - Damn I hate all this shit!
}
{$i edit\misc.inc}  { various editing stuff     }
{$i edit\thing.inc} { thing table editing stuff }
{$i edit\frame.inc} { frame table editing stuff }
{$i edit\graf.inc}  { for showing spritesnstuff }
{$i edit\misc2.inc} { MISC data editor stuff    }

procedure generalkeys(ch:char);
begin
  case(upcase(ch))of
    'V': { VIEW textfile                }
    begin
      pickfile(31,14,16,'.\*.txt'); hcursor;
      if(filechosen<>'')and(dirchosen<>'')then
        vtmp:=concat(dirchosen,filechosen)else
        vtmp:='';
      if(vtmp='')then
      begin
	message('View aborted',[#0..#255],c_att,true);
	exit;
      end;

      initmail(texty);
      if not(readmail(texty,concat(vtmp)))then
      begin
	message('Couldn''t open file!',[#0..#255],c_err,false);
	exit;
      end;
      viewmail(texty,5,45);
      donemail(texty);
    end;
    'W': { WRITE changes back to hacked }
    begin
      if not(stream_save(stream1,hackexe))then
	message('Couldn''t write changes!',[#0..#255],c_err,false)else
	  message('Changes written',[#0..#255],c_oki,true);
    end;
    'Z': { ZAP changes (load from original) }
    begin
      if not(stream_load(stream1,oldexe))then
	message('Couldn''t zap changes!',[#0..#255],c_err,false)else
	  message('Changes zapped',[#0..#255],c_oki,true);
      oldthing:=succ(numthings);
      oldframe:=succ(numframes);
      oldweap:=succ(numweapns);
    end;
    'U': { UNDO changes (reload from hacked) }
    begin
      if not(stream_load(stream1,hackexe))then
	message('Couldn''t undo changes!',[#0..#255],c_err,false)else
	  message('Changes undone',[#0..#255],c_oki,true);
      oldthing:=succ(numthings);
      oldframe:=succ(numframes);
      oldweap:=succ(numweapns);
    end;
    'R': { RUN hexen  }
    begin
      asm mov ax,3; int 10h end;
      chdir(hexendir);
      errcode:=Execute(hackexe,cmdline);
      chdir(startdir);
      if(errcode=0)then centerstr2('<RETURNED FROM HEXEN>',12,(blue shl 4+white))else
	 centerstr2('<RETURNED FROM HEXEN>',12,c_err);
      gotoxy(1,3); writeln('press any key');
      readkey;
      m80_50; hcursor;
      showscreen:=true;
      oldthing:=succ(numthings);
      oldframe:=succ(numframes);
      oldweap:=succ(numweapns);
    end;
    'S': { SAVE patch }
    begin
      getstr('Patch file Name',patchtmp);
      if(patchtmp='')then
      begin
	message('Save aborted',[#0..#255],c_att,true);
	exit;
      end;
      patchtmp:=concat(patchtmp,patch_suffix);
      if not(stream_savepatch(stream1,patchtmp,oldexe))then
	message('Couldn''t save patch file',[#0..#255],c_err,false)else
	  message('Patch file saved',[#0..#255],c_oki,true);
    end;
    'L': { LOAD patch }
    begin
      pickfile(31,14,16,'.\*.hp'); hcursor;
      if(filechosen<>'')and(dirchosen<>'')then
        patchtmp:=concat(dirchosen,filechosen)else
        patchtmp:='';
      if(patchtmp='')then
      begin
	message('Load aborted',[#0..#255],c_att,true);
	exit;
      end;
      if not(stream_loadpatch(stream1,patchtmp))then
	message('Couldn''t load patch file',[#0..#255],c_err,false)else
	  message('Patch file loaded',[#0..#255],c_oki,true);
      oldthing:=succ(numthings);
      oldframe:=succ(numframes);
      oldweap:=succ(numWeapns);
    end;
    'D': { DOS shell  }
    begin
      if not(fex(comcom))then
      begin
	message('DOS shell not available',[#0..#255],c_err,false);
	exit;
      end;
      asm mov ax,3; int 10h end;
      writeln('To exit the DOS SHELL, type ''EXIT'' and press enter.');
      execute(comcom,'');
      asm mov ax,3; int 10h end;
      m80_50; hcursor;
      showscreen:=true;
      oldthing:=succ(numthings);
      oldframe:=succ(numframes);
    end;
    kbesc:
    begin
      ch:=message('Really quit? [Y/N]',['y','Y','n','N',#13,#27],(lightgray shl 4),false);
      if not(ch in [#13,'y','Y'])then exit;
      done:=true; menuSelected:=nil;
    end;
  end;
end;

procedure mem_logo;
begin
  centerstr2(concat('HEX ',version),1,(green shl 4)+white);
  str2scr(concat('HEXEN version 1.',byte2str(_VERHEXEN)),3,1,(green shl 4));
  str2scr(concat('MEM FREE: ',long2str(memavail)),60,1,(green shl 4));
  str2scr('ã',80,50,white); { heh heh...Have you seen 'the net'? }
end;

function figure_ssr:boolean; { figure out if we have to run screensaver. }
begin
  figure_ssr:=false;
  if(ssr_act)then { If user wants screensaver }
  begin
    timecnt:=round(timer+(ssr_time*magictime));
    while not(keypressed)do
    begin
      if(timer>=timecnt)then
      begin
	figure_ssr:=true;
	if not(fex(concat(s_saver,'.ssr')))then
	begin
	  message('Couldn''t find screensaver!',[#0..#255],c_err,false);
	  exit;
	end;
	execute(s_saver+'.ssr','');
	memw[$0000:$041C]:=memw[$0000:$041A]; { Clear keyboard buffer. }
	m80_50; hcursor;
	timecnt:=$fffffff; oldthing:=succ(numthings); exit;
      end;
    end;
  end;
end;

function fname(n:string):string;
var
  a,b,dummy:string[12];
begin
  fsplit(n,dummy,a,b);
  dummy:=concat(a,b);
  fname:=dummy;
end;

procedure hex_help;
var
  ch:char;
  hn,on:string[12];  { temporary stuff }
begin
  uncrunch(@_help^,mem[$b800:0],siz4);
  mem_logo; done:=false;
  on:=leftpad(fname(oldexe),12,' ');
  hn:=leftpad(fname(hackexe),12,' ');

  str2scr(on,50,9,(blue shl 4)+white);
  str2scr(hn,50,11,(blue shl 4)+white);
  str2scr(hn,50,13,(blue shl 4)+white);
  str2scr(hn,50,21,(blue shl 4)+white);
  repeat
    if(figure_ssr)then ;
    if(showscreen)or(curthing<>oldthing)then
    begin
      mem_logo;
      oldthing:=curthing; showscreen:=false;
      uncrunch(@_help^,mem[$b800:0],siz4);
      str2scr(on,50,9,(blue shl 4)+white);
      str2scr(hn,50,11,(blue shl 4)+white);
      str2scr(hn,50,13,(blue shl 4)+white);
      str2scr(hn,50,21,(blue shl 4)+white);
    end;
    if(keypressed)then
    begin
      ch:=readkey;
      if(ch=kbnull)then
      begin
	ch:=readkey;
	case ch of
          kbf1:;
	  kbf2:begin menuSelected:=thing_edit; done:=true; end;
	  kbf3:begin menuSelected:=frame_edit; done:=true; end;
	  kbf4:begin menuSelected:=misc_edit; done:=true; end;
	end;
      end else
      case ch of
	kbnull:;
	else generalkeys(ch);
      end;
    end;
  until(done);
end;

procedure evalit(s:string;b,fatal:boolean);
var ts:string;
begin
  if(b)then ts:=concat('o ',s,': ok')else ts:=concat('o ',s,': error');
  writeln(ts);
  if(not(b)and(fatal))then halt;
end;

procedure menu_dispatcher;
begin
  repeat
    if(@menuSelected<>nil)then menuSelected;
  until(@menuSelected=nil);
  exitproc:=@takecare_exit;
end;

procedure startuphex;
begin
  curbit:=false; oldbit:=not(curbit);
  curthing:=0; oldthing:=1; e_curwin:=3;
  oldframe:=0; curframe:=1; f_curwin:=1; f_ypos:=1;
  curweap:=0; oldweap:=1; m_ypos:=1;

  evalit('stream init',stream_init(stream1),true);
  evalit('stream load',stream_load(stream1,hackexe),true);
  evalit('Wad file   ',(initwad(wadhnd,wadfile)),true);

{  write('press any key to start hex...');
  readkey;}
  m80_50;
  menuSelected:=thing_edit;
  menu_dispatcher;
end;

begin
  fillchar(t_windata,sizeof(t_twindata),0);
  clipon:=true;
  done:=false;

  {now the window data is set up. This is so my crappy menu
  system code works. It's possible to set this up directly
  when declaring "t_windata", but I guess I didn't know how
  to do that back when I wrote this code. STUPID!}
  with t_windata[1]do begin x:=19; y:=05; l:=15; num:=02; end;
  with t_windata[2]do begin x:=54; y:=05; l:=11; num:=05; end;
  with t_windata[3]do begin x:=21; y:=13; l:=10; num:=11; end;
  with t_windata[4]do begin x:=57; y:=16; l:=10; num:=08; end;
  with t_windata[5]do begin x:=35; y:=30; l:=02; num:=16; end;
  with t_windata[6]do begin x:=66; y:=30; l:=02; num:=16; end;

  with f_windata[1]do begin x:=25; x2:=27; end;
  with f_windata[2]do begin x:=29; x2:=31; end;
  with f_windata[3]do begin x:=35; x2:=37; end;
  with f_windata[4]do begin x:=42; x2:=47; end;
  with f_windata[5]do begin x:=53; x2:=58; end;
  with f_windata[6]do begin x:=63; x2:=69; end;
  tY:=1; wY:=0;

  wint:=txtwin.ftnormal;
  wcol1:=(green shl 4)+black;
  wcol2:=(green shl 4)+white;
  txtcol:=(green shl 4)+white;
  xorcol:=(green shl 4)+lightgray;
end.