program wav_to_nsn;

{ Wav2Nsn (C) 1994 Ed T. Toton III, All Rights Reserved.
  For use with UFO, The Card Game ONLY. All distribution
  prohibited except with this game. Feel free to use any
  fragments of this code you wish, so long as credit is
  given to me as appropriate.

  (BTW- sample code I hand out is always messy)

  Warning! WAV files used must be less than 64k!
}

uses dos;

const
 max_sample_size=65486;

type
 sample_type=record
              transpose:real;
              len,rep:word;
              name:string[8];
              ID:string[3];
              dummy:array[0..21] of byte;
              dat:array[0..max_sample_size] of byte;
             end;
 sample_ptr=^sample_type;
 wav_header= record
              RIFF_ID:array[0..3] of char;
              RIFF_len:longint;
              WAV_ID:array[0..3] of char;
              FMT_ID:array[0..3] of char;
              FMT_LEN:longint;
             end;
 fmt_header= record
              tag,channels,sampersec,bytespersec,blockalign:word;
              dummy:array[0..10] of word;
             end;


var
 the_name:string;
 the_eof:byte;
 fn:string;
 f1:file of shortint;
 b:byte;
 s:shortint;
 sample:sample_ptr;
 i,j,k:integer;
 l:longint;
 w,h:word;
 whd:wav_header;
 fhd:fmt_header;


{---------Functions Galore----------}


Function ucase(s:string):string;
var
 i:integer;
begin
 if length(s)>=1 then
  begin
   for i:=1 to length(s) do
    s[i]:=upcase(s[i]);
  end;
 ucase:=s;
end;

function ltrim(s1:string):string;
var
 i:integer;
begin
 while (length(s1)>0) and ((copy(s1,1,1)=' ') or (copy(s1,1,1)=#8)) do
  begin
   s1:=copy(s1,2,length(s1)-1);
  end;
 ltrim:=s1;
end;

function rtrim(s1:string):string;
var
 i:integer;
begin
 while (length(s1)>0) and ((copy(s1,length(s1),1)=' ') or (copy(s1,length(s1),1)=#8)) do
  begin
   s1:=copy(s1,1,length(s1)-1);
  end;
 rtrim:=s1;
end;

function btrim(s1:string):string;
begin
 btrim:=ltrim(rtrim(s1));
end;

function lstr(s1:string; l:integer):string;
begin
 if length(s1)<=l then lstr:=s1
 else lstr:=copy(s1,1,l);
end;

function rstr(s1:string; l:integer):string;
begin
 if length(s1)<=l then rstr:=s1
 else rstr:=copy(s1,length(s1)-l+1,l);
end;

function base_name(name:string):string;
var
 i,j,k,l:integer;
 s1,s2,s3:string;
begin
 s1:=''; s2:='';
 k:=1;
 while (k<=length(name)) and (name[k]<>'.') do
  begin
   s1:=s1+name[k];
   inc(k);
  end;
 base_name:=s1;
end;

function no_path(fn:string):string;
var
 i,k:integer;
begin
 k:=0;
 for i:=length(fn) downto 1 do
  begin
   if ((fn[i]='\') or (fn[i]=':')) and (k<i) then k:=i;
  end;
 if k<>0 then
   no_path:=rstr(fn,length(fn)-k)
  else
   no_path:=fn;
end;

Function exist(thisfile:string):boolean;
var
 afile:file;
 iocode:word;
begin 
 assign(afile,thisfile);
 {$I-}
 reset(afile);
 iocode:=ioresult;
 {$I+}
 Exist:=(iocode=0);
 if iocode=0 then close(afile);
end;

Procedure open_filein(var h:word; fn:string);
var
 w:word;
begin
 the_name:=fn+#0;
 asm
  push  ds
  mov   dx,     seg the_name
  mov   ds,     dx
  mov   dx,     offset the_name
  inc   dx
  mov   ax,     3D00h;
  int   21h
  pop   ds
  mov   w,      ax
 end;
 h:=w;
end;

Procedure open_fileout(var h:word; fn:string);
var
 w:word;
begin
 the_name:=fn+#0;
 if exist(lstr(fn,length(fn)-1)) then
 asm
  push  ds
  mov   dx,     seg the_name
  mov   ds,     dx
  mov   dx,     offset the_name
  inc   dx
  mov   ax,     3D01h;
  int   21h
  pop   ds
  mov   w,      ax
 end
 else
 asm
  push  ds
  mov   dx,     seg the_name
  mov   ds,     dx
  mov   dx,     offset the_name
  inc   dx
  mov   cx,     20h
  mov   ax,     3C00h;
  int   21h
  pop   ds
  mov   w,      ax
 end;
 h:=w;
end;

Procedure create_fileout(var h:word; fn:string);
var
 w:word;
begin
 the_name:=fn+#0;
 asm
  push  ds
  mov   dx,     seg the_name
  mov   ds,     dx
  mov   dx,     offset the_name
  inc   dx
  mov   cx,     20h
  mov   ax,     3C00h;
  int   21h
  pop   ds
  mov   w,      ax
 end;
 h:=w;
end;


Procedure read_file(h:word; ploc:pointer; var len:integer);
var
 tseg,tofs,pp,w:word;
 ll:integer;
label ok,uh_oh,alright;
begin
 tseg:=seg(ploc^);
 tofs:=ofs(ploc^);
 ll:=len; w:=0;
 asm
  push  ds
  mov   bx,     h
  mov   cx,     ll
  mov   dx,     tseg
  mov   ds,     dx
  mov   dx,     tofs
  mov   ax,     3F00h;
  int   21h
  jc    uh_oh
  jmp   alright
  uh_oh:
  mov   w,      ax
  alright:
  pop   ds
  cmp   ll,     ax
  je    ok
  mov   the_eof,1
  ok:
  mov   ll,     ax
 end;
 len:=ll;
 if w<>0 then begin writeln(' ****** ',w,' ****** '); {pausescr;} end;
end;

Procedure write_file(h:word; ploc:pointer; var len:integer);
var
 tseg,tofs:word;
 ll:integer;
begin
 tseg:=seg(ploc^);
 tofs:=ofs(ploc^);
 ll:=len;
 asm
  push  ds
  mov   bx,     h
  mov   cx,     ll
  mov   dx,     tseg
  mov   ds,     dx
  mov   dx,     tofs
  mov   ax,     4000h;
  int   21h
  pop   ds
  mov   ll,     ax
 end;
 len:=ll;
end;

Procedure read_long(h:word; ploc:pointer; var len:word);
var
 tseg,tofs,pp,w:word;
 ll:word;
label ok,uh_oh,alright;
begin
 tseg:=seg(ploc^);
 tofs:=ofs(ploc^);
 ll:=len; w:=0;
 asm
  push  ds
  mov   bx,     h
  mov   cx,     ll
  mov   dx,     tseg
  mov   ds,     dx
  mov   dx,     tofs
  mov   ax,     3F00h;
  int   21h
  jc    uh_oh
  jmp   alright
  uh_oh:
  mov   w,      ax
  alright:
  pop   ds
  cmp   ll,     ax
  je    ok
  mov   the_eof,1
  ok:
  mov   ll,     ax
 end;
 len:=ll;
 if w<>0 then begin writeln(' ****** ',w,' ****** '); {pausescr;} end;
end;

Procedure write_long(h:word; ploc:pointer; var len:word);
var
 tseg,tofs:word;
 ll:word;
begin
 tseg:=seg(ploc^);
 tofs:=ofs(ploc^);
 ll:=len;
 asm
  push  ds
  mov   bx,     h
  mov   cx,     ll
  mov   dx,     tseg
  mov   ds,     dx
  mov   dx,     tofs
  mov   ax,     4000h;
  int   21h
  pop   ds
  mov   ll,     ax
 end;
 len:=ll;
end;

procedure close_file(h:word);
begin
 asm
  mov   ax,     3E00h
  mov   bx,     h
  int   21h
 end;
end;

function file_size(fn:string):longint;
var
 f:file of byte;
begin
 if not exist(fn) then
  begin file_size:=-1; exit; end;
 assign(f,fn);
 reset(f);
 file_size:=filesize(f);
 close(f);
end;

procedure delete_file(fn:string);
var
 f:file of byte;
begin
 if not exist(fn) then exit;
 assign(f,fn);
 erase(f);
end;



{---------Main Program----------}

begin
 new(sample);
 if paramcount=0 then
  begin
   writeln('Usage: WAV2NSN <filename[.WAV]>');
   writeln;
   writeln('(you can specify as many filenames');
   writeln('onthe command line as you wish)');
   halt;
  end;
 for i:=1 to paramcount do
 begin
  fn:=ucase(btrim(paramstr(i)));
  if base_name(fn)=fn then fn:=fn+'.WAV';
  if exist(fn) then
  begin
   l:=0;
   write('Converting "'+fn+'"... ');
   open_filein(h,fn);
   l:=file_size(fn);
   k:=sizeof(whd); read_file(h,@whd,k);
   k:=whd.fmt_len; read_file(h,@fhd,k);
   k:=4; read_file(h,@l,k);
   k:=4; read_file(h,@l,k);
   w:=l; read_long(h,@sample^.dat,w); l:=w;
   close_file(h);
   if (fhd.channels<>1) or (fhd.tag<>1) then
    writeln('Icompatable data.')
   else
    begin
     sample^.transpose:=fhd.sampersec;
     sample^.transpose:=sample^.transpose/11025;
     sample^.len:=l;
     sample^.rep:=0;
     sample^.name:=ucase(btrim(no_path(base_name(fn))));
     sample^.id:='NSN';
     delete_file(base_name(fn)+'.NSN');
     create_fileout(h,base_name(fn)+'.NSN');
     w:=48+sample^.len;
     writeln(w,' bytes.');
     write_long(h,sample,w);
     close_file(h);
    end;
  end
 else
  begin
   writeln('Usage: WAV2NSN <filename[.WAV]>');
   halt;
  end;
 end;
end.
