snd_dma.pas

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(const 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,
    s_testsound,
    s_loadas8bit,
    s_khz,
    s_show,
    s_mixahead,
    s_primary: cvar_p;

  s_rawend: Integer;

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

implementation

uses
  DelphiTypes,
  Client,
  CPas,
  cl_main,
  cl_ents,
  Common,
  CVar,
  Cmd,
  Files,
  {$IFDEF WIN32}
  snd_win,
  {$ELSE}
  //snd_linux, // i switched to SDL library due to difficult on translate this unit.. by FAB
  snd_sdl,
  {$ENDIF}
  snd_mix,
  snd_mem;

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