snd_dma.pas

雷神之锤2(Quake2)Delphi源码

{----------------------------------------------------------------------------}
{                                                                            }
{ File(s): snd_dma.c                                                         }
{ Content: Quake2\ref_soft\ sound structures and constants                   }
{                                                                            }
{ Initial conversion by : Skaljac Bojan ([e-mail])                  }
{ Initial conversion on : 17-Feb-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                                                              }
{ - Language fixes to make this (near to) compile.                           }
{}
{ Updated on : 06-jun-2002                                                   }
{ Updated by : Juha Hartikainen                                              }
{ - Fixed bug in S_StartSound.                                               }
{----------------------------------------------------------------------------}
{ * Still dependent (to compile correctly) on:                               }
{----------------------------------------------------------------------------}
{ * TODO:                                                                    }
{ 1. Some test of couple functions in this unit                              }
{ 2. Still some more little fixing }
{----------------------------------------------------------------------------}
// snd_dma.pas -- main control for any streaming sound output device
unit snd_dma;

interface

uses
  Snd_loc,
  q_shared,
  SysUtils,
  Classes;

procedure S_Init; cdecl;
procedure S_Play; cdecl;
procedure S_SoundList; cdecl;
procedure S_Update(origin, _forward, right, up: vec3_t);
procedure S_Update_; cdecl;
procedure S_StopAllSounds; cdecl;
procedure S_IssuePlaysound (ps: playsound_p); cdecl;
procedure S_RawSamples(samples, rate, width, channels: Integer; data: PByte); cdecl;
procedure S_StartSound(origin: vec3_p; entnum, entchannel: Integer; sfx: sfx_p; fvol, attenuation, timeofs: Single); cdecl;
function S_RegisterSound(name: PChar): sfx_p; cdecl;
procedure S_Shutdown; cdecl;
procedure S_BeginRegistration;
procedure S_EndRegistration;
procedure S_StartLocalSound(sound: PChar);

// =======================================================================
// Internal sound data & structures
// =======================================================================
// only begin attenuating sound volumes when outside the FULLVOLUME range
const
  SOUND_FULLVOLUME = 80;
	SOUND_LOOPATTENUATE	= 0.003;

var
  s_registration_sequence : Integer;

  channels : array[0..MAX_CHANNELS-1] of channel_t;

  snd_initialized : qboolean = false;
	sound_started : Integer = 0;

  dma : dma_t;

  listener_origin     :vec3_t;
  listener_forward    :vec3_t;
  listener_right      :vec3_t;
  listener_up         :vec3_t;

  s_registering : QBoolean;

  soundtime      : Integer;	// sample PAIRS
  paintedtime    : Integer; 	// sample PAIRS

// during registration it is possible to have more sounds
// than could actually be referenced during gameplay,
// because we don't want to free anything until we are
// sure we won't need it.
const
  MAX_SFX	     =	(MAX_SOUNDS*2);
  MAX_PLAYSOUNDS	= 128;

var
  s_playsounds   : Array[0..MAX_PLAYSOUNDS-1] of playsound_t;
  s_freeplays    : playsound_t;
  s_pendingplays : playsound_t;

  s_beginofs     : Integer;


  s_volume       : cvar_p; // cvar_t  *name;
  s_testsound    : cvar_p; // cvar_t  *name;
  s_loadas8bit   : cvar_p; // cvar_t  *name;
  s_khz          : cvar_p; // cvar_t  *name;
  s_show         : cvar_p; // cvar_t  *name;
  s_mixahead     : cvar_p; // cvar_t  *name;
  s_primary      : cvar_p; // cvar_t  *name;

  s_rawend       : Integer;

  s_rawsamples_   : array[0..MAX_RAW_SAMPLES-1] of portable_samplepair_t;

implementation

uses
  Client,
  CPas,
  cl_main,
  cl_ents,
  Common,
  CVar,
  Cmd,
  Files,
  snd_win,
  snd_mix,
  snd_mem;

type
  TSmallIntArray = array[0..0] of SmallInt;
  PSmallIntArray = ^TSmallIntArray;
  TShortIntArray = array[0..0] of ShortInt;
  PShortIntArray = ^TShortIntArray;
var
  known_sfx: array[0..MAX_SFX-1] of sfx_t;
  num_sfx: Integer;



// ====================================================================
// User-setable variables
// ====================================================================


procedure S_SoundInfo_f; cdecl;
begin
	if (sound_started=0) then
	begin
		Com_Printf ('sound system not started'#10,[]);
		exit;
	end;
    Com_Printf('%5d stereo'#10, [dma.channels - 1]);
    Com_Printf('%5d samples'#10, [dma.samples]);
    Com_Printf('%5d samplepos'#10, [dma.samplepos]);
    Com_Printf('%5d samplebits'#10, [dma.samplebits]);
    Com_Printf('%5d submission_chunk'#10, [dma.submission_chunk]);
    Com_Printf('%5d speed'#10, [dma.speed]);
    Com_Printf('$%x dma buffer'#10, [Cardinal(dma.buffer)]);
end;

(*
================
S_Init
================
*)
procedure S_Init;
var
  cv: cvar_p;
begin
	Com_Printf(#10'------- sound initialization -------'#10,[]);

	cv := Cvar_Get ('s_initsound', '1', 0);
	if (cv.value=0) then
		Com_Printf ('not initializing.'#10,[])
	else
	begin
		s_volume := Cvar_Get ('s_volume', '0.7', CVAR_ARCHIVE);
		s_khz := Cvar_Get ('s_khz', '11', CVAR_ARCHIVE);
		s_loadas8bit := Cvar_Get ('s_loadas8bit', '1', CVAR_ARCHIVE);
		s_mixahead := Cvar_Get ('s_mixahead', '0.2', CVAR_ARCHIVE);
		s_show := Cvar_Get ('s_show', '0', 0);
		s_testsound := Cvar_Get ('s_testsound', '0', 0);
		s_primary := Cvar_Get ('s_primary', '0', CVAR_ARCHIVE);	// win32 specific

		Cmd_AddCommand('play', S_Play);
		Cmd_AddCommand('stopsound', S_StopAllSounds);
		Cmd_AddCommand('soundlist', S_SoundList);
		Cmd_AddCommand('soundinfo', S_SoundInfo_f);

		if (not SNDDMA_Init) then
			exit;

		S_InitScaletable;

		sound_started := 1;
		num_sfx := 0;

		soundtime := 0;
		paintedtime := 0;

		Com_Printf('sound sampling rate: %d'#10,[dma.speed]);

		S_StopAllSounds;
	end;

	Com_Printf(#10'------------------------------------'#10, []);
end;

// =======================================================================
// Shutdown sound engine
// =======================================================================

procedure S_Shutdown;
var
  i : Integer;
begin
	if (sound_started=0) then
		exit;

	SNDDMA_Shutdown;

	sound_started := 0;

	Cmd_RemoveCommand('play');
	Cmd_RemoveCommand('stopsound');
	Cmd_RemoveCommand('soundlist');
	Cmd_RemoveCommand('soundinfo');

	// free all sounds
  for i:=0 to num_sfx-1 do
	begin
		if (known_sfx[i].name[0] = #0) then
			continue;
		if (known_sfx[i].cache <> nil) then
			Z_Free (known_sfx[i].cache);
		FillChar(known_sfx[i], sizeof(sfx_t), 0);
	end;

	num_sfx := 0;
end;

// =======================================================================
// Load a sound
// =======================================================================

(*
==================
S_FindName

==================
*)
function S_FindName (name:PChar; create:QBoolean):sfx_p;
var
	i: Integer;
	sfx: sfx_p;
begin
	if (name = nil) then
		Com_Error (ERR_FATAL, 'S_FindName: NULL'#10, []);
	if (name[0] = #0) then
		Com_Error (ERR_FATAL, 'S_FindName: empty name'#10, []);

	if (strlen(name) >= MAX_QPATH) then
		Com_Error (ERR_FATAL, 'Sound name too long: %s', [name]);

	// see if already loaded
	for i := 0 to num_sfx-1 do
		if not(strcmp(known_sfx[i].name, name)<>0) then
		begin
			Result := @known_sfx[i];
      exit;
		end;

	if (not create) then begin
		Result := nil;
    exit;
  end;

	// find a free sfx
  i := 0;
  while (i < num_sfx) do begin
		if (known_sfx[i].name[0] = #0) then
//			registration_sequence < s_registration_sequence)
			break;
    Inc(i);
  end;

	if (i = num_sfx) then
	begin
		if (num_sfx = MAX_SFX) then
			Com_Error (ERR_FATAL, 'S_FindName: out of sfx_t', []);
		Inc(num_sfx);
	end;

	sfx := @known_sfx[i];
	FillChar(sfx^, sizeof(sfx_t), 0);
	strcpy(sfx^.name, name);
	sfx^.registration_sequence := s_registration_sequence;

	result := sfx;
end;


(*
==================
S_AliasName

==================
*)
function S_AliasName(aliasname: PChar; truename: PChar) : sfx_p;
var
  sfx: sfx_p;
	s: PChar;
	i: Integer;
begin
	s := Z_Malloc (MAX_QPATH);
	strcpy(s, truename);
	// find a free sfx
  i := 0;
  while (i < num_sfx) do begin
		if (known_sfx[i].name[0] = #0) then
			break;
    Inc(i);
  end;

	if (i = num_sfx) then
	begin
		if (num_sfx = MAX_SFX) then
			Com_Error(ERR_FATAL, 'S_FindName: out of sfx_t', []);
		Inc(num_sfx);
	end;

	sfx := @known_sfx[i];
	FillChar(sfx^, sizeof(sfx_t), 0);
	strcpy(sfx^.name, aliasname);

	sfx^.registration_sequence := s_registration_sequence;
	sfx^.truename := s;

	Result := sfx;
end;

(*
=====================
S_BeginRegistration

=====================
*)
procedure S_BeginRegistration;
begin
	Inc(s_registration_sequence);
	s_registering := true;
end;

(*
==================
S_RegisterSound

==================
*)
function S_RegisterSound (name: PChar) : sfx_p;
var
  sfx: sfx_p;
begin
	if (sound_started=0) then begin
		result := nil;
    exit;
  end;

	sfx := S_FindName (name, true);
	sfx^.registration_sequence := s_registration_sequence;

	if (not s_registering) then
		S_LoadSound (sfx);

	result := sfx;
end;


(*
=====================
S_EndRegistration

=====================
*)
procedure S_EndRegistration;
var
  i, size: Integer;
begin
	// free any sounds not from this registration sequence
	for i := 0 to num_sfx-1 do
	begin
		if (known_sfx[i].name[0] = #0) then
			continue;
		if (known_sfx[i].registration_sequence <> s_registration_sequence) then
		begin	// don't need this sound
			if (known_sfx[i].cache<>nil) then	// it is possible to have a leftover
				Z_Free (known_sfx[i].cache);	// from a server that didn't finish loading
			FillChar(known_sfx[i], sizeof(sfx_t), 0);
		end
		else
		begin	// make sure it is paged in
			if (known_sfx[i].cache <> nil) then
			begin
				size := known_sfx[i].cache.length * known_sfx[i].cache.width;
				Com_PageInMemory(PByte(known_sfx[i].cache), size);
			end;
		end;

	end;

	// load everything in
	for i:=0 to num_sfx-1 do
	begin
		if (known_sfx[i].name[0] = #0) then
			continue;
		S_LoadSound (@known_sfx[i]);
	end;

	s_registering := false;
end;


//=============================================================================

(*
=================
S_PickChannel
=================