snd_win.pas

雷神之锤2(Quake2)Delphi源码

{----------------------------------------------------------------------------}
{                                                                            }
{ File(s): snd_win.c                                                         }
{ Content:  Quake2\win32\ sound & sound FX routines                          }
{                                                                            }
{ Initial conversion by : Massimo Soricetti ([e-mail])               }
{ Initial conversion on : 09-Jan-2002                                        }
{                                                                            }
{ This File contains part of convertion of Quake2 source to ObjectPascal.    }
{ More information about this project can be found at:                       }
{ http://www.sulaco.co.za/quake2/                                            }
{                                                                            }
{ Copyright (C) 1997-2001 Id Software, Inc.                                  }
{                                                                            }
{ This program is free software; you can redistribute it and/or              }
{ modify it under the terms of the GNU General Public License                }
{ as published by the Free Software Foundation; either version 2             }
{ of the License, or (at your option) any later version.                     }
{                                                                            }
{ This program is distributed in the hope that it will be useful,            }
{ but WITHOUT ANY WARRANTY; without even the implied warranty of             }
{ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                       }
{                                                                            }
{ See the GNU General Public License for more details.                       }
{                                                                            }
{----------------------------------------------------------------------------}
{ Updated on : 03-jun-2002                                                   }
{ Updated by : Juha Hartikainen                                              }
{ - Added needed units to uses clause                                        }
{ - Fixed some language errors                                               }
{                                                                            }
{ Updated on : 04-jun-2002                                                   }
{ Updated by : Juha Hartikainen                                              }
{ - Moved some functions to interface                                        }
{                                                                            }
{ Updated on : 05-jul-2002                                                   }
{ Updated by : Sly                                                           }
{ - Added some stub functions because the sound code tends to crash          }
{                                                                            }
{ Updated on : 05-jul-2002                                                   }
{ Updated by : Sly                                                           }
{ - Removed stub functions.  Seems to be not crashing.                       }
{                                                                            }
{----------------------------------------------------------------------------}
{ * Still dependent (to compile correctly) on:                               }
{ none                                                                       }
{----------------------------------------------------------------------------}
{ * TODO:                                                                    }
{ none                                                                       }
{----------------------------------------------------------------------------}

unit snd_win;

interface

uses
  Windows,
  MMsystem,
  q_shared,
  snd_loc,
  client,
  DirectSound;

// 64K is > 1 second at 16-bit, 22050 Hz

function SNDDMA_Init(): boolean;
function SNDDMA_GetDMAPos(): integer;
procedure SNDDMA_BeginPainting ();
procedure SNDDMA_Submit();
procedure SNDDMA_Shutdown();

procedure S_Activate (active: qboolean);
procedure FreeSound ();


const
  WAV_BUFFERS	          =	64;
  WAV_MASK	            =	$3F;
  WAV_BUFFER_SIZE	      = $0400;
  SECONDARY_BUFFER_SIZE =	$10000;

type
  sndinitstat = (SIS_SUCCESS, SIS_FAILURE, SIS_NOTAVAIL);

  TWaveHDRArray = array[0..WAV_BUFFERS-1] of WAVEHDR;

var

{ * Global variables. Must be visible to window-procedure function
  *  so it can unlock and free the data block after it has been played. }

  hData: THANDLE;
  lpData, lpData2: Pointer;
  hWaveHdr: HGLOBAL; // GlobalAlloc handle
  lpWaveHdr: ^TWaveHDRArray;
  hWaveOut_: HWAVEOUT;
  wavecaps: WAVEOUTCAPS;
  gSndBufSize: DWORD;

  mmstarttime: MMTIME;

  pDS: IDIRECTSOUND;
  pDSBuf, pDSPBuf: IDIRECTSOUNDBUFFER;

//  hInstDS: DWORD;


implementation

uses
  Cmd,
  CVar,
  Common,
  vid_dll,
  snd_dma;


var
  s_wavonly: cvar_p;

  dsound_init,
  wav_init: qboolean;
  snd_firsttime: qboolean = true;
  snd_isdirect, snd_iswave,
  primary_format_set: qboolean;

  // starts at 0 for disabled
  snd_buffer_count: integer = 0;
  sample16,
  snd_sent, snd_completed: integer;


Function DSoundError( error: integer ): Pchar;
begin
  case error of
    DSERR_BUFFERLOST: Result:= 'DSERR_BUFFERLOST';
    DSERR_INVALIDCALL: Result:= 'DSERR_INVALIDCALLS';
    DSERR_INVALIDPARAM: Result:= 'DSERR_INVALIDPARAM';
    DSERR_PRIOLEVELNEEDED: Result:= 'DSERR_PRIOLEVELNEEDED';
  else
    Result:= 'unknown';
  end;
end;

{
** DS_CreateBuffers
}
function DS_CreateBuffers(): qboolean;
var
  dsbuf: TDSBUFFERDESC;
  dsbcaps: TDSBCAPS;
  pformat, format: TWAVEFORMATEX;
  dwWrite: DWORD;
begin
  FillChar (format, sizeof(format), 0);
  format.wFormatTag := WAVE_FORMAT_PCM;
  format.nChannels := dma.channels;
  format.wBitsPerSample := dma.samplebits;
  format.nSamplesPerSec := dma.speed;
  format.nBlockAlign := format.nChannels * format.wBitsPerSample div 8;
  format.cbSize := 0;
  format.nAvgBytesPerSec := format.nSamplesPerSec*format.nBlockAlign;

  Com_Printf( 'Creating DS buffers'#10, [] );

  Com_DPrintf('...setting EXCLUSIVE coop level: ', []);
  if DS_OK <> pDS.SetCooperativeLevel( cl_hwnd, DSSCL_EXCLUSIVE ) then
  begin
    Com_Printf ('failed'#10, []);
    FreeSound ();
    Result := false;
    Exit;
  end;
  Com_DPrintf('ok'#10, [] );

// get access to the primary buffer, if possible, so we can set the
// sound hardware format
  FillChar (dsbuf, sizeof(dsbuf), 0);
  dsbuf.dwSize := sizeof(TDSBUFFERDESC);
  dsbuf.dwFlags := DSBCAPS_PRIMARYBUFFER;
  dsbuf.dwBufferBytes := 0;
  dsbuf.lpwfxFormat := nil;

  FillChar(dsbcaps, sizeof(dsbcaps), 0);
  dsbcaps.dwSize := sizeof(dsbcaps);
  primary_format_set := false;

  Com_DPrintf( '...creating primary buffer: ', [] );
  if DS_OK = pDS.CreateSoundBuffer(dsbuf, pDSPBuf, nil) then
  begin
    pformat := format;

    Com_DPrintf( 'ok'#10, [] );
    if (DS_OK <> pDSPBuf.SetFormat(@pformat)) then
    begin
      if snd_firsttime then
	      Com_DPrintf ('...setting primary sound format: failed'#10, []);
    end
    else
    begin
      if snd_firsttime then
	      Com_DPrintf ('...setting primary sound format: ok'#10, []);
      primary_format_set := true;
    end;
  end
  else
    Com_Printf( 'failed'#10, [] );

  if (not primary_format_set) or (s_primary^.value=0) then
  begin
  // create the secondary buffer we'll actually work with
    FillChar (dsbuf, sizeof(dsbuf), 0);
    dsbuf.dwSize := sizeof(TDSBUFFERDESC);
    dsbuf.dwFlags := DSBCAPS_CTRLFREQUENCY and DSBCAPS_LOCSOFTWARE;
    dsbuf.dwBufferBytes := SECONDARY_BUFFER_SIZE;
    dsbuf.lpwfxFormat := @format;

    FillChar(dsbcaps, sizeof(dsbcaps), 0);
    dsbcaps.dwSize := sizeof(dsbcaps);
    Com_DPrintf( '...creating secondary buffer: ' , []);
    if (DS_OK <> pDS.CreateSoundBuffer( dsbuf, pDSBuf, nil)) then
    begin
      Com_Printf( 'failed'#10 , []);
      FreeSound ();
      Result := false;
      Exit;
    end;
    Com_DPrintf( 'ok'#10 , []);

    dma.channels := format.nChannels;
    dma.samplebits := format.wBitsPerSample;
    dma.speed := format.nSamplesPerSec;

    if (DS_OK <> pDSBuf.GetCaps(dsbcaps)) then
    begin
      Com_Printf ('*** GetCaps failed ***'#10, []);
      FreeSound ();
      result := false;
      exit;
    end;

    Com_Printf ('...using secondary sound buffer'#10, []);
  end
  else
  begin
    Com_Printf( '...using primary buffer'#10 , []);
    Com_DPrintf( '...setting WRITEPRIMARY coop level: ' , []);
    if (DS_OK <> pDS.SetCooperativeLevel (cl_hwnd, DSSCL_WRITEPRIMARY)) then
    begin
      Com_Printf( 'failed'#10, [] );
      FreeSound ();
      Result:= False;
      Exit;
    end;
    Com_DPrintf( 'ok'#10, [] );
    if DS_OK <> pDSPBuf.GetCaps(dsbcaps) then
    begin
      Com_Printf ('*** GetCaps failed ***'#10, []);
      Result:= false;
      Exit;
    end;

    pDSBuf := pDSPBuf;
  end;

  // Make sure mixer is active
  pDSBuf.Play(0, 0, DSBPLAY_LOOPING);
  if snd_firsttime then
    Com_Printf('   %d channel(s)'#10 +
               '   %d bits/sample'#10 +
    	   '   %d bytes/sec'#10, [dma.channels, dma.samplebits, dma.speed]);

    gSndBufSize := dsbcaps.dwBufferBytes;

	// we don't want anyone to access the buffer directly w/o locking it first.
  lpData := nil;

  pDSBuf.Stop();
  pDSBuf.GetCurrentPosition(@mmstarttime.sample, @dwWrite);
  pDSBuf.Play(0, 0, DSBPLAY_LOOPING);

  dma.samples := gSndBufSize div (dma.samplebits div 8);
  dma.samplepos := 0;
  dma.submission_chunk := 1;
  dma.buffer := lpData;
  sample16 := dma.samplebits div 8 - 1;

  Result := true;
end;

{
** DS_DestroyBuffers
}
Procedure DS_DestroyBuffers();
begin
  Com_DPrintf( 'Destroying DS buffers'#10, [] );
  if Assigned(pDS) then
  begin
    Com_DPrintf( '...setting NORMAL coop level'#10, [] );
    pDS.SetCooperativeLevel( cl_hwnd, DSSCL_NORMAL );
  end;

  if Assigned(pDSBuf) then
  begin
    Com_DPrintf( '...stopping and releasing sound buffer'#10, [] );
    pDSBuf.Stop();
    //pDSBuf._Release();
    pDSBuf := nil;
  end;

  // only release primary buffer if it's not also the mixing buffer we just released
  if Assigned(pDSPBuf) and ( pDSBuf <> pDSPBuf ) then
  begin
    Com_DPrintf( '...releasing primary buffer'#10, [] );
    //pDSPBuf._Release( );
    pDSPBuf := nil;
  end;
  dma.buffer := nil;
end;

{
=========
FreeSound
=========
}
Procedure FreeSound ();
var
  i: integer;
begin
  Com_DPrintf( 'Shutting down sound system'#10, [] );

  if pDS <> nil then
    DS_DestroyBuffers();

  if hWaveOut_ <> 0 then
  begin
    Com_DPrintf( '...resetting waveOut'#10, [] );
    waveOutReset (hWaveOut_);

    if lpWaveHdr <> nil then
    begin
      Com_DPrintf( '...unpreparing headers'#10, [] );
      for i:=0 to WAV_BUFFERS - 1 do
	      waveOutUnprepareHeader (hWaveOut_, @lpWaveHdr[i], sizeof(WAVEHDR));
    end;

    Com_DPrintf( '...closing waveOut'#10, [] );
    waveOutClose (hWaveOut_);

    if hWaveHdr <> 0 then
    begin
      Com_DPrintf( '...freeing WAV header'#10, [] );
      GlobalUnlock(hWaveHdr);
      GlobalFree(hWaveHdr);
    end;

    if hData <> 0 then
    begin
      Com_DPrintf( '...freeing WAV buffer'#10, [] );
      GlobalUnlock(hData);
      GlobalFree(hData);
    end;

  end;

  if pDS <> nil then
  begin
    Com_DPrintf( '...releasing DS object'#10, [] );
    pDS := nil;
  end;

  Com_DPrintf( '...freeing DSOUND.DLL'#10, [] );

  hWaveOut_ := 0;
  hData := 0;
  hWaveHdr := 0;
  lpData := nil;
  lpWaveHdr := nil;
  dsound_init := false;
  wav_init := false;
end;

{
=========
SNDDMA_InitDirect

Direct-Sound support
=========
}
function SNDDMA_InitDirect(): sndinitstat;
var
  dscaps: TDSCAPS;
  hresult_: HRESULT;
begin
  dma.channels := 2;
  dma.samplebits := 16;

  if Trunc(s_khz^.value) = 44 then
    dma.speed := 44100;
  if Trunc(s_khz^.value) = 22 then
    dma.speed := 22050
  else
    dma.speed := 11025;

  Com_Printf( 'Initializing DirectSound'#10, []);

  // Juha: This doesn't look original, since DirectSound.pas does this already
  Com_DPrintf( '...loading dsound.dll: ', [] );
  if DSoundDLL = 0 then
  begin
    Com_Printf ('failed'#10, []);
    Result := SIS_FAILURE;
    Exit;
  end;

  Com_DPrintf ('ok'#10, []);

  if @DirectSoundCreate = nil then
  begin
    Com_Printf ('*** couldn''t get DS proc addr ***'#10, []);
    Result := SIS_FAILURE;
    Exit;
  end;

  Com_DPrintf( '...creating DS object: ', [] );

  hresult_ := DirectSoundCreate( nil, pDS, nil );

  while hresult_ <> DS_OK do
  begin
    if hresult_ <> DSERR_ALLOCATED then
    begin
      Com_Printf( 'failed'#10, [] );
      Result := SIS_FAILURE;
      Exit;
    end;

    if (MessageBox (0, 'The sound hardware is in use by another app.'#10#10 +
	                     'Select Retry to try to start sound again or Cancel to run Quake with no sound.',
                       'Sound not available',
                       MB_RETRYCANCEL or MB_SETFOREGROUND or MB_ICONEXCLAMATION) <> IDRETRY) then