src/engine/e_soundfile_gme.pas

   1 (* Copyright (C)  Doom 2D: Forever Developers
   2  *
   3  * This program is free software: you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation, version 3 of the License ONLY.
   6  *
   7  * This program is distributed in the hope that it will be useful,
   8  * but WITHOUT ANY WARRANTY; without even the implied warranty of
   9  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  10  * GNU General Public License for more details.
  11  *
  12  * You should have received a copy of the GNU General Public License
  13  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  14  *)
  15 {$INCLUDE ../shared/a_modes.inc}
  16 unit e_soundfile_gme;
  17
  18 interface
  19
  20 uses e_soundfile, GME;
  21
  22 type
  23   // a module loader that uses libgme (the version from gzdoom)
  24   // TODO: play all tracks in the song file and not just 0
  25
  26   TGMELoader = class (TSoundLoader)
  27   public
  28     function Load(Data: Pointer; Len: LongWord; Loop: Boolean): Boolean; override; overload;
  29     function Load(FName: string; Loop: Boolean): Boolean; override; overload;
  30     function Finished(): Boolean; override;
  31     function Restart(): Boolean; override;
  32     function FillBuffer(Buf: Pointer; Len: LongWord): LongWord; override;
  33     procedure Free(); override;
  34   private
  35     FEmu: pgme_music_emu;
  36     FLooping: Boolean;
  37     FTrack: LongInt;
  38     FInfo: pgme_info_t;
  39
  40     function StartTrack(Track: LongInt): Boolean;
  41     function CalcTrackLength(): LongInt;
  42   end;
  43
  44   TGMELoaderFactory = class (TSoundLoaderFactory)
  45   public
  46     function MatchHeader(Data: Pointer; Len: LongWord): Boolean; override;
  47     function MatchExtension(FName: string): Boolean; override;
  48     function GetLoader(): TSoundLoader; override;
  49   end;
  50
  51 implementation
  52
  53 uses sysutils, utils, math, e_sound, e_log, ctypes;
  54
  55 (* TGMELoaderFactory *)
  56
  57 function TGMELoaderFactory.MatchHeader(Data: Pointer; Len: LongWord): Boolean;
  58 begin
  59   if (Data = nil) or (Len < 4) then exit(False);
  60   Result := ((gme_identify_header(Data))^ <> #0);
  61 end;
  62
  63 function TGMELoaderFactory.MatchExtension(FName: string): Boolean;
  64 begin
  65   Result := gme_identify_extension(PChar(FName)) <> nil;
  66 end;
  67
  68 function TGMELoaderFactory.GetLoader(): TSoundLoader;
  69 begin
  70   Result := TGMELoader.Create();
  71 end;
  72
  73 (* TGMELoader *)
  74
  75 function TGMELoader.StartTrack(Track: LongInt): Boolean;
  76 var
  77   Ret: gme_err_t;
  78 begin
  79   Result := False;
  80
  81   Ret := gme_track_info(FEmu, @FInfo, Track);
  82   if Ret <> nil then
  83   begin
  84     e_LogWritefln('GME: Error getting info for track %d: %s', [Track, string(Ret)]);
  85     exit;
  86   end;
  87
  88   FTrack := Track;
  89
  90   if FLooping then
  91     gme_set_fade(FEmu, -1)
  92   else
  93     gme_set_fade(FEmu, CalcTrackLength());
  94
  95   gme_set_autoload_playback_limit(FEmu, 0);
  96
  97   Ret := gme_start_track(FEmu, Track);
  98   // apparently this can happen
  99   if Ret <> nil then
 100   begin
 101     e_LogWritefln('GME: Could not start track %d: %s', [Track, string(Ret)]);
 102     exit;
 103   end;
 104
 105   Result := True;
 106 end;
 107
 108 function TGMELoader.Load(Data: Pointer; Len: LongWord; Loop: Boolean): Boolean;
 109 var
 110   Ret: gme_err_t;
 111 begin
 112   Result := False;
 113
 114   Ret := gme_open_data(Data, clong(Len), @FEmu, 48000);
 115   if Ret <> nil then
 116   begin
 117     e_LogWritefln('GME: Error loading song from `%p`: %s', [Data, string(Ret)]);
 118     exit;
 119   end;
 120
 121   FFormat.SampleRate := 48000;
 122   FFormat.SampleBits := 16;
 123   FFormat.Channels := 2;
 124   FStreaming := True; // modules are always streaming
 125   FLooping := Loop;
 126
 127   Result := StartTrack(0);
 128   if not Result then Free();
 129 end;
 130
 131 function TGMELoader.Load(FName: string; Loop: Boolean): Boolean;
 132 var
 133   Ret: gme_err_t;
 134 begin
 135   Result := False;
 136
 137   Ret := gme_open_file(PChar(FName), @FEmu, 48000);
 138   if Ret <> nil then
 139   begin
 140     e_LogWritefln('GME: Error loading song from `%s`: %s', [FName, string(Ret)]);
 141     exit;
 142   end;
 143
 144   FFormat.SampleRate := 48000;
 145   FFormat.SampleBits := 16;
 146   FFormat.Channels := 2;
 147   FStreaming := True; // modules are always streaming
 148   FLooping := Loop;
 149
 150   Result := StartTrack(0);
 151   if not Result then Free();
 152 end;
 153
 154 function TGMELoader.CalcTrackLength(): LongInt;
 155 begin
 156   if FInfo = nil then
 157     Result := 150000
 158   else if FInfo.length > 0 then
 159     Result := FInfo.length
 160   else if FInfo.loop_length > 0 then
 161     Result := FInfo.intro_length + FInfo.loop_length * 2
 162   else
 163     Result := 150000;
 164 end;
 165
 166 function TGMELoader.Finished(): Boolean;
 167 begin
 168   if FEmu <> nil then
 169     Result := gme_track_ended(FEmu) <> 0
 170   else
 171     Result := False;
 172 end;
 173
 174 function TGMELoader.Restart(): Boolean;
 175 begin
 176   if FEmu = nil then
 177     Result := False
 178   else
 179     Result := StartTrack(FTrack);
 180 end;
 181
 182 function TGMELoader.FillBuffer(Buf: Pointer; Len: LongWord): LongWord;
 183 begin
 184   Result := 0;
 185
 186   if FEmu = nil then Exit;
 187
 188   if FLooping and (gme_track_ended(FEmu) <> 0) then
 189     StartTrack(FTrack);
 190
 191   if gme_play(FEmu, Len div 2, PWord(Buf)) = nil then
 192     Result := Len
 193   else
 194     Result := 0;
 195 end;
 196
 197 procedure TGMELoader.Free();
 198 begin
 199   if FInfo <> nil then gme_free_info(FInfo);
 200   if FEmu <> nil then gme_delete(FEmu);
 201   FInfo := nil;
 202   FEmu := nil;
 203 end;
 204
 205 initialization
 206   e_AddSoundLoader(TGMELoaderFactory.Create());
 207 end.