home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Hack-Phreak Scene Programs
/
cleanhpvac.zip
/
cleanhpvac
/
C2SND201.ZIP
/
SND2WAV.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1994-09-11
|
34KB
|
898 lines
(* Snd2wav.pas - Convert DeskMate .snd to RIFF WAVE, version 1.1
Jeffrey L. Hayes
September 11, 1994
This is a companion program to Kenneth Udut's Conv2snd program for
converting .wav and other formats to .snd. I did the revisions for
version 2.00 of that program.
This program converts DeskMate .snd files to RIFF WAVE format, allowing
them to be played without the DeskMate Sound.pdm program. This allows
sounds recorded with Sound.pdm to be shared with users on non-Tandy
machines.
.snd files can be compressed; this program can only convert the
uncompressed kind. To convert compressed .snd's, Sound.pdm will first
have to be used to decompress them.
.snd files are of two basic types, "sound" files and "instrument" files.
Both contain 8-bit unsigned PCM samples, but instrument files may
contain more than one sample and may have looping information. Sound
files can be converted directly to .wav with no special treatment.
Instrument files reproduce the sound of musical instruments for use with
Music.pdm. Outside the DeskMate environment, they are of limited use.
The only sensible thing I can think of to do with them is to make them
into .mod samples, but this program just turns each note into a separate
.wav file, ignoring the note, the range, and the sustain region. (I
have written another program, Snd2sam, that will convert instrument
files to .mod samples - see Snd2wav.doc.)
Snd2wav can take one or two command-line parameters, though none is
required. If the program is invoked without parameters, the user will
be prompted for the input filename. If a single parameter is given, it
will be taken as the input filename. In either of these cases, the
output filename will default to the same drive and path as the input
file, but with a ".wav" extension. If two command-line parameters are
given, the second parameter is taken as the output filename. If this
name has no extension, a ".wav" extension is appended. If the input
file has no extension, the extension defaults to ".snd". If the user
desires to use a filename without an extension, he can specify a name
ending in a period.
If an instrument file with more than one note is being converted, a
digit 2-9 or letter A-G is appended to the filename for the second and
subsequent notes, overwriting the last character of the filename if
necessary. For example, if the following is entered:
snd2wav piano
and piano.snd is an instrument file with 3 notes, the following files
are created:
piano.wav
piano2.wav
piano3.wav
Snd2wav returns errorlevel 1 if conversion fails for whatever reason;
otherwise it returns errorlevel 0. Note that converting an empty .snd
file produces no output files, but still returns errorlevel 0.
*)
(*********************************************************************)
(*********************************************************************)
program snd2wav;
type
noterec = record (* needed fields from the .snd note record *)
start: longint; (* starting offset in the file for note samples *)
length: longint; (* number of note samples *)
end; (* record *)
notearray = array [1..16] of noterec;
string3 = string[3]; (* string type for file extensions *)
var
sndfile: file; (* input untyped file, treat as byte stream *)
numnotes: byte; (* number of notes in the .snd file *)
rate: word; (* sampling rate in samples per second *)
note: byte; (* current note in the .snd file being converted *)
notelist: notearray; (* list of notes in the .snd file *)
sndname: string; (* name of input .snd file, including path *)
wavname: string; (* name of output .wav file, including path *)
(*********************************************************************)
function lastpos(
st: string; (* string to be searched *)
ch: char): (* character to search for *)
integer;
(* Returns the position of the last occurrence of ch in st, 0 if not
present. *)
var
i: integer; (* for looping over the characters *)
place: integer; (* place where ch is found *)
begin (* lastpos *)
i := length( st );
place := 0;
while (i > 0) and (place = 0) do
begin
if st[i] = ch then
place := i;
i := i - 1;
end; (* while *)
lastpos := place;
end; (* lastpos *)
(*********************************************************************)
function has_extension(
st: string ): (* filename to test *)
boolean;
(* This function returns true if the string st has a file extension. *)
var
dotplace: integer; (* last position of '.' in st *)
slashplace: integer; (* last position of '\' in st *)
colonplace: integer; (* last position of ':' in st *)
begin (* has_extension *)
slashplace := lastpos( st, '\' );
colonplace := lastpos( st, ':' );
if colonplace > slashplace then
slashplace := colonplace;
if slashplace <> 0 then
delete( st, 1, slashplace );
dotplace := lastpos( st, '.' );
if dotplace = 0 then
has_extension := False
else
has_extension := (dotplace >= length( st )-3);
end; (* has_extension *)
(*********************************************************************)
function set_extension(
st: string; (* filename whose extension is to be changed *)
ext: string3 ): (* extension to replace the current one *)
string;
(* This function returns the input filename st after replacing its
extension with ext. *)
var
dotplace: integer; (* last position of '.' in st *)
slashplace: integer; (* last position of '\' in st *)
colonplace: integer; (* last position of ':' in st *)
pathname: string; (* drive and path, excluding filename *)
filename: string; (* filename, excluding drive and path *)
begin (* set_extension *)
slashplace := lastpos( st, '\' );
colonplace := lastpos( st, ':' );
if colonplace > slashplace then
slashplace := colonplace;
if slashplace = 0 then
pathname := ''
else
begin
pathname := copy( st, 1, slashplace );
delete( st, 1, slashplace );
end; (* else *)
filename := st;
dotplace := lastpos( filename, '.' );
if dotplace = 0 then
filename := filename + '.' + ext
else
filename := copy( filename, 1, dotplace ) + ext;
set_extension := pathname + filename;
end; (* set_extension *)
(*********************************************************************)
procedure display_intro;
(* This procedure displays an introductory message on the screen. *)
begin (* display_intro *)
writeln;
writeln( 'Snd2wav, v. 1.1: DeskMate .snd to RIFF WAVE conversion ',
'program.' );
writeln;
end; (* display_intro *)
(*********************************************************************)
procedure get_filenames(
var sndname: (* name of input .snd file, returned *)
string;
var wavname: (* name of output .wav file, returned *)
string );
(* This procedure reads the input and output filenames from the command
line, if present. If the input filename is not present on the command
line, the user is prompted for it. If the output filename is not
present on the command line, the output filename will default to the
same drive and path as the input filename, but with a ".wav"
extension. If the output file is specified but has no extension, a
".wav" extension will be appended. *)
begin (* get_filenames *)
(* more than 2 command-line parameters is invalid *)
if ParamCount > 2 then
begin
writeln( 'This program takes at most 2 filenames on the command ',
'line. Use one of the' );
writeln( 'following forms:' );
writeln;
writeln( ' snd2wav' );
writeln( ' snd2wav <sndfile>' );
writeln( ' snd2wav <sndfile> <wavfile>' );
halt( 1 );
end; (* if ParamCount > 2 *)
(* if no command line parameters, get the input filename from the
user *)
if ParamCount = 0 then
begin
writeln( 'Please specify the .snd file to be converted (drive ',
'and/or path OK):' );
readln( sndname );
end (* if ParamCount = 0 *)
else
sndname := ParamStr(1);
(* if the input filename has no extension, append ".snd" *)
if not has_extension( sndname ) then
sndname := set_extension( sndname, 'snd' );
(* if the output file is not specified, set it to the default *)
if ParamCount < 2 then
wavname := set_extension( sndname, 'wav' )
else
begin
wavname := ParamStr(2);
if not has_extension( wavname ) then
wavname := set_extension( wavname, 'wav' );
end; (* else if ParamCount = 2 *)
end; (* get_filenames *)
(*********************************************************************)
function is_newsnd(
sndname: (* name in input file *)
string ):
boolean;
(* This function returns true if the input file is a new-format .snd
file, or at least _not_ an old-format .snd file. *)
var
sndfile: (* input file *)
file;
firstbyte: (* first byte of the file *)
byte;
IDtag: (* ID tag for new .snd file *)
array [0..1] of byte;
bytesread: (* number of bytes successfully read *)
word;
begin (* is_newsnd *)
(* open the input file *)
assign( sndfile, sndname );
{$I-} reset( sndfile, 1 ); {$I+}
(* Note: For some bizarre reason, reset() fails on read-only files. *)
(* I decided to live with it (... and make my users live with it). *)
if IOResult <> 0 then
begin
writeln( 'File ', sndname, ' does not exist.' );
writeln( 'Check the filename and try again.' );
halt( 1 );
end;
(* if the file does not contain at least 46 bytes, it's not a new-
format file (we verify the file size to keep from seeking or reading
past the end of the file) *)
if filesize( sndfile ) < 46 then
begin
is_newsnd := false;
exit;
end;
(* read the first byte of the file *)
blockread( sndfile, firstbyte, 1, bytesread );
(* seek to the magic number *)
seek( sndfile, 44 );
(* read the ID tag *)
blockread( sndfile, IDtag, 2, bytesread );
(* close the input file *)
close( sndfile );
(* return true if ID is a match *)
is_newsnd := (firstbyte <> $1A) and (IDtag[0] = $1A) and (IDtag[1] = $80);
end; (* is_newsnd *)
(*********************************************************************)
procedure read_newheader(
var sndname: (* name of input .snd file *)
string;
var sndfile: (* input .snd file, opened by this procedure *)
file;
var rate: (* sampling rate from .snd header, returned *)
word;
var numnotes: (* number of notes in the .snd file, returned *)
byte;
var notelist: (* list of notes in the .snd file, returned *)
notearray );
(* This procedure opens the input .snd file and reads the header. If the
input file cannot be opened, or if the input file is a compressed file,
or if EOF is encountered while reading the header, the input file is
closed (if open) and the program is halted with an error message.
This routine is for the new-format .snd files used on the 2500-series. *)
var
open_successful: (* true if input file successfully opened *)
boolean;
fixed_header: (* fixed header from .snd file *)
array [0..113] of byte;
bytesread: (* number of bytes successfully read from the *)
word; (* input file *)
valid: (* true if the input file is valid so far *)
boolean;
wordptr: (* for extracting words from the input buffers *)
^word;
longptr: (* for extracting longs from the input buffers *)
^longint;
i: (* loop counter *)
integer;
note_header: (* note record from .snd file *)
array [0..45] of byte;
nextnote: (* offset in file of next note record *)
longint;
begin (* read_newheader *)
(* attempt to open the input .snd file *)
assign( sndfile, sndname );
{$I-}
reset( sndfile, 1 );
{$I+}
open_successful := (IOResult = 0);
(* if unsuccessful, display an error message and halt the program *)
if not open_successful then
begin
writeln( 'File ', sndname, ' does not exist.' );
writeln( 'Check the filename and try again.' );
halt( 1 );
end;
(* read in the fixed .snd header part *)
blockread( sndfile, fixed_header, 114, bytesread );
(* verify the fixed header *)
valid := (bytesread = 114);
valid := valid and (fixed_header[$2C] = $1A);
valid := valid and (fixed_header[$2D] = $80);
valid := valid and (fixed_header[$42] <= 2);
valid := valid and (fixed_header[$2E] in [1..16]);
(* if there was an error, display a message and halt *)
if not valid then
begin
writeln( 'You specified: ', sndname );
writeln( '... as the input file. It is not a valid .snd file. Either ',
'the file is' );
writeln( 'corrupt, or you tried to convert the wrong file. Check the ',
'filename and try' );
writeln( 'again if you mistyped.' );
close( sndfile );
halt( 1 );
end; (* if not valid *)
(* if the file is compressed, display a message and halt *)
if fixed_header[$42] <> 0 then
begin
writeln( 'The input file you specified: ', sndname );
writeln( '... is compressed. Snd2wav can''t convert compressed ',
'.snd''s. Load the file' );
writeln( 'into Sound.pdm, turn compression off, and resave the file. ',
'Then try again.' );
close( sndfile );
halt( 1 );
end; (* if fixed_header[$42] <> 0 *)
(* extract fixed header information *)
numnotes := fixed_header[$2E];
wordptr := @fixed_header[$58];
rate := wordptr^;
(* Loop over the note records. *)
for i := 1 to numnotes do
begin
(* read in a note record *)
blockread( sndfile, note_header, 46, bytesread );
(* if EOF, halt the program with an error message *)
if bytesread <> 46 then
begin
writeln( 'You specified: ', sndname );
writeln( '... as the input file. It is not a valid .snd file. ',
'Either the file is' );
writeln( 'corrupt, or you tried to convert the wrong file. Check the ',
'filename and try' );
writeln( 'again if you mistyped.' );
close( sndfile );
halt( 1 );
end; (* if bytesread <> 46 *)
(* extract information from note record *)
longptr := @note_header[$0A];
notelist[i].start := longptr^;
longptr := @note_header[$12];
notelist[i].length := longptr^;
(* seek to the next note record *)
longptr := @note_header[0];
nextnote := longptr^;
if nextnote > filesize( sndfile ) then
begin
writeln( 'You specified: ', sndname );
writeln( '... as the input file. It is not a valid .snd file. ',
'Either the file is' );
writeln( 'corrupt, or you tried to convert the wrong file. Check the ',
'filename and try' );
writeln( 'again if you mistyped.' );
close( sndfile );
halt( 1 );
end; (* if nextnote > filesize( sndfile ) *)
seek( sndfile, nextnote );
end; (* for i := 1 to numnotes *)
end; (* read_newheader *)
(*********************************************************************)
procedure read_sndheader(
var sndname: (* name of input .snd file *)
string;
var sndfile: (* input .snd file, opened by this procedure *)
file;
var rate: (* sampling rate from .snd header, returned *)
word;
var numnotes: (* number of notes in the .snd file, returned *)
byte;
var notelist: (* list of notes in the .snd file, returned *)
notearray );
(* This procedure opens the input .snd file and reads the header. If the
input file cannot be opened, or if the input file is a compressed file,
or if EOF is encountered while reading the header, the input file is
closed (if open) and the program is halted with an error message. *)
var
open_successful: (* true if input file successfully opened *)
boolean;
fixed_header: (* fixed header from .snd file *)
array [0..15] of byte;
bytesread: (* number of bytes successfully read from the *)
word; (* input file *)
valid: (* true if the input file is valid so far *)
boolean;
wordptr: (* for extracting words from the input buffers *)
^word;
longptr: (* for extracting longs from the input buffers *)
^longint;
i: (* loop counter *)
integer;
note_header: (* note record from .snd file *)
array [0..27] of byte;
begin (* read_sndheader *)
(* attempt to open the input .snd file *)
assign( sndfile, sndname );
{$I-}
reset( sndfile, 1 );
{$I+}
open_successful := (IOResult = 0);
(* if unsuccessful, display an error message and halt the program *)
if not open_successful then
begin
writeln( 'File ', sndname, ' does not exist.' );
writeln( 'Check the filename and try again.' );
halt( 1 );
end;
(* read in the fixed .snd header part *)
blockread( sndfile, fixed_header, 16, bytesread );
(* verify the fixed header *)
valid := (bytesread = 16);
valid := valid and (fixed_header[0] = $1A);
valid := valid and (fixed_header[1] <= 2);
valid := valid and (fixed_header[2] in [1..16]);
valid := valid and (fixed_header[3] in [0..32, $FF]);
(* if there was an error, display a message and halt *)
if not valid then
begin
writeln( 'You specified: ', sndname );
writeln( '... as the input file. It is not a valid .snd file. Either ',
'the file is' );
writeln( 'corrupt, or you tried to convert the wrong file. Check the ',
'filename and try' );
writeln( 'again if you mistyped.' );
close( sndfile );
halt( 1 );
end; (* if not valid *)
(* if the file is compressed, display a message and halt *)
if fixed_header[1] <> 0 then
begin
writeln( 'The input file you specified: ', sndname );
writeln( '... is compressed. Snd2wav can''t convert compressed ',
'.snd''s. Load the file' );
writeln( 'into Sound.pdm, turn compression off, and resave the file. ',
'Then try again.' );
close( sndfile );
halt( 1 );
end; (* if fixed_header[1] <> 0 *)
(* extract fixed header information *)
numnotes := fixed_header[2];
wordptr := @fixed_header[$0E];
rate := wordptr^;
(* Loop over the note records. *)
for i := 1 to numnotes do
begin
(* read in a note record *)
blockread( sndfile, note_header, 28, bytesread );
(* if EOF, halt the program with an error message *)
if bytesread <> 28 then
begin
writeln( 'You specified: ', sndname );
writeln( '... as the input file. It is not a valid .snd file. ',
'Either the file is' );
writeln( 'corrupt, or you tried to convert the wrong file. Check the ',
'filename and try' );
writeln( 'again if you mistyped.' );
close( sndfile );
halt( 1 );
end; (* if bytesread <> 28 *)
(* extract information from note record *)
longptr := @note_header[4];
notelist[i].start := longptr^;
longptr := @note_header[$10];
notelist[i].length := longptr^;
end; (* for i := 1 to numnotes *)
end; (* read_sndheader *)
(*********************************************************************)
function set_last(
st: string; (* filename to be modified *)
c: char ): (* character to be appended to the filename *)
string;
(* This function takes a filename in st and a character in c. If the
filename (excluding drive, path, and extension) has fewer than 8
characters, the function returns the filename with character c
appended (and with the same drive, path, and extension). If the
filename is already 8 characters long, the last character in the
filename is replaced by c in the string returned. *)
var
slashplace: integer; (* position of last '\' in st *)
colonplace: integer; (* position of last ':' in st *)
dotplace: integer; (* position of last '.' in st *)
pathname: string; (* drive and pathname of st *)
filename: string; (* filename of st, excluding drive, path, and ext *)
ext: string; (* extension of filename *)
begin (* set_last *)
slashplace := lastpos( st, '\');
colonplace := lastpos( st, ':');
if colonplace > slashplace then
slashplace := colonplace;
if slashplace = 0 then
pathname := ''
else
begin
pathname := copy( st, 1, slashplace );
delete( st, 1, slashplace );
end; (* else *)
dotplace := lastpos( st, '.' );
if dotplace = 0 then
begin
filename := st;
ext := '';
end (* if dotplace = 0 *)
else if dotplace = 1 then
begin
filename := '';
delete( st, 1, 1 );
ext := st;
end (* else if dotplace = 1 *)
else (* dotplace > 1 *)
begin
filename := copy( st, 1, dotplace-1 );
delete( st, 1, dotplace );
ext := st;
end; (* else if dotplace > 1 *)
if filename = '' then
set_last := ' ' (* for invalid names, so they won't be opened *)
else
begin
if length( filename ) = 8 then
filename[8] := c
else
filename := filename + c;
set_last := pathname + filename + '.' + ext;
end; (* else if filename <> '' *)
end; (* set_last *)
(*********************************************************************)
function byte2char(
b: byte ): (* byte to be converted *)
char;
(* This function converts byte integer b to an ASCII character. If b is
in the range 0..9, a digit '0'..'9' is returned. Otherwise, if b is
10 or more, an uppercase letter is returned starting with 'A'. *)
begin (* byte2char *)
if b < 10 then
byte2char := chr( b + ord( '0' ) )
else
byte2char := chr( b - 10 + ord( 'A' ) );
end; (* byte2char *)
(*********************************************************************)
procedure convert_note(
var sndfile: (* input .snd file *)
file;
wavname: (* name of output .wav file, may be modified *)
string;
rate: (* sampling rate *)
word;
note: (* note in .snd file to be converted *)
byte;
notelist: (* list of notes in the .snd file *)
notearray );
(* This routine extracts a single note from the input file and writes
that note to a .wav file. If the note is note 1, wavname is used
unmodified as the output filename. Otherwise, the note number is
appended to the output filename, overwriting the last character of
wavname if the name is already 8 characters long. For notes 10-16,
letters A-G will be used. If there is an error reading from the input
file, or if a full disk is detected, both files are closed, the output
file is erased, and the program is halted with an error message. *)
const
bufsize = 2048; (* size of the file I/O buffer *)
type
paoc4 = (* type for labels in the .wav header *)
packed array [0..3] of char;
var
wavfile: (* output .wav file for this note *)
file;
open_successful: (* true if output file successfully opened *)
boolean;
valid: (* true if the start and length of the note data *)
boolean; (* from the notelist are valid *)
notestart: (* starting offset of the note data in the .snd *)
longint; (* file, copied from notelist *)
notelength: (* length of the note data in the .snd file, *)
longint; (* copied from notelist *)
wavheader: (* header for new .wav file *)
array [0..43] of byte;
stptr: (* for filling in string fields in the header *)
^paoc4;
wordptr: (* for filling in word fields in the header *)
^word;
longptr: (* for filling in longint fields in the header *)
^longint;
byteswritten: (* number of bytes successfully written out *)
word;
buffer: (* file I/O buffer for copying samples *)
array [1..bufsize] of byte;
bytesleft: (* number of bytes (samples) left to copy *)
longint;
bytestoread: (* number of bytes to read from the input file *)
word;
bytesread: (* number of bytes successfully read from the *)
word; (* input .snd file *)
begin (* convert_note *)
(* set output filename according to the note number *)
if note > 1 then
wavname := set_last( wavname, byte2char( note ) );
(* attempt to open the output file for writing *)
assign( wavfile, wavname );
{$I-}
rewrite( wavfile, 1 );
{$I+}
open_successful := (IOResult = 0);
(* if unsuccessful, display an error message and halt the program *)
if not open_successful then
begin
writeln;
writeln( 'Unable to create file ', wavname, '.' );
writeln( 'Either the name is not a valid filename, or the disk is ',
'write-protected, or' );
writeln( 'there is already a read-only file with that name. Check the ',
'filename and' );
writeln( 'unprotect the disk, then try again.' );
close( sndfile );
halt( 1 );
end;
(* copy the start and length of the note data from the notelist *)
notestart := notelist[note].start;
notelength := notelist[note].length;
(* If the note length is zero, display a message and exit immediately
(proceeding to the next note). The note length can be zero if an
instrument file was saved after a note was created but before it was
recorded, or if a new sound file was saved before data was recorded
into it. *)
if notelength = 0 then
begin
writeln;
writeln( 'Note number ', note, ' of the input .snd file contains ',
'no samples. The .snd file was' );
writeln( 'saved after a note was created but before sound was recorded ',
'for the note, or' );
writeln( 'the .snd file is a new sound file with no data recorded into ',
'it. This note is' );
writeln( 'being skipped.' );
close( wavfile );
erase( wavfile );
exit;
end; (* if notelength = 0 *)
(* The following is to account for two bugs in earlier versions of
Conv2snd. When version 1.98 was written, the start field of the
.snd header was not known, so Ken set it to zero. He also had
trouble getting the length right. If the file was loaded into
Sound.pdm and resaved as Ken suggested, the problems would be fixed
by Sound.pdm; the following is in case his advice was not heeded. *)
if (notestart = 0) and (note = 1) then
begin
notestart := 44;
if notelength > 255 then
notelength := filesize( sndfile ) - 44;
end; (* if notestart = 0 *)
(* verify that the note data is in fact in the input file, i.e., verify
that the start and length of the note data are valid *)
valid := (notestart >= 44) and (notelength > 0);
valid := valid and (notestart < filesize( sndfile )) and
(notelength < filesize( sndfile ));
valid := valid and (notestart+notelength <= filesize( sndfile ));
(* if the note data is not valid, skip the note and return *)
if not valid then
begin
writeln;
writeln( 'The .snd header information for note number ', note,
' of the input file is invalid.' );
writeln( 'The input .snd file is corrupt or has been truncated. This ',
'note is being' );
writeln( 'skipped.' );
close( wavfile );
erase( wavfile );
exit;
end; (* if not valid *)
(* announce the new file *)
writeln( ' Creating: ', wavname );
(* construct .wav header *)
stptr := @wavheader[0]; (* RIFF header *)
stptr^ := 'RIFF';
longptr := @wavheader[4]; (* length of RIFF data *)
longptr^ := notelength + 36;
stptr := @wavheader[8]; (* WAVE header *)
stptr^ := 'WAVE';
stptr := @wavheader[12]; (* format chunk label *)
stptr^ := 'fmt ';
longptr := @wavheader[16]; (* format chunk length *)
longptr^ := 16;
wordptr := @wavheader[20]; (* format type, 1 = Microsoft PCM *)
wordptr^ := 1;
wordptr := @wavheader[22]; (* number of channels, 1 = mono *)
wordptr^ := 1;
longptr := @wavheader[24]; (* sampling rate, samples per second *)
longptr^ := longint( rate );
longptr := @wavheader[28]; (* data rate, bytes per second *)
longptr^ := longint( rate );
wordptr := @wavheader[32]; (* bytes per (multichannel) sample *)
wordptr^ := 1;
wordptr := @wavheader[34]; (* bits per sample *)
wordptr^ := 8;
stptr := @wavheader[36]; (* data chunk label *)
stptr^ := 'data';
longptr := @wavheader[40]; (* data chunk length *)
longptr^ := notelength;
(* write .wav header to output file *)
blockwrite( wavfile, wavheader, 44, byteswritten );
(* check for full disk *)
if byteswritten <> 44 then
begin
writeln;
writeln( 'The disk where ', wavname );
writeln( '... is to be written is full. Try again and specify ',
'another disk for the' );
writeln( 'output .wav file(s).' );
close( sndfile );
close( wavfile );
erase( wavfile );
halt( 1 );
end; (* if byteswritten <> 44 *)
(* loop over the sound data and copy it to the output file *)
seek( sndfile, notestart );
bytesleft := notelength;
while bytesleft > 0 do
begin
(* determine amount of data to copy this pass *)
if bytesleft > bufsize then
bytestoread := bufsize
else
bytestoread := bytesleft;
(* read in a buffer of sound data *)
blockread( sndfile, buffer, bytestoread, bytesread );
(* if there was an error while reading, halt the program with a
message *)
if bytesread <> bytestoread then
begin
writeln;
writeln( 'Error reading the input .snd file. The disk structure may ',
'be corrupt. Use' );
writeln( 'chkdsk to verify the disk structure.' );
close( sndfile );
close( wavfile );
erase( wavfile );
halt( 1 );
end; (* if bytesread <> bytestoread *)
(* write out the buffer to the .wav file *)
blockwrite( wavfile, buffer, bytesread, byteswritten );
(* if the disk is full, halt the program with an error message *)
if byteswritten <> bytesread then
begin
writeln;
writeln( 'The disk where ', wavname );
writeln( '... is to be written is full. Try again and specify ',
'another disk for the' );
writeln( 'output .wav file(s).' );
close( sndfile );
close( wavfile );
erase( wavfile );
halt( 1 );
end; (* if byteswritten <> bytesread *)
(* update count of bytes left to copy *)
bytesleft := bytesleft - byteswritten;
end; (* while bytesleft > 0 *)
(* close the output file *)
close( wavfile );
end; (* convert_note *)
(*********************************************************************)
procedure display_exit;
(* This procedure displays an exit banner on successful conversion. *)
begin (* display_exit *)
writeln( 'Conversion complete. Thank you for using Snd2wav.' );
end; (* display_exit *)
(*********************************************************************)
begin (* snd2wav *)
display_intro;
get_filenames( sndname, wavname );
if is_newsnd( sndname ) then
read_newheader( sndname, sndfile, rate, numnotes, notelist )
else
read_sndheader( sndname, sndfile, rate, numnotes, notelist );
writeln( 'Converting: ', sndname );
for note := 1 to numnotes do
convert_note( sndfile, wavname, rate, note, notelist );
close( sndfile );
writeln;
display_exit;
halt( 0 ); (* errorlevel 0 = success *)
end. (* snd2wav *)