Commit 19aeca8

Nick committed on
WIP rendering songs to .wav
commit 19aeca8e3c8bcc6437c30f11e3e96f8baed7595c parent d6be23c
6 changed files +196−96
ModifiedGBEmu.lpi +6−1
@@ -168,7 +168,7 @@
168 <PackageName Value="LCL"/> 168 <PackageName Value="LCL"/>
169 </Item6> 169 </Item6>
170 </RequiredPackages> 170 </RequiredPackages>
171 <Units Count="22"> 171 <Units Count="23">
172 <Unit0> 172 <Unit0>
173 <Filename Value="GBEmu.lpr"/> 173 <Filename Value="GBEmu.lpr"/>
174 <IsPartOfProject Value="True"/> 174 <IsPartOfProject Value="True"/>
@@ -282,6 +282,11 @@
282 <HasResources Value="True"/> 282 <HasResources Value="True"/>
283 <ResourceBaseClass Value="Form"/> 283 <ResourceBaseClass Value="Form"/>
284 </Unit21> 284 </Unit21>
285 <Unit22>
286 <Filename Value="waveexport.pas"/>
287 <IsPartOfProject Value="True"/>
288 <UnitName Value="WaveExport"/>
289 </Unit22>
285 </Units> 290 </Units>
286 </ProjectOptions> 291 </ProjectOptions>
287 <CompilerOptions> 292 <CompilerOptions>
ModifiedSound/sound.pas +39−2
@@ -146,6 +146,9 @@ procedure SoundSetCycles(n: integer);
146 function SoundBufferTooFull: Boolean; 146 function SoundBufferTooFull: Boolean;
147 function SoundBufferSize: Integer; 147 function SoundBufferSize: Integer;
148 148
149 procedure BeginWritingSoundToFile(Filename: String);
150 procedure EndWritingSoundToFile;
151
149 var 152 var
150 soundEnable: boolean; 153 soundEnable: boolean;
151 sndRegChange: boolean; 154 sndRegChange: boolean;
@@ -166,7 +169,7 @@ var
166 169
167 implementation 170 implementation
168 171
169 uses vars, sdl2; 172 uses vars, sdl2, fpWavWriter;
170 173
171 const 174 const
172 SampleSize = SizeOf(Single)*2; 175 SampleSize = SizeOf(Single)*2;
@@ -179,6 +182,10 @@ var
179 bufCycles, bufLVal, bufRVal: integer; 182 bufCycles, bufLVal, bufRVal: integer;
180 lfsr: Cardinal = 0; 183 lfsr: Cardinal = 0;
181 184
185 WritingSoundToFile: Boolean;
186 SoundOutFile: String;
187 WaveWriter: TWavWriter;
188
182 procedure ResetSound; 189 procedure ResetSound;
183 var 190 var
184 i: Integer; 191 i: Integer;
@@ -208,6 +215,28 @@ begin
208 Result := SDL_GetQueuedAudioSize(playStream) 215 Result := SDL_GetQueuedAudioSize(playStream)
209 end; 216 end;
210 217
218 procedure BeginWritingSoundToFile(Filename: String);
219 begin
220 WritingSoundToFile := True;
221 SoundOutFile := Filename;
222 WaveWriter := TWavWriter.Create;
223 WaveWriter.StoreToFile(Filename);
224 with WaveWriter.fmt do begin
225 SampleRate := playbackFrequency;
226 BitsPerSample := 16;
227 Channels := 2;
228 ByteRate := SampleRate * Channels * (BitsPerSample div 8);
229 end;
230 end;
231
232 procedure EndWritingSoundToFile;
233 begin
234 WritingSoundToFile := False;
235
236 WaveWriter.FlushHeader;
237 WaveWriter.Free;
238 end;
239
211 procedure EnableSound; 240 procedure EnableSound;
212 var 241 var
213 Want, Have: TSDL_AudioSpec; 242 Want, Have: TSDL_AudioSpec;
@@ -249,6 +278,7 @@ end;
249 procedure SoundDoOut(l, r: Integer; cycles: integer); 278 procedure SoundDoOut(l, r: Integer; cycles: integer);
250 var 279 var
251 buf: array[0..1] of Single; 280 buf: array[0..1] of Single;
281 buf2: array[0..1] of Smallint;
252 begin 282 begin
253 Inc(bufLVal, l * cycles); 283 Inc(bufLVal, l * cycles);
254 Inc(bufRVal, r * cycles); 284 Inc(bufRVal, r * cycles);
@@ -260,7 +290,14 @@ begin
260 bufCycles := 0; 290 bufCycles := 0;
261 bufLVal := 0; 291 bufLVal := 0;
262 bufRVal := 0; 292 bufRVal := 0;
263 SDL_QueueAudio(playStream, @buf, SampleSize); 293
294 if WritingSoundToFile then begin
295 buf2[0] := Trunc(buf[0]*High(Smallint));
296 buf2[1] := Trunc(buf[1]*High(Smallint));
297 WaveWriter.WriteBuf(buf2, SizeOf(Smallint)*2);
298 end
299 else
300 SDL_QueueAudio(playStream, @buf, SampleSize);
264 end; 301 end;
265 end; 302 end;
266 303
Modifiedemulationthread.pas +1−5
@@ -57,11 +57,7 @@ begin
57 FrameEnd := GetCounter; 57 FrameEnd := GetCounter;
58 58
59 frameElapsedInSec := (frameEnd - frameStart) / tickFreq; 59 frameElapsedInSec := (frameEnd - frameStart) / tickFreq;
60 until ((frameElapsedInSec > TimePerFrame) and (not SoundBufferTooFull)) 60 until ((frameElapsedInSec > TimePerFrame) and (not SoundBufferTooFull));
61 or (frameElapsedInSec > 1); // HACK: Prevent lockups from happening.
62
63 // Find out why this (super rarely) locks up and never stops looping. I think
64 // it has to do something with the SoundBufferTooFull call, but I really don't know.
65 61
66 frameStart := frameEnd; 62 frameStart := frameEnd;
67 until Terminated; 63 until Terminated;
Modifiedtracker.lfm +100−87
@@ -1,7 +1,7 @@
1 object frmTracker: TfrmTracker 1 object frmTracker: TfrmTracker
2 Left = 763 2 Left = 1822
3 Height = 714 3 Height = 714
4 Top = 239 4 Top = 143
5 Width = 1181 5 Width = 1181
6 Caption = 'hUGETracker' 6 Caption = 'hUGETracker'
7 ClientHeight = 694 7 ClientHeight = 694
@@ -57,15 +57,15 @@ object frmTracker: TfrmTracker
57 Height = 463 57 Height = 463
58 Top = 0 58 Top = 0
59 Width = 983 59 Width = 983
60 ActivePage = PatternTabSheet 60 ActivePage = GeneralTabSheet
61 Align = alClient 61 Align = alClient
62 ParentFont = False 62 ParentFont = False
63 TabIndex = 1 63 TabIndex = 0
64 TabOrder = 0 64 TabOrder = 0
65 object GeneralTabSheet: TTabSheet 65 object GeneralTabSheet: TTabSheet
66 Caption = 'General' 66 Caption = 'General'
67 ClientHeight = 777 67 ClientHeight = 435
68 ClientWidth = 1712 68 ClientWidth = 975
69 ParentFont = False 69 ParentFont = False
70 object SongInformationGroupbox: TGroupBox 70 object SongInformationGroupbox: TGroupBox
71 Left = 8 71 Left = 8
@@ -79,25 +79,25 @@ object frmTracker: TfrmTracker
79 TabOrder = 0 79 TabOrder = 0
80 object Label15: TLabel 80 object Label15: TLabel
81 Left = 8 81 Left = 8
82 Height = 30 82 Height = 15
83 Top = 16 83 Top = 16
84 Width = 47 84 Width = 27
85 Caption = 'Song' 85 Caption = 'Song'
86 ParentColor = False 86 ParentColor = False
87 ParentFont = False 87 ParentFont = False
88 end 88 end
89 object Label16: TLabel 89 object Label16: TLabel
90 Left = 7 90 Left = 7
91 Height = 30 91 Height = 15
92 Top = 48 92 Top = 48
93 Width = 49 93 Width = 28
94 Caption = 'Artist' 94 Caption = 'Artist'
95 ParentColor = False 95 ParentColor = False
96 ParentFont = False 96 ParentFont = False
97 end 97 end
98 object SongEdit: TEdit 98 object SongEdit: TEdit
99 Left = 56 99 Left = 56
100 Height = 38 100 Height = 23
101 Hint = 'The name of your composition' 101 Hint = 'The name of your composition'
102 Top = 8 102 Top = 8
103 Width = 216 103 Width = 216
@@ -107,7 +107,7 @@ object frmTracker: TfrmTracker
107 end 107 end
108 object ArtistEdit: TEdit 108 object ArtistEdit: TEdit
109 Left = 56 109 Left = 56
110 Height = 38 110 Height = 23
111 Hint = 'Your name or handle' 111 Hint = 'Your name or handle'
112 Top = 40 112 Top = 40
113 Width = 216 113 Width = 216
@@ -117,16 +117,16 @@ object frmTracker: TfrmTracker
117 end 117 end
118 object Label21: TLabel 118 object Label21: TLabel
119 Left = 8 119 Left = 8
120 Height = 30 120 Height = 15
121 Top = 78 121 Top = 78
122 Width = 197 122 Width = 114
123 Caption = 'Tempo (ticks per row)' 123 Caption = 'Tempo (ticks per row)'
124 ParentColor = False 124 ParentColor = False
125 ParentFont = False 125 ParentFont = False
126 end 126 end
127 object TicksPerRowSpinEdit: TSpinEdit 127 object TicksPerRowSpinEdit: TSpinEdit
128 Left = 133 128 Left = 133
129 Height = 38 129 Height = 23
130 Hint = 'How many ticks should happen before the row changes. Higher means slower' 130 Hint = 'How many ticks should happen before the row changes. Higher means slower'
131 Top = 73 131 Top = 73
132 Width = 50 132 Width = 50
@@ -283,18 +283,18 @@ object frmTracker: TfrmTracker
283 end 283 end
284 object InstrumentTabSheet: TTabSheet 284 object InstrumentTabSheet: TTabSheet
285 Caption = 'Instruments' 285 Caption = 'Instruments'
286 ClientHeight = 777 286 ClientHeight = 435
287 ClientWidth = 1712 287 ClientWidth = 975
288 ParentFont = False 288 ParentFont = False
289 object PaintBox1: TPaintBox 289 object PaintBox1: TPaintBox
290 AnchorSideTop.Control = FlowPanel1 290 AnchorSideTop.Control = FlowPanel1
291 AnchorSideTop.Side = asrBottom 291 AnchorSideTop.Side = asrBottom
292 AnchorSideBottom.Side = asrBottom 292 AnchorSideBottom.Side = asrBottom
293 Left = 0 293 Left = 0
294 Height = 69 294 Height = 30
295 Hint = 'Preview of how the resulting waveform will look with envelope applied' 295 Hint = 'Preview of how the resulting waveform will look with envelope applied'
296 Top = 708 296 Top = 405
297 Width = 1712 297 Width = 975
298 Align = alClient 298 Align = alClient
299 Color = clBlack 299 Color = clBlack
300 ParentColor = False 300 ParentColor = False
@@ -304,9 +304,9 @@ object frmTracker: TfrmTracker
304 end 304 end
305 object FlowPanel1: TFlowPanel 305 object FlowPanel1: TFlowPanel
306 Left = 0 306 Left = 0
307 Height = 708 307 Height = 405
308 Top = 0 308 Top = 0
309 Width = 1712 309 Width = 975
310 Align = alTop 310 Align = alTop
311 AutoSize = True 311 AutoSize = True
312 BevelOuter = bvNone 312 BevelOuter = bvNone
@@ -341,9 +341,9 @@ object frmTracker: TfrmTracker
341 ParentFont = False 341 ParentFont = False
342 TabOrder = 0 342 TabOrder = 0
343 object InstrumentGroupBox: TGroupBox 343 object InstrumentGroupBox: TGroupBox
344 Left = 12 344 Left = 7
345 Height = 208 345 Height = 208
346 Top = 12 346 Top = 7
347 Width = 271 347 Width = 271
348 Anchors = [] 348 Anchors = []
349 BorderSpacing.Left = 7 349 BorderSpacing.Left = 7
@@ -357,7 +357,7 @@ object frmTracker: TfrmTracker
357 TabOrder = 0 357 TabOrder = 0
358 object InstrumentNumberSpinner: TSpinEdit 358 object InstrumentNumberSpinner: TSpinEdit
359 Left = 80 359 Left = 80
360 Height = 38 360 Height = 23
361 Hint = 'What instrument to edit' 361 Hint = 'What instrument to edit'
362 Top = 1 362 Top = 1
363 Width = 176 363 Width = 176
@@ -370,25 +370,25 @@ object frmTracker: TfrmTracker
370 end 370 end
371 object Label1: TLabel 371 object Label1: TLabel
372 Left = 8 372 Left = 8
373 Height = 30 373 Height = 15
374 Top = 8 374 Top = 8
375 Width = 101 375 Width = 58
376 Caption = 'Instrument' 376 Caption = 'Instrument'
377 ParentColor = False 377 ParentColor = False
378 ParentFont = False 378 ParentFont = False
379 end 379 end
380 object Label2: TLabel 380 object Label2: TLabel
381 Left = 8 381 Left = 8
382 Height = 30 382 Height = 15
383 Top = 34 383 Top = 34
384 Width = 56 384 Width = 32
385 Caption = 'Name' 385 Caption = 'Name'
386 ParentColor = False 386 ParentColor = False
387 ParentFont = False 387 ParentFont = False
388 end 388 end
389 object InstrumentNameEdit: TEdit 389 object InstrumentNameEdit: TEdit
390 Left = 80 390 Left = 80
391 Height = 38 391 Height = 23
392 Hint = 'The name of the instrument' 392 Hint = 'The name of the instrument'
393 Top = 26 393 Top = 26
394 Width = 176 394 Width = 176
@@ -398,9 +398,9 @@ object frmTracker: TfrmTracker
398 end 398 end
399 object Label3: TLabel 399 object Label3: TLabel
400 Left = 8 400 Left = 8
401 Height = 30 401 Height = 15
402 Top = 61 402 Top = 61
403 Width = 43 403 Width = 24
404 Caption = 'Type' 404 Caption = 'Type'
405 ParentColor = False 405 ParentColor = False
406 ParentFont = False 406 ParentFont = False
@@ -426,10 +426,10 @@ object frmTracker: TfrmTracker
426 end 426 end
427 object LengthEnabledCheckbox: TCheckBox 427 object LengthEnabledCheckbox: TCheckBox
428 Left = 8 428 Left = 8
429 Height = 34 429 Height = 19
430 Hint = 'Cut the sound after a certain length of time' 430 Hint = 'Cut the sound after a certain length of time'
431 Top = 84 431 Top = 84
432 Width = 98 432 Width = 57
433 Caption = 'Length' 433 Caption = 'Length'
434 OnChange = LengthEnabledCheckboxChange 434 OnChange = LengthEnabledCheckboxChange
435 ParentFont = False 435 ParentFont = False
@@ -478,9 +478,9 @@ object frmTracker: TfrmTracker
478 end 478 end
479 end 479 end
480 object EnvelopeGroupBox: TGroupBox 480 object EnvelopeGroupBox: TGroupBox
481 Left = 510 481 Left = 292
482 Height = 136 482 Height = 136
483 Top = 12 483 Top = 7
484 Width = 659 484 Width = 659
485 Anchors = [] 485 Anchors = []
486 BorderSpacing.Left = 7 486 BorderSpacing.Left = 7
@@ -494,18 +494,18 @@ object frmTracker: TfrmTracker
494 TabOrder = 1 494 TabOrder = 1
495 object Label4: TLabel 495 object Label4: TLabel
496 Left = 8 496 Left = 8
497 Height = 30 497 Height = 15
498 Top = 9 498 Top = 9
499 Width = 80 499 Width = 46
500 Caption = 'Start vol.' 500 Caption = 'Start vol.'
501 ParentColor = False 501 ParentColor = False
502 ParentFont = False 502 ParentFont = False
503 end 503 end
504 object Label5: TLabel 504 object Label5: TLabel
505 Left = 8 505 Left = 8
506 Height = 30 506 Height = 15
507 Top = 48 507 Top = 48
508 Width = 84 508 Width = 48
509 Caption = 'Direction' 509 Caption = 'Direction'
510 ParentColor = False 510 ParentColor = False
511 ParentFont = False 511 ParentFont = False
@@ -530,9 +530,9 @@ object frmTracker: TfrmTracker
530 end 530 end
531 object Label6: TLabel 531 object Label6: TLabel
532 Left = 8 532 Left = 8
533 Height = 30 533 Height = 15
534 Top = 86 534 Top = 86
535 Width = 71 535 Width = 41
536 Caption = 'Change' 536 Caption = 'Change'
537 ParentColor = False 537 ParentColor = False
538 ParentFont = False 538 ParentFont = False
@@ -549,10 +549,10 @@ object frmTracker: TfrmTracker
549 TabOrder = 1 549 TabOrder = 1
550 object EnvelopePaintbox: TPaintBox 550 object EnvelopePaintbox: TPaintBox
551 Left = 1 551 Left = 1
552 Height = 182 552 Height = 103
553 Hint = 'Preview of the volume envelope' 553 Hint = 'Preview of the volume envelope'
554 Top = 1 554 Top = 1
555 Width = 604 555 Width = 344
556 Align = alClient 556 Align = alClient
557 ParentFont = False 557 ParentFont = False
558 OnPaint = EnvelopePaintboxPaint 558 OnPaint = EnvelopePaintboxPaint
@@ -582,9 +582,9 @@ object frmTracker: TfrmTracker
582 end 582 end
583 end 583 end
584 object SquareGroupBox: TGroupBox 584 object SquareGroupBox: TGroupBox
585 Left = 12 585 Left = 7
586 Height = 169 586 Height = 169
587 Top = 400 587 Top = 229
588 Width = 319 588 Width = 319
589 Anchors = [] 589 Anchors = []
590 BorderSpacing.Left = 7 590 BorderSpacing.Left = 7
@@ -598,9 +598,9 @@ object frmTracker: TfrmTracker
598 TabOrder = 2 598 TabOrder = 2
599 object Label7: TLabel 599 object Label7: TLabel
600 Left = 8 600 Left = 8
601 Height = 30 601 Height = 15
602 Top = 16 602 Top = 16
603 Width = 107 603 Width = 61
604 Caption = 'Sweep time' 604 Caption = 'Sweep time'
605 ParentColor = False 605 ParentColor = False
606 ParentFont = False 606 ParentFont = False
@@ -653,27 +653,27 @@ object frmTracker: TfrmTracker
653 end 653 end
654 object Label8: TLabel 654 object Label8: TLabel
655 Left = 8 655 Left = 8
656 Height = 30 656 Height = 15
657 Top = 48 657 Top = 48
658 Width = 147 658 Width = 84
659 Caption = 'Sweep direction' 659 Caption = 'Sweep direction'
660 ParentColor = False 660 ParentColor = False
661 ParentFont = False 661 ParentFont = False
662 end 662 end
663 object Label9: TLabel 663 object Label9: TLabel
664 Left = 8 664 Left = 8
665 Height = 30 665 Height = 15
666 Top = 84 666 Top = 84
667 Width = 101 667 Width = 56
668 Caption = 'Sweep size' 668 Caption = 'Sweep size'
669 ParentColor = False 669 ParentColor = False
670 ParentFont = False 670 ParentFont = False
671 end 671 end
672 object Label10: TLabel 672 object Label10: TLabel
673 Left = 8 673 Left = 8
674 Height = 30 674 Height = 15
675 Top = 120 675 Top = 120
676 Width = 44 676 Width = 25
677 Caption = 'Duty' 677 Caption = 'Duty'
678 ParentColor = False 678 ParentColor = False
679 ParentFont = False 679 ParentFont = False
@@ -713,9 +713,9 @@ object frmTracker: TfrmTracker
713 end 713 end
714 end 714 end
715 object WaveGroupBox: TGroupBox 715 object WaveGroupBox: TGroupBox
716 Left = 594 716 Left = 340
717 Height = 169 717 Height = 169
718 Top = 400 718 Top = 229
719 Width = 297 719 Width = 297
720 Anchors = [] 720 Anchors = []
721 BorderSpacing.Left = 7 721 BorderSpacing.Left = 7
@@ -730,18 +730,18 @@ object frmTracker: TfrmTracker
730 TabOrder = 3 730 TabOrder = 3
731 object Label11: TLabel 731 object Label11: TLabel
732 Left = 8 732 Left = 8
733 Height = 30 733 Height = 15
734 Top = 16 734 Top = 16
735 Width = 70 735 Width = 40
736 Caption = 'Volume' 736 Caption = 'Volume'
737 ParentColor = False 737 ParentColor = False
738 ParentFont = False 738 ParentFont = False
739 end 739 end
740 object Label12: TLabel 740 object Label12: TLabel
741 Left = 8 741 Left = 8
742 Height = 30 742 Height = 15
743 Top = 48 743 Top = 48
744 Width = 95 744 Width = 55
745 Caption = 'Waveform' 745 Caption = 'Waveform'
746 ParentColor = False 746 ParentColor = False
747 ParentFont = False 747 ParentFont = False
@@ -790,10 +790,10 @@ object frmTracker: TfrmTracker
790 TabOrder = 1 790 TabOrder = 1
791 object WavePaintbox: TPaintBox 791 object WavePaintbox: TPaintBox
792 Left = 1 792 Left = 1
793 Height = 101 793 Height = 57
794 Hint = 'Preview of the waveform associated with this instrument' 794 Hint = 'Preview of the waveform associated with this instrument'
795 Top = 1 795 Top = 1
796 Width = 474 796 Width = 270
797 Align = alClient 797 Align = alClient
798 Color = clBlack 798 Color = clBlack
799 ParentColor = False 799 ParentColor = False
@@ -823,9 +823,9 @@ object frmTracker: TfrmTracker
823 end 823 end
824 end 824 end
825 object NoiseGroupBox: TGroupBox 825 object NoiseGroupBox: TGroupBox
826 Left = 1138 826 Left = 651
827 Height = 169 827 Height = 169
828 Top = 400 828 Top = 229
829 Width = 264 829 Width = 264
830 Anchors = [] 830 Anchors = []
831 BorderSpacing.Left = 7 831 BorderSpacing.Left = 7
@@ -840,10 +840,10 @@ object frmTracker: TfrmTracker
840 TabOrder = 4 840 TabOrder = 4
841 object SevenBitCounterCheckbox: TCheckBox 841 object SevenBitCounterCheckbox: TCheckBox
842 Left = 8 842 Left = 8
843 Height = 34 843 Height = 19
844 Hint = 'Select LFSR width. When checked, output will sound like a tone rather than noise' 844 Hint = 'Select LFSR width. When checked, output will sound like a tone rather than noise'
845 Top = 80 845 Top = 80
846 Width = 373 846 Width = 215
847 Alignment = taLeftJustify 847 Alignment = taLeftJustify
848 Caption = '7 bit counter (more tone-like output)' 848 Caption = '7 bit counter (more tone-like output)'
849 OnChange = SevenBitCounterCheckboxChange 849 OnChange = SevenBitCounterCheckboxChange
@@ -852,9 +852,9 @@ object frmTracker: TfrmTracker
852 end 852 end
853 object Label14: TLabel 853 object Label14: TLabel
854 Left = 9 854 Left = 9
855 Height = 30 855 Height = 15
856 Top = 51 856 Top = 51
857 Width = 124 857 Width = 71
858 Caption = 'Dividing ratio' 858 Caption = 'Dividing ratio'
859 ParentColor = False 859 ParentColor = False
860 ParentFont = False 860 ParentFont = False
@@ -872,9 +872,9 @@ object frmTracker: TfrmTracker
872 end 872 end
873 object Label25: TLabel 873 object Label25: TLabel
874 Left = 9 874 Left = 9
875 Height = 30 875 Height = 15
876 Top = 16 876 Top = 16
877 Width = 149 877 Width = 86
878 Caption = 'Shift clock mask' 878 Caption = 'Shift clock mask'
879 ParentColor = False 879 ParentColor = False
880 ParentFont = False 880 ParentFont = False
@@ -1702,7 +1702,7 @@ object frmTracker: TfrmTracker
1702 ParentShowHint = False 1702 ParentShowHint = False
1703 end 1703 end
1704 object PanicToolButton: TToolButton 1704 object PanicToolButton: TToolButton
1705 Left = 458 1705 Left = 556
1706 Hint = 'Stops all sound output' 1706 Hint = 'Stops all sound output'
1707 Top = 0 1707 Top = 0
1708 AutoSize = True 1708 AutoSize = True
@@ -1713,21 +1713,21 @@ object frmTracker: TfrmTracker
1713 ShowHint = True 1713 ShowHint = True
1714 end 1714 end
1715 object ToolButton2: TToolButton 1715 object ToolButton2: TToolButton
1716 Left = 145 1716 Left = 147
1717 Top = 0 1717 Top = 0
1718 Caption = '▶️ Cursor' 1718 Caption = '▶️ Cursor'
1719 ImageIndex = 75 1719 ImageIndex = 75
1720 OnClick = ToolButton2Click 1720 OnClick = ToolButton2Click
1721 end 1721 end
1722 object ToolButton4: TToolButton 1722 object ToolButton4: TToolButton
1723 Left = 219 1723 Left = 221
1724 Top = 0 1724 Top = 0
1725 Caption = '⏹ Stop' 1725 Caption = '⏹ Stop'
1726 ImageIndex = 73 1726 ImageIndex = 73
1727 OnClick = ToolButton4Click 1727 OnClick = ToolButton4Click
1728 end 1728 end
1729 object ExportGBButton: TToolButton 1729 object ExportGBButton: TToolButton
1730 Left = 287 1730 Left = 291
1731 Top = 0 1731 Top = 0
1732 AutoSize = True 1732 AutoSize = True
1733 Caption = 'Export .GB' 1733 Caption = 'Export .GB'
@@ -1742,21 +1742,21 @@ object frmTracker: TfrmTracker
1742 Style = tbsDivider 1742 Style = tbsDivider
1743 end 1743 end
1744 object ToolButton6: TToolButton 1744 object ToolButton6: TToolButton
1745 Left = 284 1745 Left = 286
1746 Height = 22 1746 Height = 22
1747 Top = 0 1747 Top = 0
1748 Caption = 'ToolButton6' 1748 Caption = 'ToolButton6'
1749 Style = tbsDivider 1749 Style = tbsDivider
1750 end 1750 end
1751 object ToolButton7: TToolButton 1751 object ToolButton7: TToolButton
1752 Left = 1020 1752 Left = 1121
1753 Height = 22 1753 Height = 22
1754 Top = 0 1754 Top = 0
1755 Caption = 'ToolButton7' 1755 Caption = 'ToolButton7'
1756 Style = tbsSeparator 1756 Style = tbsSeparator
1757 end 1757 end
1758 object OctaveSpinEdit: TSpinEdit 1758 object OctaveSpinEdit: TSpinEdit
1759 Left = 561 1759 Left = 662
1760 Height = 23 1760 Height = 23
1761 Top = 0 1761 Top = 0
1762 Width = 90 1762 Width = 90
@@ -1766,14 +1766,14 @@ object frmTracker: TfrmTracker
1766 TabOrder = 0 1766 TabOrder = 0
1767 end 1767 end
1768 object ToolButton9: TToolButton 1768 object ToolButton9: TToolButton
1769 Left = 513 1769 Left = 611
1770 Height = 22 1770 Height = 22
1771 Top = 0 1771 Top = 0
1772 Caption = 'ToolButton9' 1772 Caption = 'ToolButton9'
1773 Style = tbsSeparator 1773 Style = tbsSeparator
1774 end 1774 end
1775 object Label22: TLabel 1775 object Label22: TLabel
1776 Left = 518 1776 Left = 619
1777 Height = 15 1777 Height = 15
1778 Top = 0 1778 Top = 0
1779 Width = 43 1779 Width = 43
@@ -1782,7 +1782,7 @@ object frmTracker: TfrmTracker
1782 ParentFont = False 1782 ParentFont = False
1783 end 1783 end
1784 object Label23: TLabel 1784 object Label23: TLabel
1785 Left = 651 1785 Left = 752
1786 Height = 15 1786 Height = 15
1787 Top = 0 1787 Top = 0
1788 Width = 70 1788 Width = 70
@@ -1791,7 +1791,7 @@ object frmTracker: TfrmTracker
1791 ParentFont = False 1791 ParentFont = False
1792 end 1792 end
1793 object InstrumentComboBox: TComboBox 1793 object InstrumentComboBox: TComboBox
1794 Left = 721 1794 Left = 822
1795 Height = 23 1795 Height = 23
1796 Top = 0 1796 Top = 0
1797 Width = 214 1797 Width = 214
@@ -1822,7 +1822,7 @@ object frmTracker: TfrmTracker
1822 Text = '(no instrument)' 1822 Text = '(no instrument)'
1823 end 1823 end
1824 object Label24: TLabel 1824 object Label24: TLabel
1825 Left = 935 1825 Left = 1036
1826 Height = 15 1826 Height = 15
1827 Top = 0 1827 Top = 0
1828 Width = 35 1828 Width = 35
@@ -1831,7 +1831,7 @@ object frmTracker: TfrmTracker
1831 ParentFont = False 1831 ParentFont = False
1832 end 1832 end
1833 object StepSpinEdit: TSpinEdit 1833 object StepSpinEdit: TSpinEdit
1834 Left = 970 1834 Left = 1071
1835 Height = 23 1835 Height = 23
1836 Top = 0 1836 Top = 0
1837 Width = 50 1837 Width = 50
@@ -1841,26 +1841,33 @@ object frmTracker: TfrmTracker
1841 TabOrder = 2 1841 TabOrder = 2
1842 end 1842 end
1843 object ToolButton3: TToolButton 1843 object ToolButton3: TToolButton
1844 Left = 82 1844 Left = 84
1845 Top = 0 1845 Top = 0
1846 Caption = '▶️ Start' 1846 Caption = '▶️ Start'
1847 ImageIndex = 74 1847 ImageIndex = 74
1848 OnClick = ToolButton3Click 1848 OnClick = ToolButton3Click
1849 end 1849 end
1850 object ExportGBSButton: TToolButton 1850 object ExportGBSButton: TToolButton
1851 Left = 368 1851 Left = 372
1852 Top = 0 1852 Top = 0
1853 Caption = 'Export .GBS' 1853 Caption = 'Export .GBS'
1854 ImageIndex = 77 1854 ImageIndex = 76
1855 OnClick = ExportGBSButtonClick 1855 OnClick = ExportGBSButtonClick
1856 end 1856 end
1857 object ToolButton5: TToolButton 1857 object ToolButton5: TToolButton
1858 Left = 455 1858 Left = 551
1859 Height = 22 1859 Height = 22
1860 Top = 0 1860 Top = 0
1861 Caption = 'ToolButton5' 1861 Caption = 'ToolButton5'
1862 Style = tbsDivider 1862 Style = tbsDivider
1863 end 1863 end
1864 object ToolButton10: TToolButton
1865 Left = 459
1866 Top = 0
1867 Caption = 'Export .WAV'
1868 ImageIndex = 77
1869 OnClick = ToolButton10Click
1870 end
1864 end 1871 end
1865 object MainMenu1: TMainMenu 1872 object MainMenu1: TMainMenu
1866 Images = ImageList1 1873 Images = ImageList1
@@ -4991,4 +4998,10 @@ object frmTracker: TfrmTracker
4991 OnClick = TrackerPopupRedoClick 4998 OnClick = TrackerPopupRedoClick
4992 end 4999 end
4993 end 5000 end
5001 object WavSaveDialog: TSaveDialog
5002 DefaultExt = '.wav'
5003 Filter = 'Wave files|*.wav'
5004 left = 232
5005 top = 46
5006 end
4994 end 5007 end
Modifiedtracker.pas +13−1
@@ -10,7 +10,7 @@ uses
10 Song, EmulationThread, Utils, Constants, sound, vars, machine, 10 Song, EmulationThread, Utils, Constants, sound, vars, machine,
11 about_hugetracker, TrackerGrid, lclintf, lmessages, Buttons, Grids, DBCtrls, 11 about_hugetracker, TrackerGrid, lclintf, lmessages, Buttons, Grids, DBCtrls,
12 HugeDatatypes, LCLType, RackCtls, Codegen, SymParser, options, IniFiles, 12 HugeDatatypes, LCLType, RackCtls, Codegen, SymParser, options, IniFiles,
13 bgrabitmap, effecteditor; 13 bgrabitmap, effecteditor, WaveExport;
14 14
15 type 15 type
16 { TfrmTracker } 16 { TfrmTracker }
@@ -37,6 +37,8 @@ type
37 MenuItem28: TMenuItem; 37 MenuItem28: TMenuItem;
38 NoiseVisualizer: TPaintBox; 38 NoiseVisualizer: TPaintBox;
39 Panel6: TPanel; 39 Panel6: TPanel;
40 WavSaveDialog: TSaveDialog;
41 ToolButton10: TToolButton;
40 TrackerPopupEditEffect: TMenuItem; 42 TrackerPopupEditEffect: TMenuItem;
41 TrackerPopupTransposeOctaveUp: TMenuItem; 43 TrackerPopupTransposeOctaveUp: TMenuItem;
42 TrackerPopupTransposeOctaveDown: TMenuItem; 44 TrackerPopupTransposeOctaveDown: TMenuItem;
@@ -276,6 +278,7 @@ type
276 procedure TicksPerRowSpinEditChange(Sender: TObject); 278 procedure TicksPerRowSpinEditChange(Sender: TObject);
277 procedure OscilloscopeUpdateTimerTimer(Sender: TObject); 279 procedure OscilloscopeUpdateTimerTimer(Sender: TObject);
278 procedure ExportGBSButtonClick(Sender: TObject); 280 procedure ExportGBSButtonClick(Sender: TObject);
281 procedure ToolButton10Click(Sender: TObject);
279 procedure ToolButton2Click(Sender: TObject); 282 procedure ToolButton2Click(Sender: TObject);
280 procedure ToolButton3Click(Sender: TObject); 283 procedure ToolButton3Click(Sender: TObject);
281 procedure ToolButton4Click(Sender: TObject); 284 procedure ToolButton4Click(Sender: TObject);
@@ -1603,6 +1606,15 @@ begin
1603 RenderSongToFile(Song, GBSSaveDialog.FileName, emGBS); 1606 RenderSongToFile(Song, GBSSaveDialog.FileName, emGBS);
1604 end; 1607 end;
1605 1608
1609 procedure TfrmTracker.ToolButton10Click(Sender: TObject);
1610 begin
1611 EmulationThread.Terminate;
1612 if RenderPreviewROM(Song) and WavSaveDialog.Execute then begin
1613 ExportWaveToFile(WavSaveDialog.Filename);
1614 ResetEmulationThread;
1615 end;
1616 end;
1617
1606 procedure TfrmTracker.ToolButton2Click(Sender: TObject); 1618 procedure TfrmTracker.ToolButton2Click(Sender: TObject);
1607 begin 1619 begin
1608 if PreparePreview then begin 1620 if PreparePreview then begin
Addedwaveexport.pas +37−0
@@ -0,0 +1,37 @@
1 unit WaveExport;
2
3 {$mode objfpc}{$H+}
4
5 interface
6
7 uses
8 Classes, SysUtils;
9
10 procedure ExportWaveToFile(Filename: String);
11
12 implementation
13
14 uses sound, mainloop, vars, machine, constants;
15
16 procedure ExportWaveToFile(Filename: String);
17 var
18 CompletedCycles: QWord = 0;
19 begin
20 z80_reset;
21 ResetSound;
22 enablesound;
23
24 BeginWritingSoundToFile(Filename);
25
26 FDCallback := nil;
27
28 load('hUGEDriver/preview.gb');
29
30 while CompletedCycles < (70224*60)*10 do
31 Inc(CompletedCycles, z80_decode);
32
33 EndWritingSoundToFile;
34 end;
35
36 end.
37