Commit e412a9d

Nick committed on
Loading/saving, fixed some bugs
commit e412a9db37848b9389a8fa988e10d833556a698c parent 3b678d8
4 changed files +209−62
Modifiedsong.pas +72−3
@@ -4,7 +4,7 @@ unit Song;
4 4
5 interface 5 interface
6 6
7 uses HugeDatatypes; 7 uses Classes, HugeDatatypes;
8 8
9 type 9 type
10 { TSong } 10 { TSong }
@@ -17,13 +17,82 @@ type
17 Instruments: TInstrumentBank; 17 Instruments: TInstrumentBank;
18 Waves: TWaveBank; 18 Waves: TWaveBank;
19 19
20 TicksPerRow: Integer;
21
20 Patterns: TPatternMap; 22 Patterns: TPatternMap;
21 OrderMatrix: TOrderMatrix; 23 OrderMatrix: TOrderMatrix;
22
23 TicksPerRow: Integer;
24 end; 24 end;
25 25
26 procedure WriteSongToStream(S: TStream; const ASong: TSong);
27 procedure ReadSongFromStream(S: TStream; var ASong: TSong);
28
26 implementation 29 implementation
27 30
31 // Thanks to WP on the FreePascal forums for this code!
32 // https://forum.lazarus.freepascal.org/index.php/topic,47892.msg344152.html#msg344152
33
34 procedure WriteSongToStream(S: TStream; const ASong: TSong);
35 var
36 i, n: Integer;
37 pPat: PPattern;
38 begin
39 // Write the fixed record elements first
40 n := SizeOf(TSong) - SizeOf(TPatternMap) - SizeOf(TOrderMatrix);
41 S.Write(ASong, n);
42
43 // Write the pattern count
44 S.Write(ASong.Patterns.Count, SizeOf(Integer));
45 // Write the patterns
46 for i := 0 to ASong.Patterns.Count-1 do
47 begin
48 pPat := ASong.Patterns[i];
49 S.Write(pPat^, SizeOf(pPat^));
50 end;
51
52 // Write the OrderMatrix arrays
53 for i := 0 to 3 do
54 begin
55 n := Length(ASong.OrderMatrix[i]);
56 S.Write(n, SizeOf(Integer));
57 S.Write(ASong.OrderMatrix[i][0], n*SizeOf(Integer));
58 end;
59 end;
60
61 procedure ReadSongFromStream(S: TStream; var ASong: TSong);
62 var
63 i, n: Integer;
64 pat: PPattern;
65 begin
66 // Read the fixed elements first
67 n := SizeOf(TSong) - SizeOf(TPatternMap) - SizeOf(TOrderMatrix);
68 S.Read(ASong, n);
69
70 // ASong.Patterns.Clear;
71
72 // Create the patterns
73 ASong.Patterns := TPatternMap.Create;
74 // Read the pattern count
75 S.Read(n, SizeOf(Integer));
76 for i:=0 to n - 1 do begin
77 // Allocate memory for each pattern ...
78 New(pat);
79 // and read the pattern content
80 S.Read(pat^, SizeOf(TPattern));
81 // Add the pattern to the list
82 ASong.Patterns.Add(i, pat);
83 end;
84
85 // Read the OrderMatrix
86 for i := 0 to 3 do
87 begin
88 // Read length of each OrderMatrix array
89 S.Read(n, SizeOf(Integer));
90 // Allocate memory for it
91 SetLength(ASong.OrderMatrix[i], n);
92 // Read content of OrderMatrix array
93 S.Read(ASong.OrderMatrix[i, 0], n*SizeOf(Integer));
94 end;
95 end;
96
28 end. 97 end.
29 98
Modifiedtracker.lfm +26−26
@@ -1,7 +1,7 @@
1 object frmTracker: TfrmTracker 1 object frmTracker: TfrmTracker
2 Left = 666 2 Left = 862
3 Height = 1396 3 Height = 1396
4 Top = 161 4 Top = 197
5 Width = 2212 5 Width = 2212
6 Caption = 'hUGETracker' 6 Caption = 'hUGETracker'
7 ClientHeight = 1362 7 ClientHeight = 1362
@@ -53,15 +53,15 @@ object frmTracker: TfrmTracker
53 Height = 966 53 Height = 966
54 Top = 0 54 Top = 0
55 Width = 1865 55 Width = 1865
56 ActivePage = PatternTabSheet 56 ActivePage = WavesTabSheet
57 Align = alClient 57 Align = alClient
58 ParentFont = False 58 ParentFont = False
59 TabIndex = 1 59 TabIndex = 3
60 TabOrder = 0 60 TabOrder = 0
61 object GeneralTabSheet: TTabSheet 61 object GeneralTabSheet: TTabSheet
62 Caption = 'General' 62 Caption = 'General'
63 ClientHeight = 1041 63 ClientHeight = 923
64 ClientWidth = 1853 64 ClientWidth = 1857
65 ParentFont = False 65 ParentFont = False
66 object SongInformationGroupbox: TGroupBox 66 object SongInformationGroupbox: TGroupBox
67 Left = 14 67 Left = 14
@@ -279,18 +279,18 @@ object frmTracker: TfrmTracker
279 end 279 end
280 object InstrumentTabSheet: TTabSheet 280 object InstrumentTabSheet: TTabSheet
281 Caption = 'Instruments' 281 Caption = 'Instruments'
282 ClientHeight = 1041 282 ClientHeight = 923
283 ClientWidth = 1853 283 ClientWidth = 1857
284 ParentFont = False 284 ParentFont = False
285 object PaintBox1: TPaintBox 285 object PaintBox1: TPaintBox
286 AnchorSideTop.Control = FlowPanel1 286 AnchorSideTop.Control = FlowPanel1
287 AnchorSideTop.Side = asrBottom 287 AnchorSideTop.Side = asrBottom
288 AnchorSideBottom.Side = asrBottom 288 AnchorSideBottom.Side = asrBottom
289 Left = 0 289 Left = 0
290 Height = 459 290 Height = 341
291 Hint = 'Preview of how the resulting waveform will look with envelope applied' 291 Hint = 'Preview of how the resulting waveform will look with envelope applied'
292 Top = 582 292 Top = 582
293 Width = 1853 293 Width = 1857
294 Align = alClient 294 Align = alClient
295 Color = clBlack 295 Color = clBlack
296 ParentColor = False 296 ParentColor = False
@@ -301,7 +301,7 @@ object frmTracker: TfrmTracker
301 Left = 0 301 Left = 0
302 Height = 582 302 Height = 582
303 Top = 0 303 Top = 0
304 Width = 1853 304 Width = 1857
305 Align = alTop 305 Align = alTop
306 AutoSize = True 306 AutoSize = True
307 BevelOuter = bvNone 307 BevelOuter = bvNone
@@ -1071,16 +1071,16 @@ object frmTracker: TfrmTracker
1071 end 1071 end
1072 object WavesTabSheet: TTabSheet 1072 object WavesTabSheet: TTabSheet
1073 Caption = 'Waves' 1073 Caption = 'Waves'
1074 ClientHeight = 892 1074 ClientHeight = 923
1075 ClientWidth = 1587 1075 ClientWidth = 1857
1076 ParentFont = False 1076 ParentFont = False
1077 object WaveEditPaintBox: TPaintBox 1077 object WaveEditPaintBox: TPaintBox
1078 AnchorSideTop.Control = WaveEditGroupBox 1078 AnchorSideTop.Control = WaveEditGroupBox
1079 AnchorSideTop.Side = asrBottom 1079 AnchorSideTop.Side = asrBottom
1080 Left = 0 1080 Left = 0
1081 Height = 652 1081 Height = 643
1082 Top = 240 1082 Top = 280
1083 Width = 1587 1083 Width = 1857
1084 Align = alBottom 1084 Align = alBottom
1085 Anchors = [akTop, akLeft, akRight, akBottom] 1085 Anchors = [akTop, akLeft, akRight, akBottom]
1086 BorderSpacing.Top = 23 1086 BorderSpacing.Top = 23
@@ -1102,16 +1102,16 @@ object frmTracker: TfrmTracker
1102 TabOrder = 0 1102 TabOrder = 0
1103 object Label20: TLabel 1103 object Label20: TLabel
1104 Left = 28 1104 Left = 28
1105 Height = 25 1105 Height = 30
1106 Top = 28 1106 Top = 28
1107 Width = 43 1107 Width = 51
1108 Caption = 'Wave' 1108 Caption = 'Wave'
1109 ParentColor = False 1109 ParentColor = False
1110 ParentFont = False 1110 ParentFont = False
1111 end 1111 end
1112 object WaveEditNumberSpinner: TSpinEdit 1112 object WaveEditNumberSpinner: TSpinEdit
1113 Left = 112 1113 Left = 112
1114 Height = 33 1114 Height = 38
1115 Top = 14 1115 Top = 14
1116 Width = 140 1116 Width = 140
1117 MaxValue = 15 1117 MaxValue = 15
@@ -1143,16 +1143,16 @@ object frmTracker: TfrmTracker
1143 end 1143 end
1144 object CommentsTabSheet: TTabSheet 1144 object CommentsTabSheet: TTabSheet
1145 Caption = 'Comments' 1145 Caption = 'Comments'
1146 ClientHeight = 892 1146 ClientHeight = 923
1147 ClientWidth = 1587 1147 ClientWidth = 1857
1148 ParentFont = False 1148 ParentFont = False
1149 object CommentMemo: TMemo 1149 object CommentMemo: TMemo
1150 AnchorSideTop.Control = Label17 1150 AnchorSideTop.Control = Label17
1151 AnchorSideTop.Side = asrBottom 1151 AnchorSideTop.Side = asrBottom
1152 Left = 0 1152 Left = 0
1153 Height = 835 1153 Height = 856
1154 Top = 57 1154 Top = 67
1155 Width = 1587 1155 Width = 1857
1156 Align = alBottom 1156 Align = alBottom
1157 Anchors = [akTop, akLeft, akRight, akBottom] 1157 Anchors = [akTop, akLeft, akRight, akBottom]
1158 BorderSpacing.Top = 23 1158 BorderSpacing.Top = 23
@@ -1162,9 +1162,9 @@ object frmTracker: TfrmTracker
1162 end 1162 end
1163 object Label17: TLabel 1163 object Label17: TLabel
1164 Left = 14 1164 Left = 14
1165 Height = 25 1165 Height = 30
1166 Top = 14 1166 Top = 14
1167 Width = 500 1167 Width = 587
1168 Caption = 'This is an area to write comments for anyone editing your tune.' 1168 Caption = 'This is an area to write comments for anyone editing your tune.'
1169 ParentColor = False 1169 ParentColor = False
1170 ParentFont = False 1170 ParentFont = False
Modifiedtracker.pas +75−20
@@ -231,6 +231,7 @@ type
231 PreviewingInstrument: Boolean; 231 PreviewingInstrument: Boolean;
232 DrawingWave: Boolean; 232 DrawingWave: Boolean;
233 Playing: Boolean; 233 Playing: Boolean;
234 LoadingFile: Boolean;
234 235
235 PatternsNode, InstrumentsNode, WavesNode, RoutinesNode: TTreeNode; 236 PatternsNode, InstrumentsNode, WavesNode, RoutinesNode: TTreeNode;
236 237
@@ -243,10 +244,12 @@ type
243 procedure LoadWave(Wave: Integer); 244 procedure LoadWave(Wave: Integer);
244 procedure ReloadPatterns; 245 procedure ReloadPatterns;
245 procedure CopyOrderGridToOrderMatrix; 246 procedure CopyOrderGridToOrderMatrix;
247 procedure CopyOrderMatrixToOrderGrid;
246 function PeekSymbol(Symbol: String): Integer; 248 function PeekSymbol(Symbol: String): Integer;
247 procedure ResetEmulationThread; 249 procedure ResetEmulationThread;
248 procedure OnFD; 250 procedure OnFD;
249 251
252 procedure RecreateTrackerGrid;
250 procedure UpdateUIAfterLoad; 253 procedure UpdateUIAfterLoad;
251 254
252 procedure DrawWaveform(PB: TPaintBox; Wave: TWave); 255 procedure DrawWaveform(PB: TPaintBox; Wave: TWave);
@@ -267,6 +270,7 @@ implementation
267 270
268 procedure TfrmTracker.UpdateUIAfterLoad; 271 procedure TfrmTracker.UpdateUIAfterLoad;
269 begin 272 begin
273 LoadingFile := True; // HACK!!!!!
270 LoadInstrument(1); 274 LoadInstrument(1);
271 LoadWave(0); 275 LoadWave(0);
272 276
@@ -275,6 +279,14 @@ begin
275 CommentMemo.Text := Song.Comment; 279 CommentMemo.Text := Song.Comment;
276 280
277 TicksPerRowSpinEdit.Value := Song.TicksPerRow; 281 TicksPerRowSpinEdit.Value := Song.TicksPerRow;
282
283 RecreateTrackerGrid;
284 CopyOrderMatrixToOrderGrid;
285
286 LoadingFile := False; // HACK!!!!
287
288 OrderEditStringGrid.Row := 1;
289 ReloadPatterns;
278 end; 290 end;
279 291
280 procedure TfrmTracker.DrawWaveform(PB: TPaintBox; Wave: TWave); 292 procedure TfrmTracker.DrawWaveform(PB: TPaintBox; Wave: TWave);
@@ -369,6 +381,8 @@ var
369 I: Integer; 381 I: Integer;
370 OrderNum: Integer; 382 OrderNum: Integer;
371 begin 383 begin
384 if LoadingFile then Exit;
385
372 for I := 0 to 3 do begin 386 for I := 0 to 3 do begin
373 OrderNum := 0; 387 OrderNum := 0;
374 TryStrToInt( 388 TryStrToInt(
@@ -399,6 +413,38 @@ begin
399 end; 413 end;
400 end; 414 end;
401 415
416 procedure TfrmTracker.CopyOrderMatrixToOrderGrid;
417
418 function IntToStr_(X: Integer): String;
419 begin
420 if X = 0 then Result := '' else Result := IntToStr(X);
421 end;
422
423 var
424 MaxRows, C, R: Integer;
425 begin
426 MaxRows := -1;
427 OrderEditStringGrid.Clean([gzNormal]);
428
429 for C := Low(TOrderMatrix) to High(TOrderMatrix) do
430 if Length(Song.OrderMatrix[C]) > MaxRows then
431 MaxRows := Length(Song.OrderMatrix[C]);
432
433 OrderEditStringGrid.RowCount := MaxRows;
434
435 for C := Low(Song.OrderMatrix) to High(Song.OrderMatrix) do begin
436 for R := 0 to High(Song.OrderMatrix[C])-1 do
437 OrderEditStringGrid.Cells[C+1, R+1] := IntToStr_(Song.OrderMatrix[C, R]);
438 end;
439
440 // Show zeroes where they belong
441 for R := 1 to OrderEditStringGrid.RowCount-1 do
442 if Trim(OrderEditStringGrid.Rows[R].Text) <> '' then
443 for C := 1 to OrderEditStringGrid.ColCount-1 do
444 if OrderEditStringGrid.Cells[C, R] = '' then
445 OrderEditStringGrid.Cells[C, R] := '0';
446 end;
447
402 function TfrmTracker.PeekSymbol(Symbol: String): Integer; 448 function TfrmTracker.PeekSymbol(Symbol: String): Integer;
403 begin 449 begin
404 if SymbolTable = nil then exit; 450 if SymbolTable = nil then exit;
@@ -426,6 +472,12 @@ begin
426 TrackerGrid.HighlightedRow:=PeekSymbol(SYM_ROW); 472 TrackerGrid.HighlightedRow:=PeekSymbol(SYM_ROW);
427 end; 473 end;
428 474
475 procedure TfrmTracker.RecreateTrackerGrid;
476 begin
477 if TrackerGrid <> nil then TrackerGrid.Free;
478 TrackerGrid := TTrackerGrid.Create(Self, ScrollBox1, Song.Patterns);
479 end;
480
429 procedure TfrmTracker.LoadInstrument(Instr: Integer); 481 procedure TfrmTracker.LoadInstrument(Instr: Integer);
430 var 482 var
431 CI: ^TInstrument; 483 CI: ^TInstrument;
@@ -619,8 +671,7 @@ begin
619 671
620 // Create pattern editor control 672 // Create pattern editor control
621 Song.Patterns := TPatternMap.Create; 673 Song.Patterns := TPatternMap.Create;
622 TrackerGrid := TTrackerGrid.Create(Self, ScrollBox1, Song.Patterns); 674 RecreateTrackerGrid;
623
624 675
625 // Fix the size of the channel headers 676 // Fix the size of the channel headers
626 for Section in HeaderControl1.Sections do 677 for Section in HeaderControl1.Sections do
@@ -738,13 +789,29 @@ begin
738 end; 789 end;
739 790
740 procedure TfrmTracker.FileSaveAs1Accept(Sender: TObject); 791 procedure TfrmTracker.FileSaveAs1Accept(Sender: TObject);
741 {var 792 var
742 F: file of TSong;} 793 Stream: TStream;
743 begin 794 begin
744 {AssignFile(F, FileSaveAs1.Dialog.FileName); 795 stream := TFileStream.Create(FileSaveAs1.Dialog.FileName, fmCreate);
745 Rewrite(F); 796 try
746 Write(F, Song); 797 WriteSongToStream(stream, Song);
747 CloseFile(F);} 798 finally
799 stream.Free;
800 end;
801 end;
802
803 procedure TfrmTracker.FileOpen1Accept(Sender: TObject);
804 var
805 Stream: TStream;
806 begin
807 stream := TFileStream.Create(FileOpen1.Dialog.FileName, fmOpenRead);
808 try
809 ReadSongFromStream(stream, Song);
810 finally
811 stream.Free;
812 end;
813
814 UpdateUIAfterLoad;
748 end; 815 end;
749 816
750 procedure TfrmTracker.HeaderControl1MouseDown(Sender: TObject; 817 procedure TfrmTracker.HeaderControl1MouseDown(Sender: TObject;
@@ -787,18 +854,6 @@ begin
787 Section.Width := TrackerGrid.ColumnWidth; 854 Section.Width := TrackerGrid.ColumnWidth;
788 end; 855 end;
789 856
790 procedure TfrmTracker.FileOpen1Accept(Sender: TObject);
791 {var
792 F: file of TSong;}
793 begin
794 {AssignFile(F, FileOpen1.Dialog.FileName);
795 Reset(F);
796 Read(F, Song);
797 CloseFile(F);
798
799 UpdateUIAfterLoad;}
800 end;
801
802 procedure TfrmTracker.CutActionExecute(Sender: TObject); 857 procedure TfrmTracker.CutActionExecute(Sender: TObject);
803 begin 858 begin
804 PostMessage(Screen.ActiveControl.Handle, LM_CUT, 0, 0); 859 PostMessage(Screen.ActiveControl.Handle, LM_CUT, 0, 0);
Modifiedtrackergrid.pas +36−13
@@ -43,11 +43,6 @@ type
43 { TTrackerGrid } 43 { TTrackerGrid }
44 44
45 TTrackerGrid = class(TCustomControl) 45 TTrackerGrid = class(TCustomControl)
46 constructor Create(
47 AOwner: TComponent;
48 Parent: TWinControl;
49 PatternMap: TPatternMap); reintroduce;
50
51 procedure Paint; override; 46 procedure Paint; override;
52 procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 47 procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
53 override; 48 override;
@@ -117,6 +112,13 @@ type
117 function GetAt(SelectionPos: TSelectionPos): Integer; 112 function GetAt(SelectionPos: TSelectionPos): Integer;
118 procedure SetAt(SelectionPos: TSelectionPos; Value: Integer); 113 procedure SetAt(SelectionPos: TSelectionPos; Value: Integer);
119 procedure ClearAt(SelectionPos: TSelectionPos); 114 procedure ClearAt(SelectionPos: TSelectionPos);
115
116 constructor Create(
117 AOwner: TComponent;
118 Parent: TWinControl;
119 PatternMap: TPatternMap); reintroduce;
120 destructor Destroy; override;
121
120 end; 122 end;
121 123
122 implementation 124 implementation
@@ -154,6 +156,14 @@ begin
154 Height := RowHeight*64; 156 Height := RowHeight*64;
155 end; 157 end;
156 158
159 destructor TTrackerGrid.Destroy;
160 begin
161 inherited Destroy;
162
163 Performed.Free;
164 Recall.Free;
165 end;
166
157 procedure TTrackerGrid.Paint; 167 procedure TTrackerGrid.Paint;
158 var 168 var
159 I: Integer; 169 I: Integer;
@@ -237,6 +247,8 @@ procedure TTrackerGrid.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
237 begin 247 begin
238 inherited MouseUp(Button, Shift, X, Y); 248 inherited MouseUp(Button, Shift, X, Y);
239 249
250 NormalizeCursors;
251
240 MouseButtonDown := False; 252 MouseButtonDown := False;
241 DigitInputting := False; 253 DigitInputting := False;
242 end; 254 end;
@@ -245,18 +257,26 @@ procedure TTrackerGrid.KeyDown(var Key: Word; Shift: TShiftState);
245 begin 257 begin
246 inherited KeyDown(Key, Shift); 258 inherited KeyDown(Key, Shift);
247 259
248 case Key of 260 if Key in [VK_CONTROL, VK_SHIFT] then Exit;
249 VK_Z: if ssCtrl in Shift then DoUndo; 261
250 VK_Y: if ssCtrl in Shift then DoRedo; 262 if ssCtrl in Shift then
251 VK_V: if ssShift in Shift then DoRepeatPaste; 263 case Key of
252 VK_L: begin 264 VK_Z: DoUndo;
253 if ssCtrl in Shift then begin 265 VK_Y: DoRedo;
266 VK_L: begin
254 Cursor.Y := 0; 267 Cursor.Y := 0;
255 Other.Y := High(TPattern); 268 Other.Y := High(TPattern);
256 Cursor.SelectedPart := Low(TCellPart); 269 Cursor.SelectedPart := Low(TCellPart);
257 Other.SelectedPart := High(TCellPart); 270 Other.SelectedPart := High(TCellPart);
258 end; 271 end;
259 end; 272 end;
273
274 if ssShift in Shift then
275 case Key of
276 VK_V: DoRepeatPaste;
277 end;
278
279 case Key of
260 VK_DELETE: begin 280 VK_DELETE: begin
261 EraseSelection; 281 EraseSelection;
262 end; 282 end;
@@ -296,7 +316,7 @@ begin
296 end; 316 end;
297 end; 317 end;
298 318
299 if not (ssShift in Shift) and not(ssCtrl in Shift) then 319 if not (ssShift in Shift) then
300 Other := Cursor; 320 Other := Cursor;
301 Selecting := ssShift in Shift; 321 Selecting := ssShift in Shift;
302 322
@@ -476,6 +496,8 @@ var
476 TempI: Integer; 496 TempI: Integer;
477 TempS: TCellPart; 497 TempS: TCellPart;
478 begin 498 begin
499 ClampCursors;
500
479 // Normalize the cursor positions such that cursor is always in the top left 501 // Normalize the cursor positions such that cursor is always in the top left
480 if (Cursor > Other) then begin 502 if (Cursor > Other) then begin
481 TempI := Other.X; 503 TempI := Other.X;
@@ -594,7 +616,8 @@ begin
594 Pen.Color := RGBToColor(58, 52, 39); 616 Pen.Color := RGBToColor(58, 52, 39);
595 617
596 for I := 0 to High(Patterns) do 618 for I := 0 to High(Patterns) do
597 RenderCell(Patterns[I]^[Row]); 619 if Patterns[I] <> nil then
620 RenderCell(Patterns[I]^[Row]);
598 end; 621 end;
599 end; 622 end;
600 623