{Playlist process}
unit playlist;

interface

type
  tPlaylist = class
  private
    fShuffle  :boolean;
    plSize    :cardinal;  // playlist entries
    plCapacity:cardinal;
    base      :pWideChar;
    name      :pWideChar;
    descr     :pWideChar;
    plStrings :array of PWideChar;
    CurElement:cardinal;
    PlOrder   :array of cardinal;
    CurOrder  :cardinal;

    procedure SetShuffle(value:boolean);
    function  GetShuffle:boolean;
    procedure DoShuffle;

    function GetTrackNumber:integer;
    procedure SetTrackNumber(value:integer);

    procedure AddLine(name,descr:pWideChar;new:boolean=true);
    function ProcessElement(num:integer=-1):PWideChar; //virtual;

  public
    constructor Create(fname:pWideChar);
    destructor Free;

    procedure SetBasePath(path:pWideChar);

    function GetSong(number:integer=-1):pWideChar;
    function GetCount:integer;

    function Next    :pWideChar;
    function Previous:pWideChar;

    property Track  :integer read GetTrackNumber write SetTrackNumber;
    property Shuffle:boolean read GetShuffle     write SetShuffle;
  end;

function isPlaylist(fname:pWideChar):integer;
function CreatePlaylist(fname:pWideChar):tPlaylist;
function CreatePlaylistBuf(buf:pointer;format:integer):tPlaylist;

implementation

uses windows, common, io, memini;

const
  plSizeStart = 2048;
  plSizeStep  = 256;
const
  pltM3OLD   = $100;
  pltM3UTF   = $200;

type
  tM3UPlaylist = class(tPlaylist)
  private
  public
    constructor Create(fname:pWideChar);
    constructor CreateBuf(buf:pointer);
  end;

  tPLSPlaylist = class(tPlaylist)
  private
  public
    constructor Create(fname:pWideChar);
    constructor CreateBuf(buf:pointer);
  end;

function isPlaylist(fname:pWideChar):integer;
var
  ext:array [0..7] of WideChar;
begin
  GetExt(fname,ext,7);
  if      StrCmpW(ext,'M3U',3)=0 then result:=1
  else if StrCmpW(ext,'PLS'  )=0 then result:=2
  else result:=0;
end;

function CreatePlaylist(fname:pWideChar):tPlaylist;
begin
  case isPlaylist(fname) of
    1: result:=tM3UPlaylist.Create(fname);
    2: result:=tPLSPlaylist.Create(fname);
  else result:=nil;
  end;
end;

function CreatePlaylistBuf(buf:pointer;format:integer):tPlaylist;
begin
  case format of
    1: result:=tM3UPlaylist.CreateBuf(buf);
    2: result:=tPLSPlaylist.CreateBuf(buf);
  else result:=nil;
  end;
end;

//-----  -----

function SkipLine(var p:PWideChar):bool;
begin
  while p^>=' ' do inc(p);
  while p^<=' ' do // Skip spaces too
  begin
    if p^=#0 then
    begin
      result:=false;
      exit;
    end;
    p^:=#0;
    inc(p);
  end;
  result:=true;
end;

constructor tM3UPlaylist.CreateBuf(buf:pointer);
var
  p:PAnsiChar;
  pp,pd:pWideChar;
  plBufW:pWideChar;
  lname,ldescr:pWideChar;
  finish:boolean;
  pltNew:boolean;
begin
  inherited;

  p:=buf;
  if (pdword(p)^ and $00FFFFFF)=$00BFBBEF then
  begin
    inc(p,3);
    UTF8ToWide(p,plBufW)
  end
  else
    AnsiToWide(p,plBufW);

  pp:=plBufW;
  pltNew:=StrCmpW(pp,'#EXTM3U',7)=0;
  if pltNew then SkipLine(pp);

  ldescr:=nil;
  finish:=false;
  repeat
    if pltNew then
    begin
      pd:=StrScanW(pp,',');
      if pd<>nil then
      begin
        ldescr:=pd+1;
        if not SkipLine(pp) then break;
      end;
    end;
    lname:=pp;
    finish:=SkipLine(pp);
    AddLine(lname,ldescr);
  until not finish;

  mFreeMem(plBufW);
end;

constructor tM3UPlaylist.Create(fname:pWideChar);
var
  f:THANDLE;
  i:integer;
  plBuf:pAnsiChar;
begin
  inherited;

  f:=Reset(fname);

  if f<>THANDLE(INVALID_HANDLE_VALUE) then
  begin
    i:=integer(FileSize(f));
    if i=-1 then
      i:=integer(GetFSize(fname));
    if i<>-1 then
    begin
      mGetMem(plBuf,i+1);
      BlockRead(f,plBuf^,i);
      CloseHandle(f);
      plBuf[i]:=#0;
      CreateBuf(plBuf);
      mFreeMem(plBuf);
    end;
  end;

end;

//-----  -----

constructor tPLSPlaylist.CreateBuf(buf:pointer);
var
  lname,ldescr:pWideChar;
  section,storage,sectionlist:pointer;
  ffile,ftitle:array [0..31] of AnsiChar;
  f,t:pAnsiChar;
  i,size:integer;
begin
  inherited;

  storage:=OpenStorageBuf(buf);
  if storage=nil then
    exit;
  sectionlist:=GetSectionList(storage);
  section:=SearchSection(storage,sectionlist);
  FreeSectionList(sectionlist);

  size:=GetParamSectionInt(section,'NumberOfEntries');
  f:=StrCopyE(ffile ,'File');
  t:=StrCopyE(ftitle,'Title');
  for i:=1 to size do
  begin
    IntToStr(f,i);
    AnsiToWide(GetParamSectionStr(section,ffile),lname);

    IntToStr(t,i);
    AnsiToWide(GetParamSectionStr(section,ftitle),ldescr);

    AddLine(lname,ldescr,false);
  end;

  CloseStorage(storage);
end;

constructor tPLSPlaylist.Create(fname:pWideChar);
var
  buf:pAnsiChar;
  h:THANDLE;
  size:integer;
begin
  if FileExists(fname) then
  begin
    h:=Reset(fname);
    if h<>THANDLE(INVALID_HANDLE_VALUE) then
    begin
      size:=FileSize(h);
      if size>0 then
      begin
        GetMem(buf,size+1);
        BlockRead(h,buf^,size);
        buf[size]:=#0;
        CreateBuf(buf);
        FreeMem(buf);
      end;
      CloseHandle(h);
    end;
  end;
end;

//-----  -----

constructor tPlaylist.Create(fName:pWideChar);
begin
//  inherited;

  CurElement:=0;
  base:=nil;
  name:=nil;
  descr:=nil;
  Shuffle:=false;
  plSize:=0;

  SetBasePath(fname);
end;

destructor tPlaylist.Free;
var
  i:integer;
begin
  PlOrder:=nil;

  mFreeMem(base);
  mFreeMem(name);
  mFreeMem(descr);

  for i:=0 to plSize-1 do
  begin
    mFreeMem(plStrings[i*2]);
    mFreeMem(plStrings[i*2+1]);
  end;
  plStrings:=nil;

  inherited Free;
end;

procedure tPlaylist.AddLine(name,descr:pWideChar;new:boolean=true);
begin
  if plCapacity=0 then
  begin
    plCapacity:=plSizeStart;
    SetLength(plStrings,plSizeStart*2);
    fillChar(plStrings[0],plSizeStart*2*SizeOf(pWideChar),0);
  end
  else if plSize=plCapacity then
  begin
    inc(plCapacity,plSizeStep);
    SetLength(plStrings,plCapacity*2);
    fillChar(plStrings[plSize],plSizeStep*2*SizeOf(pWideChar),0);
  end;
  if new then
  begin
    StrDupW(plStrings[plSize*2  ],name);
    StrDupW(plStrings[plSize*2+1],descr);
  end
  else
  begin
    plStrings[plSize*2  ]:=name;
    plStrings[plSize*2+1]:=descr;
  end;
  inc(plSize);
end;

procedure tPlaylist.SetBasePath(path:pWideChar);
var
  buf:array [0..MAX_PATH-1] of WideChar;
  p,pp:pWideChar;
begin
  mFreeMem(base);

  pp:=ExtractW(path,false);
  p:=StrCopyEW(buf,pp);
  mFreeMem(pp);
  
  if ((p-1)^<>'\') and ((p-1)^<>'/') then
  begin
    if StrScanW(buf,'/')<>nil then
      p^:='/'
    else
      p^:='\';
    inc(p);
  end;
  p^:=#0;
  StrDupW(base,buf);
end;

function tPlaylist.GetCount:integer;
begin
  result:=plSize;
end;

function tPlaylist.GetTrackNumber:integer;
begin
  if fShuffle then
    result:=CurOrder
  else
    result:=CurElement;
end;

procedure tPlaylist.SetTrackNumber(value:integer);
begin
  if value<0 then
    value:=0
  else if value>=integer(plSize) then
    value:=plSize-1;

  if fShuffle then
    CurOrder:=value
  else
    CurElement:=value;
end;

function tPlaylist.ProcessElement(num:integer=-1):pWideChar;
begin
  if num<0 then
    num:=Track
  else if num>=integer(plSize) then
    num:=plSize-1;
  if fShuffle then
    num:=PlOrder[num];

  result:=plStrings[num*2];
end;

function tPlaylist.GetSong(number:integer=-1):PWideChar;
var
  buf:array [0..MAX_PATH-1] of WideChar;
begin
  result:=ProcessElement(number);

  if (result<>nil) and not isPathAbsolute(result) and (base<>nil) then
  begin
    StrCopyW(StrCopyEW(buf,base),result);
    StrDupW(result,buf);
  end
  else
    StrDupW(result,result);
end;

procedure tPlaylist.SetShuffle(value:boolean);
begin
  if value then
  begin
//    if not fShuffle then // need to set Shuffle
      DoShuffle;
  end;

  fShuffle:=value;
end;

function tPlaylist.GetShuffle:boolean;
begin
  result:=fShuffle;
end;

procedure tPlaylist.DoShuffle;
var
  i,RandInx: cardinal;
  SwapItem: cardinal;
begin
  SetLength(PlOrder,plSize);
  Randomize;
  for i:=0 to plSize-1 do
    PlOrder[i]:=i;
  if plSize>1 then
  begin
    for i:=0 to plSize-2 do
    begin
      RandInx:=cardinal(Random(plSize-i));
      SwapItem:=PlOrder[i];
      PlOrder[i      ]:=PlOrder[RandInx];
      PlOrder[RandInx]:=SwapItem;
    end;
  end;
  CurOrder:=0;
end;

function tPlaylist.Next:PWideChar;
begin
  if plSize<>0 then
  begin
    if not Shuffle then
    begin
      inc(CurElement);
      if CurElement=plSize then
        CurElement:=0;
    end
    else // if mode=plShuffle then
    begin
      inc(CurOrder);
      if CurOrder=plSize then
      begin
        DoShuffle;
        CurOrder:=0;
      end;
    end;
    result:=GetSong;
  end
  else
    result:=nil;
end;

function tPlaylist.Previous:PWideChar;
begin
  if plSize<>0 then
  begin
    if not Shuffle then
    begin
      if CurElement=0 then
        CurElement:=plSize;
      Dec(CurElement);
    end
    else // if mode=plShuffle then
    begin
      if CurOrder=0 then
      begin
        DoShuffle;
        CurOrder:=plSize;
      end;
      dec(CurOrder);
    end;
    result:=GetSong;
  end
  else
    result:=nil;
end;

end.