Работа с WAVE файлами. [PAS,SoundBlaster]

uses DOS,CRT;
type
 WAVHeader = record
  Str1       : array[1..4] of char;  { ='RIFF'}
  FLen       : longint;              { Длина файла от следующего поля}
  Str2       : array[1..8] of char;  { ='WAVEfmt '}
  InfoLen    : longint;              { Обычно = 16}
  Tag        : word;                 { 1- Linear PCM}
  ChanNum    : word;                 { 1 - моно, 2 - стерео, 4 - квадро}
  SamFreq    : longint;              { Частота сэмплинга}
  BytePerSec : longint;              { Байт в секунду}
  BlockSize  : word;                 { Байт на полный сэмпл}
  BitPerSamp : word;                 { Разрядность оцифровки }
  Str3       : array[1..4] of char;  { ='data'}
  DataLen    : longint;
 end;

{Фрагмент}
 TWaveItem = record
  Buffer : pointer;
  Length : word;
 end;

{Массив для загрузки данных длиной более 64К}
 PWaveArray = ^TWaveArray;
 TWaveArray = array[1..255] of TWaveItem;

const
{Длина одного загружаемого фрагмента}
 PartLength = $FF00;

{Коды устройств воспроизведения}
 dvCoVox = 0;
 dvSB    = 1;
 dvPC    = 2;

{ Таблица сэмплинга для PC Speaker}
 PCTable : array[byte] of byte =
 (1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,
 2,2,3,3,3,3,3,3,3,3,3,3,3,4,4,4,4,
 4,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,
 5,5,5,6,6,6,6,6,6,6,6,6,6,6,6,6,7,
 7,7,7,7,7,7,7,7,7,7,8,8,8,8,8,8,8,
 8,8,8,8,8,8,9,9,9,9,9,9,9,10,10,10,10,
 11,11,12,12,13,14,14,15,16,17,17,18,19,20,21,22,23,
 24,26,27,28,29,30,31,33,34,35,36,38,39,40,41,43,44,
 45,46,48,49,50,51,52,53,54,55,57,58,58,59,60,61,62,
 63,64,64,65,66,66,67,67,67,67,67,67,68,68,68,68,68,
 68,68,68,68,68,68,68,68,69,69,69,69,69,69,69,69,69,
 69,69,70,70,70,70,70,70,70,70,70,70,70,70,70,71,71,
 71,71,71,71,71,71,71,71,71,72,72,72,72,72,72,72,72,
 72,72,72,72,72,73,73,73,73,73,73,73,73,73,73,73,74,
 74,74,74,74,74,74,74,74,74,74,74,74,75,75,75,75,75,75);

{Константы, измняемые из командной строки}
const
 BasePort : word = $378;         {Порт данных LPT1}
 BlasterPort : word = $220;      {Порт SB}
 QuietMode : boolean = false;    {"Тихий" режим}
 PlayLoop : boolean = false;     {Циклический режим}
 Device : byte = dvCoVox;        {Устройство - SB,CoVox или Speaker}
 DumpOnly : boolean = false;     {Информация из заголовка}
 LptN : word = 1;                {Hомер LPT}

{Внутренние переменные - внести в implementation}
var
 WHeader     : WAVHeader;
 CurrentPart : byte;
 NSample     : word;
 IsPlaying   : boolean;
 Data        : PWaveArray;

{Переменные для сохранения исходных установок системы}
var
 OldInt08 : pointer;
 LastShape : word;

{$F+}
{Собственно процедура воспроизведения сэмпла}
procedure Player; assembler;
asm
 push   ds
 push   es
 push   dx
 push   bx
 push   ax

 mov    ax,SEG @Data
 mov    ds,ax
 mov    al,CurrentPart
 dec    al
 mov    ah,06h
 mul    ah
 les    bx,Data
 add    bx,ax
 push   bx
 push   es
 les    bx,es:[bx]
 mov    ax,es
 mov    dx,bx
 or     ax,dx
 jz     @TheEnd
 add    bx,NSample
 mov    al,byte ptr es:[bx]

 cmp    Device,dvPC
 je     @PCSpeaker
 cmp    Device,dvSB
 je     @Blaster
 mov    dx,BasePort
 out    dx,al
(*add    dx,2h     {Вроде бы положено, но работает и так}
 mov    al,0fdh
 out    dx,al*)
 jmp    @EndSample
@PCSpeaker:
 mov    bx,SEG @Data
 mov    es,dx
 mov    bx,offset PCTable
 xlat
 out    42h,al
 jmp    @EndSample
@Blaster:
 mov    ah,al
 mov    dx,BlasterPort
 add    dx,0Ch
@Wait1:
 in     al,dx
 and    al,80h
 jnz    @Wait1
 mov    al,10h
 out    dx,al
@Wait2:
 in     al,dx
 and    al,80h
 jnz    @Wait2
 mov    al,ah
 out    dx,al
@EndSample:
 pop    es
 pop    bx
 inc    NSample
 mov    ax,NSample
 cmp    ax,word ptr es:[bx+4]
 jbe    @EndInt
@NextPart:
 mov    ax,0
 mov    NSample,ax
 inc    CurrentPart
 jmp    @EndInt
@TheEnd:
 pop    es
 pop    bx
 mov    al,false
 mov    IsPlaying,al
@EndInt:
 mov    al,20h
 out    20h,al
 pop    ax
 pop    bx
 pop    dx
 pop    es
 pop    ds
 iret
end;
{$F-}

{Установка системных параметров}
procedure SetupPlayer;
begin
 asm cli end;  {Можно InLine, но так понятнее}
 GetIntVec($08,OldInt08);
 SetIntVec($08,Addr(Player));
 asm
  mov   al,36h
  out   43h,al
  mov   cx,WHeader.SamFreq.word[0]
  mov   ax,34DCh
  mov   dx,0012h
  div   cx              {DX:AX = делитель частоты}
  out   40h,al
  xchg  al,ah
  out   40h,al
  sti
  cmp   Device,dvSB
  je    @Blaster
  cmp   Device,dvPC
  je    @PCSpeaker
  jmp   @Exit
@Blaster:
  mov   dx,BlasterPort
  add   dx,0Ch
@Wait:
  in    al,dx
  and   al,80h
  jnz   @Wait
  mov   al,0D1h         {Инициализация SB}
  out   dx,al
  jmp   @Exit
@PCSpeaker:            {Выставление режима работы динамика}
 mov    al,0B0h
 out    43h,al
 mov    al,1
 out    42h,al
 mov    al,0
 out    42h,al
 in     al,61h
 or     al,3
 out    61h,al
 mov    al,90h
 out    43h,al
@Exit:
end;
end;

{Восстановление предыдущих установок}
procedure ResetPlayer;
begin
 asm cli end;
 SetIntVec($08,OldInt08);
 asm
  mov   al,36h
  out   43h,al
  xor   al,al
  out   40h,al
  out   40h,al
  sti
 end;
 OldInt08:=nil;
end;

{Спрятать курсор - см. TechHelp}
procedure HideCursor; assembler;
asm
 mov    ah,03h
 int    10h
 mov    LastShape,cx
 mov    ch,20h
 mov    ah,01h
 int    10h
end;

{Восстановить курсор - см. там же}
procedure ShowCursor; assembler;
asm
 mov    cx,LastShape
 mov    ah,01h
 int    10h
end;

{Можно использовать KeyPressed из CRT, но придется читать значения клавиши}
function GetKey:word; assembler;
asm
   mov  ah,01h
   int  16h
   mov  ax,0
   jz   @Quit
   int  16h
@Quit:
end;

{Простая и в то же время незаменимая процедура - см. HelpCompiler из TV}
procedure FixName(var Name:PathStr;Ext:ExtStr;Change:boolean);
var
 N : NameStr;
 D : DirStr;
 E : ExtStr;
begin
 FSplit(Name,D,N,E);
 if Change or (E='') or (E='.') then E:=Ext;
 Name:=D+N+E;
end;

{Комментарии излишни...}
procedure Error(What:string);
begin
 if OldInt08nil then
  ResetPlayer;
 WriteLn(What);
 Halt(1);
end;

{Резервирование в памяти места для звуковых данных - возможно длиннее 64К}
function NewArray(Len:longint):PWaveArray;
var
 Arr : PWaveArray;
 N,I : byte;
begin
 NewArray:=nil;
 N:=(Len div PartLength);
 GetMem(Arr,(N+2)*6);
 for I:=1 to N do
  begin
   if MemAvailnil do
  begin
   FreeMem(Arr^[N].Buffer,Arr^[N].Length);
   Inc(N);
  end;
 FreeMem(Arr,N*6);
end;

{Загрузка данных из .WAV-файла}
function LoadWave(FName:string):PWaveArray;
var
 F : file;
 D : PWaveArray;
 DataL : longint;
 N : byte;
begin
 LoadWave:=nil;
 Assign(F,FName);
 Reset(F,1);
 BlockRead(F,WHeader,SizeOf(WHeader));
 if (WHeader.Str1'RIFF') or
    (WHeader.Str2'WAVEfmt ') or
    (WHeader.Str3'data')
 then
  Exit;
 DataL:=WHeader.DataLen;
 D:=NewArray(DataL);
 if D=nil then
  Error('Not enough memory to load wave: '+FName);
 N:=1;
 while DataL>PartLength do
  begin
   BlockRead(F,D^[N].Buffer^,PartLength);
   Inc(N);
   Dec(DataL,PartLength);
  end;
 BlockRead(F,D^[N].Buffer^,DataL);
 Close(F);
 LoadWave:=D;
end;

{Показать подсказку - а то сами не поняли!}
procedure ShowHelp;
begin
 WriteLn('Usage: WavePlay  [/options]');
 WriteLn('Where options are:');
 WriteLn(' /q      - quiet mode (No display output)');
 WriteLn(' /s[XXX] - play through SoundBlaster (base port XXX),0x220 by
default');
 WriteLn(' /c[X]   - play through CoVox (DAC) at LPT port X, LPT1 (port 0x378)
by default');
 WriteLn(' /p      - play through PC Speaker');
 WriteLn(' /l      - loop cyclic play');
 WriteLn(' /d,/x   - dump WAV file header');
 WriteLn(' /h,/?   - this help message');
 Halt(0);
end;

procedure WriteDump(FName:string);
var
 F : file;
begin
 Assign(F,FName);
 Reset(F,1);
 BlockRead(F,WHeader,SizeOf(WHeader));
 if (WHeader.Str1'RIFF') or
    (WHeader.Str2'WAVEfmt ') or
    (WHeader.Str3'data')
 then
  Error('Invalid WAV file...');
 with WHeader do
  begin
   WriteLn('File: ',FName);
   WriteLn('Number of channels: ',ChanNum);
   WriteLn('Bits per sample: ',BitPerSamp);
   WriteLn('Sampling frequency: ',SamFreq);
   WriteLn('Playing time: ',DataLen/BytePerSec:6:2,' sec.');
  end;
 Halt(0);
end;

var
 ProgressBar : string[60];
 Done : longint;
 FileName : PathStr;
 HaveName : boolean;

procedure ReadParams;
var
 N : byte;
 S : string;
function ConvertHex(S:string;OldValue:word):word;
var
 W : word;
 B : byte;
 Con : word;
const
 HexByte : string[16]='0123456789ABCDEF';
begin
 ConvertHex:=OldValue;
 if byte(S[0])=0 then Exit;
 Con:=1;
 W:=0;
 for B:=byte(S[0]) downto 1 do
  begin
   if Pos(UpCase(S[B]),HexByte)=0 then
    begin
     WriteLn('Can'#$27't convert to value - '+S+'...');
     ConvertHex:=OldValue;
     Exit;
    end
   else
    W:=W+Con*(Pos(UpCase(S[B]),HexByte)-1);
   Con:=Con*16;
  end;
 ConvertHex:=W;
end;

begin
 if ParamCount=0 then
  begin
   WriteLn('Usage: WavePlay  [/options]');
   WriteLn('WavePlay /h for online help');
   Halt(1);
  end;
 HaveName:=false;
 for N:=1 to ParamCount do
  begin
   S:=ParamStr(N);
   if S[1] in['/','-'] then
    case UpCase(S[2]) of
     'H','?':ShowHelp;
     'Q':QuietMode:=true;
     'L':PlayLoop:=true;
     'P':Device:=dvPC;
     'S':begin
      Device:=dvSB;
      BlasterPort:=ConvertHex(Copy(S,3,255),BlasterPort);
     end;
     'C':begin
      Device:=dvCoVox;
      LPTN:=ConvertHex(Copy(S,3,255),LPTN);
     end;
     'D','X':DumpOnly:=true;
    else
     WriteLn('Unknown switch '+S);
    end
   else
    begin
     FileName:=S;
     FixName(FileName,'.WAV',false);
     HaveName:=true;
    end;
  end;
 if not HaveName then
  begin
   WriteLn('No valid filename given...');
   Halt(1);
  end;
end;

var
 Percent : word;

begin
 OldInt08:=nil;
 WriteLn;
 WriteLn('WAVEPlayer version 1.0 Copyright (C) 1995 by Serge Aksenov');
 WriteLn;
 ReadParams;
 if DumpOnly then WriteDump(FileName);
 if (LPTN>0) and (LPTN0 then
     begin
      IsPlaying:=false;
      PlayLoop:=False;
      Break;
     end;
    Delay(50);
    if (not QuietMode) and (IsPlaying) then
     begin
      Done:=CurrentPart;
      Done:=(Done-1)*PartLength+NSample;
      Percent:=longint(Done*100) div WHeader.DataLen;
      FillChar(ProgressBar[1],60*Percent div 100,'-');
      GoToXY(10,WhereY-2);
      WriteLn('Playing: ',FileName,Percent:4,'% done.');
      GoToXY(10,WhereY);
      WriteLn(ProgressBar);
     end;
   end;
  ResetPlayer;
  if not (QuietMode) then
   begin
    FillChar(ProgressBar[1],60,'-');
    GoToXY(10,WhereY-2);
    WriteLn('Playing: ',FileName,' 100% done.');
    GoToXY(10,WhereY);
    WriteLn(ProgressBar);
   end;
  Delay(100);
 until not PlayLoop;
 ShowCursor;
 DisposeArray(Data);
end.