Commit 2acb13f

Nick committed on
Work on extending tracker grid
commit 2acb13f36488668529a1d0509c5097424b05f61b parent 893c8f6
4 changed files +226−41
Modifiedhugedatatypes.pas +75−0
@@ -34,7 +34,82 @@ type
34 34
35 TSelection = array of array of TCell; 35 TSelection = array of array of TCell;
36 36
37 TCellPart = (
38 cpNote = 0,
39 cpInstrument = 1,
40 cpVolume = 2,
41 cpEffectCode = 3,
42 cpEffectParams = 4
43 );
44
45 TSelectionPos = record
46 X, Y: Integer;
47 SelectedPart: TCellPart
48 end;
49
50 operator > (L, R: TSelectionPos): Boolean;
51 operator < (L, R: TSelectionPos): Boolean;
52 operator >= (L, R: TSelectionPos): Boolean;
53 operator <= (L, R: TSelectionPos): Boolean;
54 operator = (L, R: TSelectionPos): Boolean;
55
56 procedure IncSelectionPos(var SP: TSelectionPos);
57 procedure DecSelectionPos(var SP: TSelectionPos);
58
37 implementation 59 implementation
38 60
61 operator>(L, R: TSelectionPos): Boolean;
62 begin
63 if L.X > R.X then
64 Result := True
65 else if (L.X = R.X) and (L.SelectedPart > R.SelectedPart) then
66 Result := True
67 else
68 Result := False;
69 end;
70
71 operator<(L, R: TSelectionPos): Boolean;
72 begin
73 if L.X < R.X then
74 Result := True
75 else if (L.X = R.X) and (L.SelectedPart < R.SelectedPart) then
76 Result := True
77 else
78 Result := False;
79 end;
80
81 operator>=(L, R: TSelectionPos): Boolean;
82 begin
83 Result := (L > R) or (L = R);
84 end;
85
86 operator<=(L, R: TSelectionPos): Boolean;
87 begin
88 Result := (L < R) or (L = R);
89 end;
90
91 operator=(L, R: TSelectionPos): Boolean;
92 begin
93 Result := (L.X = R.X) and (L.SelectedPart = R.SelectedPart);
94 end;
95
96 procedure IncSelectionPos(var SP: TSelectionPos);
97 begin
98 if SP.SelectedPart = High(TCellPart) then begin
99 SP.SelectedPart := Low(TCellPart);
100 Inc(SP.X);
101 end
102 else Inc(SP.SelectedPart);
103 end;
104
105 procedure DecSelectionPos(var SP: TSelectionPos);
106 begin
107 if SP.SelectedPart = Low(TCellPart) then begin
108 SP.SelectedPart := High(TCellPart);
109 Dec(SP.X);
110 end
111 else Dec(SP.SelectedPart);
112 end;
113
39 end. 114 end.
40 115
Modifiedtracker.pas +0−1
@@ -957,7 +957,6 @@ end;
957 procedure TfrmTracker.OrderEditStringGridEditingDone(Sender: TObject); 957 procedure TfrmTracker.OrderEditStringGridEditingDone(Sender: TObject);
958 var 958 var
959 Temp: Integer; 959 Temp: Integer;
960 R, C: Integer;
961 begin 960 begin
962 // TODO: Fix this hack! 961 // TODO: Fix this hack!
963 // For some reason OnValidateEntry is giving bad pointers 962 // For some reason OnValidateEntry is giving bad pointers
Modifiedtrackergrid.pas +143−39
@@ -5,7 +5,7 @@ unit TrackerGrid;
5 interface 5 interface
6 6
7 uses 7 uses
8 Classes, SysUtils, Controls, Graphics, Constants, LCLType, math, 8 Classes, SysUtils, Controls, Graphics, Constants, LCLType, math, utils,
9 LCLIntf, LMessages, HugeDatatypes, ClipboardUtils; 9 LCLIntf, LMessages, HugeDatatypes, ClipboardUtils;
10 10
11 // TODO: Maybe read these from a config file 11 // TODO: Maybe read these from a config file
@@ -27,59 +27,37 @@ const
27 NUM_ROWS = 64; 27 NUM_ROWS = 64;
28 28
29 type 29 type
30 TCellPart = (
31 cpNote = 0,
32 cpInstrument = 1,
33 cpVolume = 2,
34 cpEffectCode = 3,
35 cpEffectParams = 4
36 );
37
38 TSelectionPos = record
39 X, Y: Integer;
40 SelectedPart: TCellPart
41 end;
42
43 { TTrackerGrid } 30 { TTrackerGrid }
44 31
45 TTrackerGrid = class(TCustomControl) 32 TTrackerGrid = class(TCustomControl)
46 constructor Create( 33 constructor Create(AOwner: TComponent; Parent: TWinControl);
47 AOwner: TComponent; 34
48 Parent: TWinControl);
49 procedure Paint; override; 35 procedure Paint; override;
50 procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 36 procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
51 override; 37 override;
52 procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; 38 procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
53 procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; 39 procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
54 40
55 procedure KeyDown(var Key: Word; Shift: TShiftState); override; 41 procedure KeyDown(var Key: Word; Shift: TShiftState); override;
56 42 private
43 procedure PerformPaste(Paste: TSelection);
44 procedure PerformCopy;
45 procedure DoRepeatPaste;
57 procedure DoPaste(var Msg: TLMessage); message LM_PASTE; 46 procedure DoPaste(var Msg: TLMessage); message LM_PASTE;
58 procedure DoCopy(var Msg: TLMessage); message LM_COPY; 47 procedure DoCopy(var Msg: TLMessage); message LM_COPY;
59 procedure DoCut(var Msg: TLMessage); message LM_CUT; 48 procedure DoCut(var Msg: TLMessage); message LM_CUT;
60 49
61 procedure RenderSelectedArea; 50 procedure RenderSelectedArea;
62 procedure ClampCursors; 51 procedure ClampCursors;
52 procedure NormalizeCursors;
63 53
54 procedure EraseSelection;
64 procedure InputNote(Key: Word); 55 procedure InputNote(Key: Word);
65 procedure InputInstrument(Key: Word); 56 procedure InputInstrument(Key: Word);
66 procedure InputVolume(Key: Word); 57 procedure InputVolume(Key: Word);
67 procedure InputEffectCode(Key: Word); 58 procedure InputEffectCode(Key: Word);
68 procedure InputEffectParams(Key: Word); 59 procedure InputEffectParams(Key: Word);
69 60
70 private
71 Patterns: array[0..3] of PPattern;
72
73 CharHeight: Integer;
74 CharWidth: Integer;
75
76 MouseButtonDown: Boolean;
77 Selecting: Boolean;
78
79 DigitInputting: Boolean;
80
81 FHighlightedRow: Integer;
82
83 procedure RenderRow(Row: Integer); 61 procedure RenderRow(Row: Integer);
84 procedure RenderCell(const Cell: TCell); 62 procedure RenderCell(const Cell: TCell);
85 63
@@ -92,12 +70,29 @@ type
92 function MousePosToSelection(X, Y: Integer): TSelectionPos; 70 function MousePosToSelection(X, Y: Integer): TSelectionPos;
93 function KeycodeToHexNumber(Key: Word; out Num: Nibble): Boolean; overload; 71 function KeycodeToHexNumber(Key: Word; out Num: Nibble): Boolean; overload;
94 function KeycodeToHexNumber(Key: Word; out Num: Integer): Boolean; overload; 72 function KeycodeToHexNumber(Key: Word; out Num: Integer): Boolean; overload;
73 private
74 Patterns: array[0..3] of PPattern;
75
76 CharHeight: Integer;
77 CharWidth: Integer;
78
79 MouseButtonDown: Boolean;
80 Selecting: Boolean;
81
82 DigitInputting: Boolean;
83
84 FHighlightedRow: Integer;
95 public 85 public
96 Cursor, Other: TSelectionPos; 86 Cursor, Other: TSelectionPos;
97 ColumnWidth, RowHeight: Integer; 87 ColumnWidth, RowHeight: Integer;
88
98 property HighlightedRow: Integer read FHighlightedRow write SetHighlightedRow; 89 property HighlightedRow: Integer read FHighlightedRow write SetHighlightedRow;
99 property SelectionGridRect: TRect read GetSelectionGridRect write SetSelectionGridRect; 90 property SelectionGridRect: TRect read GetSelectionGridRect write SetSelectionGridRect;
100 procedure LoadPattern(Idx: Integer; Pat: PPattern); 91 procedure LoadPattern(Idx: Integer; Pat: PPattern);
92
93 function GetAt(SelectionPos: TSelectionPos): Integer;
94 procedure SetAt(SelectionPos: TSelectionPos; Value: Integer);
95 procedure ClearAt(SelectionPos: TSelectionPos);
101 end; 96 end;
102 97
103 implementation 98 implementation
@@ -221,6 +216,18 @@ begin
221 inherited KeyDown(Key, Shift); 216 inherited KeyDown(Key, Shift);
222 217
223 case Key of 218 case Key of
219 VK_V: if ssShift in Shift then DoRepeatPaste;
220 VK_L: begin
221 if ssCtrl in Shift then begin
222 Cursor.Y := 0;
223 Other.Y := High(TPattern);
224 Cursor.SelectedPart := Low(TCellPart);
225 Other.SelectedPart := High(TCellPart);
226 end;
227 end;
228 VK_DELETE: begin
229 EraseSelection;
230 end;
224 VK_UP: begin 231 VK_UP: begin
225 Cursor.Y -= 1; 232 Cursor.Y -= 1;
226 DigitInputting := False; 233 DigitInputting := False;
@@ -266,13 +273,11 @@ begin
266 Invalidate 273 Invalidate
267 end; 274 end;
268 275
269 procedure TTrackerGrid.DoPaste(var Msg: TLMessage); 276 procedure TTrackerGrid.PerformPaste(Paste: TSelection);
270 var 277 var
271 Paste: TSelection;
272 X, Y: Integer; 278 X, Y: Integer;
273 begin 279 begin
274 try 280 try
275 Paste := GetPastedCells;
276 for Y := 0 to High(Paste) do begin 281 for Y := 0 to High(Paste) do begin
277 if Cursor.Y+Y > High(TPattern) then Break; 282 if Cursor.Y+Y > High(TPattern) then Break;
278 for X := 0 to High(Paste[Y]) do begin 283 for X := 0 to High(Paste[Y]) do begin
@@ -292,6 +297,30 @@ begin
292 Invalidate; 297 Invalidate;
293 end; 298 end;
294 299
300 procedure TTrackerGrid.PerformCopy;
301 begin
302
303 end;
304
305 procedure TTrackerGrid.DoRepeatPaste;
306 var
307 Selection: TSelection;
308 I: Integer;
309 begin
310 Selection := GetPastedCells;
311 I := Cursor.Y;
312 while I <= High(TPattern) do begin
313 Cursor.Y := I;
314 PerformPaste(Selection);
315 Inc(I, High(Selection)+1);
316 end;
317 end;
318
319 procedure TTrackerGrid.DoPaste(var Msg: TLMessage);
320 begin
321 PerformPaste(GetPastedCells);
322 end;
323
295 procedure TTrackerGrid.DoCopy(var Msg: TLMessage); 324 procedure TTrackerGrid.DoCopy(var Msg: TLMessage);
296 var 325 var
297 Selection: TSelection; 326 Selection: TSelection;
@@ -336,10 +365,49 @@ end;
336 365
337 procedure TTrackerGrid.ClampCursors; 366 procedure TTrackerGrid.ClampCursors;
338 begin 367 begin
339 Cursor.Y := Min(63, Max(0, Cursor.Y)); 368 Cursor.Y := Min(High(TPattern), Max(Low(TPattern), Cursor.Y));
340 Cursor.X := Min(3, Max(0, Cursor.X)); 369 Cursor.X := Min(High(Patterns), Max(Low(Patterns), Cursor.X));
341 Other.Y := Min(63, Max(0, Other.Y)); 370 Other.Y := Min(High(TPattern), Max(Low(TPattern), Other.Y));
342 Other.X := Min(3, Max(0, Other.X)); 371 Other.X := Min(High(Patterns), Max(Low(Patterns), Other.X));
372 end;
373
374 procedure TTrackerGrid.NormalizeCursors;
375 var
376 TempI: Integer;
377 TempS: TCellPart;
378 begin
379 // Normalize the cursor positions such that cursor is always in the top left
380 if (Cursor > Other) then begin
381 TempI := Other.X;
382 Other.X := Cursor.X;
383 Cursor.X := TempI;
384
385 TempS := Other.SelectedPart;
386 Other.SelectedPart := Cursor.SelectedPart;
387 Cursor.SelectedPart := TempS;
388 end;
389 if (Cursor.Y > Other.Y) then begin
390 TempI := Other.Y;
391 Other.Y := Cursor.Y;
392 Cursor.Y := TempI;
393 end;
394 end;
395
396 procedure TTrackerGrid.EraseSelection;
397 var
398 X: TSelectionPos;
399 R: Integer;
400 begin
401 NormalizeCursors;
402
403 for R := Cursor.Y to Other.Y do begin
404 X := Cursor;
405 X.Y := R;
406 while X <= Other do begin
407 ClearAt(X);
408 IncSelectionPos(X);
409 end;
410 end;
343 end; 411 end;
344 412
345 procedure TTrackerGrid.InputNote(Key: Word); 413 procedure TTrackerGrid.InputNote(Key: Word);
@@ -597,6 +665,42 @@ begin
597 Num := X; 665 Num := X;
598 end; 666 end;
599 667
668 function TTrackerGrid.GetAt(SelectionPos: TSelectionPos): Integer;
669 begin
670 with Patterns[SelectionPos.X]^[SelectionPos.Y] do
671 case SelectionPos.SelectedPart of
672 cpNote: Result := Note;
673 cpInstrument: Result := Instrument;
674 cpVolume:;
675 cpEffectCode: Result := EffectCode;
676 cpEffectParams: Result := EffectParams.Value;
677 end;
678 end;
679
680 procedure TTrackerGrid.SetAt(SelectionPos: TSelectionPos; Value: Integer);
681 begin
682 with Patterns[SelectionPos.X]^[SelectionPos.Y] do
683 case SelectionPos.SelectedPart of
684 cpNote: Note := Value;
685 cpInstrument: Instrument := Value;
686 cpVolume:;
687 cpEffectCode: EffectCode := Value;
688 cpEffectParams: EffectParams.Value := Value;
689 end;
690 end;
691
692 procedure TTrackerGrid.ClearAt(SelectionPos: TSelectionPos);
693 begin
694 with Patterns[SelectionPos.X]^[SelectionPos.Y] do
695 case SelectionPos.SelectedPart of
696 cpNote: Note := NO_NOTE;
697 cpInstrument: Instrument := 0;
698 cpVolume:;
699 cpEffectCode: EffectCode := 0;
700 cpEffectParams: EffectParams.Value := 0;
701 end;
702 end;
703
600 procedure TTrackerGrid.LoadPattern(Idx: Integer; Pat: PPattern); 704 procedure TTrackerGrid.LoadPattern(Idx: Integer; Pat: PPattern);
601 begin 705 begin
602 Patterns[Idx] := Pat; 706 Patterns[Idx] := Pat;
Modifiedutils.pas +8−1
@@ -5,7 +5,7 @@ unit Utils;
5 interface 5 interface
6 6
7 uses 7 uses
8 Classes, SysUtils, Instruments, Waves, HugeDatatypes, Constants; 8 Classes, SysUtils, Waves, HugeDatatypes, Constants;
9 9
10 type 10 type
11 { TOrderMapHelper } 11 { TOrderMapHelper }
@@ -18,6 +18,7 @@ type
18 18
19 function ConvertWaveform(Waveform: TWave): T4bitWave; 19 function ConvertWaveform(Waveform: TWave): T4bitWave;
20 procedure BlankPattern(Pat: PPattern); 20 procedure BlankPattern(Pat: PPattern);
21 procedure BlankCell(var Cell: TCell);
21 function EffectCodeToStr(Code: Integer; Params: TEffectParams): String; 22 function EffectCodeToStr(Code: Integer; Params: TEffectParams): String;
22 23
23 implementation 24 implementation
@@ -80,6 +81,12 @@ begin
80 end; 81 end;
81 end; 82 end;
82 83
84 procedure BlankCell(var Cell: TCell);
85 begin
86 Cell := Default(TCell);
87 Cell.Note := NO_NOTE;
88 end;
89
83 function EffectCodeToStr(Code: Integer; Params: TEffectParams): String; 90 function EffectCodeToStr(Code: Integer; Params: TEffectParams): String;
84 begin 91 begin
85 Result := HexStr((Code shl 8) or Params.Value, 3); 92 Result := HexStr((Code shl 8) or Params.Value, 3);