DEADSOFTWARE

fix 16/32 bit and float wav formats for openal
[d2df-sdl.git] / src / engine / e_soundfile_modplug.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_modplug;
18 interface
20 uses e_soundfile, modplug;
22 type
23 // a module loader that uses libmodplug
25 TModPlugLoader = class (TSoundLoader)
26 public
27 function Load(Data: Pointer; Len: LongWord; SStreaming: Boolean): Boolean; override; overload;
28 function Load(FName: string; SStreaming: Boolean): Boolean; override; overload;
29 function SetPosition(Pos: LongWord): Boolean; override;
30 function FillBuffer(Buf: Pointer; Len: LongWord): LongWord; override;
31 function GetAll(var OutPtr: Pointer): LongWord; override;
32 procedure Free(); override;
33 private
34 FFile: PModPlugFile;
35 end;
37 TModPlugLoaderFactory = class (TSoundLoaderFactory)
38 public
39 function MatchHeader(Data: Pointer; Len: LongWord): Boolean; override;
40 function MatchExtension(FName: string): Boolean; override;
41 function GetLoader(): TSoundLoader; override;
42 end;
44 implementation
46 uses sysutils, utils, e_sound, e_log, classes;
48 var
49 Settings: ModPlug_Settings = (
50 mFlags : MODPLUG_ENABLE_OVERSAMPLING or MODPLUG_ENABLE_NOISE_REDUCTION;
51 mChannels : 2;
52 mBits : 16;
53 mFrequency : 44100;
54 mResamplingMode : MODPLUG_RESAMPLE_LINEAR;
55 mStereoSeparation : 128;
56 mMaxMixChannels : 32;
57 mReverbDepth : 0;
58 mReverbDelay : 0;
59 mBassAmount : 0;
60 mBassRange : 0;
61 mSurroundDepth : 0;
62 mSurroundDelay : 0;
63 mLoopCount : -1;
64 );
66 (* TModPlugLoaderFactory *)
68 function TModPlugLoaderFactory.MatchHeader(Data: Pointer; Len: LongWord): Boolean;
69 var
70 Mpf: PModPlugFile;
71 begin
72 // HACK: there's no "test" function in modplug, so just try to load that shit
73 Result := False;
75 Mpf := ModPlug_Load(Data, Len);
76 if Mpf = nil then Exit;
77 ModPlug_Unload(Mpf);
79 Result := True;
80 end;
82 function TModPlugLoaderFactory.MatchExtension(FName: string): Boolean;
83 var
84 Ext: string;
85 begin
86 Ext := GetFilenameExt(FName);
87 Result := (Ext = '.it') or (Ext = '.xm') or (Ext = '.mod') or (Ext = '.s3m');
88 end;
90 function TModPlugLoaderFactory.GetLoader(): TSoundLoader;
91 begin
92 // update interpolation setting
93 if e_MusicLerp then
94 Settings.mResamplingMode := MODPLUG_RESAMPLE_LINEAR
95 else
96 Settings.mResamplingMode := MODPLUG_RESAMPLE_NEAREST;
97 ModPlug_SetSettings(@Settings);
98 Result := TModPlugLoader.Create();
99 end;
101 (* TModPlugLoader *)
103 function TModPlugLoader.Load(Data: Pointer; Len: LongWord; SStreaming: Boolean): Boolean;
104 begin
105 Result := False;
107 FFile := ModPlug_Load(Data, Len);
108 if FFile = nil then
109 begin
110 e_LogWriteln('ModPlug: ERROR: ModPlug_Load failed');
111 Exit;
112 end;
114 FFormat.SampleRate := 44100;
115 FFormat.SampleBits := 16;
116 FFormat.Channels := 2;
117 FStreaming := True; // modules are always streaming
119 Result := True;
120 end;
122 function TModPlugLoader.Load(FName: string; SStreaming: Boolean): Boolean;
123 var
124 S: TStream = nil;
125 Data: Pointer;
126 Len: LongInt;
127 begin
128 Result := False;
130 try
131 S := openDiskFileRO(FName);
132 // ayy just read the entire file
133 Data := GetMem(S.Size);
134 if Data = nil then
135 raise Exception.Create('out of memory');
136 Len := S.Read(Data^, S.Size);
137 if Len < 0 then
138 raise Exception.Create('what the fuck');
139 Result := Load(Data, Len, SStreaming)
140 except
141 on E: Exception do
142 e_LogWritefln('ModPlug: ERROR: could not read file `%s`: %s', [FName, E.Message]);
143 end;
145 if Data <> nil then FreeMem(Data);
146 if S <> nil then S.Free();
147 end;
149 function TModPlugLoader.SetPosition(Pos: LongWord): Boolean;
150 begin
151 Result := False;
152 if FFile = nil then Exit;
153 ModPlug_Seek(FFile, Pos);
154 Result := True;
155 end;
157 function TModPlugLoader.FillBuffer(Buf: Pointer; Len: LongWord): LongWord;
158 var
159 Cnt: LongInt;
160 begin
161 Result := 0;
162 if FFile = nil then Exit;
164 Cnt := ModPlug_Read(FFile, Buf, Len);
165 if Cnt < 0 then Exit;
167 if FLooping and (Cnt < Len) then
168 begin
169 // assume it just ended and restart, because modplug only loops if the
170 // module tells it to
171 ModPlug_Seek(FFile, 0);
172 // this used to be Result := Cnt + Read(FFile, Buf + Cnt, Len - Cnt)
173 // but the difference appears to be negligible
174 Result := ModPlug_Read(FFile, Buf, Len);
175 end
176 else
177 Result := Len;
178 end;
180 function TModPlugLoader.GetAll(var OutPtr: Pointer): LongWord;
181 begin
182 Result := 0; // modules are always streaming, so this don't make sense
183 end;
185 procedure TModPlugLoader.Free();
186 begin
187 if FFile <> nil then
188 begin
189 ModPlug_Unload(FFile);
190 FFile := nil;
191 end;
192 end;
194 initialization
195 e_AddSoundLoader(TModPlugLoaderFactory.Create());
196 end.