
{
Mplayer backend for Cactus Jukebox

written by Sebastian Kraft, <c> 2006-2008

Contact the author at: sebastian_kraft@gmx.de

This Software is published under the GPL






}

unit mplayer;

{$mode objfpc}{$H+}

interface

uses
  //{$ifdef Windows}
  //Windows,
  //{$endif}
  Classes, SysUtils, Forms, playerclass, process, debug, functions;

type

  { TMPlayerClass }

  TMPlayerClass = class(TPlayerClass)
   Private
     FMPlayerPath: string;
     MPlayerProcess: TProcess;
     FLastGet_Pos: integer;
     MPlayerFormatSettings: TFormatSettings;
     procedure SendCommand(cmd:string);
     function GetProcessOutput:string;
     function GetMPlayerPlaying: boolean;
   Public
     ExternalConfigFile: string;
     UseExternalConfig: boolean;

     constructor create; override;
     destructor destroy;
     function GetMPlayerPath: string;

     function play(index:integer):byte;override;
     function play(url: string):byte;override;
     procedure pause;override;
     procedure stop;override;
     function next_track:byte;override;
     function prev_track:byte;override;

     function Get_Stream_Status:TStreamStatus;override;

     function Get_TrackLength:longint;override;
     function Get_Time:longint;override;
     function Get_TimeStr:string;override;
     function Get_TimeRemainingStr: string; override;

     function Get_FilePosition:longint;override;
     function get_FileLength:longint;override;

     procedure Set_Time(ms: longint);override;
     procedure Set_FilePosition(fpos:longint);override;
     procedure Set_Volume(vol:byte);override;

     procedure Mute;override;
     function Muted:boolean;override;

     function setMplayerBinaryDir(dir: string):boolean;

     property MPlayerPath: string read FMPlayerPath;
     property playing: boolean read GetMPlayerPlaying;

  end;

//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

var mplayerobj: TMPlayerClass;

implementation

uses math; //used for logarithmic volume calculation

{$ifdef Unix}
const MPLAYER_BINARY='mplayer';
{$endif}
{$ifdef windows}
const MPLAYER_BINARY='mplayer.exe';
{$endif}

//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
{ TMPlayerClass }
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
procedure TMPlayerClass.SendCommand(cmd: string);
var
  res: DWORD;
begin
  DebugOutLn('[TMPlayerClass.sendcommand] START cmd=' + cmd, 9);
  cmd:=cmd+#10; //MPLayer always needs #10 as Lineending, no matter if win32 or linux
  try
    if GetMPlayerPlaying then
    begin
      MPlayerProcess.Input.write(cmd[1], length(cmd));

      // Equivalent using the Windows API, which freezes if the buffer is full (aka, not read by mplayer)
      //Windows.WriteFile(MPlayerProcess.Input.Handle,cmd[1],length(cmd), res, nil);
    end;
    DebugOutLn('[TMPlayerClass.sendcommand] END', 9);
  except
    DebugOutLn('EXCEPTION sending command to mplayer', 3);
  end;
end;
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
function TMPlayerClass.GetProcessOutput: string;
var
  AStringList: TStringList;
begin
  // writeln('getoutput');
  AStringList:=TStringList.Create;
  try
     if GetMPlayerPlaying then AStringList.LoadFromStream(MPlayerProcess.Output);
     if AStringList.Count>0 then
       Result:=AStringList.Text//Strings[0]
     else
       Result := '';
  //   writeln(Result);
  except
    DebugOutLn('EXCEPTION reading mplayer output', 0);
    result:='';
  end;
  //writeln('endget');
  AStringList.Free;
  DebugOutLn('[TMPlayerClass.GetProcessOutput] Result=' + Result, 9);
end;

//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

function TMPlayerClass.GetMPlayerPlaying: boolean;
begin
  if assigned(MPlayerProcess)=false or (MPlayerProcess.Running=false) then result:=false else result:=true;
end;

//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

constructor TMPlayerClass.create;
var
  tmps, tmppath: string;
  i: integer;
begin
  inherited;

  FMPlayerPath := GetMPlayerPath();
  MPlayerFormatSettings := SysUtils.DefaultFormatSettings;
  MPlayerFormatSettings.DecimalSeparator := '.';
end;
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
destructor TMPlayerClass.destroy;
begin

end;

// Find mplayer executable
function TMPlayerClass.GetMPlayerPath: string;
var tmps, tmppath: string; i: integer;
begin
  Result:='';
  {$ifdef Darwin}
  {$else}
  // Searches for MPlayer in the PATH
  tmps:=GetEnvironmentVariable('PATH');
  repeat
    begin
       i:=pos(':', tmps);
       if i=0 then i:=Length(tmps);
       tmppath:=IncludeTrailingPathDelimiter(copy(tmps,0,i-1))+MPLAYER_BINARY;
       if FileExists(tmppath) then Result:=tmppath
                 else Delete(tmps, 1, i);
    end;
  until (length(tmps)<=1) or (Result<>'');
  {$endif}
  if Result='' then
  begin
     DebugOutLn('FATAL: Mplayer executable not found. Make sure it is properly installed in binary path', 0);
  end
  else DebugOutLn('Mplayer executable found in '+Result, 2);
end;

//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
function TMPlayerClass.play(index: integer): byte;
var
  MPOptions: String;
  i: Integer;
begin
  DebugOutLn('[TMPlayerClass.play]', 5);
  if (index<Playlist.ItemCount) and (index>=0)  then
  begin
    if (FileExists(playlist.items[index].path)) then
    begin
      if FPlaying then stop;

      MPlayerProcess:=TProcess.Create(nil);

      if not UseExternalConfig then
      begin
        MPOptions:='-slave -quiet -softvol';
        if OutputMode=ALSAOUT then MPOptions:=MPOptions+' -ao alsa';
        if OutputMode=OSSOUT then MPOptions:=MPOptions+' -ao oss';
      end
      else
        MPOptions:='-include '+ExternalConfigFile;

      MPOptions:=' -af volume=' + IntToStr(IntTodB(FVolume, 100)) +' '+ MPOptions;// -volume xx only supported with patched mplayer;

      FPlaybackMode:=FILE_MODE;

      DebugOutLn('playing  -> '+playlist.items[index].path, 1);
      DebugOutLn(StringReplace(playlist.items[index].path, '''', '''''', [rfReplaceAll]), 1);

      MPlayerProcess.CommandLine:=FMplayerPath+' '+MPOptions+' "'+playlist.items[index].path+'"';

      DebugOutLn(MPlayerProcess.CommandLine, 5);
      FLastGet_Pos:=0;
      MPlayerProcess.Options:= MPlayerProcess.Options + [poUsePipes, poDefaultErrorMode, poNoConsole]; {, poStderrToOutPut <= This caused freezes in Windows}
      MPlayerProcess.Execute;

      if MPlayerProcess.Running then
      begin
        DebugOutLn('MPlayerProcess is Running', 9);
        FCurrentTrack:=index;
        FPlaying:=true;
        Playlist.Items[index].Played:=true;
        result:=0;
      end;
    end
    else
      result:=1;
  end
  else
    DebugOutLn('File not found ->'+playlist.items[index].path, 1);
end;
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
function TMPlayerClass.play(url: string): byte;
var MPOptions: String;
    Vol: real;
begin
  if FPlaying then stop;
  MPlayerProcess:=TProcess.Create(nil);
  if not UseExternalConfig then begin
           MPOptions:='-slave -quiet -softvol';
           if OutputMode=ALSAOUT then MPOptions:=MPOptions+' -ao alsa';
           if OutputMode=OSSOUT then MPOptions:=MPOptions+' -ao oss';
  end else MPOptions:='-include '+ExternalConfigFile;

  MPOptions:='-af volume=' + IntToStr(IntTodB(FVolume, 100)) +' '+ MPOptions;// -volume xx only supported with patched mplayer;

  FPlaybackMode:=STREAMING_MODE;
  DebugOutLn('playing  -> '+url, 1);
  MPlayerProcess.CommandLine:=FMplayerPath+' '+MPOptions+' "'+url+'"';

  DebugOutLn(MPlayerProcess.CommandLine,5);

  MPlayerProcess.Options:= MPlayerProcess.Options + [poUsePipes];
  MPlayerProcess.Execute;

  if MPlayerProcess.Running then begin
    FPlaying:=true;
    result:=0;
  end;
end;
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
procedure TMPlayerClass.pause;
begin
 if FPlaying and Assigned(MPlayerProcess) then begin
   SendCommand('pause');
   sleep(10);
   DebugOutLn('pauseee', 0);
   FPaused:=not FPaused;
 end;
end;
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
procedure TMPlayerClass.stop;
begin
 if FPlaying and Assigned(MPlayerProcess) then begin
   SendCommand('quit');
   sleep(15);
   if MPlayerProcess.Running then begin
      sleep(50);
      if MPlayerProcess.Running then
         if MPlayerProcess.Terminate(0) then DebugOutLn('Mplayer stopped', 5)
               else DebugOutLn('FATAL Mplayer process zombified',0);
      end;
   MPlayerProcess.Free;
 end;
 FCurrentTrack:=-1;
 FPlaying:=false;
end;
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
function TMPlayerClass.next_track: byte;
var r:byte;
begin
  r:=127;
  if fplaying then begin
    DebugOutLn('mnexttrack', 0);
    if FCurrentTrack<Playlist.ItemCount-1 then begin
       r:=play(FCurrentTrack+1);
     end;
   end;
  result:=r;
end;
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
function TMPlayerClass.prev_track: byte;
var r:byte;
begin
  r:=127;
  if fplaying then begin
    if (FCurrentTrack<Playlist.ItemCount) and (FCurrentTrack>0) then begin
       r:=play(FCurrentTrack-1);
     end else
         if (FCurrentTrack<Playlist.ItemCount) and (FCurrentTrack=0) then begin
             r:=play(FCurrentTrack);
           end;
   end;
  result:=r;
end;
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
function TMPlayerClass.Get_Stream_Status: TStreamStatus;
begin
  Result:=STREAM_READY;  //Impossible to get stream status from mplayer :(
end;

//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

function TMPlayerClass.Get_TrackLength:longint;
var tmps: string;
    i:integer;
    time: real;
begin
 if FPlaying and Assigned(MPlayerProcess) and MPlayerProcess.Running then begin
  repeat begin
    SendCommand('get_time_length');
    sleep(5);
    tmps:=GetProcessOutput;
   end;
   until pos('LENGTH', tmps)>0;
   i:=LastDelimiter('=', tmps);
   if i > 0 then begin
      time:= StrToFloat(Copy(tmps, i+1, Length(tmps)));
      time:=time*1000;
      result:=round(time);
   end;
 end;
end;

//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

function TMPlayerClass.Get_Time: longint;
var tmps: string;
    i:integer;
    time: real;
begin
 if GetMPlayerPlaying then begin
  i:=0;
  repeat begin
    SendCommand('get_property time_pos');
    sleep(8);
    tmps:=GetProcessOutput;
    inc(i);
   end;
   until (pos('time_pos', tmps)>0) or (i>=3);
   i:=LastDelimiter('=', tmps);
   if i > 0 then begin
        time:= StrToFloat(Copy(tmps, i+1, Length(tmps)), MPlayerFormatSettings);
        time:=time*1000;
        result:=round(time);
   end else result:=-1;
 end else result:=-1;
end;

//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

function TMPlayerClass.Get_TimeStr: string;
begin
  result:=MSecondsToFmtStr(Get_Time);
end;

//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

function TMPlayerClass.Get_TimeRemainingStr: string;
begin
  result:= '-' + MSecondsToFmtStr(Get_TrackLength - Get_Time);
end;

//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
function TMPlayerClass.Get_FilePosition: longint;
var
  tmps: string;
  i:integer;
begin
  DebugOutLn('[TMPlayerClass.Get_FilePosition] START', 9);
  if GetMPlayerPlaying then
  begin
    DebugOutLn('[TMPlayerClass.Get_FilePosition] A', 9);
    i:=0;
    repeat
      SendCommand('get_property percent_pos');
      sleep(8);
      tmps:=GetProcessOutput;
      inc(i);
      DebugOutLn('[TMPlayerClass.Get_FilePosition] GetProcessOutput=' + tmps, 9);
    until (pos('percent_pos', tmps)>0) or (i>=5);

    // writeln('getpos');
    i:=LastDelimiter('=', tmps);
    if i > 0 then
    begin
      FLastGet_Pos:=round(StrToFloat(Copy(tmps, i+1, Length(tmps)-i)));
      result:=FLastGet_Pos;
    end
    else
      result:=-1;
  end
  else
    result:=-1;

  if (result=-1) and (FLastGet_Pos>0) then Result:=100;
  DebugOutLn('[TMPlayerClass.Get_FilePosition] END', 9);
end;
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
function TMPlayerClass.get_FileLength: longint;
var tmps: string;
    i:integer;
begin
 if FPlaying and Assigned(MPlayerProcess) and MPlayerProcess.Running then begin
   SendCommand('get_property stream_length');
   sleep(10);
   tmps:=GetProcessOutput;
   i:=LastDelimiter('=', tmps);
   if i > 0 then begin
      result:= Trunc(StrToFloat(Copy(tmps, i+1, Length(tmps)-i)));
   end;
 end;
end;

//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

procedure TMPlayerClass.Set_Time(ms: longint);
begin

end;

//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
procedure TMPlayerClass.Set_FilePosition(fpos: longint);
begin
 if FPlaying and Assigned(MPlayerProcess) and MPlayerProcess.Running then begin
   SendCommand('set_property percent_pos '+IntToStr(fpos));
   sleep(20);
 end;
end;

//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

procedure TMPlayerClass.Set_Volume(vol: byte);
var commandstr: string;
begin
 FVolume:=vol;
 if FPlaying and Assigned(MPlayerProcess) and MPlayerProcess.Running then begin
   if vol<0 then vol:=0;
   if vol>100 then vol:=100;
   SendCommand('set_property volume '+IntToStr(vol)+'/1');
 end;
end;

//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

procedure TMPlayerClass.Mute;
var commandstr: string;
begin
 if FPlaying and Assigned(MPlayerProcess) and MPlayerProcess.Running then begin
   SendCommand('mute');
 end;
end;

//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

function TMPlayerClass.Muted: boolean;
var tmps, s: string;
    i:integer;
begin
 if FPlaying and Assigned(MPlayerProcess) and MPlayerProcess.Running then begin
  repeat begin
    SendCommand('get_property mute');
    sleep(5);
    tmps:=GetProcessOutput;
   end;
   until pos('mute', tmps)>0;
   i:=LastDelimiter('=', tmps);
   if i > 0 then begin
        s:=Copy(tmps, i+1, Length(tmps)-i);
        if s='yes' then Result:=true else Result:=false;
   end;
 end;
end;

//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

function TMPlayerClass.setMplayerBinaryDir(dir: string): boolean;
begin
  dir:=IncludeTrailingPathDelimiter(dir);
  if FileExists(dir+MPLAYER_BINARY) then begin
      result:=true;
      FMPlayerPath:=dir+MPLAYER_BINARY;
      DebugOutLn('Manually set MPlayer path to '+FMPlayerPath, 0);
     end else begin
      result:=false;
      FMPlayerPath:='';
   end;
end;

//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
end.

