DEADSOFTWARE

Game: Weapon autoswitch by travi$
[d2df-sdl.git] / 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;
18 interface
20 uses e_soundfile, GME;
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
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;
40 function StartTrack(Track: LongInt): Boolean;
41 function CalcTrackLength(): LongInt;
42 end;
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;
51 implementation
53 uses sysutils, utils, math, e_sound, e_log, ctypes;
55 (* TGMELoaderFactory *)
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;
63 function TGMELoaderFactory.MatchExtension(FName: string): Boolean;
64 begin
65 Result := gme_identify_extension(PChar(FName)) <> nil;
66 end;
68 function TGMELoaderFactory.GetLoader(): TSoundLoader;
69 begin
70 Result := TGMELoader.Create();
71 end;
73 (* TGMELoader *)
75 function TGMELoader.StartTrack(Track: LongInt): Boolean;
76 var
77 Ret: gme_err_t;
78 begin
79 Result := False;
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;
88 FTrack := Track;
90 if FLooping then
91 gme_set_fade(FEmu, -1)
92 else
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
99 if Ret <> nil then
100 begin
101 e_LogWritefln('GME: Could not start track %d: %s', [Track, string(Ret)]);
102 exit;
103 end;
105 Result := True;
106 end;
108 function TGMELoader.Load(Data: Pointer; Len: LongWord; Loop: Boolean): Boolean;
109 var
110 Ret: gme_err_t;
111 begin
112 Result := False;
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;
121 FFormat.SampleRate := 48000;
122 FFormat.SampleBits := 16;
123 FFormat.Channels := 2;
124 FStreaming := True; // modules are always streaming
125 FLooping := Loop;
127 Result := StartTrack(0);
128 if not Result then Free();
129 end;
131 function TGMELoader.Load(FName: string; Loop: Boolean): Boolean;
132 var
133 Ret: gme_err_t;
134 begin
135 Result := False;
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;
144 FFormat.SampleRate := 48000;
145 FFormat.SampleBits := 16;
146 FFormat.Channels := 2;
147 FStreaming := True; // modules are always streaming
148 FLooping := Loop;
150 Result := StartTrack(0);
151 if not Result then Free();
152 end;
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;
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;
174 function TGMELoader.Restart(): Boolean;
175 begin
176 if FEmu = nil then
177 Result := False
178 else
179 Result := StartTrack(FTrack);
180 end;
182 function TGMELoader.FillBuffer(Buf: Pointer; Len: LongWord): LongWord;
183 begin
184 Result := 0;
186 if FEmu = nil then Exit;
188 if FLooping and (gme_track_ended(FEmu) <> 0) then
189 StartTrack(FTrack);
191 if gme_play(FEmu, Len div 2, PWord(Buf)) = nil then
192 Result := Len
193 else
194 Result := 0;
195 end;
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;
205 initialization
206 e_AddSoundLoader(TGMELoaderFactory.Create());
207 end.