source: tags/1.3.8/Music.pas

unit Music;

interface

uses
  Classes, SysUtils, Dialogs, uos_flat, ctypes;

type

  { TMusicPlayer }

  TMusicPlayer = class
  private
    FVolume: Single;
    PlayerIndex1: Integer;
    InputIndex1: Integer;
    Initialized: Boolean;
    PlayListItemIndex: Integer;
    InputLength: Integer;
    AutoPlayNext: Boolean;
    LibrariesLoaded: Boolean;
    NewPlayerIndex: Integer;
    function GetPlaying: Boolean;
    procedure Initialize;
    procedure EndPlay(PlayerIndex: cint32);
    function GetNextPlaylistItem: string;
    procedure PlayNext(Data: PtrInt);
    procedure SetVolume(AValue: Single);
  public
    Playlist: TStringList;
    constructor Create;
    destructor Destroy; override;
    procedure RandomizePlaylist;
    procedure LoadPlaylistFromDir(Directory: string);
    procedure Play;
    procedure Stop;
    property Playing: Boolean read GetPlaying;
    property Volume: Single read FVolume write SetVolume;
  end;

var
  MusicPlayer: TMusicPlayer;


implementation

uses
  Directories, Forms;

{ TMusicPlayer }

procedure TMusicPlayer.Initialize;
var
  SndFileFileName: string;
  PortAudioFileName: string;
  XmpFileName: string;
begin
  if Initialized then Exit;

  {$IFDEF UNIX}
  SndFileFileName := 'libsndfile.so';
  PortAudioFileName := 'libportaudio.so';
  XmpFileName := 'libxmp.so.4';
  {$ELSE}
    {$if defined(cpu64)}
    SndFileFileName := 'LibSndFile-64.dll';
    PortAudioFileName := 'LibPortaudio-64.dll';
    XmpFileName := 'libxmp-64.dll';
    {$ELSE}
    SndFileFileName := 'LibSndFile-32.dll';
    PortAudioFileName := 'LibPortaudio-32.dll';
    XmpFileName := 'libxmp-32.dll';
    {$ENDIF}
  {$ENDIF}

  if (PortAudioFileName <> 'system') and (PortAudioFileName <> '') then
  if not uos_TestLoadLibrary(PChar(PortAudioFileName)) then begin
    if uos_TestLoadLibrary(PChar(PortAudioFileName + '.1')) then
      PortAudioFileName := PortAudioFileName + '.1'
    else
    if uos_TestLoadLibrary(PChar(PortAudioFileName + '.2')) then
      PortAudioFileName := PortAudioFileName + '.2';
  end;

  // Optionally load SndFile
  if (SndFileFileName <> 'system') and (SndFileFileName <> '') then
  if not uos_TestLoadLibrary(PChar(SndFileFileName)) then begin
    if uos_TestLoadLibrary(PChar(SndFileFileName + '.1')) then
      SndFileFileName := SndFileFileName + '.1'
    else
    if uos_TestLoadLibrary(PChar(SndFileFileName + '.2')) then
      SndFileFileName := SndFileFileName + '.2'
    else SndFileFileName := '';
  end;

  if uos_LoadLib(PChar(PortAudioFileName), PChar(SndFileFileName), nil, nil,
    nil, nil, PChar(XmpFileName)) = 0 then begin
    LibrariesLoaded := True;
  end else begin
    LibrariesLoaded := False;
    if uosLoadResult.PAloaderror = 1 then
      WriteLn(StdErr, 'Error: ' + PortAudioFileName + ' not found.');
    if uosLoadResult.PAloaderror = 2 then
      WriteLn(StdErr, 'Error: ' + PortAudioFileName + ' can''t be loaded.');
    if uosLoadResult.SFloaderror = 1 then
      WriteLn(StdErr, 'Error: ' + SndFileFileName + ' not found.');
    if uosLoadResult.SFloaderror = 2 then
      WriteLn(StdErr, 'Error: ' + SndFileFileName + ' can''t be loaded.');
    if uosLoadResult.XMloadError = 1 then
      WriteLn(StdErr, 'Error: ' + XmpFileName + ' not found.');
    if uosLoadResult.XMloadError = 2 then
      WriteLn(StdErr, 'Error: ' + XmpFileName + ' can''t be loaded.');
  end;

  Initialized := True;
end;

function TMusicPlayer.GetPlaying: Boolean;
begin
  Result := PlayerIndex1 >= 0;
end;

procedure TMusicPlayer.EndPlay(PlayerIndex: cint32);
begin
  if AutoPlayNext then begin
    if PlayerIndex = PlayerIndex1 then Application.QueueAsyncCall(PlayNext, 0);
  end else PlayerIndex1 := -1;
end;

function TMusicPlayer.GetNextPlaylistItem: string;
begin
  Inc(PlayListItemIndex);
  if PlayListItemIndex >= Playlist.Count then PlayListItemIndex := 0;
  Result := Playlist[PlayListItemIndex];
end;

procedure TMusicPlayer.PlayNext(Data: PtrInt);
begin
  Play;
end;

procedure TMusicPlayer.SetVolume(AValue: Single);
begin
  if FVolume = AValue then Exit;
  FVolume := AValue;
  if FVolume > 1 then FVolume := 1;
  if FVolume < 0 then FVolume := 0;
  if Playing then
    uos_InputSetDSPVolume(PlayerIndex1, InputIndex1, Volume, Volume, True);
end;

constructor TMusicPlayer.Create;
begin
  Playlist := TStringList.Create;
  PlayerIndex1 := -1;
  NewPlayerIndex := 0;
  FVolume := 1;
end;

destructor TMusicPlayer.Destroy;
begin
  uos_free();
  FreeAndNil(Playlist);
  inherited;
end;

procedure TMusicPlayer.RandomizePlaylist;
var
  I: Integer;
  Index: Integer;
  TempPlaylist: TStringList;
begin
  if Playlist.Count < 2 then Exit;

  TempPlaylist := TStringList.Create;
  try
    TempPlaylist.Assign(Playlist);
    PlayList.Clear;
    for I := 0 to TempPlaylist.Count - 1 do begin
      Index := Random(TempPlaylist.Count);
      PlayList.Add(TempPlaylist[Index]);
      TempPlaylist.Delete(Index);
    end;
  finally
    TempPlaylist.Free;
  end;
end;

procedure TMusicPlayer.LoadPlaylistFromDir(Directory: string);
var
  SearchRec: TSearchRec;
begin
  Playlist.Clear;
  Directory := IncludeTrailingPathDelimiter(Directory);
  if FindFirst(Directory + '*', faAnyFile, SearchRec) = 0 then
    try
      repeat
        if (SearchRec.Name = '.') or (SearchRec.Name = '..') or ((SearchRec.Attr and faDirectory) > 0) then Continue;
        Playlist.Add(Directory + SearchRec.Name);
      until FindNext(SearchRec) <> 0;
    finally
      FindClose(SearchRec);
    end;
end;

procedure TMusicPlayer.Play;
var
  OutputIndex1: Integer;
  FileName: string;
begin
  Initialize;
  if not LibrariesLoaded then Exit;

  AutoPlayNext := False;
  if PlayerIndex1 >= 0 then uos_Stop(PlayerIndex1);

  PlayerIndex1 := NewPlayerIndex;
  Inc(NewPlayerIndex);

  uos_CreatePlayer(PlayerIndex1);
  uos_EndProc(PlayerIndex1, EndPlay);

  FileName := GetNextPlaylistItem;
  InputIndex1 := uos_AddFromFile(PlayerIndex1, PChar(FileName));
  if InputIndex1 < 0 then begin
    MessageDlg('Music file ' + FileName + ' doesn''t exist.', mtError, [mbYes], 0);
    Exit;
  end;

  uos_InputSetPositionEnable(PlayerIndex1, InputIndex1, 1);
  InputLength := uos_InputLength(PlayerIndex1, InputIndex1);
  uos_InputAddDSPVolume(PlayerIndex1, InputIndex1, Volume, Volume);

  OutputIndex1 := uos_AddIntoDevOut(PlayerIndex1, -1, -1, -1, -1, -1, -1, -1);
  if OutputIndex1 < 0 then begin
    MessageDlg('Music output doesn''t work.', mtError, [mbYes], 0);
    Exit;
  end;

  uos_Play(PlayerIndex1);
  AutoPlayNext := True;
end;

procedure TMusicPlayer.Stop;
begin
  Initialize;
  if not LibrariesLoaded then Exit;

  AutoPlayNext := False;
  if PlayerIndex1 >= 0 then begin
    Initialize;
    uos_EndProc(PlayerIndex1, nil);
    uos_Stop(PlayerIndex1);
  end;
  PlayerIndex1 := -1;
end;

initialization

MusicPlayer := TMusicPlayer.Create;

finalization

FreeAndNil(MusicPlayer);

end.