Recent

Author Topic: United OpenLib of Sound (UOS)  (Read 77392 times)

Fred vS

  • Hero Member
  • *****
  • Posts: 3480
    • StrumPract is the musicians best friend
United OpenLib of Sound (UOS)
« on: July 20, 2012, 12:50:00 am »
Hello everybody.

Now that we have access to PortAudio,
http://www.lazarus.freepascal.org/index.php/topic,17521.msg96750.html#msg96750

SndFile,
http://www.lazarus.freepascal.org/index.php/topic,17539.msg96864.html#msg96864

and MPG123,
http://www.lazarus.freepascal.org/index.php/topic,17558.msg96976.html#msg96976

im busy with a new project : United OpenLib of Sound (UOS).

This will be a utility to link each lib together with unique functions.

So sound gonna be much easier to develop.

Here the sources :

http://fredvs.github.io/uos/

At the moment i nearly finish :

UOS_Load()
UOS_Init()
UOS_Open()
UOS_Play()
UOS_Pause()
UOS_Resume()
UOS_Stop()
UOS_Unload()

Of course you can still use the functions of each lib, but it is only to do live more easy...

Is somebody interest to join me for that Open Source Project ?

Cheers
« Last Edit: May 16, 2013, 03:20:15 pm by Fred vS »
I use Lazarus 2.2.0 32/64 and FPC 3.2.2 32/64 on Debian 11 64 bit, Windows 10, Windows 7 32/64, Windows XP 32,  FreeBSD 64.
Widgetset: fpGUI, MSEgui, Win32, GTK2, Qt.

https://github.com/fredvs
https://gitlab.com/fredvs
https://codeberg.org/fredvs

KpjComp

  • Hero Member
  • *****
  • Posts: 680
Re: United OpenLib of Sound (U_OS)
« Reply #1 on: July 20, 2012, 12:29:47 pm »
Quote
Is somebody interest to join me for that Open Source Project ?

I was thinking of making a class wrapper for this, even better maybe a reference counted interface class, (this makes it easy to make into another DLL if wanted, and also from other languages)

Fred vS

  • Hero Member
  • *****
  • Posts: 3480
    • StrumPract is the musicians best friend
Re: United OpenLib of Sound (U_OS)
« Reply #2 on: July 20, 2012, 07:06:04 pm »
Hello everybody.

Here the first one night shot of United OpenLib of Sound.
Only load, init, open and play are ready.
But this first shot work only for a single handle.
The next step is to enhance UOS_Open(soundfile : string) with
 UOS_Open(soundfile : string; UOA_Handle : pointer) to have the possibility to create many handles.

Each handle needs : a proper Tinfo, a proper Tstream and of course a THandle.
I want a procedure, for example UOS_CreateHandle() who creates a
 a proper Tinfo, a proper Tstream and of course a THandle.

But how to do it ?

By the way, here the code of a demo using UOS :http://fredvs.github.io/uos/

Here the first UOS code for single playing.
 :-[

Code: [Select]
unit U_OS;

{*******************************************************************************
*                  United Openlibraries of Sound ( U_OS )                      *
*                  --------------------------------------                      *
*                                                                              *
*           United procedures to access Open Sound libraries                   *
*                                                                              *
*                                                                              *
*     Lazarus Forum     /   Fred van Stappen   /  Fiens@hotmail.com            *
*                                                                              *
********************************************************************************
*         first realease     latest changes: 2012-07-20                        *
*******************************************************************************}

interface

uses
 Forms, SysUtils, LazDyn_PortAudio, LazDyn_LibSndFile, LazDyn_Mpg123;


const
  ///// error
  noError            = 0;
  FilePAError        = 10;
  LoadPAError        = 11;
  FileSFError        = 20;
  LoadSFError        = 21;
  FileMPError        = 30;
  LoadMPError        = 31;

  //////// UOS_load() flag
  LoadAll            = 0;   // load all PortAudio + SndFile + MPG123
  LoadPA             = 1;   // load only PortAudio
  LoadSF             = 2;   // load only SndFile
  LoadMP             = 3;   // load only MPG123
  LoadPA_SF          = 4;   // load only PortAudio + SndFile
  LoadPA_MP          = 5;   // load only PortAudio + MPG123
  LoadSF_MP          = 6;   // load only SndFile + MPG123

type
   TResult = record
    PAloadERROR          : shortint;
    SFloadERROR          : shortint;
    MPloadERROR          : shortint;
    PAinitError          : integer;
    MPinitError          : integer;
    MPOpenERROR          : shortint;
    SFOpenERROR          : shortint;
  end;

type
   Tinfo= record
    filename : string;
    channels          : integer;
    format            : integer;
    frames            : integer;
    samplerate        : integer;
    sections          : integer;
    seekable          : integer;
    encoding          : integer;
     end;

  var
   UOSStopStream       : shortint;
   UOSloadflag         : shortint ;
   UOSresult           : TResult;
   UOSDefOut           : PaDeviceIndex;
   UOSDEVinfo          : PPaDeviceInfo;
   UOSAPIinfo          : PPaHostApiInfo;
   UOS_HANDLE          : pointer;
   UOSsoundfile        : String;
   sfInfo              : TSF_INFO;
   UOSOpenInfo         : Tinfo;
   mhErr               : integer;
   Stream              : PPaStream;
   NumSampleBlocks     :integer;
   SFoutbuf            : array [0..2047]  of byte;  //1023 for stereo only !
   MPoutbuf            : array [0..65535] of byte;
   OutputParameters    : PaStreamParameters;
   BufFrames           : Tsf_count_t;
   OutFrames           : Tsf_count_t;


procedure UOS_Load(PA_FileName,SF_FileName,MP_FileName : AnsiString ; flag : shortint );
procedure UOS_UnLoad() ;
procedure UOS_Init()  ;
procedure UOS_Open(UOSsoundfile:ansistring) ;
procedure UOS_Play() ;
//procedure UOS_Pause() ;                      //   to do ....
//procedure UOS_Resume():TResult ;             //   to do ....
//procedure UOS_Stop():TResult ;               //   to do ....

implementation

procedure UOS_Play() ;

 begin
  UOSStopStream := 0 ;
  if (UOSresult.SFOpenError = 0) or (UOSresult.MPOpenError = 0) then
    begin

    OutputParameters.Device := UOSDefOut;
    OutputParameters.channelCount:= UOSOpenInfo.channels;
    OutputParameters.SampleFormat := paint16 ;
    OutputParameters.SuggestedLatency :=
      (Pa_GetDeviceInfo( OutputParameters.device)^.defaultHighOutputLatency) * 1;
    OutputParameters.HostApiSpecificStreamInfo := nil;

    Pa_OpenStream(@Stream, nil, @OutputParameters,  UOSOpenInfo.samplerate ,
      64, paClipOff, nil,nil) ;


    Pa_StartStream(stream) ;

    NumSampleBlocks:= 0;

  if UOSresult.SFOpenError = 0 then
     BufFrames:= length( SFoutbuf) else
     if UOSresult.MPOpenError = 0 then
        BufFrames:= length(MPoutbuf)   ;
     OutFrames :=0;

  repeat
     if UOSresult.SFOpenError = 0 then
     OutFrames:= sf_read_short(UOS_HANDLE, @SFoutbuf[0], BufFrames)
     else  if UOSresult.MPOpenError = 0 then
     mpg123_read( UOS_HANDLE, @MPoutbuf[0], BufFrames, OutFrames);

     if UOSresult.SFOpenError = 0 then
     Pa_WriteStream(stream,@SFoutbuf[0],OutFrames div 2)
     else if UOSresult.MPOpenError = 0 then
     Pa_WriteStream(stream,@MPoutbuf[0],OutFrames div 4);

     inc( NumSampleBlocks);

     application.ProcessMessages;     //////////// important if we want to do something else in the program !

  until  (OutFrames < BufFrames) or (UOSStopStream <> 0);

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

    Pa_StopStream(stream) ;

    Pa_CloseStream(stream) ;

    end;
   end;

procedure UOS_Open(UOSsoundfile:ansistring) ;

 begin
   UOSresult.MPOpenError := - 1;
   UOSresult.SFOpenError := - 1;
    if (UOSresult.SFloadERROR = 0) and ((UOSloadflag = LoadAll) or (UOSloadflag = LoadSF)  or (UOSloadflag = LoadPA_SF) or
    (UOSloadflag = LoadSF_MP)) then begin
     UOS_HANDLE  := sf_open(pchar(UOSsoundfile),SFM_READ,sfInfo) ; (* try to open the file *)

   If UOS_HANDLE = NIL then
       begin
       UOSresult.SFOpenError := 1 ;
       end
       else
     ////////////////////// have to add more info of course .......
         begin
            UOSresult.SFOpenError := 0;
            UOSOpenInfo.filename := UOSsoundfile ;
            UOSOpenInfo.channels := SFinfo.channels;
            UOSOpenInfo.format := SFinfo.format;
            UOSOpenInfo.frames := SFinfo.frames;
            UOSOpenInfo.samplerate := SFinfo.samplerate;
            UOSOpenInfo.sections := SFinfo.sections;
            UOSOpenInfo.seekable := SFinfo.seekable;
                 end;

    end;


 if ((UOSresult.SFOpenError  = 1) or (UOSresult.SFOpenError  = -1)) and (UOSresult.MPloadERROR = 0)
 and  ((UOSloadflag = LoadAll) or (UOSloadflag = LoadMP)  or (UOSloadflag = LoadPA_MP) or
    (UOSloadflag = LoadSF_MP)) then begin

       mhErr := -1;
 UOS_HANDLE:= mpg123_new( NIL, mhErr);
  if mhErr = 0 then mhErr := mpg123_open( UOS_HANDLE,pchar(UOSsoundfile))

  else UOSresult.MPOpenError := 1 ;

  if mhErr = 0 then mhErr := mpg123_getformat( UOS_HANDLE, UOSOpenInfo.samplerate , UOSOpenInfo.channels, UOSOpenInfo.encoding) ;
  if mhErr = 0 then  begin
     UOSresult.MPOpenError := 0;
    UOSOpenInfo.filename := UOSsoundfile ;

  end else
  begin

  UOSresult.MPOpenError := 2 ;

  end;

    end;


 end;

procedure UOS_Unload() ;

 begin
 UOSStopStream := 1 ;
 application.ProcessMessages;

  if (UOSresult.SFOpenError  = 0 ) then sf_close(UOS_HANDLE) ;
  Sf_Unload();
  if (UOSresult.MPOpenError  = 0) then mpg123_close(UOS_HANDLE)  ;
  Mp_Unload();

  Pa_Unload();
 end;

 procedure UOS_Init() ;

 begin

   if (UOSresult.MPloadERROR = 0) and ((UOSloadflag = LoadAll) or (UOSloadflag = LoadMP)  or (UOSloadflag = LoadPA_MP) or
    (UOSloadflag = LoadSF_MP)) then if mpg123_init()=MPG123_OK  then  UOSresult.MPinitError := 0 else UOSresult.MPinitError := 1;


  IF (UOSresult.PAloadERROR = 0) and ((UOSloadflag = LoadAll) or (UOSloadflag = LoadPA) or
  (UOSloadflag = LoadPA_SF) or (UOSloadflag = LoadPA_MP)) Then begin
    UOSresult.PAinitError := Pa_Initialize();

      if UOSresult.PAinitError = 0 then begin
    UOSDefOut := Pa_GetDefaultOutputDevice();    /////////////////// at the moment only default device but i gonna fix it
    UOSDEVinfo:= Pa_GetDeviceInfo(UOSDefOut);
    UOSAPIinfo:= Pa_GetHostApiInfo(UOSDEVinfo^.hostApi);
     end;

  end;

   end;

procedure UOS_Load( PA_FileName,SF_FileName,MP_FileName : AnsiString ; flag : shortint ) ;

begin

 UOSloadflag := flag ;

   case flag of

    LoadAll : begin

   if not fileexists(PA_FileName) then UOSresult.PAloadERROR:= 1   else
     if  Pa_Load (PA_FileName) then UOSresult.PAloadERROR:= 0 else UOSresult.PAloadERROR:= 2 ;

  if not fileexists(SF_FileName) then UOSresult.SFloadERROR:= 1 else
    if  Sf_Load (SF_FileName)  then UOSresult.SFloadERROR:= 0 else UOSresult.SFloadERROR:= 2 ;

   if not fileexists(MP_FileName) then UOSresult.MPloadERROR := 1 else
    if  mp_Load (Mp_FileName)  then UOSresult.MPloadERROR := 0 else UOSresult.MPloadERROR := 2 ;

    end;

     LoadPA : begin

    if not fileexists(PA_FileName) then  UOSresult.PAloadERROR:= 1   else
     if  Pa_Load (PA_FileName) then  UOSresult.PAloadERROR:= 0  else UOSresult.PAloadERROR:= 2 ;

    end;

    LoadSF : begin

  if not fileexists(SF_FileName) then UOSresult.SFloadERROR:= 1 else
  if  Sf_Load (SF_FileName)  then UOSresult.SFloadERROR:= 0 else UOSresult.SFloadERROR:= 2 ;

    end;

     LoadMP : begin

    if not fileexists(MP_FileName) then UOSresult.MPloadERROR := 1 else
    if  mp_Load (Mp_FileName)  then UOSresult.MPloadERROR := 0 else UOSresult.MPloadERROR := 2 ;

    end;

   LoadPA_SF : begin

    if not fileexists(PA_FileName) then  UOSresult.PAloadERROR:= 1   else
     if  Pa_Load (PA_FileName) then  UOSresult.PAloadERROR:= 0  else UOSresult.PAloadERROR:= 2 ;

  if not fileexists(SF_FileName) then UOSresult.SFloadERROR:= 1 else
    if  Sf_Load (SF_FileName)  then UOSresult.SFloadERROR:= 0 else UOSresult.SFloadERROR:= 2 ;

     end;

   LoadPA_MP : begin
     if not fileexists(MP_FileName) then UOSresult.MPloadERROR := 1 else
    if  MP_Load (Mp_FileName)  then UOSresult.MPloadERROR := 0 else UOSresult.MPloadERROR := 2 ;


    if not fileexists(PA_FileName) then  UOSresult.PAloadERROR:= 1   else
     if  Pa_Load (PA_FileName) then  UOSresult.PAloadERROR:= 0  else UOSresult.PAloadERROR:= 2 ;


    end;

    LoadSF_MP : begin

   if not fileexists(SF_FileName) then UOSresult.SFloadERROR:= 1 else
    if  SF_Load (SF_FileName)  then UOSresult.SFloadERROR:= 0 else UOSresult.SFloadERROR:= 2 ;

   if not fileexists(MP_FileName) then UOSresult.MPloadERROR := 1 else
    if  mp_Load (Mp_FileName)  then UOSresult.MPloadERROR := 0 else UOSresult.MPloadERROR := 2 ;

    end;


   end;


   end;

 initialization

  UOSresult.PAloadERROR:= -1 ;
 UOSresult.SFloadERROR := -1 ;
 UOSresult.MPloadERROR := -1 ;
  UOSresult.PAinitError := -1 ;
  UOSresult.MPinitError := -1 ;
  UOSStopStream        := 0   ;

end.
« Last Edit: May 16, 2013, 03:20:58 pm by Fred vS »
I use Lazarus 2.2.0 32/64 and FPC 3.2.2 32/64 on Debian 11 64 bit, Windows 10, Windows 7 32/64, Windows XP 32,  FreeBSD 64.
Widgetset: fpGUI, MSEgui, Win32, GTK2, Qt.

https://github.com/fredvs
https://gitlab.com/fredvs
https://codeberg.org/fredvs

Fred vS

  • Hero Member
  • *****
  • Posts: 3480
    • StrumPract is the musicians best friend
Re: United OpenLib of Sound (U_OS)
« Reply #3 on: July 31, 2012, 12:58:23 pm »
Hello everybody.

Im happy to give you the new release of U_OS.  :-[
Now you can play multiple streams together (it was a big fight but i win  ::) )

Take a look at the example here with mp3, wav, flac and ogg test files :
http://fredvs.github.io/uos/

Here is the code of U_OS : of course all of your comments are welcome.  And sure you could make it better... ;)

Code: [Select]
unit U_OS;

{*******************************************************************************
*                  United Openlibraries of Sound ( U_OS )                      *
*                  --------------------------------------                      *
*                                                                              *
*           United procedures to access Open Sound libraries                   *
*                                                                              *
*                                                                              *
*     Lazarus Forum     /   Fred van Stappen   /  Fiens@hotmail.com            *
*                                                                              *
********************************************************************************
*        second realease     first changes:  2012-07-20                        *
*                            second changes: 2012-07-31                        *
*******************************************************************************}

interface

uses
 Forms, SysUtils, dialogs ,LazDyn_PortAudio, LazDyn_LibSndFile, LazDyn_Mpg123;


const
  ///// error
  noError            = 0;
  FilePAError        = 10;
  LoadPAError        = 11;
  FileSFError        = 20;
  LoadSFError        = 21;
  FileMPError        = 30;
  LoadMPError        = 31;

  //////// UOS_load() flag
  LoadAll            = 0;   // load all PortAudio + SndFile + MPG123
  LoadPA             = 1;   // load only PortAudio
  LoadSF             = 2;   // load only SndFile
  LoadMP             = 3;   // load only MPG123
  LoadPA_SF          = 4;   // load only PortAudio + SndFile
  LoadPA_MP          = 5;   // load only PortAudio + MPG123
  LoadSF_MP          = 6;   // load only SndFile + MPG123

  Samplerate_root    = 0;

type
   TLoadResult = record
    PAloadERROR          : shortint;
    SFloadERROR          : shortint;
    MPloadERROR          : shortint;
    PAinitError          : integer;
    MPinitError          : integer;
   end;



type
    TStreaminfo= record
    streamname        : string;
    Stream               : PPaStream;
    StreamisOpen         : boolean ;
    DEVICE               : integer ;
    LATENCY              : integer ;
    OutputParameters     : PaStreamParameters;
    handle            : pointer;
    SFopenError       : shortint;
    MPopenError       : shortint;
    SFoutbuf          : array [0..2047]  of byte  ;
    MPoutbuf          : array [0..2047]  of byte  ;
    {$IFDEF Windows}
    BufFrames         : cardinal;
    OutFrames         : cardinal;
     {$else}
    BufFrames       : Tsf_count_t;
    OutFrames       : Tsf_count_t;

     {$endif}
    Filename          : string;
    Stop              : boolean;
    channels          : integer;
    format            : integer;
    frames            : integer;
    samplerateroot    : integer;
    samplerate        : integer;
    sections          : integer;
    seekable          : integer;
    encoding          : integer;
    title             : string;
    copyright         : string;
    software          : string;
    artist            : string;
    comment           : string;
    date              : string;
    tag               : array[0..2] of Char;   (**< Always the string "TAG", the classic intro. *)
    album             : string;  (**< Album string. *)
    genre             : byte;    (**< Genre index. *)

     end;


  var
   UOSLoadFlag         : shortint ;
   UOSLoadResult       : TLoadResult;
   UOSDefOut           : PaDeviceIndex;
   UOSDEVinfo          : PPaDeviceInfo;
   UOSAPIinfo          : PPaHostApiInfo;
   UOSSTREAM            : array   of  Tstreaminfo;
   UOSSTREAMisopen     : boolean ;


procedure UOS_Load(PA_FileName,SF_FileName,MP_FileName : AnsiString ; flag : shortint );  /////////// dynamic load libraries

procedure UOS_UnLoad() ;

procedure UOS_Init()  ; ////// init libraries

procedure UOS_CreateStream(Soundfile:ansistring;UOS_STREAMNAME:string; SAMPLERATE:integer ; DEVICE:integer ; CHANNELS :integer; LATENCY:integer; SAMPLEFORMAT : string) ;
       ////////////// at Samplerate ( -1 is samplerate of Soundfile) ,
       /////////////   with device ( -1 is default device )
       //////////////// with number of channels (-1 = channels of soundfile, 2 = stereo, -)
        /////////////   at latency  ( -1 is latency suggested ) )
        ///////////// with sampleformat : int8 or int16 or int24 or int32 or float32
        //////////// example : UOS_CreateStream('/home/user/test.mp3','testStream',-1,-1,-1,-1,'int16');

procedure UOS_OpenStream() ;

procedure UOS_PlaySound(UOS_STREAMNAME:string) ;

procedure UOS_StopSound(UOS_STREAMNAME:string) ;

//procedure UOS_Pause() ;                     //   to do ....
//procedure UOS_Resume() ;                    //   to do ....
//procedure UOS_Position() ;                  //   to do ....


implementation

procedure UOS_StopSound(UOS_STREAMNAME:string) ;
var
 x : integer ;
begin
 x := 0 ;
   while (x < ( Length(UOSSTREAM)) )  do begin
 if (UOSSTREAM[x].streamname =  UOS_STREAMNAME)    then
  begin
   UOSSTREAM[x].Stop := true ;
  exit;
  end;
   x := x + 1   ;
  end;

end;


procedure UOS_CreateStream(Soundfile:ansistring;UOS_STREAMNAME:string; SAMPLERATE:integer ; DEVICE:integer ; CHANNELS :integer; LATENCY:integer; SAMPLEFORMAT : string) ;   /// sampleformat : int8 or int16 or int24 or int32 or float32
var
 x, x2, err : integer ;
  sfInfo      : TSF_INFO;
begin
    if not fileexists(Soundfile) then  MessageDlg (Soundfile + ' do not exists...', mtWarning,[mbYes],0)  else
  begin

 x2 := 0 ;
err := -1 ;
   while (x2 < ( Length(UOSSTREAM)) ) and (err <> 1) do begin


 if  UOSSTREAM[x2].streamname =  UOS_STREAMNAME   then
  begin
   if  UOSSTREAM[x2].StreamisOpen = true then
    begin
     UOSSTREAM[x2].stop := true ;
     application.ProcessMessages;
    end;
   if UOSSTREAM[x2].SFOpenError = 0 then  sf_close(UOSSTREAM[x2].handle);
   if UOSSTREAM[x2].MPOpenError = 0 then mpg123_close(UOSSTREAM[x2].handle);
  err := 1  ;
  x := x2;
  end;
   x2 := x2 + 1
  end;

   x2 := 0 ;

 if err = -1 then
  while ( x2 < Length(UOSSTREAM)) and (err <> 2) do begin

 if  (UOSSTREAM[x2].streamname = '')  then
 begin
 UOSSTREAM[x2].streamname:= UOS_STREAMNAME  ;
 x := x2 ;
  err := 2 ;
  end;
 x2 := x2+1 ;
end;

 if err = -1 then

 begin
 SetLength(UOSSTREAM,  Length(UOSSTREAM) + 1)  ;
 UOSSTREAM[Length(UOSSTREAM)-1].streamname:= UOS_STREAMNAME  ;
  err := 0 ;
 x :=  Length(UOSSTREAM)-1 ;
  UOSSTREAM[x].StreamisOpen := false ;
end;


 if err <> -1 then begin
   if  UOSSTREAM[x].StreamisOpen = false then begin

     if device = -1 then
    UOSSTREAM[x].OutputParameters.Device := UOSDefOut else
     UOSSTREAM[x].OutputParameters.Device :=  DEVICE;


if SAMPLEFORMAT = 'int8' then

 UOSSTREAM[x].OutputParameters.SampleFormat :=  paint8 else
 if SAMPLEFORMAT = 'int16' then

 UOSSTREAM[x].OutputParameters.SampleFormat :=  paint16 else
 if SAMPLEFORMAT = 'int32' then

 UOSSTREAM[x].OutputParameters.SampleFormat :=  paint32 else
 if SAMPLEFORMAT = 'float32' then

 UOSSTREAM[x].OutputParameters.SampleFormat :=  pafloat32 else
  UOSSTREAM[x].OutputParameters.SampleFormat :=  paint16  ;


     if LATENCY = -1 then
    UOSSTREAM[x].OutputParameters.SuggestedLatency :=
      (Pa_GetDeviceInfo(  UOSSTREAM[x].OutputParameters.device)^.defaultHighOutputLatency) * 1
      else UOSSTREAM[x].OutputParameters.SuggestedLatency := Latency;


     UOSSTREAM[x].OutputParameters.HostApiSpecificStreamInfo := nil;

     UOSSTREAM[x].StreamisOpen := false ;

     end;
 end;

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

         err := -1;

  UOSSTREAM[x].MPopenError := - 1;
  UOSSTREAM[x].SFOpenError := - 1;
    if (UOSloadresult.SFloadERROR = 0) and ((UOSloadflag = LoadAll) or (UOSloadflag = LoadSF)  or (UOSloadflag = LoadPA_SF) or
    (UOSloadflag = LoadSF_MP)) then begin

   UOSSTREAM[x].handle := sf_open(pchar(Soundfile),SFM_READ,sfInfo) ; (* try to open the file *)

   If UOSSTREAM[x].handle  = NIL then
       begin
       UOSSTREAM[x].SFOpenError := 1 ;
       end
       else
        begin
            UOSSTREAM[x].SFOpenError := 0;
            UOSSTREAM[x].filename := Soundfile ;
            UOSSTREAM[x].channels := SFinfo.channels;
            UOSSTREAM[x].format := SFinfo.format;
            UOSSTREAM[x].frames := SFinfo.frames;
            UOSSTREAM[x].samplerate := SFinfo.samplerate;
            UOSSTREAM[x].samplerateroot := SFinfo.samplerate;
            UOSSTREAM[x].sections := SFinfo.sections;
            UOSSTREAM[x].seekable := SFinfo.seekable;
            UOSSTREAM[x].copyright:= sf_get_string(UOSSTREAM[x].handle,SF_STR_COPYRIGHT);
            UOSSTREAM[x].software:= sf_get_string(UOSSTREAM[x].handle,SF_STR_SOFTWARE);
            UOSSTREAM[x].comment:= sf_get_string(UOSSTREAM[x].handle,SF_STR_COMMENT);
            UOSSTREAM[x].date   := sf_get_string(UOSSTREAM[x].handle,SF_STR_DATE);
            UOSSTREAM[x].BufFrames:= length(UOSSTREAM[x].SFoutbuf)   ;
            err := 0;
       end;

    end;


 if ((UOSSTREAM[x].SFOpenError  = 1) or (UOSSTREAM[x].SFOpenError  = -1)) and (UOSLoadresult.MPloadERROR = 0)
 and  ((UOSloadflag = LoadAll) or (UOSloadflag = LoadMP)  or (UOSloadflag = LoadPA_MP) or
    (UOSloadflag = LoadSF_MP)) then begin

       Err := -1;
 UOSSTREAM[x].handle := mpg123_new( NIL, Err);

  if Err = 0 then mpg123_open(UOSSTREAM[x].handle,pchar(Soundfile))

  else UOSSTREAM[x].MPOpenError := 1 ;
  if Err = 0 then Err := mpg123_getformat( UOSSTREAM[x].handle, UOSSTREAM[x].samplerate , UOSSTREAM[x].channels, UOSSTREAM[x].encoding) ;
  if Err = 0 then  begin

    UOSSTREAM[x].MPOpenError := 0;
    UOSSTREAM[x].filename := Soundfile ;
    UOSSTREAM[x].samplerateroot := UOSSTREAM[x].samplerate;
    UOSSTREAM[x].BufFrames:= length(UOSSTREAM[x].MPoutbuf)   ;

  end else UOSSTREAM[x].MPOpenError := 2 ;

    end;
   if err <> 0 then begin

   MessageDlg ('Cannot Open ' + Soundfile + '...', mtWarning,[mbYes],0)  ;
   exit;
   end
   else  begin

    UOSSTREAM[x].streamname   := UOS_STREAMNAME ;
    UOSSTREAM[x].stop := true;
    UOSSTREAM[x].StreamisOpen := false;

    UOSSTREAM[x].OutFrames := 0;
      if CHANNELS = -1 then UOSSTREAM[x].OutputParameters.channelCount:= UOSSTREAM[x].channels
  else  UOSSTREAM[x].OutputParameters.channelCount:= CHANNELS;

    if SAMPLERATE = -1 then
    Pa_OpenStream(@UOSSTREAM[x].Stream, nil, @UOSSTREAM[x].OutputParameters, UOSSTREAM[x].samplerate ,
      64, paClipOff, nil,nil)
      else  Pa_OpenStream(@UOSSTREAM[x].Stream, nil, @UOSSTREAM[x].OutputParameters,SAMPLERATE ,
      64, paClipOff, nil,nil)  ;

  end;

   end;

 end;

procedure UOS_OpenStream() ;
  VAR
  x ,   err  : integer  ;
  begin
     x := 0 ;
      while (x < ( Length(UOSSTREAM)) )  do begin

 if  (UOSSTREAM[x].stop = false) and (UOSSTREAM[x].StreamisOpen = false) then
 begin
  UOSSTREAM[x].StreamisOpen := true;
 Pa_StartStream(UOSSTREAM[X].stream) ;
  end;
  inc(x);
  end;

  if UOSSTREAMisopen = false then begin
   UOSSTREAMisopen := true;

 ////////////////////////////////////////////////////
  repeat

     x := 0 ;

     while (x < ( Length(UOSSTREAM)) )  do begin

 if (UOSSTREAM[x].Stop = false) and (UOSSTREAM[x].handle <> nil)  then
 begin

   if UOSSTREAM[x].SFOpenError = 0 then
   begin
 UOSSTREAM[x].OutFrames:= sf_read_short(UOSSTREAM[x].handle, @UOSSTREAM[x].SFoutbuf[0], UOSSTREAM[x].BufFrames  ) ;
   if  (UOSSTREAM[x].OutFrames < UOSSTREAM[x].BufFrames) then UOSSTREAM[x].Stop := true;
    end
   else if UOSSTREAM[x].MPOpenError = 0 then
   begin
  mpg123_read( UOSSTREAM[x].handle, @UOSSTREAM[x].MPoutbuf[0], UOSSTREAM[x].BufFrames, UOSSTREAM[x].OutFrames ) ;
   if  (UOSSTREAM[x].OutFrames < UOSSTREAM[x].BufFrames) then UOSSTREAM[x].Stop := true;
     end;


    if UOSSTREAM[x].SFOpenError = 0 then
   begin
   Pa_WriteStream( UOSSTREAM[x].Stream,@UOSSTREAM[x].SFoutbuf[0],Length(UOSstream[x].SFoutbuf) div 2) ;
   end
     else if UOSSTREAM[x].MPOpenError = 0 then
   begin
   Pa_WriteStream( UOSSTREAM[x].Stream,@UOSSTREAM[x].MPoutbuf[0],Length(UOSstream[x].MPoutbuf) div 4) ;
   end;

   end ;
  inc(x);
  end;
    x := 0 ;

   while (x < ( Length(UOSSTREAM)) )  do
   begin
   if UOSSTREAM[x].Stop = true then
   begin
   Pa_StopStream(UOSSTREAM[x].Stream);
   UOSSTREAM[x].StreamisOpen := false  ;
    end;
    inc(x);
   end ;

   x := 0 ;
   err := 1 ;

   while (x < ( Length(UOSSTREAM)) )  do
   begin
   if UOSSTREAM[x].Stop = false then err := 0;
    inc(x);
   end;
  if err = 1 then  UOSSTREAMisopen := false;

  application.ProcessMessages;     //////////// important if we want to do something else in the program !

 until  err = 1;

     end;

  end;


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

procedure UOS_PlaySound(UOS_STREAMNAME:string) ;
var
 x : integer ;
begin
 x := 0 ;


   while (x < ( Length(UOSSTREAM)) )  do begin


 if(UOSSTREAM[x].streamname =  UOS_STREAMNAME)    then
  begin
   UOSSTREAM[x].Stop := false ;
    UOS_OpenStream() ;
  exit ;
  end;
   x := x + 1   ;
  end;

end;

////////////////////////////////////////////////////////////////////
procedure UOS_Unload() ;

 begin

  Sf_Unload();
  Mp_Unload();
  Pa_Unload();

 end;
///////////////////////////////////////////////////////////////////////////////
 procedure UOS_Init() ;

 begin

    if (UOSLoadResult.MPloadERROR = 0) and ((UOSloadflag = LoadAll) or (UOSloadflag = LoadMP)  or (UOSloadflag = LoadPA_MP) or
    (UOSloadflag = LoadSF_MP)) then if mpg123_init()=MPG123_OK  then  UOSLoadResult.MPinitError := 0 else UOSLoadResult.MPinitError := 1;


  IF (UOSLoadResult.PAloadERROR = 0) and ((UOSloadflag = LoadAll) or (UOSloadflag = LoadPA) or
  (UOSloadflag = LoadPA_SF) or (UOSloadflag = LoadPA_MP)) Then begin
    UOSLoadResult.PAinitError := Pa_Initialize();

      if UOSLoadResult.PAinitError = 0 then begin
    UOSDefOut := Pa_GetDefaultOutputDevice();
    UOSDEVinfo:= Pa_GetDeviceInfo(UOSDefOut);
    UOSAPIinfo:= Pa_GetHostApiInfo(UOSDEVinfo^.hostApi);
     end;

  end;

   end;

procedure UOS_Load( PA_FileName,SF_FileName,MP_FileName : AnsiString ; flag : shortint ) ;

begin

 UOSloadflag := flag ;

   case flag of

    LoadAll : begin

   if not fileexists(PA_FileName) then UOSLoadResult.PAloadERROR:= 1   else
     if  Pa_Load (PA_FileName) then UOSLoadResult.PAloadERROR:= 0 else UOSLoadResult.PAloadERROR:= 2 ;

  if not fileexists(SF_FileName) then UOSLoadResult.SFloadERROR:= 1 else
    if  Sf_Load (SF_FileName)  then UOSLoadResult.SFloadERROR:= 0 else UOSLoadResult.SFloadERROR:= 2 ;

   if not fileexists(MP_FileName) then UOSLoadResult.MPloadERROR := 1 else
    if  mp_Load (Mp_FileName)  then UOSLoadResult.MPloadERROR := 0 else UOSLoadResult.MPloadERROR := 2 ;

    end;

     LoadPA : begin

    if not fileexists(PA_FileName) then  UOSLoadResult.PAloadERROR:= 1   else
     if  Pa_Load (PA_FileName) then  UOSLoadResult.PAloadERROR:= 0  else UOSLoadResult.PAloadERROR:= 2 ;

    end;

    LoadSF : begin

  if not fileexists(SF_FileName) then UOSLoadResult.SFloadERROR:= 1 else
  if  Sf_Load (SF_FileName)  then UOSLoadResult.SFloadERROR:= 0 else UOSLoadResult.SFloadERROR:= 2 ;

    end;

     LoadMP : begin

    if not fileexists(MP_FileName) then UOSLoadResult.MPloadERROR := 1 else
    if  mp_Load (Mp_FileName)  then UOSLoadResult.MPloadERROR := 0 else UOSLoadResult.MPloadERROR := 2 ;

    end;

   LoadPA_SF : begin

    if not fileexists(PA_FileName) then  UOSLoadResult.PAloadERROR:= 1   else
     if  Pa_Load (PA_FileName) then  UOSLoadResult.PAloadERROR:= 0  else UOSLoadResult.PAloadERROR:= 2 ;

  if not fileexists(SF_FileName) then UOSLoadResult.SFloadERROR:= 1 else
    if  Sf_Load (SF_FileName)  then UOSLoadResult.SFloadERROR:= 0 else UOSLoadResult.SFloadERROR:= 2 ;

     end;

   LoadPA_MP : begin
     if not fileexists(MP_FileName) then UOSLoadResult.MPloadERROR := 1 else
    if  MP_Load (Mp_FileName)  then UOSLoadResult.MPloadERROR := 0 else UOSLoadResult.MPloadERROR := 2 ;


    if not fileexists(PA_FileName) then  UOSLoadResult.PAloadERROR:= 1   else
     if  Pa_Load (PA_FileName) then  UOSLoadResult.PAloadERROR:= 0  else UOSLoadResult.PAloadERROR:= 2 ;


    end;

    LoadSF_MP : begin

   if not fileexists(SF_FileName) then UOSLoadResult.SFloadERROR:= 1 else
    if  SF_Load (SF_FileName)  then UOSLoadResult.SFloadERROR:= 0 else UOSLoadResult.SFloadERROR:= 2 ;

   if not fileexists(MP_FileName) then UOSLoadResult.MPloadERROR := 1 else
    if  mp_Load (Mp_FileName)  then UOSLoadResult.MPloadERROR := 0 else UOSLoadResult.MPloadERROR := 2 ;

    end;
    end;
    end;

 initialization
  UOSSTREAMisopen := false;
  SetLength(UOSSTREAM, 1) ;
 UOSLoadResult.PAloadERROR := -1 ;
 UOSLoadResult.SFloadERROR := -1 ;
 UOSLoadResult.MPloadERROR := -1 ;
 UOSLoadResult.PAinitError := -1 ;
 UOSLoadResult.MPinitError := -1 ;

end.               
« Last Edit: May 16, 2013, 03:21:35 pm by Fred vS »
I use Lazarus 2.2.0 32/64 and FPC 3.2.2 32/64 on Debian 11 64 bit, Windows 10, Windows 7 32/64, Windows XP 32,  FreeBSD 64.
Widgetset: fpGUI, MSEgui, Win32, GTK2, Qt.

https://github.com/fredvs
https://gitlab.com/fredvs
https://codeberg.org/fredvs

BigChimp

  • Hero Member
  • *****
  • Posts: 5740
  • Add to the wiki - it's free ;)
    • FPCUp, PaperTiger scanning and other open source projects
Re: United OpenLib of Sound (U_OS)
« Reply #4 on: July 31, 2012, 01:09:53 pm »
Hi Fred,

Thanks for working on this. Some remarks from a brief look at the code (haven't compiled it):

I'd add a license statement to your code so people know what they can do with it (or state it is public domain/use as you wish).

In u_os.pas, I'd indicate what libraries exactly are supported - nice to have an overview and to know what libraries you should download.

Also, you might want to make an overloaded version of UOS_Load without library filenames, and in the code call the existing UOS_Load with default/sensible filenames for that platform (e.g. .dll in current directory, system directory on Windows... and perhaps you can just load the .so files without specifying the path on Linux; likewise for dylib??)

Thanks,
BigChimp
Want quicker answers to your questions? Read http://wiki.lazarus.freepascal.org/Lazarus_Faq#What_is_the_correct_way_to_ask_questions_in_the_forum.3F

Open source including papertiger OCR/PDF scanning:
https://bitbucket.org/reiniero

Lazarus trunk+FPC trunk x86, Windows x64 unless otherwise specified

KpjComp

  • Hero Member
  • *****
  • Posts: 680
Re: United OpenLib of Sound (U_OS)
« Reply #5 on: July 31, 2012, 01:28:08 pm »
Looking good Fred_VS,  the only thing I would say is that I still believe using a class would be better.  It just makes more advanced features later that much easer.  The procedure type functions are still a good idea, but I think having them sit on top of the Class versions would seem logical.

Fred vS

  • Hero Member
  • *****
  • Posts: 3480
    • StrumPract is the musicians best friend
Re: United OpenLib of Sound (U_OS)
« Reply #6 on: July 31, 2012, 01:32:37 pm »
@ BigChimp : Many thanks to look at the code.

Of course that code is for everybody, the only think i hope is that it become better with the help of all of you (im not a Lazarus guru).

At the moment only Portaudio, SndFile and MPG123 are supported but every lib is welcome.

I have sent mail to the owners of that libraries, they respond and all agree with U_OS project.


Quote
Also, you might want to make an overloaded version of UOS_Load without library filenames, and in the code call the existing UOS_Load with default/sensible filenames for that platform (e.g. .dll in current directory, system directory on Windows... and perhaps you can just load the .so files without specifying the path on Linux; likewise for dylib??)

Sorry BigChimp, i do not understand perfectly what you suggested (but i agree  ;) )




PS: I do not understand perfectly Dutch (i know, it is a shame, my name is in Dutch  :-X), i speak French.
(But i have a good Google translator  :-[)
« Last Edit: July 31, 2012, 01:43:02 pm by Fred vS »
I use Lazarus 2.2.0 32/64 and FPC 3.2.2 32/64 on Debian 11 64 bit, Windows 10, Windows 7 32/64, Windows XP 32,  FreeBSD 64.
Widgetset: fpGUI, MSEgui, Win32, GTK2, Qt.

https://github.com/fredvs
https://gitlab.com/fredvs
https://codeberg.org/fredvs

Fred vS

  • Hero Member
  • *****
  • Posts: 3480
    • StrumPract is the musicians best friend
Re: United OpenLib of Sound (U_OS)
« Reply #7 on: July 31, 2012, 01:35:41 pm »
@ KpjComp

Quote
the only thing I would say is that I still believe using a class would be better

Sure but what do you mean with using a class ?  :-\

Could you give me a example how you see it ?

Many thanks
« Last Edit: July 31, 2012, 01:38:18 pm by Fred vS »
I use Lazarus 2.2.0 32/64 and FPC 3.2.2 32/64 on Debian 11 64 bit, Windows 10, Windows 7 32/64, Windows XP 32,  FreeBSD 64.
Widgetset: fpGUI, MSEgui, Win32, GTK2, Qt.

https://github.com/fredvs
https://gitlab.com/fredvs
https://codeberg.org/fredvs

KpjComp

  • Hero Member
  • *****
  • Posts: 680
Re: United OpenLib of Sound (U_OS)
« Reply #8 on: July 31, 2012, 01:51:08 pm »
Quote
Sure but what do you mean with using a class ? 

Oh right, well a class in Lazarus is what we call the OOP (Object Orientated Programming).  As a good example when you create a Form in Lazarus your using OOP/Classes.  TForm been the class, and your Form1 been the object that uses this class.

What you created is what we call procedural programming, there is nothing wrong with this, but as a whole doesn't scale as well as OOP.  If your not familiar with OOP concepts then don't worry and keep on implementing the way you have, creating a good class is not always that easy, get it wrong and it can end up looking harder to follow than a procedural based one.

Fred vS

  • Hero Member
  • *****
  • Posts: 3480
    • StrumPract is the musicians best friend
Re: United OpenLib of Sound (U_OS)
« Reply #9 on: July 31, 2012, 01:58:05 pm »
@ KpjComp

OK, i see now.
By the way, you are welcome to translate it into a Class  ;)
I use Lazarus 2.2.0 32/64 and FPC 3.2.2 32/64 on Debian 11 64 bit, Windows 10, Windows 7 32/64, Windows XP 32,  FreeBSD 64.
Widgetset: fpGUI, MSEgui, Win32, GTK2, Qt.

https://github.com/fredvs
https://gitlab.com/fredvs
https://codeberg.org/fredvs

Leledumbo

  • Hero Member
  • *****
  • Posts: 8786
  • Programming + Glam Metal + Tae Kwon Do = Me
Re: United OpenLib of Sound (U_OS)
« Reply #10 on: July 31, 2012, 02:04:06 pm »
Quote
the only thing I would say is that I still believe using a class would be better
Actually the class could sit as an OO wrapper over this procedural unit. I almost always do that for certain benefits, but the most important one for me is that the procedural unit can be used by other languages while we could still comfortly use the OO version.

KpjComp

  • Hero Member
  • *****
  • Posts: 680
Re: United OpenLib of Sound (U_OS)
« Reply #11 on: July 31, 2012, 02:13:11 pm »
Quote
Actually the class could sit as an OO wrapper over this procedural unit.

Yes, it could, I never said otherwise.  But I believe it works better the other way round.   Especially when it comes to code maintenance and scalability.

BigChimp

  • Hero Member
  • *****
  • Posts: 5740
  • Add to the wiki - it's free ;)
    • FPCUp, PaperTiger scanning and other open source projects
Re: United OpenLib of Sound (U_OS)
« Reply #12 on: July 31, 2012, 03:04:50 pm »
Quote
Also, you might want to make an overloaded version of UOS_Load without library filenames, and in the code call the existing UOS_Load with default/sensible filenames for that platform (e.g. .dll in current directory, system directory on Windows... and perhaps you can just load the .so files without specifying the path on Linux; likewise for dylib??)

Sorry BigChimp, i do not understand perfectly what you suggested (but i agree  ;) )
Short version: if you let your code search for the dlls in some standard locations, your library users don't have to ;)

PS: I do not understand perfectly Dutch (i know, it is a shame, my name is in Dutch  :-X), i speak French.
(But i have a good Google translator  :-[)
Pas de probleme et excusez. Je peux parler francais un peu mais hollandais, c'est beaucoup plus facile pour moi ;)
Want quicker answers to your questions? Read http://wiki.lazarus.freepascal.org/Lazarus_Faq#What_is_the_correct_way_to_ask_questions_in_the_forum.3F

Open source including papertiger OCR/PDF scanning:
https://bitbucket.org/reiniero

Lazarus trunk+FPC trunk x86, Windows x64 unless otherwise specified

Fred vS

  • Hero Member
  • *****
  • Posts: 3480
    • StrumPract is the musicians best friend
Re: United OpenLib of Sound (U_OS)
« Reply #13 on: November 13, 2012, 08:32:54 pm »
Hello everybody.  :)

Here is the new release of United Openlib of Sound (Included multi-stream example) :

http://fredvs.github.io/uos/

Added : Now each stream is in a personal thread.
So you can play lot of songs together (best for dj program or multi-rec programs).
Added too : pause and resume.

The new code :

Code: [Select]
unit U_OS;

{*******************************************************************************
*                  United Openlibraries of Sound ( U_OS )                      *
*                  --------------------------------------                      *
*                                                                              *
*           United procedures to access Open Sound libraries                   *
*                                                                              *
*                                                                              *
*     Lazarus Forum     /   Fred van Stappen   /  Fiens@hotmail.com            *
*                                                                              *
********************************************************************************
*        second realease     first changes:  2012-07-20                        *
*                            second changes: 2012-07-31                        *
*                            3 th changes: 2012-11-13                          *                        *
*******************************************************************************}

interface

uses

  Classes, Forms, SysUtils, dialogs ,LazDyn_PortAudio, LazDyn_LibSndFile, LazDyn_Mpg123;


const
  ///// error
  noError            = 0;
  FilePAError        = 10;
  LoadPAError        = 11;
  FileSFError        = 20;
  LoadSFError        = 21;
  FileMPError        = 30;
  LoadMPError        = 31;

  //////// UOS_load() flag
  LoadAll            = 0;   // load all PortAudio + SndFile + MPG123
  LoadPA             = 1;   // load only PortAudio
  LoadSF             = 2;   // load only SndFile
  LoadMP             = 3;   // load only MPG123
  LoadPA_SF          = 4;   // load only PortAudio + SndFile
  LoadPA_MP          = 5;   // load only PortAudio + MPG123
  LoadSF_MP          = 6;   // load only SndFile + MPG123

  Samplerate_root    = 0;

type

  TUOSThread = class(TThread)
  private

  protected
    procedure Execute; override;
  public
   constructor Create(CreateSuspended: boolean);

  end;


type
   TLoadResult = record
    PAloadERROR          : shortint;
    SFloadERROR          : shortint;
    MPloadERROR          : shortint;
    PAinitError          : integer;
    MPinitError          : integer;
   end;



type
    TStreaminfo= record
    streamname        : string;
    Stream               : PPaStream;
    thread               : TUOSThread;
    StreamisOpen         : boolean ;
    DEVICE               : integer ;
    LATENCY              : integer ;
    OutputParameters     : PaStreamParameters;
    handle            : pointer;
    SFopenError       : shortint;
    MPopenError       : shortint;
    SFoutbuf          : array [0..2047]  of byte  ;
    MPoutbuf          : array [0..2047]  of byte  ;
    {$IFDEF Win32}   //// Only Windows 32 bits
    BufFrames         : cardinal;
    OutFrames         : cardinal;
     {$else}
    BufFrames       : Tsf_count_t;
    OutFrames       : Tsf_count_t;

     {$endif}
    Filename          : string;
    Status            : shortint;  //// stop = 0, play = 1, pause = 2
    channels          : integer;
    format            : integer;
    frames            : integer;
    samplerateroot    : integer;
    samplerate        : integer;
    sections          : integer;
    seekable          : integer;
    encoding          : integer;
    title             : string;
    copyright         : string;
    software          : string;
    artist            : string;
    comment           : string;
    date              : string;
    tag               : array[0..2] of Char;   (**< Always the string "TAG", the classic intro. *)
    album             : string;  (**< Album string. *)
    genre             : byte;    (**< Genre index. *)

     end;


  var
   UOSLoadFlag         : shortint ;
   UOSLoadResult       : TLoadResult;
   UOSDefOut           : PaDeviceIndex;
   UOSDEVinfo          : PPaDeviceInfo;
   UOSAPIinfo          : PPaHostApiInfo;
   UOSSTREAM            : array   of  Tstreaminfo;
   UOSSTREAMNUM       : integer;
procedure UOS_Load(PA_FileName,SF_FileName,MP_FileName : AnsiString ; flag : shortint );  /////////// dynamic load libraries

procedure UOS_UnLoad() ;

procedure UOS_Init()  ; ////// init libraries

procedure UOS_CreateStream(Soundfile:ansistring;UOS_STREAMNAME:string; SAMPLERATE:integer ; DEVICE:integer ; CHANNELS :integer; LATENCY:integer; SAMPLEFORMAT : string) ;
       ////////////// at Samplerate ( -1 is samplerate of Soundfile) ,
       /////////////   with device ( -1 is default device )
       //////////////// with number of channels (-1 = channels of soundfile, 2 = stereo, -)
        /////////////   at latency  ( -1 is latency suggested ) )
        ///////////// with sampleformat : int8 or int16 or int24 or int32 or float32
        //////////// example : UOS_CreateStream('/home/user/test.mp3','testStream',-1,-1,-1,-1,'int16');

procedure UOS_Play(UOS_STREAMNAME:string) ;   ////// or resume if song was paused

procedure UOS_Stop(UOS_STREAMNAME:string) ;

procedure UOS_Pause(UOS_STREAMNAME:string) ;

//procedure UOS_Position() ;                  //   to do ....


implementation

procedure UOS_Stop(UOS_STREAMNAME:string) ;
var
 x : integer ;
begin
 x := 0 ;
   while (x < ( Length(UOSSTREAM)) )  do begin
 if (UOSSTREAM[x].streamname =  UOS_STREAMNAME)    then
  begin
   UOSSTREAM[x].status := 0 ;
  exit;
  end;
   x := x + 1   ;
  end;

end;

procedure UOS_Pause(UOS_STREAMNAME:string) ;
var
 x : integer ;
begin
 x := 0 ;
   while (x < ( Length(UOSSTREAM)) )  do begin
 if (UOSSTREAM[x].streamname =  UOS_STREAMNAME)    then
  begin
    UOSSTREAM[x].Status := 2 ;
  exit;
  end;
   x := x + 1   ;
  end;

end;



procedure UOS_CreateStream(Soundfile:ansistring;UOS_STREAMNAME:string; SAMPLERATE:integer ; DEVICE:integer ; CHANNELS :integer; LATENCY:integer; SAMPLEFORMAT : string) ;   /// sampleformat : int8 or int16 or int24 or int32 or float32
var
 x, x2, err : integer ;
  sfInfo      : TSF_INFO;
begin
    if not fileexists(Soundfile) then  MessageDlg (Soundfile + ' do not exists...', mtWarning,[mbYes],0)  else
  begin

 x2 := 0 ;
err := -1 ;
   while (x2 < ( Length(UOSSTREAM)) ) and (err <> 1) do begin
     application.ProcessMessages;

 if  UOSSTREAM[x2].streamname =  UOS_STREAMNAME   then
  begin


   if  UOSSTREAM[x2].StreamisOpen = true then
    begin
    UOSSTREAM[x2].status := 0 ;
    application.ProcessMessages;
    sleep(150) ; /////// < buffers need time to release (on some systems) !!!!
     application.ProcessMessages;
    end;

  err := 1  ;
  x := x2;
  end;
   x2 := x2 + 1
  end;

   x2 := 0 ;

 if err = -1 then
  while ( x2 < Length(UOSSTREAM)) and (err <> 2) do begin

 if  (UOSSTREAM[x2].streamname = '')  then
 begin
 UOSSTREAM[x2].streamname:= UOS_STREAMNAME  ;
  UOSSTREAM[x2].status := 0 ;
   UOSSTREAM[x2].StreamisOpen := false ;
 x := x2 ;
  err := 2 ;
  end;
 x2 := x2+1 ;
end;

 if err = -1 then

 begin
 SetLength(UOSSTREAM,  Length(UOSSTREAM) + 1)  ;
 UOSSTREAM[Length(UOSSTREAM)-1].streamname:= UOS_STREAMNAME  ;
  err := 0 ;
 x :=  Length(UOSSTREAM)-1 ;
  UOSSTREAM[x].StreamisOpen := false ;
   UOSSTREAM[x].status := 0 ;
end;


 if err <> -1 then begin
   if  UOSSTREAM[x].StreamisOpen = false then begin

     if device = -1 then
    UOSSTREAM[x].OutputParameters.Device := UOSDefOut else
     UOSSTREAM[x].OutputParameters.Device :=  DEVICE;


if SAMPLEFORMAT = 'int8' then

 UOSSTREAM[x].OutputParameters.SampleFormat :=  paint8 else
 if SAMPLEFORMAT = 'int16' then

 UOSSTREAM[x].OutputParameters.SampleFormat :=  paint16 else
 if SAMPLEFORMAT = 'int32' then

 UOSSTREAM[x].OutputParameters.SampleFormat :=  paint32 else
 if SAMPLEFORMAT = 'float32' then

 UOSSTREAM[x].OutputParameters.SampleFormat :=  pafloat32 else
  UOSSTREAM[x].OutputParameters.SampleFormat :=  paint16  ;


     if LATENCY = -1 then
    UOSSTREAM[x].OutputParameters.SuggestedLatency :=
      (Pa_GetDeviceInfo(  UOSSTREAM[x].OutputParameters.device)^.defaultHighOutputLatency) * 1
      else UOSSTREAM[x].OutputParameters.SuggestedLatency := Latency;


     UOSSTREAM[x].OutputParameters.HostApiSpecificStreamInfo := nil;

     UOSSTREAM[x].StreamisOpen := false ;

     end;
 end;

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

         err := -1;

  UOSSTREAM[x].MPopenError := - 1;
  UOSSTREAM[x].SFOpenError := - 1;
    if (UOSloadresult.SFloadERROR = 0) and ((UOSloadflag = LoadAll) or (UOSloadflag = LoadSF)  or (UOSloadflag = LoadPA_SF) or
    (UOSloadflag = LoadSF_MP)) then begin

   UOSSTREAM[x].handle := sf_open(pchar(Soundfile),SFM_READ,sfInfo) ; (* try to open the file *)

   If UOSSTREAM[x].handle  = NIL then
       begin
       UOSSTREAM[x].SFOpenError := 1 ;
       end
       else
        begin
            UOSSTREAM[x].SFOpenError := 0;
            UOSSTREAM[x].filename := Soundfile ;
            UOSSTREAM[x].channels := SFinfo.channels;
            UOSSTREAM[x].format := SFinfo.format;
            UOSSTREAM[x].frames := SFinfo.frames;
            UOSSTREAM[x].samplerate := SFinfo.samplerate;
            UOSSTREAM[x].samplerateroot := SFinfo.samplerate;
            UOSSTREAM[x].sections := SFinfo.sections;
            UOSSTREAM[x].seekable := SFinfo.seekable;
            UOSSTREAM[x].copyright:= sf_get_string(UOSSTREAM[x].handle,SF_STR_COPYRIGHT);
            UOSSTREAM[x].software:= sf_get_string(UOSSTREAM[x].handle,SF_STR_SOFTWARE);
            UOSSTREAM[x].comment:= sf_get_string(UOSSTREAM[x].handle,SF_STR_COMMENT);
            UOSSTREAM[x].date   := sf_get_string(UOSSTREAM[x].handle,SF_STR_DATE);
            UOSSTREAM[x].BufFrames:= length(UOSSTREAM[x].SFoutbuf)   ;
            err := 0;
       end;

    end;


 if ((UOSSTREAM[x].SFOpenError  = 1) or (UOSSTREAM[x].SFOpenError  = -1)) and (UOSLoadresult.MPloadERROR = 0)
 and  ((UOSloadflag = LoadAll) or (UOSloadflag = LoadMP)  or (UOSloadflag = LoadPA_MP) or
    (UOSloadflag = LoadSF_MP)) then begin

       Err := -1;
 UOSSTREAM[x].handle := mpg123_new( NIL, Err);

  if Err = 0 then mpg123_open(UOSSTREAM[x].handle,pchar(Soundfile))

  else UOSSTREAM[x].MPOpenError := 1 ;
  if Err = 0 then Err := mpg123_getformat( UOSSTREAM[x].handle, UOSSTREAM[x].samplerate , UOSSTREAM[x].channels, UOSSTREAM[x].encoding) ;
  if Err = 0 then  begin

    UOSSTREAM[x].MPOpenError := 0;
    UOSSTREAM[x].filename := Soundfile ;
    UOSSTREAM[x].samplerateroot := UOSSTREAM[x].samplerate;
    UOSSTREAM[x].BufFrames:= length(UOSSTREAM[x].MPoutbuf)   ;

  end else UOSSTREAM[x].MPOpenError := 2 ;

    end;
   if err <> 0 then begin

   MessageDlg ('Cannot Open ' + Soundfile + '...', mtWarning,[mbYes],0)  ;
   exit;
   end
   else  begin

    UOSSTREAM[x].streamname   := UOS_STREAMNAME ;
    UOSSTREAM[x].status := 0;
    UOSSTREAM[x].StreamisOpen := false;

    UOSSTREAM[x].OutFrames := 0;
      if CHANNELS = -1 then UOSSTREAM[x].OutputParameters.channelCount:= UOSSTREAM[x].channels
  else  UOSSTREAM[x].OutputParameters.channelCount:= CHANNELS;

    if SAMPLERATE = -1 then
    Pa_OpenStream(@UOSSTREAM[x].Stream, nil, @UOSSTREAM[x].OutputParameters, UOSSTREAM[x].samplerate ,
      64, paClipOff, nil,nil)
      else  Pa_OpenStream(@UOSSTREAM[x].Stream, nil, @UOSSTREAM[x].OutputParameters,SAMPLERATE ,
      64, paClipOff, nil,nil)  ;

    ////////////////
     application.ProcessMessages;
       UOSSTREAM[x].Thread := TUOSThread.Create(True); // With the True parameter it doesn't start automatically
       UOSSTREAM[x].thread.FreeOnTerminate:=true;

        if Assigned(UOSSTREAM[x].Thread.FatalException) then
  raise UOSSTREAM[x].Thread.FatalException;
    application.ProcessMessages
  end;

   end;

 end;



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


 procedure TUOSThread.Execute;

  VAR
  x ,   err  : integer  ;

  begin
    x := UOSSTREAMNUM ;

 if  (UOSSTREAM[x].status = 1) and (UOSSTREAM[x].StreamisOpen = false) then
 begin
  UOSSTREAM[x].StreamisOpen := true;
 Pa_StartStream(UOSSTREAM[X].stream) ;
   application.ProcessMessages;
 ////////////////////////////////////////////////////
  repeat
         application.ProcessMessages;
  if (UOSSTREAM[x].Status = 1) and (UOSSTREAM[x].handle <> nil)  then
 begin

   if UOSSTREAM[x].SFOpenError = 0 then
   begin
 UOSSTREAM[x].OutFrames:= sf_read_short(UOSSTREAM[x].handle, @UOSSTREAM[x].SFoutbuf[0], UOSSTREAM[x].BufFrames  ) ;
   if  (UOSSTREAM[x].OutFrames < UOSSTREAM[x].BufFrames) then UOSSTREAM[x].status := 0;
    end
   else if UOSSTREAM[x].MPOpenError = 0 then
   begin
  mpg123_read( UOSSTREAM[x].handle, @UOSSTREAM[x].MPoutbuf[0], UOSSTREAM[x].BufFrames, UOSSTREAM[x].OutFrames ) ;
   if  (UOSSTREAM[x].OutFrames < UOSSTREAM[x].BufFrames) then UOSSTREAM[x].status := 0;
     end;

   application.ProcessMessages;

    if (UOSSTREAM[x].Status = 1) and (UOSSTREAM[x].handle <> nil)  then
 begin
    if UOSSTREAM[x].SFOpenError = 0 then
   begin
   Pa_WriteStream( UOSSTREAM[x].Stream,@UOSSTREAM[x].SFoutbuf[0],Length(UOSstream[x].SFoutbuf) div 2) ;
   end
     else if UOSSTREAM[x].MPOpenError = 0 then
   begin
   Pa_WriteStream( UOSSTREAM[x].Stream,@UOSSTREAM[x].MPoutbuf[0],Length(UOSstream[x].MPoutbuf) div 4) ;
   end;

   end ;
   end;


   if UOSSTREAM[x].Status = 2 then
   begin
   sleep(100);
   end;

    err := 0;

application.ProcessMessages;     //////////// important if we want to do something else in the program !
   if UOSSTREAM[x].Status = 0 then err := 1   ;
 until  (err = 1);

     end;

if(err = 1) then

 begin

   Pa_StopStream(UOSSTREAM[x].Stream);
    Pa_CloseStream(UOSSTREAM[x].Stream);
    UOSSTREAM[x].StreamisOpen := false  ;
     if UOSSTREAM[x].SFOpenError = 0 then sf_close(UOSSTREAM[x].handle);
   if UOSSTREAM[x].MPOpenError = 0 then mpg123_close(UOSSTREAM[x].handle);
   UOSSTREAM[x].thread.Terminate;
 application.ProcessMessages;

  end;

  end;


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



procedure UOS_Play(UOS_STREAMNAME:string) ;
var
 x : integer ;

begin
 x := 0 ;
    application.ProcessMessages;

   while (x < ( Length(UOSSTREAM)) )  do begin


 if(UOSSTREAM[x].streamname =  UOS_STREAMNAME)    then
  begin

   UOSSTREAM[x].Status := 1 ;
   UOSSTREAMNUM := x ;
   application.ProcessMessages;
  UOSSTREAM[x].Thread.resume;
    exit ;
  end;
   x := x + 1   ;
  end;

end;

////////////////////////////////////////////////////////////////////
procedure UOS_Unload() ;

 begin

  Sf_Unload();
  Mp_Unload();
  Pa_Unload();

 end;
///////////////////////////////////////////////////////////////////////////////
 procedure UOS_Init() ;

 begin

    if (UOSLoadResult.MPloadERROR = 0) and ((UOSloadflag = LoadAll) or (UOSloadflag = LoadMP)  or (UOSloadflag = LoadPA_MP) or
    (UOSloadflag = LoadSF_MP)) then if mpg123_init()=MPG123_OK  then  UOSLoadResult.MPinitError := 0 else UOSLoadResult.MPinitError := 1;


  IF (UOSLoadResult.PAloadERROR = 0) and ((UOSloadflag = LoadAll) or (UOSloadflag = LoadPA) or
  (UOSloadflag = LoadPA_SF) or (UOSloadflag = LoadPA_MP)) Then begin
    UOSLoadResult.PAinitError := Pa_Initialize();

      if UOSLoadResult.PAinitError = 0 then begin
    UOSDefOut := Pa_GetDefaultOutputDevice();
    UOSDEVinfo:= Pa_GetDeviceInfo(UOSDefOut);
    UOSAPIinfo:= Pa_GetHostApiInfo(UOSDEVinfo^.hostApi);
     end;

  end;

   end;

procedure UOS_Load( PA_FileName,SF_FileName,MP_FileName : AnsiString ; flag : shortint ) ;

begin

 UOSloadflag := flag ;

   case flag of

    LoadAll : begin

   if not fileexists(PA_FileName) then UOSLoadResult.PAloadERROR:= 1   else
     if  Pa_Load (PA_FileName) then UOSLoadResult.PAloadERROR:= 0 else UOSLoadResult.PAloadERROR:= 2 ;

  if not fileexists(SF_FileName) then UOSLoadResult.SFloadERROR:= 1 else
    if  Sf_Load (SF_FileName)  then UOSLoadResult.SFloadERROR:= 0 else UOSLoadResult.SFloadERROR:= 2 ;

   if not fileexists(MP_FileName) then UOSLoadResult.MPloadERROR := 1 else
    if  mp_Load (Mp_FileName)  then UOSLoadResult.MPloadERROR := 0 else UOSLoadResult.MPloadERROR := 2 ;

    end;

     LoadPA : begin

    if not fileexists(PA_FileName) then  UOSLoadResult.PAloadERROR:= 1   else
     if  Pa_Load (PA_FileName) then  UOSLoadResult.PAloadERROR:= 0  else UOSLoadResult.PAloadERROR:= 2 ;

    end;

    LoadSF : begin

  if not fileexists(SF_FileName) then UOSLoadResult.SFloadERROR:= 1 else
  if  Sf_Load (SF_FileName)  then UOSLoadResult.SFloadERROR:= 0 else UOSLoadResult.SFloadERROR:= 2 ;

    end;

     LoadMP : begin

    if not fileexists(MP_FileName) then UOSLoadResult.MPloadERROR := 1 else
    if  mp_Load (Mp_FileName)  then UOSLoadResult.MPloadERROR := 0 else UOSLoadResult.MPloadERROR := 2 ;

    end;

   LoadPA_SF : begin

    if not fileexists(PA_FileName) then  UOSLoadResult.PAloadERROR:= 1   else
     if  Pa_Load (PA_FileName) then  UOSLoadResult.PAloadERROR:= 0  else UOSLoadResult.PAloadERROR:= 2 ;

  if not fileexists(SF_FileName) then UOSLoadResult.SFloadERROR:= 1 else
    if  Sf_Load (SF_FileName)  then UOSLoadResult.SFloadERROR:= 0 else UOSLoadResult.SFloadERROR:= 2 ;

     end;

   LoadPA_MP : begin
     if not fileexists(MP_FileName) then UOSLoadResult.MPloadERROR := 1 else
    if  MP_Load (Mp_FileName)  then UOSLoadResult.MPloadERROR := 0 else UOSLoadResult.MPloadERROR := 2 ;


    if not fileexists(PA_FileName) then  UOSLoadResult.PAloadERROR:= 1   else
     if  Pa_Load (PA_FileName) then  UOSLoadResult.PAloadERROR:= 0  else UOSLoadResult.PAloadERROR:= 2 ;


    end;

    LoadSF_MP : begin

   if not fileexists(SF_FileName) then UOSLoadResult.SFloadERROR:= 1 else
    if  SF_Load (SF_FileName)  then UOSLoadResult.SFloadERROR:= 0 else UOSLoadResult.SFloadERROR:= 2 ;

   if not fileexists(MP_FileName) then UOSLoadResult.MPloadERROR := 1 else
    if  mp_Load (Mp_FileName)  then UOSLoadResult.MPloadERROR := 0 else UOSLoadResult.MPloadERROR := 2 ;

    end;
    end;
    end;

  constructor TUOSThread.Create(CreateSuspended: boolean);
begin
  FreeOnTerminate := True;
  inherited Create(CreateSuspended);
end;

 initialization

  SetLength(UOSSTREAM, 1) ;
 UOSLoadResult.PAloadERROR := -1 ;
 UOSLoadResult.SFloadERROR := -1 ;
 UOSLoadResult.MPloadERROR := -1 ;
 UOSLoadResult.PAinitError := -1 ;
 UOSLoadResult.MPinitError := -1 ;

end.

All your comments or corrections are welcome.

@ KpjComp

Quote
Looking good Fred_VS,  the only thing I would say is that I still believe using a class would be better.  It just makes more advanced features later that much easer.  The procedure type functions are still a good idea, but I think having them sit on top of the Class versions would seem logical.

Fully agree with you but i find it simpler to have first the procedure working and then translate it into a beautifull class (with your help maybe ?  :-[ )

Have fun.
« Last Edit: May 16, 2013, 03:22:18 pm by Fred vS »
I use Lazarus 2.2.0 32/64 and FPC 3.2.2 32/64 on Debian 11 64 bit, Windows 10, Windows 7 32/64, Windows XP 32,  FreeBSD 64.
Widgetset: fpGUI, MSEgui, Win32, GTK2, Qt.

https://github.com/fredvs
https://gitlab.com/fredvs
https://codeberg.org/fredvs

Fred vS

  • Hero Member
  • *****
  • Posts: 3480
    • StrumPract is the musicians best friend
Re: United OpenLib of Sound (U_OS)
« Reply #14 on: November 14, 2012, 12:37:50 am »
OOOps, help please  :-\

Have probems with Windows...

With Linux and OSX it works great but with Windows at iine 473 :

Code: [Select]
UOSSTREAM[x].Thread.Start;
Does not work with Windows, it only works with :

Code: [Select]
UOSSTREAM[x].Thread.Execute;

But then the streams do not play together.

Why Thread.Start does not work with Windows in the code ?


PS : For Windows 64 bits you have to use  longint and not cardinal then

Code: [Select]
{$IFDEF Windows}
    BufFrames         : cardinal;
    OutFrames         : cardinal;
     {$else}
    BufFrames       : Tsf_count_t;
    OutFrames       : Tsf_count_t;

     {$endif}     

became

Code: [Select]
{$IFDEF Win32}          //// Only Windows 32 bits
    BufFrames         : cardinal;
    OutFrames         : cardinal;
     {$else}
    BufFrames       : Tsf_count_t;
    OutFrames       : Tsf_count_t;

     {$endif}     

I have sent a new release.
« Last Edit: November 14, 2012, 12:41:19 am by Fred vS »
I use Lazarus 2.2.0 32/64 and FPC 3.2.2 32/64 on Debian 11 64 bit, Windows 10, Windows 7 32/64, Windows XP 32,  FreeBSD 64.
Widgetset: fpGUI, MSEgui, Win32, GTK2, Qt.

https://github.com/fredvs
https://gitlab.com/fredvs
https://codeberg.org/fredvs

 

TinyPortal © 2005-2018