-
Notifications
You must be signed in to change notification settings - Fork 1
/
unitcommonspectrum.pas
142 lines (116 loc) · 3.02 KB
/
unitcommonspectrum.pas
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
unit UnitCommonSpectrum;
// Copyright 2022-2024 Zoran Vučenović
// SPDX-License-Identifier: Apache-2.0
{$mode ObjFPC}{$H+}
{$i zxinc.inc}
interface
uses
SysUtils, UnitCommon;
type
TCommonSpectrum = class sealed (TObject)
public
const
AuthorName: String = 'Zoran Vučenović';
strict private
class var
FBuildYear: Word;
FBuildMonth: Word;
FBuildDay: Word;
private
class function GetBuildDateString: String; static;
class procedure Init;
class procedure Final;
public
const
KiloByte = 1024;
KB16 = KiloByte * 16;
KB48 = KiloByte * 48;
KB64 = KiloByte * 64;
SpectrumColourNames: Array of String = ('black', 'blue', 'red', 'magenta', 'green', 'cyan', 'yellow', 'white');
public
class procedure SortSpectrumKeys(var AKeys: Array of Word); static;
class function CompareSpectrumKeyValues(X, Y: Word): Integer; static;
class procedure SetBuildDate(const AYear, AMonth, ADay: Word); static;
class property BuildDateString: String read GetBuildDateString;
end;
implementation
type
TSpectrumKeysSorter = class(specialize TNumArraySorter<Word>)
end;
var
SpectrumKeysSorter: TSpectrumKeysSorter;
{ TCommonSpectrum }
class procedure TCommonSpectrum.SortSpectrumKeys(var AKeys: array of Word);
begin
if SpectrumKeysSorter = nil then
SpectrumKeysSorter := TSpectrumKeysSorter.Create(@CompareSpectrumKeyValues);
SpectrumKeysSorter.SortArray(AKeys);
end;
class function TCommonSpectrum.CompareSpectrumKeyValues(X, Y: Word): Integer;
function GetPositionRowNum(B: Byte): Byte; inline;
begin
if B > 3 then
Result := (B - 4) * 2 + 1
else
Result := (3 - B) * 2;
end;
var
WRx: WordRec absolute X;
WRy: WordRec absolute Y;
begin
X := X and $07FF;
Y := Y and $07FF;
if X = Y then
Exit(0);
// Caps shift before all others
if X = 0 then
Exit(-1);
if Y = 0 then
Exit(1);
// Then symbol shift
if X = $0701 then
Exit(-1);
if Y = $0701 then
Exit(1);
// Then top to bottom, left to right
if WRx.Hi = WRy.Hi then begin
if WRx.Lo < WRy.Lo then
Result := -1
else
Result := 1;
if WRx.Hi > 3 then
Result := -Result;
end else begin
if GetPositionRowNum(WRx.Hi) < GetPositionRowNum(WRy.Hi) then
Result := -1
else
Result := 1;
end;
end;
class procedure TCommonSpectrum.SetBuildDate(const AYear, AMonth, ADay: Word);
begin
FBuildYear := AYear;
FBuildMonth := AMonth;
FBuildDay := ADay;
end;
class function TCommonSpectrum.GetBuildDateString: String;
begin
Result :=
// We might display build date in localized form:
//DateToStr(EncodeDate(FBuildYear, FBuildMonth, FBuildDay))
// or rather always use standard YYYY-MM-DD form:
Format('%.4d-%.2d-%.2d', [FBuildYear, FBuildMonth, FBuildDay]);
end;
class procedure TCommonSpectrum.Init;
begin
SpectrumKeysSorter := nil;
end;
class procedure TCommonSpectrum.Final;
begin
SpectrumKeysSorter.Free;
end;
initialization
TCommonSpectrum.Init;
finalization
TCommonSpectrum.Final;
end.