Commit e1adc14

Nick Faro committed on
Working VGM dumping
commit e1adc14d42bb5bdca24e6ff300e5d3621a1d6ec1 parent cf80f03
7 changed files +105−77
ModifiedCPU/machine.pas +4−1
@@ -85,7 +85,7 @@ function getcompany: string;
85 85
86 implementation 86 implementation
87 87
88 uses vars, sound; 88 uses vars, sound, vgm;
89 89
90 function getCompany: string; 90 function getCompany: string;
91 var 91 var
@@ -462,6 +462,9 @@ begin
462 end; 462 end;
463 $ff10..$ff3F: 463 $ff10..$ff3F:
464 begin 464 begin
465 if WritingVGM then
466 VGMWriteReg(Address, Data);
467
465 sndRegChange := True; 468 sndRegChange := True;
466 if address = $ff26 then 469 if address = $ff26 then
467 begin 470 begin
ModifiedCPU/z80cpu.pas +7−1
@@ -2132,6 +2132,12 @@ begin
2132 Result := 0; 2132 Result := 0;
2133 end; 2133 end;
2134 2134
2135 function uge_f4: byte;
2136 begin
2137 if Assigned(F4Callback) then F4Callback;
2138 Result := 0;
2139 end;
2140
2135 function rlc_b: byte; 2141 function rlc_b: byte;
2136 begin 2142 begin
2137 af.l := rlcr_f[bc.h]; 2143 af.l := rlcr_f[bc.h];
@@ -4381,7 +4387,7 @@ begin
4381 Z80[241] := @pop_af; 4387 Z80[241] := @pop_af;
4382 Z80[242] := @ld_a_ff00plusc; 4388 Z80[242] := @ld_a_ff00plusc;
4383 Z80[243] := @di; 4389 Z80[243] := @di;
4384 Z80[244] := @unimplemented; 4390 Z80[244] := @uge_f4;
4385 Z80[245] := @push_af; 4391 Z80[245] := @push_af;
4386 Z80[246] := @or_XX; 4392 Z80[246] := @or_XX;
4387 Z80[247] := @rst_48; 4393 Z80[247] := @rst_48;
ModifiedGlobal/vars.pas +2−2
@@ -16,9 +16,9 @@ const
16 isddraw: boolean = True; // DirectDraw; 16 isddraw: boolean = True; // DirectDraw;
17 17
18 var 18 var
19 FDCallback, FCCallback: TCPUCallback; 19 FDCallback, FCCallback, F4Callback: TCPUCallback;
20 20
21 IsWritingVGM: Boolean = False; 21 WritingVGM: Boolean = False;
22 22
23 bdrop, dirname, dirload: string; 23 bdrop, dirname, dirload: string;
24 romname, speicher: string[128]; 24 romname, speicher: string[128];
Modifiedmainloop.pas +2−1
@@ -286,7 +286,8 @@ begin
286 end; 286 end;
287 287
288 Count := z80[code](); 288 Count := z80[code]();
289 SoundUpdate(Count * (3 - gb_speed)); 289 if not WritingVGM then
290 SoundUpdate(Count * (3 - gb_speed));
290 cnumber := Count div gb_speed; 291 cnumber := Count div gb_speed;
291 292
292 if (stop_mode = 1) then 293 if (stop_mode = 1) then
Modifiedtracker.lfm +2−2
@@ -1,7 +1,7 @@
1 object frmTracker: TfrmTracker 1 object frmTracker: TfrmTracker
2 Left = 937 2 Left = 1572
3 Height = 857 3 Height = 857
4 Top = 137 4 Top = 160
5 Width = 1318 5 Width = 1318
6 AllowDropFiles = True 6 AllowDropFiles = True
7 Caption = 'hUGETracker' 7 Caption = 'hUGETracker'
Modifiedtracker.pas +7−1
@@ -2014,7 +2014,7 @@ begin
2014 StopPlayback; 2014 StopPlayback;
2015 ParseSymFile('render/preview.sym'); 2015 ParseSymFile('render/preview.sym');
2016 2016
2017 ExportVGMFile(VGMSaveDialog.FileName); 2017 ExportVGMFile(VGMSaveDialog.FileName, Song.Name, Song.Artist, Song.Comment);
2018 end; 2018 end;
2019 end; 2019 end;
2020 2020
@@ -2046,6 +2046,12 @@ end;
2046 2046
2047 procedure TfrmTracker.DebugButtonClick(Sender: TObject); 2047 procedure TfrmTracker.DebugButtonClick(Sender: TObject);
2048 begin 2048 begin
2049 if RenderPreviewROM then begin
2050 StopPlayback;
2051 ParseSymFile('render/preview.sym');
2052
2053 ExportVGMFile('C:/tmp/yeah.vgm', 'Joogus', 'Nick Faro', 'This song sucks.');
2054 end;
2049 end; 2055 end;
2050 2056
2051 procedure TfrmTracker.DecreaseOctaveActionExecute(Sender: TObject); 2057 procedure TfrmTracker.DecreaseOctaveActionExecute(Sender: TObject);
Modifiedvgm.pas +81−69
@@ -68,23 +68,13 @@ type
68 K053260clock: UInt32; 68 K053260clock: UInt32;
69 Pokeyclock: UInt32; 69 Pokeyclock: UInt32;
70 QSoundclock: UInt32; 70 QSoundclock: UInt32;
71 Reserved3: UInt64; // 8 bytes
71 end; 72 end;
72 73
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>;
82
83 var 74 var
84 RecordingVGM: Boolean = False; 75 RecordingVGM: Boolean = False;
85 76
86 procedure ExportVGMFile(F: String); 77 procedure ExportVGMFile(F: String; TrackName: String; ArtistName: String; Comments: String);
87 procedure EndRecordingVGM;
88 78
89 procedure VGMWriteReg(Reg: Integer; Value: Integer); 79 procedure VGMWriteReg(Reg: Integer; Value: Integer);
90 procedure VGMWait(Amount: Integer); 80 procedure VGMWait(Amount: Integer);
@@ -101,6 +91,7 @@ type
101 91
102 TOrderChecker = class 92 TOrderChecker = class
103 procedure OrderCheckCallback; 93 procedure OrderCheckCallback;
94 procedure TickCallback;
104 end; 95 end;
105 96
106 var 97 var
@@ -108,16 +99,22 @@ var
108 OrderChecker: TOrderChecker; 99 OrderChecker: TOrderChecker;
109 StartOfSong, CurrentOrder: Integer; 100 StartOfSong, CurrentOrder: Integer;
110 VGMFile: TFileStream; 101 VGMFile: TFileStream;
111 CommandBuffer: TCommandVector; 102 TotalWaitSamps: Integer;
112 TotalWaitTicks: Integer;
113 103
114 procedure ExportVGMFile(F: String); 104 procedure ExportVGMFile(F: String; TrackName: String; ArtistName: String; Comments: String);
115 var 105 var
116 OldFD, OldFC: TCPUCallback; 106 OldFD, OldFC, OldF4: TCPUCallback;
107 Header: TVGMHeader;
108 Utf16Bytes: TBytes;
109 YY,MM,DD: Word;
110 GD3Temp: Integer;
117 begin 111 begin
112 // TODO: Manage these callbacks in a better way, maybe some sort of stack.
118 OldFD := FDCallback; 113 OldFD := FDCallback;
119 OldFC := FCCallback; 114 OldFC := FCCallback;
115 OldF4 := F4Callback;
120 FDCallback := nil; 116 FDCallback := nil;
117 F4Callback := @OrderChecker.TickCallback;
121 FCCallback := @OrderChecker.OrderCheckCallback; 118 FCCallback := @OrderChecker.OrderCheckCallback;
122 119
123 z80_reset; 120 z80_reset;
@@ -129,78 +126,89 @@ begin
129 StartOfSong := -1; 126 StartOfSong := -1;
130 CurrentOrder := -1; 127 CurrentOrder := -1;
131 128
132 // Due to the annoying format of VGM where the header needs values that can 129 WritingVGM := True;
133 // only be computed after rendering the entire file, we store the data in 130 VGMFile := TFileStream.Create(F, fmCreate);
134 // memory until recording is finished, and dump it all out then. 131
135 // Thankfully VGM files are small enough to fit in RAM. 132 Header := Default(TVGMHeader); // Zero the header
136 IsWritingVGM := True; 133 VGMFile.WriteBuffer(Header, SizeOf(Header)); // Write dummy header (will overwrite later)
137 VGMFile := TFileStream.Create(F, fmOpenWrite);
138 CommandBuffer.Clear;
139 134
140 repeat 135 repeat
141 z80_decode 136 z80_decode
142 until StartOfSong <> -1; 137 until StartOfSong <> -1;
143 138
144 EndRecordingVGM; 139 WritingVGM := False;
145 140
146 FDCallback := OldFD; 141 // Update the header to point to the GD3 tag, then write it
147 FCCallback := OldFC; 142 Header.GD3offset := VGMFile.Position - $14;
148 end; 143
149 144 VGMFile.WriteDWord($20336447);
150 procedure EndRecordingVGM; 145 VGMFile.WriteDWord($00000100);
151 var 146
152 Header: TVGMHeader; 147 GD3Temp := VGMFile.Position;
153 Cmd: TVGMCommand; 148 VGMFile.WriteDWord(0); // dummy value...
154 begin 149 Utf16Bytes := WideBytesOf(UTF8Decode(TrackName));
155 IsWritingVGM := False; 150 VGMFile.WriteBuffer(Utf16Bytes[0], Length(Utf16Bytes)); // English name
156 151 VGMFile.WriteWord(0);
157 Header := Default(TVGMHeader); // Zero the header 152
158 Header.Vgmident := $56676d20; // "Vgm " 153 VGMFile.WriteWord(0); // No japanese track name
154 VGMFile.WriteWord(0); // No game name
155 VGMFile.WriteWord(0); // No japanese game name
156 Utf16Bytes := WideBytesOf('Nintendo Game Boy');
157 VGMFile.WriteBuffer(Utf16Bytes[0], Length(Utf16Bytes));
158 VGMFile.WriteWord(0);
159 VGMFile.WriteWord(0); // No japanese system name
160 Utf16Bytes := WideBytesOf(UTF8Decode(ArtistName));
161 VGMFile.WriteBuffer(Utf16Bytes[0], Length(Utf16Bytes));
162 VGMFile.WriteWord(0);
163 VGMFile.WriteWord(0); // No japanese author name
164 DecodeDate(Date, YY, MM, DD);
165 Utf16Bytes := WideBytesOf(UTF8Decode(Format('%d/%.2d/%.2d', [YY, MM, DD])));
166 VGMFile.WriteBuffer(Utf16Bytes[0], Length(Utf16Bytes));
167 VGMFile.WriteWord(0);
168 Utf16Bytes := WideBytesOf('hUGETracker');
169 VGMFile.WriteBuffer(Utf16Bytes[0], Length(Utf16Bytes));
170 VGMFile.WriteWord(0);
171 Utf16Bytes := WideBytesOf(UTF8Decode(Comments));
172 VGMFile.WriteBuffer(Utf16Bytes[0], Length(Utf16Bytes));
173 VGMFile.WriteWord(0);
174
175 // Go back and overwrite that dummy (unnecessary) length value.
176 // The VGM and GD3 formats sure are ugly. Not that UGE is any better.
177 GD3Temp := VGMFile.Position - GD3Temp;
178 VGMFile.Seek(-GD3Temp, soCurrent);
179 VGMFile.WriteDWord(GD3Temp);
180
181 // Rewrite the header now that we know the correct values
182 Header.Vgmident := SwapEndian($56676d20); // "Vgm "
159 Header.Version := $00000161; // 1.61 183 Header.Version := $00000161; // 1.61
160 Header.Rate := 60; // 60hz 184 Header.Rate := 60; // 60hz
161 Header.GBDMGclock := 4194304; // 4194304 hz (from docs) 185 Header.GBDMGclock := 4194304; // 4194304 hz (from docs)
186 Header.EoFoffset := VGMFile.Size - $4;
187 Header.VGMdataoffset := $8C;
188 Header.TotalNumsamples := TotalWaitSamps;
162 189
163 // TODO: Fill total wait ticks, loop point offset, loop length 190 VGMFile.Seek(0, soBeginning);
164
165 VGMFile.WriteBuffer(Header, SizeOf(Header)); 191 VGMFile.WriteBuffer(Header, SizeOf(Header));
166 192
167 for Cmd in CommandBuffer do begin
168 case Cmd.type_ of
169 ctRegWrite: begin
170 VGMFile.WriteByte($B3); // Write DMG Reg
171 VGMFile.WriteByte(Byte(Cmd.Reg - $FF10));
172 VGMFile.WriteByte(Byte(Cmd.Param));
173 end;
174 ctWait: begin
175 VGMFile.WriteByte($61); // TODO: Use the smaller commands if it matches
176 VGMFile.WriteWord(Word(Cmd.Param));
177 end;
178 end;
179 end;
180
181 VGMFile.Free; 193 VGMFile.Free;
182 CommandBuffer.Clear; 194
195 F4Callback := OldF4;
196 FDCallback := OldFD;
197 FCCallback := OldFC;
183 end; 198 end;
184 199
185 procedure VGMWriteReg(Reg: Integer; Value: Integer); 200 procedure VGMWriteReg(Reg: Integer; Value: Integer);
186 var
187 Cmd: TVGMCommand;
188 begin 201 begin
189 Cmd.type_ := ctRegWrite; 202 VGMFile.WriteByte($B3); // Write DMG Reg
190 Cmd.Reg := Reg; 203 VGMFile.WriteByte(Byte(Reg - $FF10));
191 Cmd.Param := Value; 204 VGMFile.WriteByte(Byte(Value));
192
193 CommandBuffer.PushBack(Cmd);
194 end; 205 end;
195 206
196 procedure VGMWait(Amount: Integer); 207 procedure VGMWait(Amount: Integer);
197 var
198 Cmd: TVGMCommand;
199 begin 208 begin
200 Cmd.type_ := ctWait; 209 VGMFile.WriteByte($62); // TODO: Use the smaller commands if it matches
201 Cmd.Param := Amount; 210 //VGMFile.WriteWord(Word(Amount));
202 211 Inc(TotalWaitSamps, 735);
203 CommandBuffer.PushBack(Cmd);
204 end; 212 end;
205 213
206 { TOrderChecker } 214 { TOrderChecker }
@@ -218,8 +226,12 @@ begin
218 CurrentOrder := Ord; 226 CurrentOrder := Ord;
219 end; 227 end;
220 228
229 procedure TOrderChecker.TickCallback;
230 begin
231 VGMWait(0);
232 end;
233
221 begin 234 begin
222 OrderChecker := TOrderChecker.Create; 235 OrderChecker := TOrderChecker.Create;
223 CommandBuffer := TCommandVector.Create;
224 end. 236 end.
225 237