Commit 45c0b51

Nick committed on
Redo wave rendering form/code
commit 45c0b51b0d6cc936ac206ee6d21ee87394b358ae parent 7ade34c
4 changed files +175−267
ModifiedSound/sound.pas +6−30
@@ -132,6 +132,7 @@ uses Classes, sysutils, sdl2;
132 132
133 const 133 const
134 SAMPLE_BUFFER_SIZE = 1024; 134 SAMPLE_BUFFER_SIZE = 1024;
135 PlaybackFrequency = 44100;
135 136
136 type 137 type
137 PSingle = ^Single; 138 PSingle = ^Single;
@@ -152,9 +153,6 @@ procedure DisableSound;
152 procedure ResetSound; 153 procedure ResetSound;
153 procedure SoundUpdate(cycles: integer); 154 procedure SoundUpdate(cycles: integer);
154 155
155 function SoundBufferTooFull: Boolean;
156 function SoundBufferSize: Integer;
157
158 procedure BeginWritingSoundToStream(Stream: TStream); 156 procedure BeginWritingSoundToStream(Stream: TStream);
159 procedure EndWritingSoundToStream; 157 procedure EndWritingSoundToStream;
160 158
@@ -178,13 +176,11 @@ var
178 176
179 implementation 177 implementation
180 178
181 uses mainloop, vars, fpWavWriter; 179 uses mainloop, vars;
182 180
183 const 181 const
184 SampleSize = SizeOf(Single)*2; 182 SampleSize = SizeOf(Single)*2;
185 playbackFrequency = 44100; 183 SampleCycles: LongInt = (8192 * 1024) div PlaybackFrequency;
186 sampleCycles: longint = (8192 * 1024) div playbackFrequency;
187 TooFullThreshold: Integer = (playbackFrequency div 10)*sizeof(single); //0.1s
188 184
189 var 185 var
190 PlayStream: TSDL_AudioDeviceID; 186 PlayStream: TSDL_AudioDeviceID;
@@ -196,7 +192,7 @@ var
196 lfsr: Cardinal = 0; 192 lfsr: Cardinal = 0;
197 193
198 WritingSoundToStream: Boolean; 194 WritingSoundToStream: Boolean;
199 WaveWriter: TWavWriter; 195 SoundStream: TStream;
200 196
201 procedure ResetSound; 197 procedure ResetSound;
202 var 198 var
@@ -217,33 +213,15 @@ begin
217 end; 213 end;
218 end; 214 end;
219 215
220 function SoundBufferTooFull: Boolean;
221 begin
222 Result := SoundBufferSize > TooFullThreshold
223 end;
224
225 function SoundBufferSize: Integer;
226 begin
227 Result := SDL_GetQueuedAudioSize(PlayStream)
228 end;
229
230 procedure BeginWritingSoundToStream(Stream: TStream); 216 procedure BeginWritingSoundToStream(Stream: TStream);
231 begin 217 begin
232 WritingSoundToStream := True; 218 WritingSoundToStream := True;
233 WaveWriter := TWavWriter.Create; 219 SoundStream := Stream;
234 {$push}{$R-}WaveWriter.StoreToStream(Stream);{$pop}
235 with WaveWriter.fmt do begin
236 SampleRate := playbackFrequency;
237 BitsPerSample := 16;
238 Channels := 2;
239 ByteRate := SampleRate * Channels * (BitsPerSample div 8);
240 end;
241 end; 220 end;
242 221
243 procedure EndWritingSoundToStream; 222 procedure EndWritingSoundToStream;
244 begin 223 begin
245 WritingSoundToStream := False; 224 WritingSoundToStream := False;
246 WaveWriter.Free;
247 end; 225 end;
248 226
249 procedure StartPlayback; 227 procedure StartPlayback;
@@ -332,9 +310,7 @@ begin
332 bufRVal := 0; 310 bufRVal := 0;
333 311
334 if WritingSoundToStream then begin 312 if WritingSoundToStream then begin
335 buf2[0] := Trunc(buf[0]*High(Smallint)); 313 SoundStream.Write(buf, SizeOf(Single)*2);
336 buf2[1] := Trunc(buf[1]*High(Smallint));
337 WaveWriter.WriteBuf(buf2, SizeOf(Smallint)*2);
338 end 314 end
339 else begin 315 else begin
340 sndBuffer^ := buf[0]; 316 sndBuffer^ := buf[0];
Modifiedrendertowave.lfm +74−112
@@ -1,19 +1,19 @@
1 object frmRenderToWave: TfrmRenderToWave 1 object frmRenderToWave: TfrmRenderToWave
2 Left = 1086 2 Left = 1800
3 Height = 313 3 Height = 219
4 Top = 105 4 Top = 231
5 Width = 451 5 Width = 451
6 BorderStyle = bsSingle 6 BorderStyle = bsSingle
7 Caption = 'Render song' 7 Caption = 'Render song'
8 ClientHeight = 313 8 ClientHeight = 219
9 ClientWidth = 451 9 ClientWidth = 451
10 OnShow = FormShow 10 OnShow = FormShow
11 Position = poDefault 11 Position = poDefault
12 LCLVersion = '2.0.11.0' 12 LCLVersion = '2.0.11.0'
13 object RenderButton: TButton 13 object RenderButton: TButton
14 Left = 17 14 Left = 16
15 Height = 25 15 Height = 25
16 Top = 272 16 Top = 176
17 Width = 264 17 Width = 264
18 Caption = 'Render' 18 Caption = 'Render'
19 Enabled = False 19 Enabled = False
@@ -22,10 +22,10 @@ object frmRenderToWave: TfrmRenderToWave
22 TabOrder = 0 22 TabOrder = 0
23 end 23 end
24 object FileNameEdit1: TFileNameEdit 24 object FileNameEdit1: TFileNameEdit
25 Left = 72 25 Left = 80
26 Height = 23 26 Height = 23
27 Top = 8 27 Top = 8
28 Width = 362 28 Width = 353
29 OnAcceptFileName = FileNameEdit1AcceptFileName 29 OnAcceptFileName = FileNameEdit1AcceptFileName
30 Filter = 'Wave Files|*.wav|MP3 Files|*.mp3' 30 Filter = 'Wave Files|*.wav|MP3 Files|*.mp3'
31 FilterIndex = 0 31 FilterIndex = 0
@@ -38,7 +38,7 @@ object frmRenderToWave: TfrmRenderToWave
38 OnChange = FileNameEdit1Change 38 OnChange = FileNameEdit1Change
39 end 39 end
40 object Label1: TLabel 40 object Label1: TLabel
41 Left = 8 41 Left = 16
42 Height = 15 42 Height = 15
43 Top = 16 43 Top = 16
44 Width = 48 44 Width = 48
@@ -46,121 +46,83 @@ object frmRenderToWave: TfrmRenderToWave
46 ParentColor = False 46 ParentColor = False
47 ParentFont = False 47 ParentFont = False
48 end 48 end
49 object RadioGroup1: TRadioGroup
50 Left = 8
51 Height = 58
52 Top = 40
53 Width = 193
54 AutoFill = True
55 Caption = 'Duration'
56 ChildSizing.LeftRightSpacing = 6
57 ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
58 ChildSizing.EnlargeVertical = crsHomogenousChildResize
59 ChildSizing.ShrinkHorizontal = crsScaleChilds
60 ChildSizing.ShrinkVertical = crsScaleChilds
61 ChildSizing.Layout = cclLeftToRightThenTopToBottom
62 ChildSizing.ControlsPerLine = 2
63 ClientHeight = 38
64 ClientWidth = 189
65 Columns = 2
66 ItemIndex = 0
67 Items.Strings = (
68 'Time in seconds'
69 'Loops'
70 )
71 OnClick = RadioGroup1Click
72 ParentFont = False
73 TabOrder = 2
74 end
75 object Notebook1: TNotebook
76 Left = 8
77 Height = 112
78 Top = 104
79 Width = 425
80 PageIndex = 1
81 TabOrder = 3
82 object Page1: TPage
83 object Label2: TLabel
84 Left = 16
85 Height = 15
86 Top = 24
87 Width = 44
88 Caption = 'Seconds'
89 ParentColor = False
90 ParentFont = False
91 end
92 object SecondsSpinEdit: TSpinEdit
93 Left = 72
94 Height = 23
95 Top = 16
96 Width = 344
97 ParentFont = False
98 TabOrder = 0
99 end
100 end
101 object Page2: TPage
102 object Label3: TLabel
103 Left = 16
104 Height = 15
105 Top = 16
106 Width = 129
107 Caption = 'Stop playing when order'
108 ParentColor = False
109 ParentFont = False
110 end
111 object OrderSpinEdit: TSpinEdit
112 Left = 160
113 Height = 23
114 Top = 8
115 Width = 248
116 ParentFont = False
117 TabOrder = 0
118 end
119 object Label4: TLabel
120 Left = 16
121 Height = 15
122 Top = 48
123 Width = 92
124 Caption = 'has been reached'
125 ParentColor = False
126 ParentFont = False
127 end
128 object LoopTimesSpinEdit: TSpinEdit
129 Left = 160
130 Height = 23
131 Top = 40
132 Width = 248
133 ParentFont = False
134 TabOrder = 1
135 end
136 object Label5: TLabel
137 Left = 16
138 Height = 15
139 Top = 80
140 Width = 29
141 Caption = 'times'
142 ParentColor = False
143 ParentFont = False
144 end
145 end
146 end
147 object ProgressBar1: TProgressBar 49 object ProgressBar1: TProgressBar
148 Left = 17 50 Left = 16
149 Height = 28 51 Height = 28
150 Top = 232 52 Top = 136
151 Width = 417 53 Width = 417
152 ParentFont = False 54 ParentFont = False
153 TabOrder = 4 55 Smooth = True
56 TabOrder = 2
154 end 57 end
155 object CancelButton: TButton 58 object CancelButton: TButton
156 Left = 288 59 Left = 287
157 Height = 25 60 Height = 25
158 Top = 272 61 Top = 176
159 Width = 146 62 Width = 146
160 Caption = 'Cancel' 63 Caption = 'Cancel'
161 Enabled = False 64 Enabled = False
162 OnClick = CancelButtonClick 65 OnClick = CancelButtonClick
163 ParentFont = False 66 ParentFont = False
67 TabOrder = 3
68 end
69 object PlayEntireSongRadioButton: TRadioButton
70 Left = 16
71 Height = 19
72 Top = 56
73 Width = 104
74 Caption = 'Play entire song'
75 Checked = True
76 TabOrder = 8
77 TabStop = True
78 end
79 object FromPositionRadioButton: TRadioButton
80 Left = 16
81 Height = 19
82 Top = 96
83 Width = 94
84 Caption = 'From position'
85 TabOrder = 7
86 end
87 object PlayEntireSongSpinEdit: TSpinEdit
88 Left = 136
89 Height = 23
90 Top = 52
91 Width = 98
92 MinValue = 1
93 TabOrder = 4
94 Value = 1
95 end
96 object Label2: TLabel
97 Left = 248
98 Height = 15
99 Top = 58
100 Width = 29
101 Caption = 'times'
102 ParentColor = False
103 end
104 object FromPositionLowerSpinEdit: TSpinEdit
105 Left = 136
106 Height = 23
107 Top = 92
108 Width = 72
109 MaxValue = 9999999
164 TabOrder = 5 110 TabOrder = 5
165 end 111 end
112 object FromPositionUpperSpinEdit: TSpinEdit
113 Left = 256
114 Height = 23
115 Top = 92
116 Width = 72
117 MaxValue = 99999999
118 TabOrder = 6
119 end
120 object Label3: TLabel
121 Left = 226
122 Height = 15
123 Top = 98
124 Width = 11
125 Caption = 'to'
126 ParentColor = False
127 end
166 end 128 end
Modifiedrendertowave.pas +95−110
@@ -6,53 +6,48 @@ 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, bufstream; 9 ExtCtrls, Spin, ComCtrls, Arrow, constants, process;
10 10
11 type 11 type
12 TRenderFormat = (rfWave, rfMP3); 12 { EInvalidOrder }
13 13
14 { EHaltingProblem } 14 EInvalidOrder = class(Exception);
15
16 EHaltingProblem = class(Exception);
17 15
18 { TfrmRenderToWave } 16 { TfrmRenderToWave }
19 17
20 TfrmRenderToWave = class(TForm) 18 TfrmRenderToWave = class(TForm)
19 Label2: TLabel;
20 Label3: TLabel;
21 PlayEntireSongRadioButton: TRadioButton;
22 FromPositionRadioButton: TRadioButton;
21 RenderButton: TButton; 23 RenderButton: TButton;
22 CancelButton: TButton; 24 CancelButton: TButton;
23 FileNameEdit1: TFileNameEdit; 25 FileNameEdit1: TFileNameEdit;
24 Label1: TLabel; 26 Label1: TLabel;
25 Label2: TLabel;
26 Label3: TLabel;
27 Label4: TLabel;
28 Label5: TLabel;
29 Notebook1: TNotebook;
30 Page1: TPage;
31 Page2: TPage;
32 ProgressBar1: TProgressBar; 27 ProgressBar1: TProgressBar;
33 RadioGroup1: TRadioGroup; 28 PlayEntireSongSpinEdit: TSpinEdit;
34 SecondsSpinEdit: TSpinEdit; 29 FromPositionLowerSpinEdit: TSpinEdit;
35 OrderSpinEdit: TSpinEdit; 30 FromPositionUpperSpinEdit: TSpinEdit;
36 LoopTimesSpinEdit: TSpinEdit;
37 procedure CancelButtonClick(Sender: TObject); 31 procedure CancelButtonClick(Sender: TObject);
38 procedure RenderButtonClick(Sender: TObject); 32 procedure RenderButtonClick(Sender: TObject);
39 procedure ComboBox1Change(Sender: TObject);
40 procedure FileNameEdit1AcceptFileName(Sender: TObject; var Value: String); 33 procedure FileNameEdit1AcceptFileName(Sender: TObject; var Value: String);
41 procedure FileNameEdit1Change(Sender: TObject); 34 procedure FileNameEdit1Change(Sender: TObject);
42 procedure FormShow(Sender: TObject); 35 procedure FormShow(Sender: TObject);
43 procedure RadioGroup1Click(Sender: TObject);
44 private 36 private
45 PatternsSeen, CurrentSeenPattern, TimesSeenTargetPattern: Integer; 37 SeenPatterns: array of Integer;
38 StartOfSong, CurrentPattern: Integer;
46 39
47 Rendering: Boolean; 40 Rendering: Boolean;
48 CancelRequested: Boolean; 41 CancelRequested: Boolean;
49 42
50 procedure UpdateButtonEnabledStates; 43 procedure UpdateButtonEnabledStates;
51 44
52 procedure ExportWaveToFile(Filename: String; Format: TRenderFormat); 45 procedure ExportWaveToFile(Filename: String);
53 46
54 procedure RenderSeconds(Seconds: Integer); 47 {procedure RenderSeconds(Seconds: Integer);
55 procedure RenderLoops(TargetOrder: Integer; Loops: Integer); 48 procedure RenderLoops(TargetOrder: Integer; Loops: Integer);}
49 procedure RenderEntireSong(Times: Integer);
50 procedure RenderFromPosition(FromPos, ToPos: Integer);
56 51
57 procedure OrderCheckFD; 52 procedure OrderCheckFD;
58 public 53 public
@@ -75,22 +70,14 @@ begin
75 end; 70 end;
76 71
77 procedure TfrmRenderToWave.RenderButtonClick(Sender: TObject); 72 procedure TfrmRenderToWave.RenderButtonClick(Sender: TObject);
78 var
79 RF: TRenderFormat;
80 begin 73 begin
81 ProgressBar1.Position := 0; 74 ProgressBar1.Position := 0;
82 Rendering := True; 75 Rendering := True;
83 CancelRequested := False; 76 CancelRequested := False;
84 UpdateButtonEnabledStates; 77 UpdateButtonEnabledStates;
85 78
86 case LowerCase(ExtractFileExt(FileNameEdit1.FileName)) of
87 '.wav': RF := rfWave;
88 '.mp3': RF := rfMP3;
89 else RF := rfWave;
90 end;
91
92 try 79 try
93 ExportWaveToFile(FileNameEdit1.FileName, RF); 80 ExportWaveToFile(FileNameEdit1.FileName);
94 except 81 except
95 on E: Exception do begin 82 on E: Exception do begin
96 MessageDlg('Error!', 'Couldn''t write ' + FileNameEdit1.FileName + '!' + LineEnding + 83 MessageDlg('Error!', 'Couldn''t write ' + FileNameEdit1.FileName + '!' + LineEnding +
@@ -110,14 +97,6 @@ begin
110 UpdateButtonEnabledStates; 97 UpdateButtonEnabledStates;
111 end; 98 end;
112 99
113 procedure TfrmRenderToWave.ComboBox1Change(Sender: TObject);
114 begin
115 {case ComboBox1.ItemIndex of
116 0: FileNameEdit1.Filter := 'Wave Files|*.wav';
117 1: FileNameEdit1.Filter := 'MP3 Files|*.mp3';
118 end;}
119 end;
120
121 procedure TfrmRenderToWave.FileNameEdit1Change(Sender: TObject); 100 procedure TfrmRenderToWave.FileNameEdit1Change(Sender: TObject);
122 begin 101 begin
123 UpdateButtonEnabledStates; 102 UpdateButtonEnabledStates;
@@ -127,15 +106,10 @@ procedure TfrmRenderToWave.FormShow(Sender: TObject);
127 begin 106 begin
128 ProgressBar1.Position:=0; 107 ProgressBar1.Position:=0;
129 FileNameEdit1.FileName:=''; 108 FileNameEdit1.FileName:='';
130 RadioGroup1.ItemIndex:=0; 109 PlayEntireSongRadioButton.Checked:=True;
131 SecondsSpinEdit.Value:=0; 110 PlayEntireSongSpinEdit.Value:=0;
132 OrderSpinEdit.Value:=0; 111 FromPositionLowerSpinEdit.Value:=0;
133 LoopTimesSpinEdit.Value:=0; 112 FromPositionUpperSpinEdit.Value:=0;
134 end;
135
136 procedure TfrmRenderToWave.RadioGroup1Click(Sender: TObject);
137 begin
138 Notebook1.PageIndex := RadioGroup1.ItemIndex;
139 end; 113 end;
140 114
141 procedure TfrmRenderToWave.UpdateButtonEnabledStates; 115 procedure TfrmRenderToWave.UpdateButtonEnabledStates;
@@ -144,9 +118,8 @@ begin
144 CancelButton.Enabled := Rendering and not CancelRequested; 118 CancelButton.Enabled := Rendering and not CancelRequested;
145 end; 119 end;
146 120
147 procedure TfrmRenderToWave.ExportWaveToFile(Filename: String; Format: TRenderFormat); 121 procedure TfrmRenderToWave.ExportWaveToFile(Filename: String);
148 var 122 var
149 OutStream: TStream;
150 Proc: TProcess; 123 Proc: TProcess;
151 begin 124 begin
152 ProgressBar1.Position := 0; 125 ProgressBar1.Position := 0;
@@ -158,88 +131,100 @@ begin
158 FDCallback := nil; 131 FDCallback := nil;
159 load('render/preview.gb'); 132 load('render/preview.gb');
160 133
161 if format = rfWave then begin 134 Proc := TProcess.Create(nil);
162 OutStream := TBufferedFileStream.Create(Filename, fmCreate); 135 Proc.Executable := 'ffmpeg';
163 end 136 with Proc.Parameters do begin
164 else begin 137 // HACK: to prevent ffmpeg from writing to stderr, we disable all output
165 Proc := TProcess.Create(nil); 138 // This is needed because ffmpeg blocks unless you read what it writes
166 Proc.Executable := 'lame'; 139 Add('-nostats');
167 with Proc.Parameters do begin 140 Add('-loglevel');
168 Add('-'); 141 Add('0');
169 Add(Filename); 142
170 end; 143 Add('-sample_rate');
171 Proc.Options := [poUsePipes]; 144 Add(IntToStr(PlaybackFrequency));
172 Proc.Execute; 145 Add('-f');
173 146 Add('f32le');
174 OutStream := TMemoryStream.Create; 147 Add('-channels');
148 Add('2');
149 Add('-i');
150 Add('-');
151 Add(Filename);
175 end; 152 end;
153 Proc.Options := [poUsePipes, poNoConsole];
154 Proc.Execute;
176 155
177 try 156 try
178 BeginWritingSoundToStream(OutStream); 157 BeginWritingSoundToStream(Proc.Input);
179 158
180 // Choose which rendering time strategy to use 159 if PlayEntireSongRadioButton.Checked then
181 case RadioGroup1.ItemIndex of 160 RenderEntireSong(PlayEntireSongSpinEdit.Value)
182 0: RenderSeconds(SecondsSpinEdit.Value); 161 else if FromPositionRadioButton.Checked then
183 1: RenderLoops(OrderSpinEdit.Value, LoopTimesSpinEdit.Value); 162 RenderFromPosition(FromPositionLowerSpinEdit.Value, FromPositionUpperSpinEdit.Value);
184 end;
185 163
186 if CancelRequested then Exit; 164 if CancelRequested then Exit;
187 165
188 finally 166 finally
189 EndWritingSoundToStream; 167 EndWritingSoundToStream;
190 168 Proc.CloseInput;
191 try 169 Proc.WaitOnExit;
192 if Format = rfMP3 then begin 170 Proc.Free;
193 OutStream.Seek(0, soFromBeginning);
194 Proc.Input.CopyFrom(OutStream, OutStream.Size);
195 Proc.CloseInput;
196 Proc.WaitOnExit;
197 end;
198 finally
199 if Format = rfMP3 then Proc.Free;
200 OutStream.Free
201 end;
202 end; 171 end;
203 end; 172 end;
204 173
205 procedure TfrmRenderToWave.RenderSeconds(Seconds: Integer); 174 procedure TfrmRenderToWave.RenderEntireSong(Times: Integer);
206 var 175 var
207 CompletedCycles: QWord = 0; 176 OldFD: TFDCallback;
208 CyclesToDo: QWord;
209 begin 177 begin
210 CyclesToDo := (70224*60)*Seconds; 178 OldFD := FDCallback;
211 while (CompletedCycles < CyclesToDo) and not CancelRequested do begin 179 FDCallback := @OrderCheckFD;
212 Inc(CompletedCycles, z80_decode); 180
213 ProgressBar1.Position := Trunc((CompletedCycles / CyclesToDo)*100); 181 SetLength(SeenPatterns, PeekSymbol(SYM_ORDER_COUNT) div 2);
182 StartOfSong := -1;
183 CurrentPattern := -1;
184
185 repeat
186 z80_decode;
214 if Random(500) = 1 then Application.ProcessMessages; 187 if Random(500) = 1 then Application.ProcessMessages;
215 end; 188 until ((StartOfSong <> -1) and (SeenPatterns[StartOfSong]-1 = PlayEntireSongSpinEdit.Value)) or CancelRequested;
189
190 SetLength(SeenPatterns, 0);
191 FDCallback := OldFD;
216 end; 192 end;
217 193
218 procedure TfrmRenderToWave.RenderLoops(TargetOrder: Integer; Loops: Integer); 194 procedure TfrmRenderToWave.RenderFromPosition(FromPos, ToPos: Integer);
219 var 195 var
220 TimesToSeePattern: Integer;
221 OldFD: TFDCallback; 196 OldFD: TFDCallback;
222 OrderCount: Integer; 197 StartPattern, TargetPattern: Integer;
198 SawTargetPattern: Boolean;
223 begin 199 begin
224 OldFD := FDCallback; 200 OldFD := FDCallback;
225 FDCallback := @OrderCheckFD; 201 FDCallback := @OrderCheckFD;
226 202
227 OrderCount := PeekSymbol(SYM_ORDER_COUNT) div 2; 203 SetLength(SeenPatterns, PeekSymbol(SYM_ORDER_COUNT) div 2);
204 StartOfSong := -1;
205 CurrentPattern := -1;
206 StartPattern := FromPositionLowerSpinEdit.Value;
207 TargetPattern := FromPositionUpperSpinEdit.Value;
208 SawTargetPattern := False;
209
210 if StartPattern > High(SeenPatterns) then
211 raise EInvalidOrder.Create('The specified order doesn''t exist!');
228 212
229 CurrentSeenPattern := -1; 213 PokeSymbol(SYM_CURRENT_ORDER, 2*StartPattern);
230 TimesSeenTargetPattern := 0; 214 PokeSymbol(SYM_ROW, 0);
231 PatternsSeen := 0;
232 TimesToSeePattern := (LoopTimesSpinEdit.Value+1);
233 215
234 while (TimesSeenTargetPattern < TimesToSeePattern) and not CancelRequested do begin 216 repeat
235 z80_decode; 217 z80_decode;
236 ProgressBar1.Position := Trunc((TimesSeenTargetPattern / TimesToSeePattern)*100);
237 if Random(500) = 1 then Application.ProcessMessages;
238 218
239 if (PatternsSeen > OrderCount) and (TimesSeenTargetPattern <= 1) then 219 if CurrentPattern = TargetPattern then
240 raise EHaltingProblem.Create('The specified loop point cannot be reached more than once!'); 220 SawTargetPattern := True;
241 end;
242 221
222 if Random(500) = 1 then Application.ProcessMessages;
223 until (StartOfSong <> -1) or
224 (SawTargetPattern and (CurrentPattern <> TargetPattern)) or
225 CancelRequested;
226
227 SetLength(SeenPatterns, 0);
243 FDCallback := OldFD; 228 FDCallback := OldFD;
244 end; 229 end;
245 230
@@ -248,13 +233,13 @@ var
248 Pat: Integer; 233 Pat: Integer;
249 begin 234 begin
250 Pat := (PeekSymbol(SYM_CURRENT_ORDER) div 2); 235 Pat := (PeekSymbol(SYM_CURRENT_ORDER) div 2);
251 if CurrentSeenPattern <> Pat then begin 236 if Pat = CurrentPattern then Exit;
252 Inc(PatternsSeen);
253 CurrentSeenPattern := Pat;
254 237
255 if Pat = OrderSpinEdit.Value then 238 if (SeenPatterns[Pat] <> 0) and (StartOfSong = -1) then
256 Inc(TimesSeenTargetPattern); 239 StartOfSong := Pat;
257 end; 240
241 Inc(SeenPatterns[Pat]);
242 CurrentPattern := Pat;
258 end; 243 end;
259 244
260 end. 245 end.
Modifiedutils.pas +0−15
@@ -7,14 +7,6 @@ interface
7 uses 7 uses
8 Classes, SysUtils, Song, Waves, HugeDatatypes, Constants, gHashSet, fgl, instruments; 8 Classes, SysUtils, Song, Waves, HugeDatatypes, Constants, gHashSet, fgl, instruments;
9 9
10 type
11
12 { TIntegerHash }
13
14 TIntegerHash = class
15 class function hash(I: Integer; N: Integer): Integer;
16 end;
17
18 function Lerp(v0, v1, t: Double): Double; 10 function Lerp(v0, v1, t: Double): Double;
19 function Snap(Value, Every: Integer): Integer; 11 function Snap(Value, Every: Integer): Integer;
20 function ReMap(Value, Istart, Istop, Ostart, Ostop: Double): Double; 12 function ReMap(Value, Istart, Istop, Ostart, Ostop: Double): Double;
@@ -31,13 +23,6 @@ function InstBankName(Bank: TInstrumentType): String;
31 23
32 implementation 24 implementation
33 25
34 { TIntegerHash }
35
36 class function TIntegerHash.hash(I: Integer; N: Integer): Integer;
37 begin
38 Result := I mod N;
39 end;
40
41 function Lerp(v0, v1, t: Double): Double; 26 function Lerp(v0, v1, t: Double): Double;
42 begin 27 begin
43 Result := ((1 - t) * v0) + (t * v1); 28 Result := ((1 - t) * v0) + (t * v1);