Commit 9814cad

Nick Faro committed on
WIP vgm export
commit 9814cad263e26583a8c31e40eb7658094716d926 parent abaee80
3 changed files +137−36
Modifiedcodegen.pas +1−1
@@ -479,7 +479,7 @@ begin
479 Stream.Free; 479 Stream.Free;
480 480
481 Stream := TFileStream.Create(GBSFile, fmOpenWrite); 481 Stream := TFileStream.Create(GBSFile, fmOpenWrite);
482 Stream.Write(Buffer[0], Length(Buffer)); 482 Stream.WriteBuffer(Buffer[0], Length(Buffer));
483 Stream.Free; 483 Stream.Free;
484 end; 484 end;
485 485
Modifiedtracker.lfm +32−32
@@ -1,7 +1,7 @@
1 object frmTracker: TfrmTracker 1 object frmTracker: TfrmTracker
2 Left = 1669 2 Left = 880
3 Height = 857 3 Height = 857
4 Top = 152 4 Top = 201
5 Width = 1318 5 Width = 1318
6 AllowDropFiles = True 6 AllowDropFiles = True
7 Caption = 'hUGETracker' 7 Caption = 'hUGETracker'
@@ -20,7 +20,7 @@ object frmTracker: TfrmTracker
20 LCLVersion = '2.2.3.0' 20 LCLVersion = '2.2.3.0'
21 object TreeView1: TTreeView 21 object TreeView1: TTreeView
22 Left = 0 22 Left = 0
23 Height = 720 23 Height = 725
24 Top = 89 24 Top = 89
25 Width = 193 25 Width = 193
26 Align = alLeft 26 Align = alLeft
@@ -42,34 +42,34 @@ object frmTracker: TfrmTracker
42 end 42 end
43 object Splitter1: TSplitter 43 object Splitter1: TSplitter
44 Left = 193 44 Left = 193
45 Height = 720 45 Height = 725
46 Top = 89 46 Top = 89
47 Width = 5 47 Width = 5
48 end 48 end
49 object Panel1: TPanel 49 object Panel1: TPanel
50 Left = 198 50 Left = 198
51 Height = 720 51 Height = 725
52 Top = 89 52 Top = 89
53 Width = 1120 53 Width = 1120
54 Align = alClient 54 Align = alClient
55 BevelOuter = bvNone 55 BevelOuter = bvNone
56 ClientHeight = 720 56 ClientHeight = 725
57 ClientWidth = 1120 57 ClientWidth = 1120
58 ParentFont = False 58 ParentFont = False
59 TabOrder = 2 59 TabOrder = 2
60 object PageControl1: TPageControl 60 object PageControl1: TPageControl
61 Left = 0 61 Left = 0
62 Height = 720 62 Height = 725
63 Top = 0 63 Top = 0
64 Width = 1120 64 Width = 1120
65 ActivePage = InstrumentTabSheet 65 ActivePage = GeneralTabSheet
66 Align = alClient 66 Align = alClient
67 ParentFont = False 67 ParentFont = False
68 TabIndex = 2 68 TabIndex = 0
69 TabOrder = 0 69 TabOrder = 0
70 object GeneralTabSheet: TTabSheet 70 object GeneralTabSheet: TTabSheet
71 Caption = 'General' 71 Caption = 'General'
72 ClientHeight = 692 72 ClientHeight = 697
73 ClientWidth = 1112 73 ClientWidth = 1112
74 ParentFont = False 74 ParentFont = False
75 object SongInformationGroupbox: TGroupBox 75 object SongInformationGroupbox: TGroupBox
@@ -186,16 +186,16 @@ object frmTracker: TfrmTracker
186 end 186 end
187 object PatternTabSheet: TTabSheet 187 object PatternTabSheet: TTabSheet
188 Caption = 'Patterns' 188 Caption = 'Patterns'
189 ClientHeight = 692 189 ClientHeight = 697
190 ClientWidth = 1112 190 ClientWidth = 1112
191 ParentFont = False 191 ParentFont = False
192 object Panel3: TPanel 192 object Panel3: TPanel
193 Left = 224 193 Left = 224
194 Height = 692 194 Height = 697
195 Top = 0 195 Top = 0
196 Width = 888 196 Width = 888
197 Align = alClient 197 Align = alClient
198 ClientHeight = 692 198 ClientHeight = 697
199 ClientWidth = 888 199 ClientWidth = 888
200 ParentFont = False 200 ParentFont = False
201 TabOrder = 0 201 TabOrder = 0
@@ -249,7 +249,7 @@ object frmTracker: TfrmTracker
249 end 249 end
250 object ScrollBox1: TScrollBox 250 object ScrollBox1: TScrollBox
251 Left = 1 251 Left = 1
252 Height = 660 252 Height = 665
253 Top = 31 253 Top = 31
254 Width = 886 254 Width = 886
255 HorzScrollBar.Increment = 3 255 HorzScrollBar.Increment = 3
@@ -262,7 +262,7 @@ object frmTracker: TfrmTracker
262 VertScrollBar.Tracking = True 262 VertScrollBar.Tracking = True
263 Align = alClient 263 Align = alClient
264 BorderStyle = bsNone 264 BorderStyle = bsNone
265 ClientHeight = 660 265 ClientHeight = 665
266 ClientWidth = 886 266 ClientWidth = 886
267 ParentFont = False 267 ParentFont = False
268 TabOrder = 1 268 TabOrder = 1
@@ -270,7 +270,7 @@ object frmTracker: TfrmTracker
270 OnMouseWheelUp = ScrollBox1MouseWheelUp 270 OnMouseWheelUp = ScrollBox1MouseWheelUp
271 object RowNumberStringGrid: TStringGrid 271 object RowNumberStringGrid: TStringGrid
272 Left = 0 272 Left = 0
273 Height = 660 273 Height = 665
274 Top = 0 274 Top = 0
275 Width = 32 275 Width = 32
276 Align = alLeft 276 Align = alLeft
@@ -287,7 +287,7 @@ object frmTracker: TfrmTracker
287 end 287 end
288 object OrderEditStringGrid: TStringGrid 288 object OrderEditStringGrid: TStringGrid
289 Left = 0 289 Left = 0
290 Height = 692 290 Height = 697
291 Top = 0 291 Top = 0
292 Width = 224 292 Width = 224
293 Align = alLeft 293 Align = alLeft
@@ -352,12 +352,12 @@ object frmTracker: TfrmTracker
352 end 352 end
353 object InstrumentTabSheet: TTabSheet 353 object InstrumentTabSheet: TTabSheet
354 Caption = 'Instruments' 354 Caption = 'Instruments'
355 ClientHeight = 692 355 ClientHeight = 697
356 ClientWidth = 1112 356 ClientWidth = 1112
357 ParentFont = False 357 ParentFont = False
358 object FlowPanel1: TFlowPanel 358 object FlowPanel1: TFlowPanel
359 Left = 0 359 Left = 0
360 Height = 692 360 Height = 697
361 Top = 0 361 Top = 0
362 Width = 952 362 Width = 952
363 Align = alClient 363 Align = alClient
@@ -990,19 +990,19 @@ object frmTracker: TfrmTracker
990 end 990 end
991 object SubpatternGroupBox: TGroupBox 991 object SubpatternGroupBox: TGroupBox
992 Left = 952 992 Left = 952
993 Height = 685 993 Height = 690
994 Top = 7 994 Top = 7
995 Width = 160 995 Width = 160
996 Align = alRight 996 Align = alRight
997 Anchors = [] 997 Anchors = []
998 BorderSpacing.Top = 7 998 BorderSpacing.Top = 7
999 Caption = 'Subpattern' 999 Caption = 'Subpattern'
1000 ClientHeight = 665 1000 ClientHeight = 670
1001 ClientWidth = 156 1001 ClientWidth = 156
1002 TabOrder = 1 1002 TabOrder = 1
1003 object ScrollBox2: TScrollBox 1003 object ScrollBox2: TScrollBox
1004 Left = 0 1004 Left = 0
1005 Height = 665 1005 Height = 670
1006 Top = 0 1006 Top = 0
1007 Width = 156 1007 Width = 156
1008 HorzScrollBar.Increment = 3 1008 HorzScrollBar.Increment = 3
@@ -1015,14 +1015,14 @@ object frmTracker: TfrmTracker
1015 VertScrollBar.Tracking = True 1015 VertScrollBar.Tracking = True
1016 Align = alClient 1016 Align = alClient
1017 BorderStyle = bsNone 1017 BorderStyle = bsNone
1018 ClientHeight = 665 1018 ClientHeight = 670
1019 ClientWidth = 156 1019 ClientWidth = 156
1020 TabOrder = 0 1020 TabOrder = 0
1021 OnMouseWheelDown = ScrollBox1MouseWheelDown 1021 OnMouseWheelDown = ScrollBox1MouseWheelDown
1022 OnMouseWheelUp = ScrollBox1MouseWheelUp 1022 OnMouseWheelUp = ScrollBox1MouseWheelUp
1023 object RowNumberStringGrid1: TStringGrid 1023 object RowNumberStringGrid1: TStringGrid
1024 Left = 124 1024 Left = 124
1025 Height = 665 1025 Height = 670
1026 Top = 0 1026 Top = 0
1027 Width = 32 1027 Width = 32
1028 Align = alRight 1028 Align = alRight
@@ -1040,14 +1040,14 @@ object frmTracker: TfrmTracker
1040 end 1040 end
1041 object WavesTabSheet: TTabSheet 1041 object WavesTabSheet: TTabSheet
1042 Caption = 'Waves' 1042 Caption = 'Waves'
1043 ClientHeight = 692 1043 ClientHeight = 697
1044 ClientWidth = 1112 1044 ClientWidth = 1112
1045 ParentFont = False 1045 ParentFont = False
1046 object WaveEditPaintBox: TPaintBox 1046 object WaveEditPaintBox: TPaintBox
1047 AnchorSideTop.Control = WaveEditGroupBox 1047 AnchorSideTop.Control = WaveEditGroupBox
1048 AnchorSideTop.Side = asrBottom 1048 AnchorSideTop.Side = asrBottom
1049 Left = 0 1049 Left = 0
1050 Height = 532 1050 Height = 537
1051 Top = 160 1051 Top = 160
1052 Width = 1112 1052 Width = 1112
1053 Align = alBottom 1053 Align = alBottom
@@ -1144,14 +1144,14 @@ object frmTracker: TfrmTracker
1144 end 1144 end
1145 object CommentsTabSheet: TTabSheet 1145 object CommentsTabSheet: TTabSheet
1146 Caption = 'Comments' 1146 Caption = 'Comments'
1147 ClientHeight = 692 1147 ClientHeight = 697
1148 ClientWidth = 1112 1148 ClientWidth = 1112
1149 ParentFont = False 1149 ParentFont = False
1150 object CommentMemo: TMemo 1150 object CommentMemo: TMemo
1151 AnchorSideTop.Control = Label17 1151 AnchorSideTop.Control = Label17
1152 AnchorSideTop.Side = asrBottom 1152 AnchorSideTop.Side = asrBottom
1153 Left = 0 1153 Left = 0
1154 Height = 656 1154 Height = 661
1155 Hint = 'The comments section for your song. Greetings/links/etc' 1155 Hint = 'The comments section for your song. Greetings/links/etc'
1156 Top = 36 1156 Top = 36
1157 Width = 1112 1157 Width = 1112
@@ -1175,14 +1175,14 @@ object frmTracker: TfrmTracker
1175 end 1175 end
1176 object RoutinesTabSheet: TTabSheet 1176 object RoutinesTabSheet: TTabSheet
1177 Caption = 'Routines' 1177 Caption = 'Routines'
1178 ClientHeight = 692 1178 ClientHeight = 697
1179 ClientWidth = 1112 1179 ClientWidth = 1112
1180 ParentFont = False 1180 ParentFont = False
1181 inline RoutineSynedit: TSynEdit 1181 inline RoutineSynedit: TSynEdit
1182 AnchorSideTop.Control = Label19 1182 AnchorSideTop.Control = Label19
1183 AnchorSideTop.Side = asrBottom 1183 AnchorSideTop.Side = asrBottom
1184 Left = 0 1184 Left = 0
1185 Height = 564 1185 Height = 569
1186 Top = 128 1186 Top = 128
1187 Width = 1112 1187 Width = 1112
1188 Align = alBottom 1188 Align = alBottom
@@ -1815,8 +1815,8 @@ object frmTracker: TfrmTracker
1815 end 1815 end
1816 object StatusBar1: TStatusBar 1816 object StatusBar1: TStatusBar
1817 Left = 0 1817 Left = 0
1818 Height = 28 1818 Height = 23
1819 Top = 809 1819 Top = 814
1820 Width = 1318 1820 Width = 1318
1821 AutoHint = True 1821 AutoHint = True
1822 Panels = < 1822 Panels = <
Modifiedvgm.pas +104−3
@@ -5,7 +5,80 @@ unit VGM;
5 interface 5 interface
6 6
7 uses 7 uses
8 Classes, SysUtils; 8 Classes, SysUtils, gvector;
9
10 type
11 // Header for a v1.61 VGM file.
12 // https://github.com/vgmrips/vgmplay/blob/4ac9870f13fd67155569c41da2269c70cd3fcb31/vgmspec161.txt
13 TVGMHeader = packed record
14 Vgmident: UInt32;
15 EoFoffset: UInt32;
16 Version: UInt32;
17 SN76489clock: UInt32;
18 YM2413clock: UInt32;
19 GD3offset: UInt32;
20 TotalNumsamples: UInt32;
21 Loopoffset: UInt32;
22 LoopNumsamples: UInt32;
23 Rate: UInt32;
24 SNFB: UInt16;
25 SNW: UInt8;
26 SF: UInt8;
27 YM2612clock: UInt32;
28 YM2151clock: UInt32;
29 VGMdataoffset: UInt32;
30 SegaPCMclock: UInt32;
31 SPCMInterface: UInt32;
32 RF5C68clock: UInt32;
33 YM2203clock: UInt32;
34 YM2608clock: UInt32;
35 YM2610Bclock: UInt32;
36 YM3812clock: UInt32;
37 YM3526clock: UInt32;
38 Y8950clock: UInt32;
39 YMF262clock: UInt32;
40 YMF278Bclock: UInt32;
41 YMF271clock: UInt32;
42 YMZ280Bclock: UInt32;
43 RF5C164clock: UInt32;
44 PWMclock: UInt32;
45 AY8910clock: UInt32;
46 AYT: UInt8;
47 AYFlags: UInt8;
48 AYFlags1: UInt8;
49 AYFlags2: UInt8;
50 VM: UInt8;
51 Reserved1: UInt8;
52 LB: UInt8;
53 LM: UInt8;
54 GBDMGclock: UInt32;
55 NESAPUclock: UInt32;
56 MultiPCMclock: UInt32;
57 uPD7759clock: UInt32;
58 OKIM6258clock: UInt32;
59 _OF: UInt8;
60 KF: UInt8;
61 CF: UInt8;
62 Reserved2: UInt8;
63 OKIM6295clock: UInt32;
64 K051649clock: UInt32;
65 K054539clock: UInt32;
66 HuC6280clock: UInt32;
67 C140clock: UInt32;
68 K053260clock: UInt32;
69 Pokeyclock: UInt32;
70 QSoundclock: UInt32;
71 end;
72
73 TVGMCommandType = (ctWait, ctRegWrite);
74
75 TVGMCommand = record
76 type_: TVGMCommandType;
77 Reg: Integer;
78 Param: Integer;
79 end;
80
81 TCommandVector = specialize TVector<TVGMCommand>;
9 82
10 var 83 var
11 RecordingVGM: Boolean = False; 84 RecordingVGM: Boolean = False;
@@ -13,33 +86,61 @@ var
13 procedure BeginRecordingVGM(F: String); 86 procedure BeginRecordingVGM(F: String);
14 procedure EndRecordingVGM; 87 procedure EndRecordingVGM;
15 88
16 procedure VGMWriteReg(Command: Integer; Param: Integer); 89 procedure VGMWriteReg(Reg: Integer; Value: Integer);
17 procedure VGMWait(Amount: Integer); 90 procedure VGMWait(Amount: Integer);
18 91
19 implementation 92 implementation
20 93
21 var 94 var
22 VGMFile: TFileStream; 95 VGMFile: TFileStream;
96 CommandBuffer: TCommandVector;
23 97
24 procedure BeginRecordingVGM(F: String); 98 procedure BeginRecordingVGM(F: String);
25 begin 99 begin
100 // Due to the annoying format of VGM where the header needs values that can
101 // only be computed after rendering the entire file, we store the data in
102 // memory until recording is finished, and dump it all out then.
103 // Thankfully VGM files are small enough to fit in RAM.
104
26 VGMFile := TFileStream.Create(F, fmOpenWrite); 105 VGMFile := TFileStream.Create(F, fmOpenWrite);
106 CommandBuffer.Clear;
27 end; 107 end;
28 108
29 procedure EndRecordingVGM; 109 procedure EndRecordingVGM;
110 var
111 Header: TVGMHeader;
30 begin 112 begin
113 Header := Default(TVGMHeader); // Zero the header
114 Header.Vgmident := $56676d20; // "Vgm "
115 Header.Version := $00000161; // 1.61
116 Header.Rate := 60; // 60hz
117 Header.GBDMGclock := 4194304; // 4194304 hz (from docs)
31 118
119 VGMFile.WriteBuffer(Header, SizeOf(Header));
32 end; 120 end;
33 121
34 procedure VGMWriteReg(Command: Integer; Param: Integer); 122 procedure VGMWriteReg(Reg: Integer; Value: Integer);
123 var
124 Cmd: TVGMCommand;
35 begin 125 begin
126 Cmd.type_ := ctRegWrite;
127 Cmd.Reg := Reg - $FF10;
128 Cmd.Param := Value;
36 129
130 CommandBuffer.PushBack(Cmd);
37 end; 131 end;
38 132
39 procedure VGMWait(Amount: Integer); 133 procedure VGMWait(Amount: Integer);
134 var
135 Cmd: TVGMCommand;
40 begin 136 begin
137 Cmd.type_ := ctWait;
138 Cmd.Param := Amount;
41 139
140 CommandBuffer.PushBack(Cmd);
42 end; 141 end;
43 142
143 begin
144 CommandBuffer := TCommandVector.Create;
44 end. 145 end.
45 146