1 (* Copyright (C) Doom 2D: Forever Developers
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.
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.
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/>.
15 {$INCLUDE ../shared/a_modes.inc}
20 uses e_soundfile
, GME
;
23 // a module loader that uses libgme (the version from gzdoom)
24 // TODO: play all tracks in the song file and not just 0
26 TGMELoader
= class (TSoundLoader
)
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;
40 function StartTrack(Track
: LongInt): Boolean;
41 function CalcTrackLength(): LongInt;
44 TGMELoaderFactory
= class (TSoundLoaderFactory
)
46 function MatchHeader(Data
: Pointer; Len
: LongWord): Boolean; override;
47 function MatchExtension(FName
: string): Boolean; override;
48 function GetLoader(): TSoundLoader
; override;
53 uses sysutils
, utils
, math
, e_sound
, e_log
, ctypes
;
55 (* TGMELoaderFactory *)
57 function TGMELoaderFactory
.MatchHeader(Data
: Pointer; Len
: LongWord): Boolean;
59 if (Data
= nil) or (Len
< 4) then exit(False);
60 Result
:= ((gme_identify_header(Data
))^ <> #0);
63 function TGMELoaderFactory
.MatchExtension(FName
: string): Boolean;
65 Result
:= gme_identify_extension(PChar(FName
)) <> nil;
68 function TGMELoaderFactory
.GetLoader(): TSoundLoader
;
70 Result
:= TGMELoader
.Create();
75 function TGMELoader
.StartTrack(Track
: LongInt): Boolean;
81 Ret
:= gme_track_info(FEmu
, @FInfo
, Track
);
84 e_LogWritefln('GME: Error getting info for track %d: %s', [Track
, string(Ret
)]);
91 gme_set_fade(FEmu
, -1)
93 gme_set_fade(FEmu
, CalcTrackLength());
95 gme_set_autoload_playback_limit(FEmu
, 0);
97 Ret
:= gme_start_track(FEmu
, Track
);
98 // apparently this can happen
101 e_LogWritefln('GME: Could not start track %d: %s', [Track
, string(Ret
)]);
108 function TGMELoader
.Load(Data
: Pointer; Len
: LongWord; Loop
: Boolean): Boolean;
114 Ret
:= gme_open_data(Data
, clong(Len
), @FEmu
, 48000);
117 e_LogWritefln('GME: Error loading song from `%p`: %s', [Data
, string(Ret
)]);
121 FFormat
.SampleRate
:= 48000;
122 FFormat
.SampleBits
:= 16;
123 FFormat
.Channels
:= 2;
124 FStreaming
:= True; // modules are always streaming
127 Result
:= StartTrack(0);
128 if not Result
then Free();
131 function TGMELoader
.Load(FName
: string; Loop
: Boolean): Boolean;
137 Ret
:= gme_open_file(PChar(FName
), @FEmu
, 48000);
140 e_LogWritefln('GME: Error loading song from `%s`: %s', [FName
, string(Ret
)]);
144 FFormat
.SampleRate
:= 48000;
145 FFormat
.SampleBits
:= 16;
146 FFormat
.Channels
:= 2;
147 FStreaming
:= True; // modules are always streaming
150 Result
:= StartTrack(0);
151 if not Result
then Free();
154 function TGMELoader
.CalcTrackLength(): LongInt;
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
166 function TGMELoader
.Finished(): Boolean;
169 Result
:= gme_track_ended(FEmu
) <> 0
174 function TGMELoader
.Restart(): Boolean;
179 Result
:= StartTrack(FTrack
);
182 function TGMELoader
.FillBuffer(Buf
: Pointer; Len
: LongWord): LongWord;
186 if FEmu
= nil then Exit
;
188 if FLooping
and (gme_track_ended(FEmu
) <> 0) then
191 if gme_play(FEmu
, Len
div 2, PWord(Buf
)) = nil then
197 procedure TGMELoader
.Free();
199 if FInfo
<> nil then gme_free_info(FInfo
);
200 if FEmu
<> nil then gme_delete(FEmu
);
206 e_AddSoundLoader(TGMELoaderFactory
.Create());