platformsound.pas

一个不出名的GBA模拟器

//////////////////////////////////////////////////////////////////////
//                                                                  //
// platformSound.pas: Platform dependant sound code                 //
//                                                                  //
// The contents of this file are subject to the Bottled Light       //
// Public License Version 1.0 (the "License"); you may not use this //
// file except in compliance with the License. You may obtain a     //
// copy of the License at http://www.bottledlight.com/BLPL/         //
//                                                                  //
// Software distributed under the License is distributed on an      //
// "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or   //
// implied. See the License for the specific language governing     //
// rights and limitations under the License.                        //
//                                                                  //
// The Original Code is the Mappy VM User Interface, released       //
// April 1st, 2003. The Initial Developer of the Original Code is   //
// Bottled Light, Inc. Portions created by Bottled Light, Inc. are  //
// Copyright (C) 2001-2003 Bottled Light, Inc. All Rights Reserved. //
//                                                                  //
// Author(s):                                                       //
//   Michael Noland (joat), [e-mail]                //
//                                                                  //
// Changelog:                                                       //
//   1.0: First public release (April 1st, 2003)                    //
//                                                                  //
// Notes:                                                           //
//   MVM sound output frankly sucks right now, and I'm not certain  //
//   if its the fault of this code or the simluation code in the    //
//   core.                                                          //
//                                                                  //
//////////////////////////////////////////////////////////////////////

//////////////////////////////////////////////////////////////////////
unit platformSound; //////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

//////////////////////////////////////////////////////////////////////
interface ////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

uses
  Windows, Classes, SysUtils, Forms, MMSystem, Math,
  DirectSound, nexus, console;

//////////////////////////////////////////////////////////////////////

type
  TPlatformSound = class
  private
    // State variables
    FEnabled: boolean;
    FAvailable: boolean;
    FThreadPriority: TThreadPriority;
    FFrequency: integer;
  protected
    procedure SetEnabled(Value: boolean); virtual; abstract;
    procedure SetAvailable(Value: boolean); virtual; abstract;
    procedure SetFrequency(Value: integer); virtual; abstract;
    procedure SetPriority(Value: TThreadPriority); virtual; abstract;
  public
    constructor Create;
    destructor Destroy; override;

    property Enabled: Boolean read FEnabled write SetEnabled;
    property Available: Boolean read FAvailable write SetAvailable;
    property ThreadPriority: TThreadPriority read FThreadPriority write SetPriority;
    property Frequency: integer read FFrequency write SetFrequency;
  end;

  TDirectSoundDriver = class;

  TMixerThread = class(TThread)
    FParent: TDirectSoundDriver;
    procedure Execute; override;
  end;

  TDirectSoundDriver = class(TPlatformSound)
  private
    // Playback related
    DSound: IDirectSound;
    secondaryBuffer: IDirectSoundBuffer;
    FTimerThread: TMixerThread;
    lastPos: longword;
    lastTime: integer;

    function InitSound: boolean;
    procedure FreeSound;
  protected
    procedure Timer;

    procedure SetEnabled(Value: boolean); override;
    procedure SetAvailable(Value: boolean); override;
    procedure SetFrequency(Value: integer); override;
    procedure SetPriority(Value: TThreadPriority); override;
  public
    constructor Create;
    destructor Destroy; override;
    procedure OnSoundReady(data: pointer; length: integer);
  end;

//////////////////////////////////////////////////////////////////////

type
  TObserverOnSoundReady = procedure (data: pointer; length: integer) of object;

var
  sysSound: TDirectSoundDriver;
  soundObserverCallback: TObserverOnSoundReady;

//////////////////////////////////////////////////////////////////////
implementation ///////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

//////////////////////////////////////////////////////////////////////
// TPlatformSound ////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

constructor TPlatformSound.Create;
begin
  FEnabled := false;
  FAvailable := false;
  FThreadPriority := tpNormal;
  FFrequency := 22050;
end;

//////////////////////////////////////////////////////////////////////

destructor TPlatformSound.Destroy;
begin
  inherited;
end;

//////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

procedure HackSoundReady(data: pointer; length: integer);
begin
  sysSound.onSoundReady(data, length);
  if @soundObserverCallback <> nil then soundObserverCallback(data, length);
end;

//////////////////////////////////////////////////////////////////////
// TMixerThread //////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

procedure TMixerThread.Execute;
begin
  Priority := FParent.FThreadPriority;
  repeat
    SleepEx(50, False);
    Synchronize(FParent.Timer);
  until Terminated;
end;

/////////////////////////////////////////////////////////////////////
// TDirectSoundDriver ////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

constructor TDirectSoundDriver.Create;
begin
  inherited;

  // Playback related
  DSound := nil;
  secondaryBuffer := nil;
  FTimerThread := TMixerThread.Create(true);
  FTimerThread.Priority := FThreadPriority;
  FTimerThread.FParent := self;
  lastPos := 0;

  lastTime := timeGetTime;
end;

//////////////////////////////////////////////////////////////////////

destructor TDirectSoundDriver.Destroy;
begin
  FreeSound;
  FTimerThread.Free;

  inherited;
end;

//////////////////////////////////////////////////////////////////////

procedure TDirectSoundDriver.SetEnabled(value: boolean);
begin
  if FAvailable then begin
    if value and not FEnabled then begin
      secondaryBuffer.Play(0, 0, DSBPLAY_LOOPING);
      FTimerThread.Resume;
      FEnabled := true;
    end;

    if FEnabled and not value then begin
      secondaryBuffer.Stop;
      FTimerThread.Suspend;
      FEnabled := false;
    end;
  end;
end;

//////////////////////////////////////////////////////////////////////

procedure TDirectSoundDriver.SetAvailable(value: boolean);
begin
  if FAvailable xor value then begin
    if value then
      FAvailable := InitSound
    else
      FreeSound;
  end;
end;

//////////////////////////////////////////////////////////////////////

procedure TDirectSoundDriver.SetFrequency(value: integer);
var
  wasAvailable: boolean;
  wasEnabled: boolean;
begin
  wasAvailable := FAvailable;
  wasEnabled := FEnabled;

  FFrequency := value;

  SetAvailable(false);
  SetAvailable(wasAvailable);
  SetEnabled(wasEnabled);
end;

//////////////////////////////////////////////////////////////////////

procedure TDirectSoundDriver.SetPriority(Value: TThreadPriority);
begin
  if Value <> FThreadPriority then begin
    FThreadPriority := Value;
    FTimerThread.Priority := Value;
  end;
end;

//////////////////////////////////////////////////////////////////////

var
nilspace: array[0..16383] of byte;

procedure TDirectSoundDriver.Timer;
var
  curTime, delta: integer;
  data: pointer;
  length: integer;
begin
  if FAvailable and FEnabled then begin
    curTime := timeGetTime;
    delta := curTime-lastTime;
    if delta < 10 then Exit;

    vmGetAudioData(data, length);

    if length = 0 then begin
      length := min(16384, FFrequency div 20);
      data := @nilspace;
    end;
    OnSoundReady(data, length);
    if @soundObserverCallback <> nil then soundObserverCallback(data, length);

    lastTime := curTime;
  end;
end;

//////////////////////////////////////////////////////////////////////

function TDirectSoundDriver.InitSound: boolean;
var
  primaryBuffer: IDirectSoundBuffer;
  bufferInfo: TDSBufferDesc;
  waveFormat: TWaveFormatEx;
begin
  Result := false;

  // Create the DirectSound interface
  logWriteLn('PlatformSound: Creating DirectSound interface');
  if Failed(DirectSoundCreate(nil, DSound, nil)) then begin
    logWriteLn('  DirectSoundCreate failed, sound output unavailable');
    Exit;
  end;

  // Set up a wave format structure with our data type of choice (8-bit stereo at 44100 Hz)
  FillChar(waveFormat, SizeOf(waveFormat), 0);
  with waveFormat do begin
    wFormatTag := WAVE_FORMAT_PCM;
    nChannels := 2;
    nSamplesPerSec := FFrequency;
    wBitsPerSample := 8;
    nBlockAlign := (wBitsPerSample shr 3) * nChannels;
    nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
  end;

  // Set the DSound priority level
  if Failed(DSound.SetCooperativeLevel(application.Handle, DSSCL_PRIORITY)) then begin
    logWriteLn('  SetCooperativeLevel with DSSCL_PRIORITY failed, trying DSSCL_NORMAL');

    if Failed(DSound.SetCooperativeLevel(application.Handle, DSSCL_NORMAL)) then begin
      logWriteLn('  Unable to set priority level, sound output unavailable.');
      Exit;
    end;
  end;

  // Try to capture the primary buffer
  FillChar(bufferInfo, SizeOf(bufferInfo), 0);
  bufferInfo.dwSize  := SizeOf(bufferInfo);
  bufferInfo.dwFlags := DSBCAPS_PRIMARYBUFFER;
  if Failed(DSound.CreateSoundBuffer(bufferInfo, primaryBuffer, nil)) then
    logWriteLn('  Primary buffer capture failed')
  else begin
    if Failed(primaryBuffer.SetFormat(waveFormat)) then
      logWriteLn('  SetFormat on primary buffer failed');
  end;

  if Assigned(primaryBuffer) then primaryBuffer := nil;

  // Create the secondary buffer
  FillChar(bufferInfo, SizeOf(bufferInfo), 0);
  bufferInfo.dwSize  := SizeOf(bufferInfo);
  bufferInfo.dwFlags := DSBCAPS_GETCURRENTPOSITION2 or DSBCAPS_GLOBALFOCUS or DSBCAPS_CTRLPOSITIONNOTIFY;
  bufferInfo.dwBufferBytes := waveFormat.nAvgBytesPerSec div 5; // 200 ms buffer
  bufferInfo.lpwfxFormat := @waveFormat;
  if Failed(DSound.CreateSoundBuffer(bufferInfo, secondaryBuffer, nil)) then begin
    logWriteLn('  CreateSoundBuffer failed, sound output unavailable.');
    Exit;
  end;

  // Whee, we're done!
  Result := true;

  if coreLoaded then begin
    vmSetAudioRate(FFrequency);
    vmSetOnSound(HackSoundReady);
  end;
end;

//////////////////////////////////////////////////////////////////////

procedure TDirectSoundDriver.FreeSound;
begin
  if coreLoaded then vmSetOnSound(nil);

  FAvailable := false;
  SetEnabled(false);

  logWriteLn('PlatformSound: Releasing DirectSound interfaces');
  if Assigned(secondaryBuffer) then secondaryBuffer := nil;
  if Assigned(DSound) then DSound := nil;
end;

//////////////////////////////////////////////////////////////////////

procedure TDirectSoundDriver.OnSoundReady(data: pointer; length: integer);
var
  size1, size2: longword;
  bank1, bank2: pointer;
  hr: HResult;
begin
  // Get some mixing action going on
  if FAvailable and FEnabled then begin
    // Attempt to lock just after our last write
    hr := secondaryBuffer.Lock(lastPos, length*2, bank1, size1, bank2, size2, 0);
    if Failed(hr) then begin
      // That didn't work, so lock at the current writable position instead
//      logwrite('f');
      secondaryBuffer.GetCurrentPosition(nil, @lastPos);
      hr := secondaryBuffer.Lock(lastPos, length*2, bank1, size1, bank2, size2, 0);
    end;

    // Copy from the synthesis buffer to the output buffer
    if not Failed(hr) then begin
      Move(data^, bank1^, size1);
      if size2 > 0 then begin
        data := pointer(longword(data) + size1);
        Move(data^, bank2^, size2);
        lastPos := size2;
      end else
        lastPos := lastPos + size1;

      // Unlock the buffer
      secondaryBuffer.Unlock(bank1, size1, bank2, size2);
    end;
  end;
end;

//////////////////////////////////////////////////////////////////////

begin
  soundObserverCallback := nil;
end.

//////////////////////////////////////////////////////////////////////