1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
|
unit VGM;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, vars, mainloop, sound, constants;
type
// Header for a v1.61 VGM file.
// https://github.com/vgmrips/vgmplay/blob/4ac9870f13fd67155569c41da2269c70cd3fcb31/vgmspec161.txt
TVGMHeader = packed record
Vgmident: UInt32;
EoFoffset: UInt32;
Version: UInt32;
SN76489clock: UInt32;
YM2413clock: UInt32;
GD3offset: UInt32;
TotalNumsamples: UInt32;
Loopoffset: UInt32;
LoopNumsamples: UInt32;
Rate: UInt32;
SNFB: UInt16;
SNW: UInt8;
SF: UInt8;
YM2612clock: UInt32;
YM2151clock: UInt32;
VGMdataoffset: UInt32;
SegaPCMclock: UInt32;
SPCMInterface: UInt32;
RF5C68clock: UInt32;
YM2203clock: UInt32;
YM2608clock: UInt32;
YM2610Bclock: UInt32;
YM3812clock: UInt32;
YM3526clock: UInt32;
Y8950clock: UInt32;
YMF262clock: UInt32;
YMF278Bclock: UInt32;
YMF271clock: UInt32;
YMZ280Bclock: UInt32;
RF5C164clock: UInt32;
PWMclock: UInt32;
AY8910clock: UInt32;
AYT: UInt8;
AYFlags: UInt8;
AYFlags1: UInt8;
AYFlags2: UInt8;
VM: UInt8;
Reserved1: UInt8;
LB: UInt8;
LM: UInt8;
GBDMGclock: UInt32;
NESAPUclock: UInt32;
MultiPCMclock: UInt32;
uPD7759clock: UInt32;
OKIM6258clock: UInt32;
_OF: UInt8;
KF: UInt8;
CF: UInt8;
Reserved2: UInt8;
OKIM6295clock: UInt32;
K051649clock: UInt32;
K054539clock: UInt32;
HuC6280clock: UInt32;
C140clock: UInt32;
K053260clock: UInt32;
Pokeyclock: UInt32;
QSoundclock: UInt32;
Reserved3: UInt64;
end;
procedure ExportVGMFile(F: String; TrackName: String; ArtistName: String; Comments: String);
procedure VGMWriteReg(Reg: Integer; Value: Integer);
procedure VGMWait(Amount: Integer);
implementation
uses symparser;
type
// Need to wrap the FC callback in a class because it's declared to be
// "procedure of object" :(
{ TOrderChecker }
TOrderChecker = class
procedure OrderCheckCallback;
procedure TickCallback;
end;
var
SeenOrders: array of record
TimesSeen: Integer;
SampsToReach: Integer;
DataOffset: Integer;
end;
OrderChecker: TOrderChecker;
StartOfSong: Integer;
VGMFile: TFileStream;
TotalWaitSamps: Integer;
CyclesSinceLastTick: Integer;
procedure WriteUtf16String(S: String);
var
Utf16Bytes: TBytes;
begin
if Length(S) > 0 then begin
Utf16Bytes := WideBytesOf(UTF8Decode(S));
VGMFile.WriteBuffer(Utf16Bytes[0], Length(Utf16Bytes));
end;
VGMFile.WriteWord(0);
end;
procedure ExportVGMFile(F: String; TrackName: String; ArtistName: String; Comments: String);
var
OldFD, OldFC, OldF4: TCPUCallback;
Header: TVGMHeader;
YY,MM,DD: Word;
GD3Temp: Integer;
StepCycles: Integer;
begin
// TODO: Manage these callbacks in a better way, maybe some sort of stack.
OldFD := FDCallback;
OldFC := FCCallback;
OldF4 := F4Callback;
FDCallback := nil;
F4Callback := @OrderChecker.TickCallback;
FCCallback := @OrderChecker.OrderCheckCallback;
z80_reset;
ResetSound;
enablesound;
load(ConcatPaths([CacheDir, 'render/preview.gb']));
SetLength(SeenOrders, PeekSymbol(SYM_SONG_DESCRIPTOR, 4) div 2);
StartOfSong := -1;
WritingVGM := True;
VGMFile := TFileStream.Create(F, fmCreate);
Header := Default(TVGMHeader); // Zero the header
VGMFile.WriteBuffer(Header, SizeOf(Header)); // Write dummy header (will overwrite later)
CyclesSinceLastTick := 0;
repeat
StepCycles := z80_decode;
Inc(CyclesSinceLastTick, StepCycles);
until StartOfSong <> -1;
VGMFile.WriteByte($66); // End of data
WritingVGM := False;
// Update the header to point to the GD3 tag, then write it
Header.GD3offset := VGMFile.Position - $14;
VGMFile.WriteDWord($20336447); // 'Gd3 '
VGMFile.WriteDWord($00000100); // Version
GD3Temp := VGMFile.Position;
VGMFile.WriteDWord(0); // dummy value...
DecodeDate(Date, YY, MM, DD);
WriteUtf16String(TrackName); // English track name
WriteUtf16String(''); // Japanese track name
WriteUtf16String(''); // English game name
WriteUtf16String(''); // Japanese game name
WriteUtf16String('Nintendo Game Boy'); // English system name
WriteUtf16String(''); // Japanese system name
WriteUtf16String(ArtistName); // English artist name
WriteUtf16String(''); // Japanese artist name
WriteUtf16String(Format('%d/%.2d/%.2d', [YY, MM, DD])); // Creation date
WriteUtf16String('hUGETracker'); // Program name
WriteUtf16String(''); // Japanese program name
WriteUtf16String(Comments); // Comments
// Go back and overwrite that dummy (unnecessary) length value.
// The VGM and GD3 formats sure are ugly. Not that UGE is any better.
GD3Temp := VGMFile.Position - GD3Temp;
VGMFile.Seek(-GD3Temp, soCurrent);
VGMFile.WriteDWord(GD3Temp);
// Rewrite the header now that we know the correct values
Header.Vgmident := SwapEndian($56676d20); // "Vgm "
Header.Version := $00000161; // 1.61
Header.Rate := 60; // 60hz
Header.GBDMGclock := 4194304; // 4194304 hz (from docs)
Header.EoFoffset := VGMFile.Size - $4;
Header.VGMdataoffset := $8C;
Header.TotalNumsamples := TotalWaitSamps;
Header.LoopNumsamples := TotalWaitSamps - SeenOrders[StartOfSong].SampsToReach;
Header.Loopoffset := SeenOrders[StartOfSong].DataOffset - $1C;
VGMFile.Seek(0, soBeginning);
VGMFile.WriteBuffer(Header, SizeOf(Header));
VGMFile.Free;
SetLength(SeenOrders, 0);
F4Callback := OldF4;
FDCallback := OldFD;
FCCallback := OldFC;
end;
procedure VGMWriteReg(Reg: Integer; Value: Integer);
begin
VGMFile.WriteByte($B3); // Write DMG Reg
VGMFile.WriteByte(Byte(Reg - $FF10));
VGMFile.WriteByte(Byte(Value));
end;
procedure VGMWait(Amount: Integer);
begin
VGMFile.WriteByte($61); // TODO: Use the smaller commands if it matches
VGMFile.WriteWord(Word(Amount));
Inc(TotalWaitSamps, Amount);
end;
{ TOrderChecker }
procedure TOrderChecker.OrderCheckCallback;
var
Ord: Integer;
begin
Ord := (PeekSymbol(SYM_CURRENT_ORDER) div 2);
if (SeenOrders[Ord].TimesSeen = 0) then begin
SeenOrders[Ord].SampsToReach := TotalWaitSamps;
SeenOrders[Ord].DataOffset := VGMFile.Position;
end;
if (SeenOrders[Ord].TimesSeen <> 0) and (StartOfSong = -1) then
StartOfSong := Ord;
Inc(SeenOrders[Ord].TimesSeen);
end;
procedure TOrderChecker.TickCallback;
begin
VGMWait(Trunc((CyclesSinceLastTick / (4194304))*44100.0));
CyclesSinceLastTick := 0;
end;
begin
OrderChecker := TOrderChecker.Create;
end.
|
