Commit cf80f03

Nick Faro committed on
WIP vgm export
commit cf80f03b2da32142110dc57ee5d70d3e5ade2033 parent d973544
4 changed files +101−22
ModifiedGlobal/vars.pas +2−0
@@ -18,6 +18,8 @@ const
18 var 18 var
19 FDCallback, FCCallback: TCPUCallback; 19 FDCallback, FCCallback: TCPUCallback;
20 20
21 IsWritingVGM: Boolean = False;
22
21 bdrop, dirname, dirload: string; 23 bdrop, dirname, dirload: string;
22 romname, speicher: string[128]; 24 romname, speicher: string[128];
23 buffer: array[0..1023] of char; 25 buffer: array[0..1023] of char;
Modifiedtracker.lfm +23−17
@@ -1,7 +1,7 @@
1 object frmTracker: TfrmTracker 1 object frmTracker: TfrmTracker
2 Left = 880 2 Left = 937
3 Height = 857 3 Height = 857
4 Top = 201 4 Top = 137
5 Width = 1318 5 Width = 1318
6 AllowDropFiles = True 6 AllowDropFiles = True
7 Caption = 'hUGETracker' 7 Caption = 'hUGETracker'
@@ -1855,7 +1855,7 @@ object frmTracker: TfrmTracker
1855 ParentShowHint = False 1855 ParentShowHint = False
1856 end 1856 end
1857 object PanicToolButton: TToolButton 1857 object PanicToolButton: TToolButton
1858 Left = 557 1858 Left = 551
1859 Hint = 'Stops all sound output' 1859 Hint = 'Stops all sound output'
1860 Top = 0 1860 Top = 0
1861 AutoSize = True 1861 AutoSize = True
@@ -1880,7 +1880,7 @@ object frmTracker: TfrmTracker
1880 Hint = 'Export the song as a standalone ROM' 1880 Hint = 'Export the song as a standalone ROM'
1881 Top = 0 1881 Top = 0
1882 AutoSize = True 1882 AutoSize = True
1883 Caption = 'Export .GB' 1883 Caption = 'Export GB'
1884 ImageIndex = 81 1884 ImageIndex = 81
1885 OnClick = ExportGBButtonClick 1885 OnClick = ExportGBButtonClick
1886 end 1886 end
@@ -1899,14 +1899,14 @@ object frmTracker: TfrmTracker
1899 Style = tbsDivider 1899 Style = tbsDivider
1900 end 1900 end
1901 object ToolButton7: TToolButton 1901 object ToolButton7: TToolButton
1902 Left = 1097 1902 Left = 1091
1903 Height = 22 1903 Height = 22
1904 Top = 0 1904 Top = 0
1905 Caption = 'ToolButton7' 1905 Caption = 'ToolButton7'
1906 Style = tbsSeparator 1906 Style = tbsSeparator
1907 end 1907 end
1908 object OctaveSpinEdit: TSpinEdit 1908 object OctaveSpinEdit: TSpinEdit
1909 Left = 663 1909 Left = 657
1910 Height = 23 1910 Height = 23
1911 Hint = 'The octave offset for entering new notes' 1911 Hint = 'The octave offset for entering new notes'
1912 Top = 0 1912 Top = 0
@@ -1917,14 +1917,14 @@ object frmTracker: TfrmTracker
1917 TabOrder = 0 1917 TabOrder = 0
1918 end 1918 end
1919 object ToolButton9: TToolButton 1919 object ToolButton9: TToolButton
1920 Left = 612 1920 Left = 606
1921 Height = 22 1921 Height = 22
1922 Top = 0 1922 Top = 0
1923 Caption = 'ToolButton9' 1923 Caption = 'ToolButton9'
1924 Style = tbsSeparator 1924 Style = tbsSeparator
1925 end 1925 end
1926 object Label22: TLabel 1926 object Label22: TLabel
1927 Left = 620 1927 Left = 614
1928 Height = 22 1928 Height = 22
1929 Top = 0 1929 Top = 0
1930 Width = 43 1930 Width = 43
@@ -1935,7 +1935,7 @@ object frmTracker: TfrmTracker
1935 ParentFont = False 1935 ParentFont = False
1936 end 1936 end
1937 object Label23: TLabel 1937 object Label23: TLabel
1938 Left = 728 1938 Left = 722
1939 Height = 22 1939 Height = 22
1940 Top = 0 1940 Top = 0
1941 Width = 70 1941 Width = 70
@@ -1946,7 +1946,7 @@ object frmTracker: TfrmTracker
1946 ParentFont = False 1946 ParentFont = False
1947 end 1947 end
1948 object InstrumentComboBox: TComboBox 1948 object InstrumentComboBox: TComboBox
1949 Left = 798 1949 Left = 792
1950 Height = 23 1950 Height = 23
1951 Hint = 'The selected instrument for new notes' 1951 Hint = 'The selected instrument for new notes'
1952 Top = 0 1952 Top = 0
@@ -1964,7 +1964,7 @@ object frmTracker: TfrmTracker
1964 Text = '(no instrument)' 1964 Text = '(no instrument)'
1965 end 1965 end
1966 object Label24: TLabel 1966 object Label24: TLabel
1967 Left = 1012 1967 Left = 1006
1968 Height = 22 1968 Height = 22
1969 Top = 0 1969 Top = 0
1970 Width = 35 1970 Width = 35
@@ -1975,7 +1975,7 @@ object frmTracker: TfrmTracker
1975 ParentFont = False 1975 ParentFont = False
1976 end 1976 end
1977 object StepSpinEdit: TSpinEdit 1977 object StepSpinEdit: TSpinEdit
1978 Left = 1047 1978 Left = 1041
1979 Height = 23 1979 Height = 23
1980 Hint = 'How many rows to step down after entering a new note' 1980 Hint = 'How many rows to step down after entering a new note'
1981 Top = 0 1981 Top = 0
@@ -1991,22 +1991,22 @@ object frmTracker: TfrmTracker
1991 Action = PlayStartAction 1991 Action = PlayStartAction
1992 end 1992 end
1993 object ExportGBSButton: TToolButton 1993 object ExportGBSButton: TToolButton
1994 Left = 372 1994 Left = 369
1995 Hint = 'Export the song as a GBS soundtrack' 1995 Hint = 'Export the song as a GBS soundtrack'
1996 Top = 0 1996 Top = 0
1997 Caption = 'Export .GBS' 1997 Caption = 'Export GBS'
1998 ImageIndex = 80 1998 ImageIndex = 80
1999 OnClick = ExportGBSButtonClick 1999 OnClick = ExportGBSButtonClick
2000 end 2000 end
2001 object ToolButton5: TToolButton 2001 object ToolButton5: TToolButton
2002 Left = 552 2002 Left = 546
2003 Height = 22 2003 Height = 22
2004 Top = 0 2004 Top = 0
2005 Caption = 'ToolButton5' 2005 Caption = 'ToolButton5'
2006 Style = tbsDivider 2006 Style = tbsDivider
2007 end 2007 end
2008 object ToolButton10: TToolButton 2008 object ToolButton10: TToolButton
2009 Left = 459 2009 Left = 453
2010 Hint = 'Export the song as WAV or MP3' 2010 Hint = 'Export the song as WAV or MP3'
2011 Top = 0 2011 Top = 0
2012 Caption = 'Render Song' 2012 Caption = 'Render Song'
@@ -2067,6 +2067,7 @@ object frmTracker: TfrmTracker
2067 Caption = 'Export VGM ...' 2067 Caption = 'Export VGM ...'
2068 Hint = 'Export the song as a VGM, useful for creating sound effects' 2068 Hint = 'Export the song as a VGM, useful for creating sound effects'
2069 ImageIndex = 84 2069 ImageIndex = 84
2070 OnClick = MenuItem10Click
2070 end 2071 end
2071 object MenuItem40: TMenuItem 2072 object MenuItem40: TMenuItem
2072 Caption = '-' 2073 Caption = '-'
@@ -2633,7 +2634,7 @@ object frmTracker: TfrmTracker
2633 Top = 24 2634 Top = 24
2634 end 2635 end
2635 object GBSaveDialog: TSaveDialog 2636 object GBSaveDialog: TSaveDialog
2636 Filter = 'Gameboy ROM|*.GB' 2637 Filter = 'Gameboy ROM|*.gb'
2637 Left = 328 2638 Left = 328
2638 Top = 24 2639 Top = 24
2639 end 2640 end
@@ -3079,4 +3080,9 @@ object frmTracker: TfrmTracker
3079 Left = 272 3080 Left = 272
3080 Top = 48 3081 Top = 48
3081 end 3082 end
3083 object VGMSaveDialog: TSaveDialog
3084 Filter = 'VGM Rip|*.vgm'
3085 Left = 356
3086 Top = 52
3087 end
3082 end 3088 end
Modifiedtracker.pas +13−1
@@ -10,7 +10,7 @@ uses
10 sound, vars, machine, about_hugetracker, TrackerGrid, lclintf, lmessages, 10 sound, vars, machine, about_hugetracker, TrackerGrid, lclintf, lmessages,
11 Buttons, Grids, DBCtrls, HugeDatatypes, LCLType, Clipbrd, RackCtls, Codegen, 11 Buttons, Grids, DBCtrls, HugeDatatypes, LCLType, Clipbrd, RackCtls, Codegen,
12 SymParser, options, bgrabitmap, effecteditor, RenderToWave, 12 SymParser, options, bgrabitmap, effecteditor, RenderToWave,
13 modimport, mainloop, strutils, Types, Keymap, hUGESettings; 13 modimport, mainloop, strutils, Types, Keymap, hUGESettings, vgm;
14 14
15 // TODO: Move to config file? 15 // TODO: Move to config file?
16 const 16 const
@@ -42,6 +42,7 @@ type
42 { TfrmTracker } 42 { TfrmTracker }
43 43
44 TfrmTracker = class(TForm) 44 TfrmTracker = class(TForm)
45 VGMSaveDialog: TSaveDialog;
45 MenuItem10: TMenuItem; 46 MenuItem10: TMenuItem;
46 TempoBPMLabel: TLabel; 47 TempoBPMLabel: TLabel;
47 TimerEnabledCheckBox: TCheckBox; 48 TimerEnabledCheckBox: TCheckBox;
@@ -288,6 +289,7 @@ type
288 TreeView1: TTreeView; 289 TreeView1: TTreeView;
289 TrackerGrid: TTrackerGrid; 290 TrackerGrid: TTrackerGrid;
290 TableGrid: TTableGrid; 291 TableGrid: TTableGrid;
292 procedure MenuItem10Click(Sender: TObject);
291 procedure TimerDividerSpinEditChange(Sender: TObject); 293 procedure TimerDividerSpinEditChange(Sender: TObject);
292 procedure TimerEnabledCheckBoxChange(Sender: TObject); 294 procedure TimerEnabledCheckBoxChange(Sender: TObject);
293 procedure TrackerPopupMixPasteClick(Sender: TObject); 295 procedure TrackerPopupMixPasteClick(Sender: TObject);
@@ -2006,6 +2008,16 @@ begin
2006 UpdateBPMLabel 2008 UpdateBPMLabel
2007 end; 2009 end;
2008 2010
2011 procedure TfrmTracker.MenuItem10Click(Sender: TObject);
2012 begin
2013 if RenderPreviewROM and VGMSaveDialog.Execute then begin
2014 StopPlayback;
2015 ParseSymFile('render/preview.sym');
2016
2017 ExportVGMFile(VGMSaveDialog.FileName);
2018 end;
2019 end;
2020
2009 procedure TfrmTracker.TimerEnabledCheckBoxChange(Sender: TObject); 2021 procedure TfrmTracker.TimerEnabledCheckBoxChange(Sender: TObject);
2010 begin 2022 begin
2011 Song.TimerEnabled := TimerEnabledCheckBox.Checked; 2023 Song.TimerEnabled := TimerEnabledCheckBox.Checked;
Modifiedvgm.pas +63−4
@@ -5,7 +5,7 @@ unit VGM;
5 interface 5 interface
6 6
7 uses 7 uses
8 Classes, SysUtils, gvector; 8 Classes, SysUtils, gvector, vars, mainloop, sound, constants;
9 9
10 type 10 type
11 // Header for a v1.61 VGM file. 11 // Header for a v1.61 VGM file.
@@ -83,7 +83,7 @@ type
83 var 83 var
84 RecordingVGM: Boolean = False; 84 RecordingVGM: Boolean = False;
85 85
86 procedure BeginRecordingVGM(F: String); 86 procedure ExportVGMFile(F: String);
87 procedure EndRecordingVGM; 87 procedure EndRecordingVGM;
88 88
89 procedure VGMWriteReg(Reg: Integer; Value: Integer); 89 procedure VGMWriteReg(Reg: Integer; Value: Integer);
@@ -91,20 +91,60 @@ procedure VGMWait(Amount: Integer);
91 91
92 implementation 92 implementation
93 93
94 uses symparser;
95
96 type
97 // Need to wrap the FC callback in a class because it's declared to be
98 // "procedure of object" :(
99
100 { TOrderChecker }
101
102 TOrderChecker = class
103 procedure OrderCheckCallback;
104 end;
105
94 var 106 var
107 SeenOrders: array of Integer;
108 OrderChecker: TOrderChecker;
109 StartOfSong, CurrentOrder: Integer;
95 VGMFile: TFileStream; 110 VGMFile: TFileStream;
96 CommandBuffer: TCommandVector; 111 CommandBuffer: TCommandVector;
97 TotalWaitTicks: Integer; 112 TotalWaitTicks: Integer;
98 113
99 procedure BeginRecordingVGM(F: String); 114 procedure ExportVGMFile(F: String);
115 var
116 OldFD, OldFC: TCPUCallback;
100 begin 117 begin
118 OldFD := FDCallback;
119 OldFC := FCCallback;
120 FDCallback := nil;
121 FCCallback := @OrderChecker.OrderCheckCallback;
122
123 z80_reset;
124 ResetSound;
125 enablesound;
126 load('render/preview.gb');
127
128 SetLength(SeenOrders, PeekSymbol(SYM_ORDER_COUNT) div 2);
129 StartOfSong := -1;
130 CurrentOrder := -1;
131
101 // Due to the annoying format of VGM where the header needs values that can 132 // Due to the annoying format of VGM where the header needs values that can
102 // only be computed after rendering the entire file, we store the data in 133 // only be computed after rendering the entire file, we store the data in
103 // memory until recording is finished, and dump it all out then. 134 // memory until recording is finished, and dump it all out then.
104 // Thankfully VGM files are small enough to fit in RAM. 135 // Thankfully VGM files are small enough to fit in RAM.
105 136 IsWritingVGM := True;
106 VGMFile := TFileStream.Create(F, fmOpenWrite); 137 VGMFile := TFileStream.Create(F, fmOpenWrite);
107 CommandBuffer.Clear; 138 CommandBuffer.Clear;
139
140 repeat
141 z80_decode
142 until StartOfSong <> -1;
143
144 EndRecordingVGM;
145
146 FDCallback := OldFD;
147 FCCallback := OldFC;
108 end; 148 end;
109 149
110 procedure EndRecordingVGM; 150 procedure EndRecordingVGM;
@@ -112,6 +152,8 @@ var
112 Header: TVGMHeader; 152 Header: TVGMHeader;
113 Cmd: TVGMCommand; 153 Cmd: TVGMCommand;
114 begin 154 begin
155 IsWritingVGM := False;
156
115 Header := Default(TVGMHeader); // Zero the header 157 Header := Default(TVGMHeader); // Zero the header
116 Header.Vgmident := $56676d20; // "Vgm " 158 Header.Vgmident := $56676d20; // "Vgm "
117 Header.Version := $00000161; // 1.61 159 Header.Version := $00000161; // 1.61
@@ -121,6 +163,7 @@ begin
121 // TODO: Fill total wait ticks, loop point offset, loop length 163 // TODO: Fill total wait ticks, loop point offset, loop length
122 164
123 VGMFile.WriteBuffer(Header, SizeOf(Header)); 165 VGMFile.WriteBuffer(Header, SizeOf(Header));
166
124 for Cmd in CommandBuffer do begin 167 for Cmd in CommandBuffer do begin
125 case Cmd.type_ of 168 case Cmd.type_ of
126 ctRegWrite: begin 169 ctRegWrite: begin
@@ -160,7 +203,23 @@ begin
160 CommandBuffer.PushBack(Cmd); 203 CommandBuffer.PushBack(Cmd);
161 end; 204 end;
162 205
206 { TOrderChecker }
207
208 procedure TOrderChecker.OrderCheckCallback;
209 var
210 Ord: Integer;
211 begin
212 Ord := (PeekSymbol(SYM_CURRENT_ORDER) div 2);
213
214 if (SeenOrders[Ord] <> 0) and (StartOfSong = -1) then
215 StartOfSong := Ord;
216
217 Inc(SeenOrders[Ord]);
218 CurrentOrder := Ord;
219 end;
220
163 begin 221 begin
222 OrderChecker := TOrderChecker.Create;
164 CommandBuffer := TCommandVector.Create; 223 CommandBuffer := TCommandVector.Create;
165 end. 224 end.
166 225