Commit ea66f3e

Nick committed on
More WIP Codegen, kinda working playback
commit ea66f3e6dbc04a4b4837bef3e815565c6fcc7175 parent 33b0eb0
15 changed files +371−105
ModifiedGBEmu.lpi +13−1
@@ -75,7 +75,7 @@
75 <PackageName Value="LCL"/> 75 <PackageName Value="LCL"/>
76 </Item10> 76 </Item10>
77 </RequiredPackages> 77 </RequiredPackages>
78 <Units Count="25"> 78 <Units Count="27">
79 <Unit0> 79 <Unit0>
80 <Filename Value="GBEmu.lpr"/> 80 <Filename Value="GBEmu.lpr"/>
81 <IsPartOfProject Value="True"/> 81 <IsPartOfProject Value="True"/>
@@ -203,6 +203,18 @@
203 <IsPartOfProject Value="True"/> 203 <IsPartOfProject Value="True"/>
204 <UnitName Value="Codegen"/> 204 <UnitName Value="Codegen"/>
205 </Unit24> 205 </Unit24>
206 <Unit25>
207 <Filename Value="unit1.pas"/>
208 <IsPartOfProject Value="True"/>
209 <ComponentName Value="Form1"/>
210 <ResourceBaseClass Value="Form"/>
211 <UnitName Value="Unit1"/>
212 </Unit25>
213 <Unit26>
214 <Filename Value="symparser.pas"/>
215 <IsPartOfProject Value="True"/>
216 <UnitName Value="SymParser"/>
217 </Unit26>
206 </Units> 218 </Units>
207 </ProjectOptions> 219 </ProjectOptions>
208 <CompilerOptions> 220 <CompilerOptions>
ModifiedUnitMain.pas +1−1
@@ -305,7 +305,7 @@ begin
305 gb_speed := 1; 305 gb_speed := 1;
306 306
307 frmGameboy.DoubleBuffered := True; 307 frmGameboy.DoubleBuffered := True;
308 SetPaintBox(PaintBox1); 308 //SetPaintBox(PaintBox1);
309 postmessage(handle, wm_user, 0, 0); 309 postmessage(handle, wm_user, 0, 0);
310 310
311 if ParamCount >= 1 then 311 if ParamCount >= 1 then
Modifiedcodegen.pas +98−30
@@ -7,16 +7,14 @@ interface
7 uses 7 uses
8 Classes, SysUtils, math, 8 Classes, SysUtils, math,
9 Waves, Instruments, Song, 9 Waves, Instruments, Song,
10 HugeDatatypes; 10 HugeDatatypes, Constants, dialogs;
11 11
12 function RenderOrderTable(OrderMatrix: TOrderMatrix): String; 12 function RenderOrderTable(OrderMatrix: TOrderMatrix): String;
13
14 function RenderInstruments(Instruments: TInstrumentBank): String; 13 function RenderInstruments(Instruments: TInstrumentBank): String;
15
16 function RenderPattern(Name: String; Pattern: TPattern): String; 14 function RenderPattern(Name: String; Pattern: TPattern): String;
17
18 function RenderWaveforms(Waves: TWaveBank): String; 15 function RenderWaveforms(Waves: TWaveBank): String;
19 16
17 function RenderPreviewRom(Song: TSong): Boolean;
20 procedure RenderSongToFile(Song: TSong; Filename: String); 18 procedure RenderSongToFile(Song: TSong; Filename: String);
21 19
22 //TODO: RenderRoutines 20 //TODO: RenderRoutines
@@ -24,36 +22,35 @@ procedure RenderSongToFile(Song: TSong; Filename: String);
24 implementation 22 implementation
25 23
26 function RenderOrderTable(OrderMatrix: TOrderMatrix): String; 24 function RenderOrderTable(OrderMatrix: TOrderMatrix): String;
27 var
28 I: Integer;
29 Res: TStringList;
30 OrderCnt: Integer;
31
32 function ArrayHelper(Ints: array of Integer): String; 25 function ArrayHelper(Ints: array of Integer): String;
33 var 26 var
34 I: Integer; 27 I: Integer;
35 SL: TStringList; 28 SL: TStringList;
36 begin 29 begin
37 SL := TStringList.Create; 30 SL := TStringList.Create;
31 SL.StrictDelimiter := True;
38 SL.Delimiter := ','; 32 SL.Delimiter := ',';
39 for I := Low(Ints) to High(Ints) do 33 for I := Low(Ints) to High(Ints) do
40 SL.Add('o' + IntToStr(Ints[I])); 34 SL.Add('P'+IntToStr(Ints[I]));
41 Result := SL.DelimitedText; 35 Result := SL.DelimitedText;
42 SL.Free; 36 SL.Free;
43 end; 37 end;
38
39 var
40 Res: TStringList;
41 OrderCnt: Integer;
44 begin 42 begin
45 Res := TStringList.Create; 43 Res := TStringList.Create;
46 Res.Delimiter := #10;
47 OrderCnt := maxvalue([High(OrderMatrix[0]), High(OrderMatrix[1]), 44 OrderCnt := maxvalue([High(OrderMatrix[0]), High(OrderMatrix[1]),
48 High(OrderMatrix[2]), High(OrderMatrix[3])]); 45 High(OrderMatrix[2]), High(OrderMatrix[3])]);
49 46
50 Res.Add(Format('order_cnt: db %s', [OrderCnt*2])); 47 Res.Add('order_cnt: db ' + IntToStr(OrderCnt*2));
51 Res.Add(Format('order1: dw %s', [ArrayHelper(OrderMatrix[0])])); 48 Res.Add('order1: dw ' + ArrayHelper(OrderMatrix[0]));
52 Res.Add(Format('order2: dw %s', [ArrayHelper(OrderMatrix[1])])); 49 Res.Add('order2: dw ' + ArrayHelper(OrderMatrix[1]));
53 Res.Add(Format('order3: dw %s', [ArrayHelper(OrderMatrix[2])])); 50 Res.Add('order3: dw ' + ArrayHelper(OrderMatrix[2]));
54 Res.Add(Format('order4: dw %s', [ArrayHelper(OrderMatrix[3])])); 51 Res.Add('order4: dw ' + ArrayHelper(OrderMatrix[3]));
55 52
56 Result := Res.DelimitedText; 53 Result := Res.GetText;
57 Res.Free; 54 Res.Free;
58 end; 55 end;
59 56
@@ -64,11 +61,11 @@ var
64 I, J: Integer; 61 I, J: Integer;
65 begin 62 begin
66 ResultSL := TStringList.Create; 63 ResultSL := TStringList.Create;
67 ResultSL.Delimiter := #10;
68 64
69 for I := Low(Instruments) to High(Instruments) do begin 65 for I := Low(Instruments) to High(Instruments) do begin
70 AsmInstrument := InstrumentToBytes(Instruments[I]); 66 AsmInstrument := InstrumentToBytes(Instruments[I]);
71 SL := TStringList.Create; 67 SL := TStringList.Create;
68 SL.StrictDelimiter := True;
72 SL.Delimiter := ','; 69 SL.Delimiter := ',';
73 70
74 for J := Low(AsmInstrument) to High(AsmInstrument) do 71 for J := Low(AsmInstrument) to High(AsmInstrument) do
@@ -78,13 +75,44 @@ begin
78 SL.Free; 75 SL.Free;
79 end; 76 end;
80 77
81 Result := ResultSL.DelimitedText; 78 Result := ResultSL.GetText;
82 ResultSL.Free; 79 ResultSL.Free;
83 end; 80 end;
84 81
82 function RenderCell(Cell: TCell): String;
83 var
84 SL: TStringList;
85 begin
86 SL := TStringList.Create;
87 SL.Delimiter := ',';
88 SL.StrictDelimiter := True;
89
90 if Cell.Note = NO_NOTE then
91 SL.Add('___')
92 else
93 SL.Add(NoteToDriverMap.KeyData[Cell.Note]);
94
95 SL.Add(IntToStr(Cell.Instrument));
96 SL.Add('$' + HexStr((Cell.EffectCode shl 8) or Cell.EffectParams.Value, 3));
97
98 // RGBDS thinks you're defining a new macro if you don't have a space first.
99 Result := ' dn ' + SL.DelimitedText;
100 SL.Free;
101 end;
102
85 function RenderPattern(Name: String; Pattern: TPattern): String; 103 function RenderPattern(Name: String; Pattern: TPattern): String;
104 var
105 SL: TStringList;
106 I: Integer;
86 begin 107 begin
108 SL := TStringList.Create;
109 SL.Add(Name + ':');
110
111 for I := Low(TPattern) to High(TPattern) do
112 SL.Add(RenderCell(Pattern[I]));
87 113
114 Result := SL.GetText;
115 SL.Free;
88 end; 116 end;
89 117
90 function RenderWaveforms(Waves: TWaveBank): String; 118 function RenderWaveforms(Waves: TWaveBank): String;
@@ -93,39 +121,79 @@ var
93 I, J: Integer; 121 I, J: Integer;
94 begin 122 begin
95 ResultSL := TStringList.Create; 123 ResultSL := TStringList.Create;
96 ResultSL.Delimiter := #10;
97 124
98 for I := Low(Waves) to High(Waves) do begin 125 for I := Low(Waves) to High(Waves) do begin
99 SL := TStringList.Create; 126 SL := TStringList.Create;
127 SL.StrictDelimiter := True;
100 SL.Delimiter := ','; 128 SL.Delimiter := ',';
101 for J := Low(Waves[I]) to High(Waves[I]) do 129 for J := Low(Waves[I]) to High(Waves[I]) do
102 SL.Add(IntToStr(Waves[I][J])); 130 SL.Add(IntToStr(Waves[I][J]));
103 Result := Format('wave%d: db %s', [I, SL.DelimitedText]); 131 ResultSL.Add(Format('wave%d: db %s', [I, SL.DelimitedText]));
104 SL.Free; 132 SL.Free;
105 end; 133 end;
106 134
107 Result := ResultSL.DelimitedText; 135 Result := ResultSL.GetText;
108 ResultSL.Free; 136 ResultSL.Free;
109 end; 137 end;
110 138
111 procedure RenderSongToFile(Song: TSong; Filename: String); 139 function RenderPreviewROM(Song: TSong): Boolean;
112 var 140 var
113 OutFile: Text; 141 OutFile: Text;
142 I: Integer;
143 label AssemblyError, Cleanup;
114 begin 144 begin
115 Assign(OutFile, 'C:/test/wave'); 145 AssignFile(OutFile, './hUGEDriver/wave.htt');
116 Rewrite(OutFile); 146 Rewrite(OutFile);
117 Write(OutFile, RenderWaveforms(Song.Waves)); 147 Write(OutFile, RenderWaveforms(Song.Waves));
118 Close(OutFile); 148 CloseFile(OutFile);
119 149
120 {Assign(OutFile, 'C:/test/order'); 150 AssignFile(OutFile, './hUGEDriver/order.htt');
121 Rewrite(OutFile); 151 Rewrite(OutFile);
122 Write(RenderOrderTable(Song.Waves)); 152 Write(OutFile, RenderOrderTable(Song.OrderMatrix));
123 Close(OutFile);} 153 CloseFile(OutFile);
124 154
125 Assign(OutFile, 'C:/test/instrument'); 155 AssignFile(OutFile, './hUGEDriver/instrument.htt');
126 Rewrite(OutFile); 156 Rewrite(OutFile);
127 Write(OutFile, RenderInstruments(Song.Instruments)); 157 Write(OutFile, RenderInstruments(Song.Instruments));
128 Close(OutFile); 158 CloseFile(OutFile);
159
160 AssignFile(OutFile, './hUGEDriver/pattern.htt');
161 Rewrite(OutFile);
162
163 for I := 0 to Song.Patterns.Count-1 do
164 Write(OutFile, RenderPattern('P'+IntToStr(I), Song.Patterns.Data[I]^));
165
166 CloseFile(OutFile);
167
168 // Assemble the ROM
169 Chdir('hUGEDriver');
170
171 if ExecuteProcess(('rgbasm'),
172 '-opreview.obj driverLite.z80', []) <> 0 then
173 goto AssemblyError;
174
175 if ExecuteProcess(('rgblink'),
176 '-mpreview.map -npreview.sym -opreview.gb preview.obj', []) <> 0 then
177 goto AssemblyError;
178
179 if ExecuteProcess(('rgbfix'),
180 '-p0 -v preview.gb', []) <> 0 then
181 goto AssemblyError;
182
183 Result := True;
184 goto Cleanup;
185
186 // Eh, screw good practice. How bad can it be?
187 AssemblyError:
188 Result := False;
189 MessageDlg('Error!', 'There was an error assembling the song for playback. Write the rest of this dialog.', mtError, [mbOK], 0);
190
191 Cleanup:
192 Chdir('..');
193 end;
194
195 procedure RenderSongToFile(Song: TSong; Filename: String);
196 begin
129 end; 197 end;
130 198
131 end. 199 end.
Modifiedconstants.pas +76−0
@@ -185,6 +185,7 @@ const
185 185
186 var 186 var
187 NoteMap: TNoteMap; 187 NoteMap: TNoteMap;
188 NoteToDriverMap: TNoteMap;
188 Keybindings: TKeybindings; 189 Keybindings: TKeybindings;
189 NotesToFreqs: TNoteToFreqMap; 190 NotesToFreqs: TNoteToFreqMap;
190 NoteToCodeMap: TNoteToCodeMap; 191 NoteToCodeMap: TNoteToCodeMap;
@@ -203,6 +204,8 @@ end;
203 204
204 begin 205 begin
205 NoteMap := TNoteMap.Create; 206 NoteMap := TNoteMap.Create;
207 NoteToDriverMap := TNoteMap.Create;
208
206 Keybindings := TKeybindings.Create; 209 Keybindings := TKeybindings.Create;
207 NotesToFreqs := TNoteToFreqMap.Create; 210 NotesToFreqs := TNoteToFreqMap.Create;
208 NoteToCodeMap := TNoteToCodeMap.Create; 211 NoteToCodeMap := TNoteToCodeMap.Create;
@@ -388,5 +391,78 @@ begin
388 NoteMap.add(As8, 'A#8'); 391 NoteMap.add(As8, 'A#8');
389 NoteMap.add(B_8, 'B-8'); 392 NoteMap.add(B_8, 'B-8');
390 393
394 NoteToDriverMap.add(C_3, 'C_3');
395 NoteToDriverMap.add(Cs3, 'C#3');
396 NoteToDriverMap.add(D_3, 'D_3');
397 NoteToDriverMap.add(Ds3, 'D#3');
398 NoteToDriverMap.add(E_3, 'E_3');
399 NoteToDriverMap.add(F_3, 'F_3');
400 NoteToDriverMap.add(Fs3, 'F#3');
401 NoteToDriverMap.add(G_3, 'G_3');
402 NoteToDriverMap.add(Gs3, 'G#3');
403 NoteToDriverMap.add(A_3, 'A_3');
404 NoteToDriverMap.add(As3, 'A#3');
405 NoteToDriverMap.add(B_3, 'B_3');
406 NoteToDriverMap.add(C_4, 'C_4');
407 NoteToDriverMap.add(Cs4, 'C#4');
408 NoteToDriverMap.add(D_4, 'D_4');
409 NoteToDriverMap.add(Ds4, 'D#4');
410 NoteToDriverMap.add(E_4, 'E_4');
411 NoteToDriverMap.add(F_4, 'F_4');
412 NoteToDriverMap.add(Fs4, 'F#4');
413 NoteToDriverMap.add(G_4, 'G_4');
414 NoteToDriverMap.add(Gs4, 'G#4');
415 NoteToDriverMap.add(A_4, 'A_4');
416 NoteToDriverMap.add(As4, 'A#4');
417 NoteToDriverMap.add(B_4, 'B_4');
418 NoteToDriverMap.add(C_5, 'C_5');
419 NoteToDriverMap.add(Cs5, 'C#5');
420 NoteToDriverMap.add(D_5, 'D_5');
421 NoteToDriverMap.add(Ds5, 'D#5');
422 NoteToDriverMap.add(E_5, 'E_5');
423 NoteToDriverMap.add(F_5, 'F_5');
424 NoteToDriverMap.add(Fs5, 'F#5');
425 NoteToDriverMap.add(G_5, 'G_5');
426 NoteToDriverMap.add(Gs5, 'G#5');
427 NoteToDriverMap.add(A_5, 'A_5');
428 NoteToDriverMap.add(As5, 'A#5');
429 NoteToDriverMap.add(B_5, 'B_5');
430 NoteToDriverMap.add(C_6, 'C_6');
431 NoteToDriverMap.add(Cs6, 'C#6');
432 NoteToDriverMap.add(D_6, 'D_6');
433 NoteToDriverMap.add(Ds6, 'D#6');
434 NoteToDriverMap.add(E_6, 'E_6');
435 NoteToDriverMap.add(F_6, 'F_6');
436 NoteToDriverMap.add(Fs6, 'F#6');
437 NoteToDriverMap.add(G_6, 'G_6');
438 NoteToDriverMap.add(Gs6, 'G#6');
439 NoteToDriverMap.add(A_6, 'A_6');
440 NoteToDriverMap.add(As6, 'A#6');
441 NoteToDriverMap.add(B_6, 'B_6');
442 NoteToDriverMap.add(C_7, 'C_7');
443 NoteToDriverMap.add(Cs7, 'C#7');
444 NoteToDriverMap.add(D_7, 'D_7');
445 NoteToDriverMap.add(Ds7, 'D#7');
446 NoteToDriverMap.add(E_7, 'E_7');
447 NoteToDriverMap.add(F_7, 'F_7');
448 NoteToDriverMap.add(Fs7, 'F#7');
449 NoteToDriverMap.add(G_7, 'G_7');
450 NoteToDriverMap.add(Gs7, 'G#7');
451 NoteToDriverMap.add(A_7, 'A_7');
452 NoteToDriverMap.add(As7, 'A#7');
453 NoteToDriverMap.add(B_7, 'B_7');
454 NoteToDriverMap.add(C_8, 'C_8');
455 NoteToDriverMap.add(Cs8, 'C#8');
456 NoteToDriverMap.add(D_8, 'D_8');
457 NoteToDriverMap.add(Ds8, 'D#8');
458 NoteToDriverMap.add(E_8, 'E_8');
459 NoteToDriverMap.add(F_8, 'F_8');
460 NoteToDriverMap.add(Fs8, 'F#8');
461 NoteToDriverMap.add(G_8, 'G_8');
462 NoteToDriverMap.add(Gs8, 'G#8');
463 NoteToDriverMap.add(A_8, 'A_8');
464 NoteToDriverMap.add(As8, 'A#8');
465 NoteToDriverMap.add(B_8, 'B_8');
466
391 467
392 end. 468 end.
Modifiedemulationthread.pas +3−12
@@ -18,7 +18,7 @@ type
18 protected 18 protected
19 procedure Execute; override; 19 procedure Execute; override;
20 public 20 public
21 Constructor Create; 21 Constructor Create(ROM: String);
22 end; 22 end;
23 23
24 implementation 24 implementation
@@ -66,23 +66,14 @@ begin
66 until Terminated; 66 until Terminated;
67 end; 67 end;
68 68
69 constructor TEmulationThread.Create; 69 constructor TEmulationThread.Create(ROM: String);
70 begin 70 begin
71 inherited Create(True); 71 inherited Create(True);
72 FreeOnTerminate := True;
73 z80_reset; 72 z80_reset;
74 ResetSound; 73 ResetSound;
75 enablesound; 74 enablesound;
76 75
77 load('../../halt.gb'); 76 load(ROM);
78
79 {halt_mode := 1;
80 z80_decode;
81 Spokeb($FF1A, $80);
82 z80_decode;
83 Spokeb($FF25, $FF);
84 z80_decode;
85 Spokeb($FF24, $77);}
86 end; 77 end;
87 78
88 end. 79 end.
ModifiedhUGEDriver +1−1
@@ -1 +1 @@
1 Subproject commit ee42f34c9f093a67461adb46984619f47127bdad 1 Subproject commit 59fc8b44612269b03f273683eabb4e23ff1eb876
Modifiedhugedatatypes.pas +7−5
@@ -1,6 +1,6 @@
1 unit HugeDatatypes; 1 unit HugeDatatypes;
2 2
3 {$mode objfpc} 3 {$mode objfpc}{$H+}
4 4
5 interface 5 interface
6 6
@@ -8,12 +8,14 @@ uses
8 Classes, SysUtils, fgl, instruments, waves; 8 Classes, SysUtils, fgl, instruments, waves;
9 9
10 type 10 type
11 TInstrumentBank = array[1..15] of TInstrument; 11 Nibble = $0..$F;
12 TWaveBank = array[0..15] of TWave;
13 12
14 TEffectParams = packed record 13 TInstrumentBank = array[1..15] of TInstrument;
14 TWaveBank = array[0..15] of TWave;
15
16 TEffectParams = bitpacked record
15 case Boolean of 17 case Boolean of
16 True: (Param1, Param2: Byte); 18 True: (Param2, Param1: Nibble);
17 False: (Value: Word); 19 False: (Value: Word);
18 end; 20 end;
19 21
Modifiedinstruments.pas +1−1
@@ -1,6 +1,6 @@
1 unit instruments; 1 unit instruments;
2 2
3 {$mode objfpc} 3 {$mode objfpc}{$H+}
4 4
5 interface 5 interface
6 6
Modifiedmainloop.pas +2−11
@@ -16,23 +16,14 @@ interface
16 uses ExtCtrls; 16 uses ExtCtrls;
17 17
18 function main_loop(a: DWord): DWORD; 18 function main_loop(a: DWord): DWORD;
19 procedure SetPaintBox(pb: TPaintBox);
20 19
21 function z80_decode: byte; pascal; 20 function z80_decode: byte; pascal;
22 procedure z80_reset; 21 procedure z80_reset;
23 22
24 var
25 PaintBox: TPaintBox;
26
27 implementation 23 implementation
28 24
29 uses vars, gfx, machine, z80cpu, sound; 25 uses vars, gfx, machine, z80cpu, sound;
30 26
31 procedure SetPaintBox(pb: TPaintBox);
32 begin
33 PaintBox := pb;
34 end;
35
36 procedure TimerControl; 27 procedure TimerControl;
37 (* 28 (*
38 29
@@ -219,8 +210,8 @@ begin
219 if (old_mode = 0) then 210 if (old_mode = 0) then
220 begin 211 begin
221 make_line_finish(143); 212 make_line_finish(143);
222 if (m_iram[$ff40] and 128) > 0 then 213 //if (m_iram[$ff40] and 128) > 0 then
223 PaintBox.Repaint; 214 //PaintBox.Repaint;
224 vbi_count := vbi_latency; 215 vbi_count := vbi_latency;
225 end; 216 end;
226 make_line_count := -1; 217 make_line_count := -1;
Modifiedsong.pas +3−3
@@ -4,7 +4,7 @@ unit Song;
4 4
5 interface 5 interface
6 6
7 uses instruments, waves, patterns, HugeDatatypes; 7 uses HugeDatatypes;
8 8
9 type 9 type
10 { TSong } 10 { TSong }
@@ -17,8 +17,8 @@ type
17 Instruments: TInstrumentBank; 17 Instruments: TInstrumentBank;
18 Waves: TWaveBank; 18 Waves: TWaveBank;
19 19
20 Patterns: array of TPattern; 20 Patterns: TPatternMap;
21 OrderMatrix: array of integer; 21 OrderMatrix: TOrderMatrix;
22 22
23 TicksPerRow: Integer; 23 TicksPerRow: Integer;
24 end; 24 end;
Addedsymparser.pas +44−0
@@ -0,0 +1,44 @@
1 unit SymParser;
2
3 {$mode objfpc}{$H+}
4
5 interface
6
7 uses
8 Classes, SysUtils, fgl;
9
10 type
11 TSymbolMap = specialize TFPGMap<String, Integer>;
12
13 function ParseSymFile(F: String): TSymbolMap;
14
15 implementation
16
17 function ParseSymFile(F: String): TSymbolMap;
18 var
19 SL: TStringList;
20 SA: TStringArray;
21 S: String;
22 begin
23 Result := TSymbolMap.Create;
24 SL := TStringList.Create;
25 try
26 SL.LoadFromFile(F);
27
28 // Drop the first two lines
29 SL.Delete(0);
30 SL.Delete(0);
31 // Drop the last line
32 SL.Delete(SL.Count-1);
33
34 for S in SL do begin
35 SA := S.Split(' ');
36 Result.Add(SA[1], StrToInt('x'+LeftStr(SA[0], 3)));
37 end;
38 finally
39 SL.Free;
40 end;
41 end;
42
43 end.
44
Modifiedtracker.lfm +18−15
@@ -1,11 +1,11 @@
1 object frmTracker: TfrmTracker 1 object frmTracker: TfrmTracker
2 Left = 799 2 Left = 806
3 Height = 1396 3 Height = 1396
4 Top = 201 4 Top = 188
5 Width = 2208 5 Width = 2212
6 Caption = 'hUGETracker' 6 Caption = 'hUGETracker'
7 ClientHeight = 1362 7 ClientHeight = 1362
8 ClientWidth = 2208 8 ClientWidth = 2212
9 DesignTimePPI = 168 9 DesignTimePPI = 168
10 Menu = MainMenu1 10 Menu = MainMenu1
11 OnCreate = FormCreate 11 OnCreate = FormCreate
@@ -41,18 +41,18 @@ object frmTracker: TfrmTracker
41 Left = 347 41 Left = 347
42 Height = 966 42 Height = 966
43 Top = 353 43 Top = 353
44 Width = 1861 44 Width = 1865
45 Align = alClient 45 Align = alClient
46 BevelOuter = bvNone 46 BevelOuter = bvNone
47 ClientHeight = 966 47 ClientHeight = 966
48 ClientWidth = 1861 48 ClientWidth = 1865
49 ParentFont = False 49 ParentFont = False
50 TabOrder = 2 50 TabOrder = 2
51 object PageControl1: TPageControl 51 object PageControl1: TPageControl
52 Left = 0 52 Left = 0
53 Height = 966 53 Height = 966
54 Top = 0 54 Top = 0
55 Width = 1861 55 Width = 1865
56 ActivePage = PatternTabSheet 56 ActivePage = PatternTabSheet
57 Align = alClient 57 Align = alClient
58 ParentFont = False 58 ParentFont = False
@@ -138,16 +138,16 @@ object frmTracker: TfrmTracker
138 object PatternTabSheet: TTabSheet 138 object PatternTabSheet: TTabSheet
139 Caption = 'Patterns' 139 Caption = 'Patterns'
140 ClientHeight = 923 140 ClientHeight = 923
141 ClientWidth = 1853 141 ClientWidth = 1857
142 ParentFont = False 142 ParentFont = False
143 object Panel3: TPanel 143 object Panel3: TPanel
144 Left = 392 144 Left = 392
145 Height = 923 145 Height = 923
146 Top = 0 146 Top = 0
147 Width = 1461 147 Width = 1465
148 Align = alClient 148 Align = alClient
149 ClientHeight = 923 149 ClientHeight = 923
150 ClientWidth = 1461 150 ClientWidth = 1465
151 ParentFont = False 151 ParentFont = False
152 TabOrder = 0 152 TabOrder = 0
153 object HeaderControl1: THeaderControl 153 object HeaderControl1: THeaderControl
@@ -155,7 +155,7 @@ object frmTracker: TfrmTracker
155 Height = 52 155 Height = 52
156 Hint = 'Left click to mute, right click to solo' 156 Hint = 'Left click to mute, right click to solo'
157 Top = 1 157 Top = 1
158 Width = 1459 158 Width = 1463
159 DragReorder = False 159 DragReorder = False
160 Images = ImageList2 160 Images = ImageList2
161 Sections = < 161 Sections = <
@@ -188,6 +188,7 @@ object frmTracker: TfrmTracker
188 Visible = True 188 Visible = True
189 end> 189 end>
190 OnSectionClick = HeaderControl1SectionClick 190 OnSectionClick = HeaderControl1SectionClick
191 OnSectionResize = HeaderControl1SectionResize
191 Align = alTop 192 Align = alTop
192 ParentFont = False 193 ParentFont = False
193 OnMouseDown = HeaderControl1MouseDown 194 OnMouseDown = HeaderControl1MouseDown
@@ -196,7 +197,7 @@ object frmTracker: TfrmTracker
196 Left = 1 197 Left = 1
197 Height = 869 198 Height = 869
198 Top = 53 199 Top = 53
199 Width = 1459 200 Width = 1463
200 HorzScrollBar.Increment = 1 201 HorzScrollBar.Increment = 1
201 HorzScrollBar.Page = 1 202 HorzScrollBar.Page = 1
202 HorzScrollBar.Smooth = True 203 HorzScrollBar.Smooth = True
@@ -1715,7 +1716,7 @@ object frmTracker: TfrmTracker
1715 Left = 0 1716 Left = 0
1716 Height = 312 1717 Height = 312
1717 Top = 41 1718 Top = 41
1718 Width = 2208 1719 Width = 2212
1719 Align = alTop 1720 Align = alTop
1720 BevelOuter = bvNone 1721 BevelOuter = bvNone
1721 ParentFont = False 1722 ParentFont = False
@@ -1725,7 +1726,7 @@ object frmTracker: TfrmTracker
1725 Left = 0 1726 Left = 0
1726 Height = 43 1727 Height = 43
1727 Top = 1319 1728 Top = 1319
1728 Width = 2208 1729 Width = 2212
1729 AutoHint = True 1730 AutoHint = True
1730 Panels = < 1731 Panels = <
1731 item 1732 item
@@ -1746,7 +1747,7 @@ object frmTracker: TfrmTracker
1746 Left = 0 1747 Left = 0
1747 Height = 41 1748 Height = 41
1748 Top = 0 1749 Top = 0
1749 Width = 2208 1750 Width = 2212
1750 AutoSize = True 1751 AutoSize = True
1751 Caption = 'ToolBar1' 1752 Caption = 'ToolBar1'
1752 EdgeBorders = [ebBottom] 1753 EdgeBorders = [ebBottom]
@@ -1778,6 +1779,7 @@ object frmTracker: TfrmTracker
1778 Top = 0 1779 Top = 0
1779 Caption = 'Play' 1780 Caption = 'Play'
1780 ImageIndex = 74 1781 ImageIndex = 74
1782 OnClick = ToolButton2Click
1781 end 1783 end
1782 object ToolButton3: TToolButton 1784 object ToolButton3: TToolButton
1783 Left = 189 1785 Left = 189
@@ -1790,6 +1792,7 @@ object frmTracker: TfrmTracker
1790 Top = 0 1792 Top = 0
1791 Caption = 'Stop' 1793 Caption = 'Stop'
1792 ImageIndex = 73 1794 ImageIndex = 73
1795 OnClick = ToolButton4Click
1793 end 1796 end
1794 object ToolButton5: TToolButton 1797 object ToolButton5: TToolButton
1795 Left = 343 1798 Left = 343
Modifiedtracker.pas +92−15
@@ -1,6 +1,6 @@
1 unit Tracker; 1 unit Tracker;
2 2
3 {$mode objfpc} 3 {$mode objfpc}{$H+}
4 4
5 interface 5 interface
6 6
@@ -9,7 +9,7 @@ uses
9 Menus, Spin, StdCtrls, ActnList, StdActns, SynEdit, math, Instruments, Waves, 9 Menus, Spin, StdCtrls, ActnList, StdActns, SynEdit, math, Instruments, Waves,
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 ECProgressBar, HugeDatatypes, LCLType, Codegen; 12 ECProgressBar, HugeDatatypes, LCLType, Codegen, SymParser;
13 13
14 type 14 type
15 { TfrmTracker } 15 { TfrmTracker }
@@ -156,6 +156,8 @@ type
156 Shift: TShiftState; X, Y: Integer); 156 Shift: TShiftState; X, Y: Integer);
157 procedure HeaderControl1SectionClick(HeaderControl: TCustomHeaderControl; 157 procedure HeaderControl1SectionClick(HeaderControl: TCustomHeaderControl;
158 Section: THeaderSection); 158 Section: THeaderSection);
159 procedure HeaderControl1SectionResize(HeaderControl: TCustomHeaderControl;
160 Section: THeaderSection);
159 procedure HelpLookupManualExecute(Sender: TObject); 161 procedure HelpLookupManualExecute(Sender: TObject);
160 procedure ArtistEditChange(Sender: TObject); 162 procedure ArtistEditChange(Sender: TObject);
161 procedure CommentMemoChange(Sender: TObject); 163 procedure CommentMemoChange(Sender: TObject);
@@ -196,6 +198,8 @@ type
196 procedure PanicToolButtonClick(Sender: TObject); 198 procedure PanicToolButtonClick(Sender: TObject);
197 procedure PasteActionExecute(Sender: TObject); 199 procedure PasteActionExecute(Sender: TObject);
198 procedure TicksPerRowSpinEditChange(Sender: TObject); 200 procedure TicksPerRowSpinEditChange(Sender: TObject);
201 procedure ToolButton2Click(Sender: TObject);
202 procedure ToolButton4Click(Sender: TObject);
199 procedure ToolButton5Click(Sender: TObject); 203 procedure ToolButton5Click(Sender: TObject);
200 procedure WaveEditNumberSpinnerChange(Sender: TObject); 204 procedure WaveEditNumberSpinnerChange(Sender: TObject);
201 procedure WaveEditPaintBoxMouseDown(Sender: TObject; Button: TMouseButton; 205 procedure WaveEditPaintBoxMouseDown(Sender: TObject; Button: TMouseButton;
@@ -228,16 +232,19 @@ type
228 PreviewingInstrument: Boolean; 232 PreviewingInstrument: Boolean;
229 DrawingWave: Boolean; 233 DrawingWave: Boolean;
230 234
231 Patterns: TPatternMap;
232
233 PatternsNode, InstrumentsNode, WavesNode, RoutinesNode: TTreeNode; 235 PatternsNode, InstrumentsNode, WavesNode, RoutinesNode: TTreeNode;
234 236
237 SymbolTable: TSymbolMap;
238
235 procedure ChangeToSquare; 239 procedure ChangeToSquare;
236 procedure ChangeToWave; 240 procedure ChangeToWave;
237 procedure ChangeToNoise; 241 procedure ChangeToNoise;
238 procedure LoadInstrument(Instr: Integer); 242 procedure LoadInstrument(Instr: Integer);
239 procedure LoadWave(Wave: Integer); 243 procedure LoadWave(Wave: Integer);
240 procedure ReloadPatterns; 244 procedure ReloadPatterns;
245 procedure CopyOrderGridToOrderMatrix;
246 function PeekSymbol(Symbol: String): Integer;
247 procedure ResetEmulationThread;
241 248
242 procedure UpdateUIAfterLoad; 249 procedure UpdateUIAfterLoad;
243 250
@@ -368,9 +375,46 @@ begin
368 OrderEditStringGrid.Cells[I+1, OrderEditStringGrid.Row], 375 OrderEditStringGrid.Cells[I+1, OrderEditStringGrid.Row],
369 OrderNum 376 OrderNum
370 ); 377 );
371 Pat := Patterns.GetOrCreateNew(OrderNum); 378 Pat := Song.Patterns.GetOrCreateNew(OrderNum);
372 TrackerGrid.LoadPattern(I, Pat); 379 TrackerGrid.LoadPattern(I, Pat);
373 end; 380 end;
381
382 CopyOrderGridToOrderMatrix;
383 end;
384
385 procedure TfrmTracker.CopyOrderGridToOrderMatrix;
386 var
387 C, R, OrderNum: Integer;
388 begin
389 // Copy the data in the grid to the song's order matrix. Not super efficient
390 // but it's fast enough
391 with OrderEditStringGrid do begin
392 for C := 0 to 3 do begin
393 SetLength(Song.OrderMatrix[C], RowCount);
394 for R := 0 to RowCount-2 do begin
395 OrderNum := 0;
396 TryStrToInt(Cells[C+1, R+1], OrderNum);
397 Song.OrderMatrix[C, R] := OrderNum;
398 end;
399 end;
400 end;
401 end;
402
403 function TfrmTracker.PeekSymbol(Symbol: String): Integer;
404 begin
405 if SymbolTable = nil then exit;
406 Result := speekb(SymbolTable.KeyData[Symbol]);
407 end;
408
409 procedure TfrmTracker.ResetEmulationThread;
410 begin
411 SymbolTable := nil;
412
413 EmulationThread.Terminate;
414 EmulationThread.WaitFor;
415 EmulationThread.Free;
416 EmulationThread := TEmulationThread.Create('halt.gb');
417 EmulationThread.Start;
374 end; 418 end;
375 419
376 procedure TfrmTracker.LoadInstrument(Instr: Integer); 420 procedure TfrmTracker.LoadInstrument(Instr: Integer);
@@ -603,17 +647,18 @@ begin
603 (Section as THeaderSection).Width := TrackerGrid.ColumnWidth; 647 (Section as THeaderSection).Width := TrackerGrid.ColumnWidth;
604 648
605 // Initialize order table 649 // Initialize order table
606 Patterns := TPatternMap.Create; 650 Song.Patterns := TPatternMap.Create;
607 for I := 0 to 3 do begin 651 for I := 0 to 3 do begin
608 OrderEditStringGrid.Cells[I+1, 1] := IntToStr(I); 652 OrderEditStringGrid.Cells[I+1, 1] := IntToStr(I);
609 TrackerGrid.LoadPattern(I, Patterns.GetOrCreateNew(I)); 653 TrackerGrid.LoadPattern(I, Song.Patterns.GetOrCreateNew(I));
610 end; 654 end;
655 CopyOrderGridToOrderMatrix;
611 656
612 // Manually resize the fixed column in the order editor 657 // Manually resize the fixed column in the order editor
613 OrderEditStringGrid.ColWidths[0]:=50; 658 OrderEditStringGrid.ColWidths[0]:=50;
614 659
615 // Get the emulator ready to make sound... 660 // Get the emulator ready to make sound...
616 EmulationThread := TEmulationThread.Create; 661 EmulationThread := TEmulationThread.Create('halt.gb');
617 EmulationThread.Start; 662 EmulationThread.Start;
618 end; 663 end;
619 664
@@ -715,6 +760,14 @@ begin
715 Section.ImageIndex := (Section.ImageIndex + 1) mod 2; 760 Section.ImageIndex := (Section.ImageIndex + 1) mod 2;
716 end; 761 end;
717 762
763 procedure TfrmTracker.HeaderControl1SectionResize(
764 HeaderControl: TCustomHeaderControl; Section: THeaderSection);
765 begin
766 // Prevent resizing these
767 // TODO: Create a subclass of them that doesn't allow resizing maybe?
768 Section.Width := TrackerGrid.ColumnWidth;
769 end;
770
718 procedure TfrmTracker.FileOpen1Accept(Sender: TObject); 771 procedure TfrmTracker.FileOpen1Accept(Sender: TObject);
719 {var 772 {var
720 F: file of TSong;} 773 F: file of TSong;}
@@ -805,7 +858,7 @@ procedure TfrmTracker.MenuItem17Click(Sender: TObject);
805 var 858 var
806 X, Highest: Integer; 859 X, Highest: Integer;
807 begin 860 begin
808 Highest := Patterns.MaxKey; 861 Highest := Song.Patterns.MaxKey;
809 862
810 with OrderEditStringGrid do 863 with OrderEditStringGrid do
811 InsertRowWithValues( 864 InsertRowWithValues(
@@ -818,7 +871,7 @@ begin
818 ); 871 );
819 872
820 for X := 0 to 3 do 873 for X := 0 to 3 do
821 Patterns.CreateNewPattern(Highest+X); 874 Song.Patterns.CreateNewPattern(Highest+X);
822 end; 875 end;
823 876
824 procedure TfrmTracker.MenuItem18Click(Sender: TObject); 877 procedure TfrmTracker.MenuItem18Click(Sender: TObject);
@@ -880,24 +933,27 @@ procedure TfrmTracker.OrderEditStringGridDblClick(Sender: TObject);
880 var 933 var
881 Highest: Integer; 934 Highest: Integer;
882 begin 935 begin
883 Highest := Patterns.MaxKey; 936 Highest := Song.Patterns.MaxKey;
884 937
885 with OrderEditStringGrid do begin 938 with OrderEditStringGrid do begin
886 Cells[Col, Row] := IntToStr(Highest); 939 Cells[Col, Row] := IntToStr(Highest);
887 TrackerGrid.LoadPattern(Col - 1, Patterns.GetOrCreateNew(Highest)); 940 TrackerGrid.LoadPattern(Col - 1, Song.Patterns.GetOrCreateNew(Highest));
888 end; 941 end;
889 end; 942 end;
890 943
891 procedure TfrmTracker.OrderEditStringGridEditingDone(Sender: TObject); 944 procedure TfrmTracker.OrderEditStringGridEditingDone(Sender: TObject);
892 var 945 var
893 Temp: Integer; 946 Temp: Integer;
947 R, C: Integer;
894 begin 948 begin
895 // TODO: Fix this hack! 949 // TODO: Fix this hack!
896 // For some reason OnValidateEntry is giving bad pointers 950 // For some reason OnValidateEntry is giving bad pointers
897 // for its NewValue and OldValue params. This is the workaround for now. 951 // for its NewValue and OldValue params. This is the workaround for now.
898 with OrderEditStringGrid do 952 with OrderEditStringGrid do begin
899 if not TryStrToInt(Cells[Col, Row], Temp) then Cells[Col, Row] := ''; 953 if not TryStrToInt(Cells[Col, Row], Temp) then
900 954 Cells[Col, Row] := ''
955 else;
956 end;
901 ReloadPatterns; 957 ReloadPatterns;
902 end; 958 end;
903 959
@@ -933,6 +989,27 @@ begin
933 Song.TicksPerRow := TicksPerRowSpinEdit.Value; 989 Song.TicksPerRow := TicksPerRowSpinEdit.Value;
934 end; 990 end;
935 991
992 procedure TfrmTracker.ToolButton2Click(Sender: TObject);
993 begin
994 if RenderPreviewROM(Song) then begin
995 // Load the new symbol table
996 SymbolTable := ParseSymFile('hUGEDriver/preview.sym');
997
998 // Start emulation on the rendered preview binary
999 EmulationThread.Terminate;
1000 EmulationThread.WaitFor;
1001 EmulationThread.Free;
1002 EmulationThread := TEmulationThread.Create('hUGEDriver/preview.gb');
1003 EmulationThread.Start;
1004 end
1005 else ResetEmulationThread;
1006 end;
1007
1008 procedure TfrmTracker.ToolButton4Click(Sender: TObject);
1009 begin
1010 ResetEmulationThread;
1011 end;
1012
936 procedure TfrmTracker.ToolButton5Click(Sender: TObject); 1013 procedure TfrmTracker.ToolButton5Click(Sender: TObject);
937 begin 1014 begin
938 if SaveDialog1.Execute then begin 1015 if SaveDialog1.Execute then begin
Modifiedtrackergrid.pas +11−9
@@ -82,7 +82,7 @@ type
82 function SelectionsToRect(S1, S2: TSelectionPos): TRect; 82 function SelectionsToRect(S1, S2: TSelectionPos): TRect;
83 function SelectionToRect(Selection: TSelectionPos): TRect; 83 function SelectionToRect(Selection: TSelectionPos): TRect;
84 function MousePosToSelection(X, Y: Integer): TSelectionPos; 84 function MousePosToSelection(X, Y: Integer): TSelectionPos;
85 function KeycodeToHexNumber(Key: Word; out Num: Byte): Boolean; overload; 85 function KeycodeToHexNumber(Key: Word; out Num: Nibble): Boolean; overload;
86 function KeycodeToHexNumber(Key: Word; out Num: Integer): Boolean; overload; 86 function KeycodeToHexNumber(Key: Word; out Num: Integer): Boolean; overload;
87 public 87 public
88 Cursor, Other: TSelectionPos; 88 Cursor, Other: TSelectionPos;
@@ -101,6 +101,7 @@ constructor TTrackerGrid.Create(
101 begin 101 begin
102 inherited Create(AOwner); 102 inherited Create(AOwner);
103 103
104 DoubleBuffered := True;
104 ControlStyle := ControlStyle + [csCaptureMouse, csClickEvents, csDoubleClicks]; 105 ControlStyle := ControlStyle + [csCaptureMouse, csClickEvents, csDoubleClicks];
105 Self.Parent := Parent; 106 Self.Parent := Parent;
106 107
@@ -312,11 +313,11 @@ end;
312 313
313 procedure TTrackerGrid.InputInstrument(Key: Word); 314 procedure TTrackerGrid.InputInstrument(Key: Word);
314 var 315 var
315 Temp: Byte; 316 Temp: Nibble;
316 begin 317 begin
317 with Patterns[Cursor.X]^[Cursor.Y] do 318 with Patterns[Cursor.X]^[Cursor.Y] do
318 if Key = VK_DELETE then Instrument := 0 319 if Key = VK_DELETE then Instrument := 0
319 else if KeycodeToHexNumber(Key, Temp) and (Temp < 9) then 320 else if KeycodeToHexNumber(Key, Temp) and (Temp <= 9) then
320 Instrument := ((Instrument mod 10) * 10) + Temp; 321 Instrument := ((Instrument mod 10) * 10) + Temp;
321 end; 322 end;
322 323
@@ -337,7 +338,7 @@ end;
337 338
338 procedure TTrackerGrid.InputEffectParams(Key: Word); 339 procedure TTrackerGrid.InputEffectParams(Key: Word);
339 var 340 var
340 Temp: Byte; 341 Temp: Nibble;
341 begin 342 begin
342 with Patterns[Cursor.X]^[Cursor.Y] do 343 with Patterns[Cursor.X]^[Cursor.Y] do
343 if Key = VK_DELETE then begin 344 if Key = VK_DELETE then begin
@@ -351,9 +352,10 @@ begin
351 DigitInputting := True; 352 DigitInputting := True;
352 end; 353 end;
353 end 354 end
354 else 355 else if KeycodeToHexNumber(Key, Temp) then begin
355 if KeycodeToHexNumber(Key, EffectParams.Param2) then 356 EffectParams.Param2 := Temp;
356 DigitInputting := False; 357 DigitInputting := False;
358 end;
357 end; 359 end;
358 360
359 procedure TTrackerGrid.RenderRow(Row: Integer); 361 procedure TTrackerGrid.RenderRow(Row: Integer);
@@ -495,7 +497,7 @@ begin
495 end; 497 end;
496 end; 498 end;
497 499
498 function TTrackerGrid.KeycodeToHexNumber(Key: Word; out Num: Byte): Boolean; 500 function TTrackerGrid.KeycodeToHexNumber(Key: Word; out Num: Nibble): Boolean;
499 begin 501 begin
500 Result := True; 502 Result := True;
501 503
@@ -522,7 +524,7 @@ end;
522 524
523 function TTrackerGrid.KeycodeToHexNumber(Key: Word; out Num: Integer): Boolean; 525 function TTrackerGrid.KeycodeToHexNumber(Key: Word; out Num: Integer): Boolean;
524 var 526 var
525 X: Byte; 527 X: Nibble;
526 begin 528 begin
527 Result := KeycodeToHexNumber(Key, X); 529 Result := KeycodeToHexNumber(Key, X);
528 Num := X; 530 Num := X;
Modifiedutils.pas +1−1
@@ -1,6 +1,6 @@
1 unit Utils; 1 unit Utils;
2 2
3 {$mode objfpc} 3 {$mode objfpc}{$H+}
4 4
5 interface 5 interface
6 6