DEADSOFTWARE

sdl1/2: fix invalid window title
[d2df-sdl.git] / src / engine / e_soundfile_xmp.pas
index aaf1df194d3b1904f25ff6993d6e5beab46d503f..3d2ef087b957a08a1fcd69e22c17ef48b5569ea3 100644 (file)
@@ -2,8 +2,7 @@
  *
  * This program is free software: you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
+ * the Free Software Foundation, version 3 of the License ONLY.
  *
  * This program is distributed in the hope that it will be useful,
  * but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -25,18 +24,21 @@ type
 
   TXMPLoader = class (TSoundLoader)
   public
-    function Load(Data: Pointer; Len: LongWord; SStreaming: Boolean): Boolean; override; overload;
-    function Load(FName: string; SStreaming: Boolean): Boolean; override; overload;
-    function SetPosition(Pos: LongWord): Boolean; override;
+    function Load(Data: Pointer; Len: LongWord; Loop: Boolean): Boolean; override; overload;
+    function Load(FName: string; Loop: Boolean): Boolean; override; overload;
+    function Finished(): Boolean; override;
+    function Restart(): Boolean; override;
     function FillBuffer(Buf: Pointer; Len: LongWord): LongWord; override;
-    function GetAll(var OutPtr: Pointer): LongWord; override;
     procedure Free(); override;
   private
     FXMP: xmp_context;
     FLoaded: Boolean;
+    FLooping: Boolean;
+    FFinished: Boolean;
   end;
 
   TXMPLoaderFactory = class (TSoundLoaderFactory)
+  public
     function MatchHeader(Data: Pointer; Len: LongWord): Boolean; override;
     function MatchExtension(FName: string): Boolean; override;
     function GetLoader(): TSoundLoader; override;
@@ -44,7 +46,7 @@ type
 
 implementation
 
-uses sysutils, utils, e_sound, e_log;
+uses sysutils, utils, math, e_sound, e_log;
 
 (* TXMPLoaderFactory *)
 
@@ -85,9 +87,10 @@ end;
 
 (* TXMPLoader *)
 
-function TXMPLoader.Load(Data: Pointer; Len: LongWord; SStreaming: Boolean): Boolean;
+function TXMPLoader.Load(Data: Pointer; Len: LongWord; Loop: Boolean): Boolean;
 var
   Err: LongInt;
+  Interp: LongInt;
 begin
   Result := False;
 
@@ -100,15 +103,21 @@ begin
     if Err <> 0 then
       raise Exception.Create('xmp_load_module_from_memory failed');
 
-    if xmp_start_player(FXMP, e_SoundFormat.SampleRate, 0) <> 0 then
+    if xmp_start_player(FXMP, 48000, 0) <> 0 then
       raise Exception.Create('xmp_start_player failed');
 
-    FFormat.SampleRate := e_SoundFormat.SampleRate;
+    if e_MusicLerp then Interp := XMP_INTERP_LINEAR
+    else Interp := XMP_INTERP_NEAREST;
+    xmp_set_player(FXMP, XMP_PLAYER_INTERP, Interp);
+
+    FFormat.SampleRate := 48000;
     FFormat.SampleBits := 16;
     FFormat.Channels := 2;
 
     FStreaming := True; // modules are always streaming
     FLoaded := True;
+    FLooping := Loop;
+    FFinished := False;
     Result := True;
   except
     on E: Exception do
@@ -121,9 +130,10 @@ begin
   end;
 end;
 
-function TXMPLoader.Load(FName: string; SStreaming: Boolean): Boolean;
+function TXMPLoader.Load(FName: string; Loop: Boolean): Boolean;
 var
   Err: LongInt;
+  Interp: LongInt;
 begin
   Result := False;
 
@@ -136,15 +146,21 @@ begin
     if Err <> 0 then
       raise Exception.Create('xmp_load_module failed');
 
-    if xmp_start_player(FXMP, e_SoundFormat.SampleRate, 0) <> 0 then
+    if xmp_start_player(FXMP, 48000, 0) <> 0 then
       raise Exception.Create('xmp_start_player failed');
 
-    FFormat.SampleRate := e_SoundFormat.SampleRate;
+    if e_MusicLerp then Interp := XMP_INTERP_LINEAR
+    else Interp := XMP_INTERP_NEAREST;
+    xmp_set_player(FXMP, XMP_PLAYER_INTERP, Interp);
+
+    FFormat.SampleRate := 48000;
     FFormat.SampleBits := 16;
     FFormat.Channels := 2;
 
     FStreaming := True; // modules are always streaming
+    FLooping := Loop;
     FLoaded := True;
+    FFinished := False;
     Result := True;
   except
     on E: Exception do
@@ -157,24 +173,33 @@ begin
   end;
 end;
 
-function TXMPLoader.SetPosition(Pos: LongWord): Boolean;
+function TXMPLoader.Finished(): Boolean;
+begin
+  Result := FFinished;
+end;
+
+function TXMPLoader.Restart(): Boolean;
 begin
   Result := False;
   if FXMP = nil then Exit;
-  Result := xmp_set_position(FXMP, Pos) = 0;
+  Result := True;
+  FFinished := False;
+  xmp_restart_module(FXMP);
 end;
 
 function TXMPLoader.FillBuffer(Buf: Pointer; Len: LongWord): LongWord;
+var
+  Ret: LongInt;
 begin
   Result := 0;
   if FXMP = nil then Exit;
-  if xmp_play_buffer(FXMP, Buf, Len, 0) = 0 then
-    Result := Len;
-end;
 
-function TXMPLoader.GetAll(var OutPtr: Pointer): LongWord;
-begin
-  Result := 0; // modules are always streaming, so this don't make sense
+  Ret := xmp_play_buffer(FXMP, Buf, Len, IfThen(FLooping, 0, 1));
+
+  if Ret = 0 then
+    Result := Len
+  else if (Ret = -XMP_END) and not FLooping then
+    FFinished := True;
 end;
 
 procedure TXMPLoader.Free();
@@ -190,6 +215,8 @@ begin
     FXMP := nil;
   end;
   FLoaded := False;
+  FLooping := False;
+  FFinished := False;
 end;
 
 initialization