Commit b51292a

Nick committed on
Fix bug in wave rendering, go back to stock fpwavewriter because they fixed the bug
commit b51292ac3150a3cfdb5afc8eb9ff8fa43e82517f parent ed717d1
7 changed files +72−234
ModifiedCpu/z80cpu.pas +1−1
@@ -2122,7 +2122,7 @@ end;
2122 2122
2123 function PFX_FD: byte; 2123 function PFX_FD: byte;
2124 begin 2124 begin
2125 if Assigned(@FDCallback) then FDCallback; 2125 if Assigned(FDCallback) then FDCallback;
2126 Result := 0; 2126 Result := 0;
2127 end; 2127 end;
2128 2128
ModifiedGBEmu.lpi +6−11
@@ -230,7 +230,7 @@
230 <PackageName Value="LCL"/> 230 <PackageName Value="LCL"/>
231 </Item5> 231 </Item5>
232 </RequiredPackages> 232 </RequiredPackages>
233 <Units Count="25"> 233 <Units Count="24">
234 <Unit0> 234 <Unit0>
235 <Filename Value="GBEmu.lpr"/> 235 <Filename Value="GBEmu.lpr"/>
236 <IsPartOfProject Value="True"/> 236 <IsPartOfProject Value="True"/>
@@ -343,25 +343,20 @@
343 <UnitName Value="RenderToWave"/> 343 <UnitName Value="RenderToWave"/>
344 </Unit20> 344 </Unit20>
345 <Unit21> 345 <Unit21>
346 <Filename Value="htwavewriter.pas"/>
347 <IsPartOfProject Value="True"/>
348 <UnitName Value="htWaveWriter"/>
349 </Unit21>
350 <Unit22>
351 <Filename Value="modimport.pas"/> 346 <Filename Value="modimport.pas"/>
352 <IsPartOfProject Value="True"/> 347 <IsPartOfProject Value="True"/>
353 <UnitName Value="MODImport"/> 348 <UnitName Value="MODImport"/>
354 </Unit22> 349 </Unit21>
355 <Unit23> 350 <Unit22>
356 <Filename Value="keymap.pas"/> 351 <Filename Value="keymap.pas"/>
357 <IsPartOfProject Value="True"/> 352 <IsPartOfProject Value="True"/>
358 <UnitName Value="Keymap"/> 353 <UnitName Value="Keymap"/>
359 </Unit23> 354 </Unit22>
360 <Unit24> 355 <Unit23>
361 <Filename Value="hugesettings.pas"/> 356 <Filename Value="hugesettings.pas"/>
362 <IsPartOfProject Value="True"/> 357 <IsPartOfProject Value="True"/>
363 <UnitName Value="hUGESettings"/> 358 <UnitName Value="hUGESettings"/>
364 </Unit24> 359 </Unit23>
365 </Units> 360 </Units>
366 </ProjectOptions> 361 </ProjectOptions>
367 <CompilerOptions> 362 <CompilerOptions>
ModifiedSound/sound.pas +1−1
@@ -178,7 +178,7 @@ var
178 178
179 implementation 179 implementation
180 180
181 uses mainloop, vars, htWaveWriter; 181 uses mainloop, vars, fpWavWriter;
182 182
183 const 183 const
184 SampleSize = SizeOf(Single)*2; 184 SampleSize = SizeOf(Single)*2;
Deletedhtwavewriter.pas +0−160
@@ -1,160 +0,0 @@
1 {*****************************************************************************}
2 {
3 This file is part of the Free Pascal's "Free Components Library".
4 Copyright (c) 2014 by Mazen NEIFER of the Free Pascal development team
5 and was adapted from wavopenal.pas copyright (c) 2010 Dmitry Boyarintsev.
6
7 RIFF/WAVE sound file writer implementation.
8
9 See the file COPYING.FPC, included in this distribution,
10 for details about the copyright.
11
12 This program is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
15 }
16
17 {
18 This is a vendored version of the FPC fpWavWriter unit, which removes an
19 accidental debugging leftover, and explicitly removes range checks on
20 a misbehaving function.
21 }
22
23 unit htWaveWriter;
24
25 {$mode objfpc}{$H+}
26
27 interface
28
29 uses
30 fpWavFormat,
31 Classes;
32
33 type
34 { TWaveReader }
35
36 { TWavWriter }
37
38 TWavWriter = class(TObject)
39 private
40 fStream: TStream;
41 FFreeStreamOnClose: Boolean;
42 public
43 fmt: TWaveFormat;
44 destructor Destroy; override;
45 function CloseAudioFile: Boolean;
46 function FlushHeader: Boolean;
47 function StoreToFile(const FileName: string): Boolean;
48 function StoreToStream(AStream: TStream): Boolean;
49 function WriteBuf(var Buffer; BufferSize: Integer): Integer;
50 end;
51
52 implementation
53
54 uses
55 SysUtils;
56
57 procedure NtoLE(var fmt: TWaveFormat); overload;
58 begin
59 with fmt, ChunkHeader do begin
60 Size := NtoLE(Size);
61 Format := NtoLE(Format);
62 Channels := NtoLE(Channels);
63 SampleRate := NtoLE(SampleRate);
64 ByteRate := NtoLE(ByteRate);
65 BlockAlign := NtoLE(BlockAlign);
66 BitsPerSample := NtoLE(BitsPerSample);
67 end;
68 end;
69
70 { TWaveWriter }
71
72 destructor TWavWriter.Destroy;
73 begin
74 CloseAudioFile;
75 inherited Destroy;
76 end;
77
78 function TWavWriter.CloseAudioFile: Boolean;
79 begin
80 Result := True;
81 if not Assigned(fStream) then begin
82 Exit(True);
83 end;
84 FlushHeader;
85 if FFreeStreamOnClose then begin
86 fStream.Free;
87 end;
88 end;
89
90 // This whole module should probably be rewritten (and contributed back to FPC)
91 // but for now, disable range checks in this routine
92 {$push}{$R-}
93 function TWavWriter.FlushHeader: Boolean;
94 var
95 riff: TRiffHeader;
96 fmtLE: TWaveFormat;
97 DataChunk: TChunkHeader;
98 Pos: Int64;
99 begin
100 Pos := fStream.Position;
101 with riff, ChunkHeader do begin
102 ID := AUDIO_CHUNK_ID_RIFF;
103 Size := NtoLE(Pos - SizeOf(ChunkHeader));
104 Format := AUDIO_CHUNK_ID_WAVE;
105 end;
106 fmtLE := fmt;
107 NtoLE(fmtLE);
108 with fStream do begin
109 Position := 0;
110 Result := Write(riff, SizeOf(riff)) = SizeOf(riff);
111 Result := Write(fmtLE, sizeof(fmtLE)) = SizeOf(fmtLE);
112 end;
113 with DataChunk do begin
114 Id := AUDIO_CHUNK_ID_data;
115 Size := Pos - SizeOf(DataChunk) - fStream.Position;
116 end;
117 with fStream do begin
118 Result := Write(DataChunk, SizeOf(DataChunk)) = SizeOf(DataChunk);
119 end;
120 end;
121 {$pop}
122
123 function TWavWriter.StoreToFile(const FileName: string):Boolean;
124 begin
125 CloseAudioFile;
126 fStream := TFileStream.Create(FileName, fmCreate + fmOpenWrite);
127 if Assigned(fStream) then begin
128 Result := StoreToStream(fStream);
129 FFreeStreamOnClose := True;
130 end else begin
131 Result := False;
132 end;
133 end;
134
135 function TWavWriter.StoreToStream(AStream:TStream):Boolean;
136 begin
137 fStream := AStream;
138 FFreeStreamOnClose := False;
139 with fmt, ChunkHeader do begin
140 ID := AUDIO_CHUNK_ID_fmt;
141 Size := SizeOf(fmt) - SizeOf(ChunkHeader);
142 Format := AUDIO_FORMAT_PCM;
143 end;
144 Result := FlushHeader;
145 end;
146
147 function TWavWriter.WriteBuf(var Buffer; BufferSize: Integer): Integer;
148 var
149 sz: Integer;
150 begin
151 Result := 0;
152 with fStream do begin
153 sz := Write(Buffer, BufferSize);
154 if sz < 0 then Exit;
155 Inc(Result, sz);
156 end;
157 end;
158
159 end.
160
Modifiedrendertowave.lfm +57−56
@@ -1,20 +1,21 @@
1 object frmRenderToWave: TfrmRenderToWave 1 object frmRenderToWave: TfrmRenderToWave
2 Left = 1086 2 Left = 1086
3 Height = 313 3 Height = 548
4 Top = 105 4 Top = 105
5 Width = 451 5 Width = 789
6 BorderStyle = bsSingle 6 BorderStyle = bsSingle
7 Caption = 'Render song' 7 Caption = 'Render song'
8 ClientHeight = 313 8 ClientHeight = 548
9 ClientWidth = 451 9 ClientWidth = 789
10 DesignTimePPI = 168
10 OnShow = FormShow 11 OnShow = FormShow
11 Position = poDefault 12 Position = poDefault
12 LCLVersion = '2.0.8.0' 13 LCLVersion = '2.0.9.0'
13 object RenderButton: TButton 14 object RenderButton: TButton
14 Left = 17 15 Left = 30
15 Height = 25 16 Height = 44
16 Top = 272 17 Top = 476
17 Width = 264 18 Width = 462
18 Caption = 'Render' 19 Caption = 'Render'
19 Enabled = False 20 Enabled = False
20 OnClick = RenderButtonClick 21 OnClick = RenderButtonClick
@@ -22,15 +23,15 @@ object frmRenderToWave: TfrmRenderToWave
22 TabOrder = 0 23 TabOrder = 0
23 end 24 end
24 object FileNameEdit1: TFileNameEdit 25 object FileNameEdit1: TFileNameEdit
25 Left = 72 26 Left = 126
26 Height = 23 27 Height = 38
27 Top = 8 28 Top = 14
28 Width = 362 29 Width = 634
29 OnAcceptFileName = FileNameEdit1AcceptFileName 30 OnAcceptFileName = FileNameEdit1AcceptFileName
30 Filter = 'Wave Files|*.wav|MP3 Files|*.mp3' 31 Filter = 'Wave Files|*.wav|MP3 Files|*.mp3'
31 FilterIndex = 0 32 FilterIndex = 0
32 HideDirectories = False 33 HideDirectories = False
33 ButtonWidth = 23 34 ButtonWidth = 40
34 NumGlyphs = 1 35 NumGlyphs = 1
35 MaxLength = 0 36 MaxLength = 0
36 ParentFont = False 37 ParentFont = False
@@ -38,19 +39,19 @@ object frmRenderToWave: TfrmRenderToWave
38 OnChange = FileNameEdit1Change 39 OnChange = FileNameEdit1Change
39 end 40 end
40 object Label1: TLabel 41 object Label1: TLabel
41 Left = 8 42 Left = 14
42 Height = 15 43 Height = 30
43 Top = 16 44 Top = 28
44 Width = 48 45 Width = 83
45 Caption = 'Filename' 46 Caption = 'Filename'
46 ParentColor = False 47 ParentColor = False
47 ParentFont = False 48 ParentFont = False
48 end 49 end
49 object RadioGroup1: TRadioGroup 50 object RadioGroup1: TRadioGroup
50 Left = 8 51 Left = 14
51 Height = 58 52 Height = 102
52 Top = 40 53 Top = 70
53 Width = 193 54 Width = 338
54 AutoFill = True 55 AutoFill = True
55 Caption = 'Duration' 56 Caption = 'Duration'
56 ChildSizing.LeftRightSpacing = 6 57 ChildSizing.LeftRightSpacing = 6
@@ -60,8 +61,8 @@ object frmRenderToWave: TfrmRenderToWave
60 ChildSizing.ShrinkVertical = crsScaleChilds 61 ChildSizing.ShrinkVertical = crsScaleChilds
61 ChildSizing.Layout = cclLeftToRightThenTopToBottom 62 ChildSizing.Layout = cclLeftToRightThenTopToBottom
62 ChildSizing.ControlsPerLine = 2 63 ChildSizing.ControlsPerLine = 2
63 ClientHeight = 38 64 ClientHeight = 67
64 ClientWidth = 189 65 ClientWidth = 334
65 Columns = 2 66 Columns = 2
66 ItemIndex = 0 67 ItemIndex = 0
67 Items.Strings = ( 68 Items.Strings = (
@@ -73,27 +74,27 @@ object frmRenderToWave: TfrmRenderToWave
73 TabOrder = 2 74 TabOrder = 2
74 end 75 end
75 object Notebook1: TNotebook 76 object Notebook1: TNotebook
76 Left = 8 77 Left = 14
77 Height = 112 78 Height = 196
78 Top = 104 79 Top = 182
79 Width = 425 80 Width = 744
80 PageIndex = 0 81 PageIndex = 0
81 TabOrder = 3 82 TabOrder = 3
82 object Page1: TPage 83 object Page1: TPage
83 object Label2: TLabel 84 object Label2: TLabel
84 Left = 16 85 Left = 28
85 Height = 15 86 Height = 30
86 Top = 24 87 Top = 42
87 Width = 44 88 Width = 77
88 Caption = 'Seconds' 89 Caption = 'Seconds'
89 ParentColor = False 90 ParentColor = False
90 ParentFont = False 91 ParentFont = False
91 end 92 end
92 object SecondsSpinEdit: TSpinEdit 93 object SecondsSpinEdit: TSpinEdit
93 Left = 72 94 Left = 126
94 Height = 23 95 Height = 38
95 Top = 16 96 Top = 28
96 Width = 344 97 Width = 602
97 MaxValue = 0 98 MaxValue = 0
98 ParentFont = False 99 ParentFont = False
99 TabOrder = 0 100 TabOrder = 0
@@ -101,45 +102,45 @@ object frmRenderToWave: TfrmRenderToWave
101 end 102 end
102 object Page2: TPage 103 object Page2: TPage
103 object Label3: TLabel 104 object Label3: TLabel
104 Left = 16 105 Left = 28
105 Height = 15 106 Height = 15
106 Top = 16 107 Top = 28
107 Width = 129 108 Width = 129
108 Caption = 'Stop playing when order' 109 Caption = 'Stop playing when order'
109 ParentColor = False 110 ParentColor = False
110 ParentFont = False 111 ParentFont = False
111 end 112 end
112 object OrderSpinEdit: TSpinEdit 113 object OrderSpinEdit: TSpinEdit
113 Left = 160 114 Left = 280
114 Height = 23 115 Height = 23
115 Top = 8 116 Top = 14
116 Width = 248 117 Width = 434
117 MaxValue = 0 118 MaxValue = 0
118 ParentFont = False 119 ParentFont = False
119 TabOrder = 0 120 TabOrder = 0
120 end 121 end
121 object Label4: TLabel 122 object Label4: TLabel
122 Left = 16 123 Left = 28
123 Height = 15 124 Height = 15
124 Top = 48 125 Top = 84
125 Width = 92 126 Width = 92
126 Caption = 'has been reached' 127 Caption = 'has been reached'
127 ParentColor = False 128 ParentColor = False
128 ParentFont = False 129 ParentFont = False
129 end 130 end
130 object LoopTimesSpinEdit: TSpinEdit 131 object LoopTimesSpinEdit: TSpinEdit
131 Left = 160 132 Left = 280
132 Height = 23 133 Height = 23
133 Top = 40 134 Top = 70
134 Width = 248 135 Width = 434
135 MaxValue = 0 136 MaxValue = 0
136 ParentFont = False 137 ParentFont = False
137 TabOrder = 1 138 TabOrder = 1
138 end 139 end
139 object Label5: TLabel 140 object Label5: TLabel
140 Left = 16 141 Left = 28
141 Height = 15 142 Height = 15
142 Top = 80 143 Top = 140
143 Width = 29 144 Width = 29
144 Caption = 'times' 145 Caption = 'times'
145 ParentColor = False 146 ParentColor = False
@@ -148,18 +149,18 @@ object frmRenderToWave: TfrmRenderToWave
148 end 149 end
149 end 150 end
150 object ProgressBar1: TProgressBar 151 object ProgressBar1: TProgressBar
151 Left = 17 152 Left = 30
152 Height = 28 153 Height = 49
153 Top = 232 154 Top = 406
154 Width = 417 155 Width = 730
155 ParentFont = False 156 ParentFont = False
156 TabOrder = 4 157 TabOrder = 4
157 end 158 end
158 object CancelButton: TButton 159 object CancelButton: TButton
159 Left = 288 160 Left = 504
160 Height = 25 161 Height = 44
161 Top = 272 162 Top = 476
162 Width = 146 163 Width = 256
163 Caption = 'Cancel' 164 Caption = 'Cancel'
164 Enabled = False 165 Enabled = False
165 OnClick = CancelButtonClick 166 OnClick = CancelButtonClick
Modifiedrendertowave.pas +4−4
@@ -6,7 +6,7 @@ interface
6 6
7 uses 7 uses
8 Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, EditBtn, 8 Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, EditBtn,
9 ExtCtrls, Spin, ComCtrls, constants, process; 9 ExtCtrls, Spin, ComCtrls, constants, process, bufstream;
10 10
11 type 11 type
12 TRenderFormat = (rfWave, rfMP3); 12 TRenderFormat = (rfWave, rfMP3);
@@ -159,7 +159,7 @@ begin
159 load('render/preview.gb'); 159 load('render/preview.gb');
160 160
161 if format = rfWave then begin 161 if format = rfWave then begin
162 OutStream := TFileStream.Create(Filename, fmCreate); 162 OutStream := TBufferedFileStream.Create(Filename, fmCreate);
163 end 163 end
164 else begin 164 else begin
165 Proc := TProcess.Create(nil); 165 Proc := TProcess.Create(nil);
@@ -236,8 +236,8 @@ begin
236 ProgressBar1.Position := Trunc((TimesSeenTargetPattern / TimesToSeePattern)*100); 236 ProgressBar1.Position := Trunc((TimesSeenTargetPattern / TimesToSeePattern)*100);
237 if Random(500) = 1 then Application.ProcessMessages; 237 if Random(500) = 1 then Application.ProcessMessages;
238 238
239 //if (PatternsSeen > OrderCount) and (TimesSeenTargetPattern <= 1) then 239 if (PatternsSeen > OrderCount) and (TimesSeenTargetPattern <= 1) then
240 //raise EHaltingProblem.Create('The specified loop point cannot be reached more than once!'); 240 raise EHaltingProblem.Create('The specified loop point cannot be reached more than once!');
241 end; 241 end;
242 242
243 FDCallback := OldFD; 243 FDCallback := OldFD;
Modifiedtracker.pas +3−1
@@ -945,13 +945,15 @@ end;
945 945
946 function TfrmTracker.RenderPreviewROM: Boolean; 946 function TfrmTracker.RenderPreviewROM: Boolean;
947 begin 947 begin
948 RenderSongToFile('preview.gb', emPreview); 948 Result := RenderSongToFile('preview.gb', emPreview);
949 end; 949 end;
950 950
951 function TfrmTracker.RenderSongToFile(Filename: String; Mode: TExportMode = emNormal): Boolean; 951 function TfrmTracker.RenderSongToFile(Filename: String; Mode: TExportMode = emNormal): Boolean;
952 begin 952 begin
953 Result := False;
953 try 954 try
954 AssembleSong(Song, Filename, Mode); 955 AssembleSong(Song, Filename, Mode);
956 Result := True;
955 except 957 except
956 on E: ECodegenRenameException do begin 958 on E: ECodegenRenameException do begin
957 MessageDlg('Error!', 959 MessageDlg('Error!',