1 // SPDX-License-Identifier: LGPL-3.0-linking-exception
2 unit UnitMakerUnit;
3
4 {$mode objfpc}{$H+}
5
6 interface
7
8 uses
9 Classes, SysUtils, typinfo, rttiutils;
10
11 { Table of working colorspaces (where blending could be done)
12
13 | Byte Word Single
14 --------------+---------------------------------------------
15 sRGB | BGRAPixel FPColor StdRGBA
16 Adobe RGB | AdobeRGBA
17 gray | ByteMask (WordMask)
18 linear RGB | ExpandedPixel LinearRGBA
19 XYZ | WordXYZA XYZA
20
21 }
22
23 type
24 TColorspaceEnum = (csColor, csBGRAPixel, csFPColor, csStdRGBA, //sRGB
25 csAdobeRGBA,
26 csStdHSLA, csStdHSVA, csStdCMYKA, //based on sRGB
27 csByteMask, {csWordMask,} //linear grayscale
28 csExpandedPixel, csLinearRGBA, //linear RGB
29 csHSLAPixel, csGSBAPixel, //based on linear RGB
30 csXYZA, csWordXYZA, //CIE XYZ
31 csLabA, csLChA); //based on XYZ
32
33 TChannelValueType = (cvtByte, cvtWord, cvtLongWord, cvtSingle, cvtDouble);
34
35 const
36 ChannelValueTypeName : array[TChannelValueType] of string = ('byte', 'word', 'longword', 'single', 'double');
37 ChannelValueTypePrecision : array[TChannelValueType] of integer = (1, 2, 4, 2, 6);
38 ChannelValueTypeBitDepth : array[TChannelValueType] of integer = (8, 16, 32, 28, 58);
39 MAXWORD = $ffff;
40
41 type
42 TColorspaceInfo = record
43 Name: string;
44 Declaration: string;
45 Colorspace: string;
46 HasAlpha, NeedRefWhite: boolean;
47 ValueType: TChannelValueType;
48 BasicHelper: boolean;
49 VariableNames, FullNames, MinMax: string;
50 IsBridge, HasImaginary: boolean;
51 end;
52
53 const
54 ColorspaceInfo: array [TColorspaceEnum] of TColorspaceInfo =
55 ((Name: 'Color'; Declaration: 'type helper'; Colorspace: 'StdRGB'; HasAlpha: false; NeedRefWhite: false; ValueType: cvtByte; BasicHelper: false;
56 VariableNames: 'red,green,blue'; FullNames: 'Red,Green,Blue'; MinMax: '0,0,0,255,255,255'; IsBridge: false; HasImaginary: false),
57 (Name: 'BGRAPixel'; Declaration: 'record helper'; Colorspace: 'StdRGB'; HasAlpha: true; NeedRefWhite: false; ValueType: cvtByte; BasicHelper: true;
58 VariableNames: 'red,green,blue,alpha'; FullNames: 'Red,Green,Blue,Alpha'; MinMax: '0,0,0,0,255,255,255,255'; IsBridge: false; HasImaginary: false),
59 (Name: 'FPColor'; Declaration: 'record helper'; Colorspace: 'StdRGB'; HasAlpha: true; NeedRefWhite: false; ValueType: cvtWord; BasicHelper: true;
60 VariableNames: 'red,green,blue,alpha'; FullNames: 'Red,Green,Blue,Alpha'; MinMax: '0,0,0,0,65535,65535,65535,65535'; IsBridge: false; HasImaginary: false),
61
62 (Name: 'StdRGBA'; Declaration: 'packed record'; Colorspace: 'StdRGB'; HasAlpha: true; NeedRefWhite: false; ValueType: cvtSingle; BasicHelper: false;
63 VariableNames: 'red,green,blue,alpha'; FullNames: 'Red,Green,Blue,Alpha'; MinMax: '0,0,0,0,1,1,1,1'; IsBridge: false; HasImaginary: false),
64 (Name: 'AdobeRGBA'; Declaration: 'packed record'; Colorspace: 'AdobeRGB'; HasAlpha: true; NeedRefWhite: false; ValueType: cvtByte; BasicHelper: false;
65 VariableNames: 'red,green,blue,alpha'; FullNames: 'Red,Green,Blue,Alpha'; MinMax: '0,0,0,0,255,255,255,255'; IsBridge: false; HasImaginary: false),
66
67 (Name: 'StdHSLA'; Declaration: 'packed record'; Colorspace: 'StdHSL'; HasAlpha: true; NeedRefWhite: false; ValueType: cvtSingle; BasicHelper: false;
68 VariableNames: 'hue,saturation,lightness,alpha'; FullNames: 'Hue,Saturation,Lightness,Alpha'; MinMax: '0,0,0,0,360,1,1,1'; IsBridge: false; HasImaginary: false),
69 (Name: 'StdHSVA'; Declaration: 'packed record'; Colorspace: 'StdHSV'; HasAlpha: true; NeedRefWhite: false; ValueType: cvtSingle; BasicHelper: false;
70 VariableNames: 'hue,saturation,value,alpha'; FullNames: 'Hue,Saturation,Value,Alpha'; MinMax: '0,0,0,0,360,1,1,1'; IsBridge: false; HasImaginary: false),
71 (Name: 'StdCMYK'; Declaration: 'packed record'; Colorspace: 'StdCMYK'; HasAlpha: false; NeedRefWhite: false; ValueType: cvtSingle; BasicHelper: false;
72 VariableNames: 'C,M,Y,K'; FullNames: 'Cyan,Magenta,Yellow,Black'; MinMax: '0,0,0,0,1,1,1,1'; IsBridge: false; HasImaginary: false),
73
74 (Name: 'ByteMask'; Declaration: 'packed record'; Colorspace: 'Grayscale'; HasAlpha: false; NeedRefWhite: false; ValueType: cvtByte; BasicHelper: false;
75 VariableNames: 'gray'; FullNames: 'Gray'; MinMax: '0,255'; IsBridge: false; HasImaginary: false),
76 { (Name: 'WordMask'; Declaration: 'packed record'; Colorspace: 'Grayscale'; HasAlpha: false; NeedRefWhite: false; ValueType: cvtWord; BasicHelper: false;
77 VariableNames: 'gray'; FullNames: 'Gray'; MinMax: '0,65535'; IsBridge: false; HasImaginary: false),}
78
79 (Name: 'ExpandedPixel'; Declaration: 'record helper'; Colorspace: 'LinearRGB'; HasAlpha: true; NeedRefWhite: false; ValueType: cvtWord; BasicHelper: true;
80 VariableNames: 'red,green,blue,alpha'; FullNames: 'Red,Green,Blue,Alpha'; MinMax: '0,0,0,0,65535,65535,65535,65535'; IsBridge: true; HasImaginary: false),
81 (Name: 'LinearRGBA'; Declaration: 'packed record'; Colorspace: 'LinearRGB'; HasAlpha: true; NeedRefWhite: false; ValueType: cvtSingle; BasicHelper: false;
82 VariableNames: 'red,green,blue,alpha'; FullNames: 'Red,Green,Blue,Alpha'; MinMax: '0,0,0,0,1,1,1,1'; IsBridge: false; HasImaginary: false),
83
84 (Name: 'HSLAPixel'; Declaration: 'record helper'; Colorspace: 'HSL'; HasAlpha: true; NeedRefWhite: false; ValueType: cvtWord; BasicHelper: true;
85 VariableNames: 'hue,saturation,lightness,alpha'; FullNames: 'Hue,Saturation,Lightness,Alpha'; MinMax: '0,0,0,0,65535,65535,65535,65535'; IsBridge: false; HasImaginary: false),
86 (Name: 'GSBAPixel'; Declaration: 'record helper'; Colorspace: 'GSB'; HasAlpha: true; NeedRefWhite: false; ValueType: cvtWord; BasicHelper: true;
87 VariableNames: 'hue,saturation,lightness,alpha'; FullNames: 'Hue,Saturation,Brightness,Alpha';MinMax: '0,0,0,0,65535,65535,65535,65535'; IsBridge: false; HasImaginary: false),
88
89 (Name: 'XYZA'; Declaration: 'packed record'; Colorspace: 'CIE XYZ'; HasAlpha: true; NeedRefWhite: true; ValueType: cvtSingle; BasicHelper: false;
90 VariableNames: 'X,Y,Z,alpha'; FullNames: 'X,Y,Z,Alpha'; MinMax: '0,0,0,0,1,1,1,1'; IsBridge: false; HasImaginary: true),
91 (Name: 'WordXYZA'; Declaration: 'packed record'; Colorspace: 'CIE XYZ'; HasAlpha: true; NeedRefWhite: true; ValueType: cvtWord; BasicHelper: false;
92 VariableNames: 'X,Y,Z,alpha'; FullNames: 'X,Y,Z,Alpha'; MinMax: '0,0,0,0,50000,50000,50000,65535'; IsBridge: false; HasImaginary: true),
93
94 (Name: 'LabA'; Declaration: 'packed record'; Colorspace: 'CIE Lab'; HasAlpha: true; NeedRefWhite: false; ValueType: cvtSingle; BasicHelper: false;
95 VariableNames: 'L,a,b,alpha'; FullNames: 'Lightness,a,b,Alpha'; MinMax: '0,-166,-132,0,100,142,147,1'; IsBridge: false; HasImaginary: true),
96 (Name: 'LChA'; Declaration: 'packed record'; Colorspace: 'CIE LCh'; HasAlpha: true; NeedRefWhite: false; ValueType: cvtSingle; BasicHelper: false;
97 VariableNames: 'L,C,h,alpha'; FullNames: 'Lightness,Chroma,Hue,Alpha'; MinMax: '0,0,0,0,100,192,360,1'; IsBridge: false; HasImaginary: true) );
98
99 type
100 TColorPair = record
101 First, Last: TColorspaceEnum;
102 ToFirstFunc, ToLastFunc: string;
103 HandlesExtraAlpha: boolean;
104 Weight: integer;
105 end;
106
107 type
108 TColorspaceArray = array of TColorspaceEnum;
109
110 TPath = array of record
111 PairIndex: integer;
112 Reverse: boolean;
113 end;
114 TPathArray = array of TPath;
115
116 var
117 PairsList: array of TColorPair;
118 PathMatrix: packed array[TColorspaceEnum, TColorspaceEnum] of Word;
119 ConvMatrix: packed array[TColorspaceEnum, TColorspaceEnum] of boolean;
120 ConvBridgeMatrix: packed array[TColorspaceEnum, TColorspaceEnum] of TColorspaceEnum;
121
FindPathnull122 function FindPath(AFrom, ATo: TColorspaceEnum): TColorspaceArray;
NewColorPairnull123 function NewColorPair(AFirst, ALast: TColorspaceEnum;
124 AToFirstFunc, AToLastFunc: string;
125 AHandlesExtraAlpha: boolean; AWeight: integer): TColorPair;
126 procedure AddColorPair(AFirst, ALast: TColorspaceEnum;
127 AToFirstFunc : string = ''; AToLastFunc: string = '';
128 AHandlesExtraAlpha: boolean = true;
129 AWeight: integer = 1);
GetConversionFunctionnull130 function GetConversionFunction(AFrom, ATo: TColorspaceEnum): string;
131 procedure AddAlphaPairs;
132 procedure GenerateCode;
133
134 implementation
135
136 uses math;
137
IsHelperOnlynull138 function IsHelperOnly(cs: TColorspaceEnum): boolean;
139 begin
140 result := ColorspaceInfo[cs].Declaration.EndsWith(' helper');
141 end;
142
143 procedure AddColorPair(AFirst, ALast: TColorspaceEnum;
144 AToFirstFunc : string = ''; AToLastFunc: string = '';
145 AHandlesExtraAlpha: boolean = true;
146 AWeight: integer = 1);
147 begin
148 SetLength(PairsList, Length(PairsList) + 1);
149 if AToFirstFunc = '' then AToFirstFunc:= ColorspaceInfo[ALast].Name + 'To' + ColorspaceInfo[AFirst].Name;
150 if AToLastFunc = '' then AToLastFunc:= ColorspaceInfo[AFirst].Name + 'To' + ColorspaceInfo[ALast].Name;
151 PairsList[Length(PairsList) - 1] := NewColorPair(AFirst, ALast, AToFirstFunc, AToLastFunc, AHandlesExtraAlpha, AWeight);
152 end;
153
GetConversionFunctionnull154 function GetConversionFunction(AFrom, ATo: TColorspaceEnum; out AHandlesExtraAlpha: boolean): string;
155 var
156 i: Integer;
157 begin
158 for i := 0 to high(PairsList) do
159 if (PairsList[i].First = AFrom) and (PairsList[i].Last = ATo) and (PairsList[i].ToLastFunc <> '') then
160 begin
161 AHandlesExtraAlpha := PairsList[i].HandlesExtraAlpha;
162 exit(PairsList[i].ToLastFunc)
163 end
164 else if (PairsList[i].First = ATo) and (PairsList[i].Last = AFrom) and (PairsList[i].ToFirstFunc <> '') then
165 begin
166 AHandlesExtraAlpha := PairsList[i].HandlesExtraAlpha;
167 exit(PairsList[i].ToFirstFunc);
168 end;
169
170 result := ColorspaceInfo[AFrom].Name + 'To' + ColorspaceInfo[ATo].Name;
171 AHandlesExtraAlpha := ConvMatrix[AFrom,ATo];
172 end;
173
GetConversionFunctionnull174 function GetConversionFunction(AFrom, ATo: TColorspaceEnum): string;
175 var AHandlesExtraAlpha: boolean;
176 begin
Fromnull177 result := GetConversionFunction(AFrom,ATo,AHandlesExtraAlpha);
178 end;
179
NeedXYZReferenceWhitenull180 function NeedXYZReferenceWhite(c1,c2: TColorspaceEnum): boolean;
181 begin
182 result := (ColorspaceInfo[c1].NeedRefWhite or ColorspaceInfo[c2].NeedRefWhite) and not
183 ([c1,c2] = [csXYZA,csWordXYZA]);
184 end;
185
GetConversionFunctionRecnull186 function GetConversionFunctionRec(c1, c2: TColorspaceEnum; AValueParam: string; AReferenceWhiteParam: string = ''): string;
187 var
188 c, cBridge: TColorspaceEnum;
189
190 procedure AppendConv(ATo: TColorspaceEnum);
191 begin
192 if (AReferenceWhiteParam <> '') and NeedXYZReferenceWhite(c,ATo) then
193 result := GetConversionFunction(c,ATo)+'('+result+','+AReferenceWhiteParam+')'
194 else
195 result := GetConversionFunction(c,ATo)+'('+result+')';
196 c := ATo;
197 end;
198
199 begin
200 result := AValueParam;
201 c := c1;
202 while c <> c2 do
203 begin
204 if ConvMatrix[c,c2] then AppendConv(c2) else
205 begin
206 cBridge := ConvBridgeMatrix[c,c2];
207 if cBridge = low(TColorspaceEnum) then
208 raise exception.Create('Conversion bridge not found');
209 AppendConv(cBridge);
210 end;
211 end;
212 end;
213
214 procedure AddAlphaPairs;
215 var
216 i, j: TColorspaceEnum;
217 begin
218 for i := Low(TColorspaceEnum) to High(TColorspaceEnum) do
219 for j := Low(TColorspaceEnum) to High(TColorspaceEnum) do
220 if (ColorspaceInfo[j].Name = ColorspaceInfo[i].Name + 'A') and
221 (ColorspaceInfo[j].HasAlpha and not ColorspaceInfo[i].HasAlpha) then
222 begin
223 AddColorPair(i, j);
224 AddColorPair(j, i);
225 end;
226 end;
227
FindPathRecnull228 function FindPathRec(AFrom, ATo: TColorspaceEnum; AEnd: TPath;
229 ARemainLen: Word; AWantedPrecision: integer): TPathArray;
230 var
231 i, j: Integer;
232 cs: TColorspaceEnum;
233 subEnd: TPath;
234 subResult: TPathArray;
235 begin
236 result := nil;
237 for cs := low(TColorspaceEnum) to high(TColorspaceEnum) do
238 if (PathMatrix[AFrom,cs] = ARemainLen-1) and
239 (ChannelValueTypePrecision[ColorspaceInfo[cs].ValueType] >= AWantedPrecision) then
240 begin
241 for i := 0 to high(PairsList) do
242 if ((PairsList[i].First = cs) and (PairsList[i].Last = ATo)) or
243 ((PairsList[i].Last = cs) and (PairsList[i].First = ATo)) then
244 begin
245 subEnd := nil;
246 setLength(subEnd, length(AEnd)+1);
247 for j := 0 to high(AEnd) do
248 subEnd[j+1] := AEnd[j];
249 subEnd[0].PairIndex := i;
250 subEnd[0].Reverse:= PairsList[i].Last = cs;
251
252 if ARemainLen <= 1 then
253 begin
254 setlength(result, length(result)+1);
255 result[high(result)] := subEnd;
256 end else
257 begin
258 subResult := FindPathRec(AFrom,cs, subEnd, ARemainLen-1, AWantedPrecision);
259 for j := 0 to high(subResult) do
260 begin
261 setlength(result, length(result)+1);
262 result[high(result)] := subResult[j];
263 end;
264 end;
265 break;
266 end;
267 end;
268 end;
269
FindPathnull270 function FindPath(AFrom, ATo: TColorspaceEnum): TColorspaceArray;
271 var
272 pathLen: Word;
273 i: Integer;
274 subResult: TPathArray;
275 bestIndex, bestWeight, weight, j, wantedPrecision: integer;
276 path: TPath;
277 begin
278 result := nil;
279 pathLen := PathMatrix[AFrom,ATo];
280 wantedPrecision := min(ChannelValueTypePrecision[ColorspaceInfo[AFrom].ValueType],
281 ChannelValueTypePrecision[ColorspaceInfo[ATo].ValueType]);
282 if pathLen = MAXWORD then
283 raise exception.Create('No path found');
284
285 subResult := FindPathRec(AFrom,ATo, nil, pathLen, wantedPrecision);
286 bestIndex := -1;
287 bestWeight := maxLongint;
288 for i := 0 to high(subResult) do
289 begin
290 weight := 0;
291 path := subResult[i];
292 for j := 0 to high(path) do
293 inc(weight, PairsList[path[j].PairIndex].Weight);
294 if weight < bestWeight then
295 begin
296 bestWeight := weight;
297 bestIndex := i;
298 end;
299 end;
300
301 if bestIndex = -1 then raise exception.Create('No best path found between '+ColorspaceInfo[AFrom].Name+' to '+ColorspaceInfo[ATo].Name);
302 path := subResult[bestIndex];
303 setlength(result, length(path)+1);
304 for j := 0 to high(path) do
305 begin
306 if path[j].Reverse then
307 result[j] := PairsList[path[j].PairIndex].Last
308 else
309 result[j] := PairsList[path[j].PairIndex].First;
310 end;
311 if path[high(path)].Reverse then
312 result[high(result)] := PairsList[path[high(path)].PairIndex].First
313 else
314 result[high(result)] := PairsList[path[high(path)].PairIndex].Last;
315 end;
316
317 procedure MakePathMatrix;
318
FindNewPathnull319 function FindNewPath(cs: TColorspaceEnum; FromLen: integer): boolean;
320 var
321 CSFrom: TColorspaceEnum;
322 i: Integer;
323 begin
324 result := false;
325 for CSFrom := low(TColorspaceEnum) to high(TColorspaceEnum) do
326 if PathMatrix[cs,CSFrom] = FromLen then
327 begin
328 for i := 0 to high(PairsList) do
329 if PairsList[i].First = CSFrom then
330 begin
331 if PathMatrix[cs, PairsList[i].Last] = MAXWORD then
332 begin
333 PathMatrix[cs, PairsList[i].Last] := FromLen+1;
334 result := true;
335 end;
336 end else
337 if PairsList[i].Last = CSFrom then
338 begin
339 if PathMatrix[cs, PairsList[i].First] = MAXWORD then
340 begin
341 PathMatrix[cs, PairsList[i].First] := FromLen+1;
342 result := true;
343 end;
344 end;
345 end;
346 inc(FromLen);
347 end;
348
349 var
350 cs: TColorspaceEnum;
351 FromLen: integer;
352 begin
353 FillWord(PathMatrix, sizeof(PathMatrix) div sizeof(word), MAXWORD);
354 for cs := low(TColorspaceEnum) to high(TColorspaceEnum) do
355 begin
356 PathMatrix[cs,cs] := 0;
357 FromLen := 0;
358 while FindNewPath(cs, FromLen) do inc(FromLen);
359 end;
360 end;
361
NewColorPairnull362 function NewColorPair(AFirst, ALast: TColorspaceEnum; AToFirstFunc, AToLastFunc: string; AHandlesExtraAlpha: boolean; AWeight: integer): TColorPair;
363 begin
364 with Result do
365 begin
366 First := AFirst;
367 Last := ALast;
368 ToFirstFunc:= AToFirstFunc;
369 ToLastFunc:= AToLastFunc;
370 HandlesExtraAlpha:= AHandlesExtraAlpha;
371 Weight := AWeight;
372 end;
373 end;
374
375 procedure GenerateCode;
376 var
377 s: string;
378 intsl, impsl: TStringList;
379 InfSpaceAdd: string;
380 ColorTypeDefined: array[TColorspaceEnum] of boolean;
381
382 procedure Add(ls: string);
383 begin
384 if ls = '' then intsl.add('') else
385 intsl.Add(InfSpaceAdd + ls);
386 end;
387
388 procedure AddImp(ls: string);
389 begin
390 impsl.Add(ls);
391 end;
392
393 procedure AddProcedureImp(h, ls: string);
394 begin
395 AddImp(h);
396 ls := Trim(ls);
397 if ls.EndsWith(';') then delete(ls, length(ls), 1);
398 AddImp('begin ' + ls + ' end;');
399 AddImp('');
400 end;
401
402 procedure AddProcedureImp(h: string; ls: array of string);
403 var
404 i: Integer;
405 begin
406 AddImp(h);
407 AddImp('begin');
408 for i := 0 to high(ls) do
409 AddImp(' ' + ls[i]);
410 AddImp('end;');
411 AddImp('');
412 end;
413
GetProcedurenull414 function GetProcedure(AFullname, AParams: string; AOverload: boolean): string;
415 begin
416 Result := 'procedure ' + AFullname;
417 if AParams <> '' then
418 Result += '(' + AParams + ')';
419 Result += ';';
420 if AOverload then
421 Result += ' overload;';
422 end;
423
GetFunctionnull424 function GetFunction(AFullname, AParams, AResultType: string; AOverload: boolean; AStatic: boolean = False): string;
425 begin
426 Result := 'function ' + AFullname;
427 if AParams <> '' then
428 Result += '(' + AParams + ')';
429 Result += ': ' + AResultType + ';';
430 if AOverload then
431 Result += 'overload;';
432 if AStatic then
433 Result += 'static;';
434 end;
435
Splitnull436 function Split(str: string): TStringArray;
437 var
438 sl: TStringList;
439 i: integer;
440 begin
441 sl := TStringList.Create;
442 sl.StrictDelimiter := True;
443 sl.CommaText := str;
444 SetLength(Result, sl.Count);
445 for i := 0 to Length(Result) - 1 do
446 begin
447 Result[i] := sl.Strings[i];
448 end;
449 sl.Free;
450 end;
451
GetVariablesNamesnull452 function GetVariablesNames(cp: TColorspaceEnum): TStringArray;
453 begin
454 Result := Split(ColorspaceInfo[cp].VariableNames);
455 end;
456
457 procedure MakeConverters;
458
459 procedure AddAlphaConverter(c1, c2: TColorspaceEnum; ad: string);
460 var
461 s, ls, h: string;
462 i: integer;
463 vn: TStringArray;
464 begin
465 if ad <> '' then
466 vn := GetVariablesNames(c1)
467 else
468 vn := GetVariablesNames(c2);
olorspaceInfonull469 h := GetFunction(ColorspaceInfo[c1].Name + 'To' + ColorspaceInfo[c2].Name, 'const A' + ColorspaceInfo[c1].Name + ': T' + ColorspaceInfo[c1].Name + ad, 'T' + ColorspaceInfo[c2].Name, False);
470 s := '';
471 for i := 0 to Length(vn) - 1 do
472 begin
473 s += 'A' + ColorspaceInfo[c1].Name + '.' + vn[i];
474 if i <> Length(vn) - 1 then
475 s += ',';
476 end;
477 if ad <> '' then
478 s += ', AAlpha';
479 ls := 'Result := T' + ColorspaceInfo[c2].Name + '.New(' + s + ');';
480 AddProcedureImp(h, ls);
481 end;
482
GetResultnull483 function GetResult(fn, p: string): string;
484 begin
485 Result := fn + '(' + p + ')';
486 end;
487
AddConverternull488 function AddConverter(c1, c2: TColorspaceEnum): string;
489 var
490 bp: TColorspaceArray;
491 cs1, cs2: TColorspaceEnum;
492 i: integer;
493 ls, lf, s: string;
494 fn, avn: string;
495 bb: boolean;
496 vmax: string;
497 vn, vsam: TStringArray;
498 needRefPoint: boolean;
499 h, functionName: string;
500 begin
501 result := '';
502 bp := FindPath(c1, c2);
503 if Length(bp) = 0 then
504 begin
505 WriteLn('Path shouldn''t be empty');
506 Exit;
507 end;
508 if not ColorspaceInfo[c1].IsBridge and
509 not ColorspaceInfo[c2].IsBridge then
510 begin
511 for i := 1 to high(bp)-1 do
512 if ColorspaceInfo[bp[i]].IsBridge then
513 begin
514 ConvBridgeMatrix[c1,c2] := bp[i];
515 exit(''); //go via bridge
516 end;
517 end;
518
519 functionName := ColorspaceInfo[c1].Name + 'To' + ColorspaceInfo[c2].Name;
520 result := functionName;
521
522 s := 'Result := ';
523 ls := '';
524 lf := '';
525 for i := Length(bp) - 1 downto 1 do
526 begin
527 cs1 := bp[i - 1];
528 cs2 := bp[i];
s1null529 s += GetConversionFunction(cs1,cs2) + '(';
530 lf += ')';
531 end;
532
533 needRefPoint := NeedXYZReferenceWhite(c1,c2);
534
535 vsam := Split(ColorspaceInfo[c2].MinMax);
536 vmax := vsam[Length(vsam) - 1];
537
538 ls := s + 'A' + ColorspaceInfo[c1].Name + lf + ';';
539 if not ColorspaceInfo[c1].HasAlpha and ColorspaceInfo[c2].HasAlpha then
540 begin
541 vn := GetVariablesNames(c2);
542 avn := vn[Length(vn) - 1];
543 if not avn.StartsWith('[') then avn := '.'+avn;
544 ls := ls + LineEnding + ' ' + 'Result' + avn + ' := AAlpha;';
unctionNamenull545 h := GetFunction(functionName,
546 'const A' + ColorspaceInfo[c1].Name + ': T' + ColorspaceInfo[c1].Name + ';const AAlpha' + ': ' + ChannelValueTypeName[ColorspaceInfo[c2].ValueType] + '=' + vmax,
547 'T' + ColorspaceInfo[c2].Name, needRefPoint);
548 end
549 else
550 begin
unctionNamenull551 h := GetFunction(functionName,
552 'const A' + ColorspaceInfo[c1].Name + ': T' + ColorspaceInfo[c1].Name,
553 'T' + ColorspaceInfo[c2].Name, needRefPoint);
554 end;
555 AddProcedureImp(h, ls);
556 if needRefPoint then
557 begin
558 ls := 'A' + ColorspaceInfo[c1].Name;
559 for i := 0 to Length(bp) - 2 do
560 begin
561 cs1 := bp[i];
562 cs2 := bp[i + 1];
s1null563 fn := GetConversionFunction(cs1,cs2);
564 bb := NeedXYZReferenceWhite(cs1, cs2);
565 if bb then
566 ls += ',AReferenceWhite';
567 ls := fn + '(' + ls + ')';
568 end;
569 ls := 'Result := ' + ls + ';';
570 if not ColorspaceInfo[c1].HasAlpha and ColorspaceInfo[c2].HasAlpha then
571 begin
unctionNamenull572 h := GetFunction(functionName,
573 'const A' + ColorspaceInfo[c1].Name + ': T' + ColorspaceInfo[c1].Name + '; ' + 'const AReferenceWhite: TXYZReferenceWhite' + ';const AAlpha' + ': ' + ChannelValueTypeName[ColorspaceInfo[c2].ValueType] + '=' + vmax,
574 'T' + ColorspaceInfo[c2].Name, needRefPoint);
575 vn := GetVariablesNames(c2);
576 avn := vn[Length(vn) - 1];
577 if not avn.StartsWith('[') then avn := '.' + avn;
578 ls := ls + #13#10 + ' ' + 'Result' + avn + ' := AAlpha;';
579 end
580 else
unctionNamenull581 h := GetFunction(functionName,
582 'const A' + ColorspaceInfo[c1].Name + ': T' + ColorspaceInfo[c1].Name + '; ' + 'const AReferenceWhite: TXYZReferenceWhite',
583 'T' + ColorspaceInfo[c2].Name, needRefPoint);
584 AddProcedureImp(h, ls);
585 end;
586 end;
587
588 var
589 i, j: TColorspaceEnum;
590 convertFunc: string;
591 pl: integer;
592
593 begin
594 AddImp('{Converters}');
595 AddImp('');
596
597 for i := Low(TColorspaceEnum) to High(TColorspaceEnum) do
598 begin
599 for j := Low(TColorspaceEnum) to High(TColorspaceEnum) do
600 begin
601 if (ColorspaceInfo[j].Name = ColorspaceInfo[i].Name + 'A'){ or
602 ((not (i in AlphaSupportedColorspaces)) and (j in AlphaSupportedColorspaces)) } then
603 begin
604 AddAlphaConverter(i, j, '; const AAlpha: single = 1');
605 AddAlphaConverter(j, i, '');
606 end;
607 end;
608 end;
609 for i := Low(TColorspaceEnum) to High(TColorspaceEnum) do
610 begin
611 for j := Low(TColorspaceEnum) to High(TColorspaceEnum) do
612 begin
613 if (i <> j) and (ColorspaceInfo[j].Name <> ColorspaceInfo[i].Name + 'A') and (ColorspaceInfo[i].Name <> ColorspaceInfo[j].Name + 'A') then
614 begin
615 convertFunc := '';
616 for pl := 0 to Length(PairsList) - 1 do
617 begin
618 if (PairsList[pl].First = i) and (PairsList[pl].Last = j) then
619 begin
620 convertFunc := PairsList[pl].ToLastFunc;
621 break;
622 end;
623 if (PairsList[pl].Last = i) and (PairsList[pl].First = j) then
624 begin
625 convertFunc := PairsList[pl].ToFirstFunc;
626 break;
627 end;
628 end;
629 if convertFunc = '' then
630 convertFunc := AddConverter(i, j);
631
632 if convertFunc = '' then continue;
633
634 ConvMatrix[i,j] := true;
635
636 AddImp('procedure Convert' + ColorspaceInfo[i].Name+'ArrayTo'+ColorspaceInfo[j].Name+'Array' +
637 '(ASource: pointer; ADest: Pointer; ACount: integer; '+
638 'ASourceStride:integer=sizeOf(T'+ColorspaceInfo[i].Name+'); '+
639 'ADestStride:integer=sizeOf(T'+ColorspaceInfo[j].Name+'); '+
640 '{%H-}AReferenceWhite: PXYZReferenceWhite=nil);');
641 AddImp('begin');
642 if NeedXYZReferenceWhite(i,j) then
643 AddImp(' if AReferenceWhite = nil then AReferenceWhite := @CurrentReferenceWhite;');
644 AddImp(' while ACount > 0 do begin');
645 if NeedXYZReferenceWhite(i,j) then
646 AddImp(' T'+ColorspaceInfo[j].Name+'(ADest^) := '+convertFunc+'(T'+ColorspaceInfo[i].Name+'(ASource^), AReferenceWhite^);')
647 else
648 AddImp(' T'+ColorspaceInfo[j].Name+'(ADest^) := '+convertFunc+'(T'+ColorspaceInfo[i].Name+'(ASource^));');
649 AddImp(' inc(PByte(ASource), ASourceStride); inc(PByte(ADest), ADestStride); dec(ACount); end;');
650 AddImp('end;');
651 AddImp('');
652 end;
653 end;
654 end;
655 end;
656
657 procedure MakeHelper(Colorspace: TColorspaceEnum; AHelperOnly, AColorspaceOnly: boolean);
658 var
659 i: integer;
660 HelperName, ColorspaceName, ColorTypeName, n, h, nt: string;
661 VariablesNames: TStringArray;
662 MinValues,MaxValues: TStringArray;
663 cs: TColorspaceEnum;
664 b: boolean;
665
GetConvertProcedureImpnull666 function GetConvertProcedureImp(cpto: TColorspaceEnum; AReferenceWhiteParam: string): string;
667 begin
668 Result := 'Result := ' + GetConversionFunctionRec(ColorSpace, cpto, 'Self', AReferenceWhiteParam) + ';';
669 end;
670
GetFromConvertProcedureImpnull671 function GetFromConvertProcedureImp(cpfrom: TColorspaceEnum; AReferenceWhiteParam: string): string;
672 begin
673 Result := 'Self := ' + GetConversionFunctionRec(cpfrom, ColorSpace, 'AValue', AReferenceWhiteParam) + ';';
674 end;
675
676 procedure AddNew(s: string; ov: boolean);
677 var ls: array of string;
678 i: integer;
679 params: TStringList;
680 begin
681 params := TStringList.Create;
682 params.Delimiter:= ',';
683 params.StrictDelimiter:= true;
684 params.DelimitedText := s;
685
686 h := 'class ' + GetFunction('New', 'const ' + s + ':' + ChannelValueTypeName[ColorspaceInfo[Colorspace].ValueType], ColorTypeName, ov, True);
687 Add(' ' + h);
elperNamenull688 h := 'class ' + GetFunction(HelperName + '.New', 'const ' + s + ':' + ChannelValueTypeName[ColorspaceInfo[Colorspace].ValueType], ColorTypeName, ov);
689 case Colorspace of
690 csColor: AddProcedureImp(h, 'Result := BGRAGraphics.RGBToColor(' + s + ');');
691 else
692 begin
693 setlength(ls, length(VariablesNames));
694 for i := 0 to high(VariablesNames) do
695 if VariablesNames[i].StartsWith('[') then
696 begin
697 if i >= params.Count then
698 WriteStr(ls[i],'Result',VariablesNames[i],' := ',MaxValues[i],';')
699 else
700 WriteStr(ls[i],'Result',VariablesNames[i],' := ',params[i],';');
701 end else
702 begin
703 if i >= params.Count then
704 WriteStr(ls[i],'Result.',VariablesNames[i],' := ',MaxValues[i],';')
705 else
706 WriteStr(ls[i],'Result.',VariablesNames[i],' := ',params[i],';');
707 end;
708 AddProcedureImp(h, ls);
709 end
710 end;
711 params.Free;
712 end;
713
714 var
715 ov, ba: boolean;
716 vsam, vsfm, body, vn2: TStringArray;
717 cn: integer;
718 typeDeclaration, flagStr: string;
719 handlesExtraAlpha: boolean;
720 begin
721 ColorspaceName := ColorspaceInfo[Colorspace].Name;
722
723 ColorTypeName := 'T' + ColorspaceName;
724 VariablesNames := GetVariablesNames(Colorspace);
725 vsfm := Split(ColorspaceInfo[Colorspace].FullNames);
726 vsam := Split(ColorspaceInfo[Colorspace].MinMax);
727 cn := Length(vsam) div 2;
728 setlength(MaxValues, cn);
729 setlength(MinValues, cn);
730 for i := 0 to cn-1 do
731 begin
732 MinValues[i] := vsam[i];
733 MaxValues[i] := vsam[i+cn];
734 end;
735
736 if AColorspaceOnly then
737 begin
738 Add('{ '+ColorTypeName+'Colorspace }');
739 Add('');
740 Add(ColorTypeName+'Colorspace = class(TCustomColorspace)');
741 Add(' class function GetChannelName(AIndex: integer): string; override;');
742 Add(' class function GetChannelCount: integer; override;');
743 Add(' class function IndexOfAlphaChannel: integer; override;');
744 if not ColorspaceInfo[Colorspace].HasAlpha then
745 Add(' class function GetColorTransparency({%H-}AColor: Pointer): TColorTransparency; override;')
746 else
747 Add(' class function GetColorTransparency(AColor: Pointer): TColorTransparency; override;');
748 Add(' class function GetMaxValue(AIndex: integer): single; override;');
749 Add(' class function GetMinValue(AIndex: integer): single; override;');
750 Add(' class function GetChannelBitDepth({%H-}AIndex: integer): byte; override;');
751 Add(' class function GetName: string; override;');
752 Add(' class function GetSize: integer; override;');
753 Add(' class function GetChannel(AColor: Pointer; AIndex: integer): single; override;');
754 Add(' class procedure SetChannel(AColor: Pointer; AIndex: integer; AValue: single); override;');
755 Add(' class function GetFlags: TColorspaceFlags; override;');
756 Add('end;');
757 Add('');
758 AddImp('{ '+ColorTypeName+'Colorspace }');
759 AddImp('');
760
761 setlength(body, length(vsfm)+3);
762 body[0] := 'case AIndex of';
763 for i := 0 to high(vsfm) do
764 body[i+1] := inttostr(i)+': result := ''' + vsfm[i] + ''';';
765 body[high(body)-1] := 'else raise ERangeError.Create(''Index out of bounds'');';
766 body[high(body)] := 'end;';
767 AddProcedureImp('class function '+ColorTypeName+'Colorspace.GetChannelName(AIndex: integer): string;', body);
768
769 AddProcedureImp('class function '+ColorTypeName+'Colorspace.GetChannelCount: integer;',
770 'result := ' + inttostr(length(vsfm)));
771
772 if ColorspaceInfo[Colorspace].HasAlpha then
773 AddProcedureImp('class function '+ColorTypeName+'Colorspace.IndexOfAlphaChannel: integer;',
774 'result := ' + inttostr(length(vsfm)-1))
775 else
776 AddProcedureImp('class function '+ColorTypeName+'Colorspace.IndexOfAlphaChannel: integer;',
777 'result := -1');
778
779 if not ColorspaceInfo[Colorspace].HasAlpha then
780 AddProcedureImp('class function '+ColorTypeName+'Colorspace.GetColorTransparency(AColor: Pointer): TColorTransparency;',
781 'result := ctFullyOpaque')
782 else
783 AddProcedureImp('class function '+ColorTypeName+'Colorspace.GetColorTransparency(AColor: Pointer): TColorTransparency;',
784 ['if '+ColorTypeName+'(AColor^).'+VariablesNames[cn-1]+' >= '+MaxValues[cn-1]+' then exit(ctFullyOpaque) else',
785 'if '+ColorTypeName+'(AColor^).'+VariablesNames[cn-1]+' <= '+MinValues[cn-1]+' then exit(ctFullyTransparent) else',
786 'exit(ctSemiTransparent)']);
787
788 setlength(body, cn + 3);
789 body[0] := 'case AIndex of';
790 for i := 0 to cn - 1 do
791 body[i+1] := inttostr(i)+': result := ' + MaxValues[i] + ';';
792 body[high(body)-1] := 'else raise ERangeError.Create(''Index out of bounds'');';
793 body[high(body)] := 'end;';
794 AddProcedureImp('class function '+ColorTypeName+'Colorspace.GetMaxValue(AIndex: integer): single;', body);
795
796 for i := 0 to cn - 1 do
797 body[i+1] := inttostr(i)+': result := ' + MinValues[i] + ';';
798 AddProcedureImp('class function '+ColorTypeName+'Colorspace.GetMinValue(AIndex: integer): single;', body);
799
800 AddProcedureImp('class function '+ColorTypeName+'Colorspace.GetChannelBitDepth(AIndex: integer): byte;',
801 'result := ' + IntToStr(ChannelValueTypeBitDepth[ColorspaceInfo[Colorspace].ValueType]) + ';');
802
803 AddProcedureImp('class function '+ColorTypeName+'Colorspace.GetName: string;',
804 'result := ''' + ColorspaceName + ''';');
805
806 AddProcedureImp('class function '+ColorTypeName+'Colorspace.GetSize: integer;',
807 'result := sizeof(' + ColorTypeName + ');');
808
809 setlength(body, length(VariablesNames)+3);
810 body[0] := 'case AIndex of';
811 for i := 0 to high(VariablesNames) do
812 body[i+1] := inttostr(i)+': result := ' + ColorTypeName + '(AColor^).' + VariablesNames[i] + ';';
813 body[high(body)-1] := 'else raise ERangeError.Create(''Index out of bounds'');';
814 body[high(body)] := 'end;';
815 AddProcedureImp('class function '+ColorTypeName+'Colorspace.GetChannel(AColor: Pointer; AIndex: integer): single;', body);
816
817 setlength(body, length(VariablesNames)+3);
818 body[0] := 'case AIndex of';
819 for i := 0 to high(VariablesNames) do
820 begin
821 if not (ColorspaceInfo[Colorspace].ValueType in[cvtSingle,cvtDouble]) then
822 body[i+1] := inttostr(i)+': ' + ColorTypeName + '(AColor^).' + VariablesNames[i] + ' := Round(Clamp(AValue,' + MinValues[i] + ',' +MaxValues[i] + '));'
823 else
824 body[i+1] := inttostr(i)+': ' + ColorTypeName + '(AColor^).' + VariablesNames[i] + ' := AValue;';
825 end;
826 body[high(body)-1] := 'else raise ERangeError.Create(''Index out of bounds'');';
827 body[high(body)] := 'end;';
828 AddProcedureImp('class procedure '+ColorTypeName+'Colorspace.SetChannel(AColor: Pointer; AIndex: integer; AValue: single);', body);
829
830 if ColorspaceInfo[Colorspace].NeedRefWhite then flagStr := 'cfMovableReferenceWhite' else
831 if Colorspace >= csXYZA then flagStr := 'cfReferenceWhiteIndependent' else
832 flagStr := 'cfFixedReferenceWhite';
833 if ColorspaceInfo[Colorspace].HasImaginary then flagStr += ',cfHasImaginaryColors';
834 AddProcedureImp('class function '+ColorTypeName+'Colorspace.GetFlags: TColorspaceFlags;',
835 'result := [' + flagStr + '];');
836
837 AddImp('');
838 exit;
839 end;
840
841 if IsHelperOnly(Colorspace) or AHelperOnly then
842 begin
843 if not AHelperOnly then exit;
844 HelperName := ColorTypeName + 'Helper';
845 if IsHelperOnly(Colorspace) then
846 begin
847 if ColorspaceInfo[Colorspace].BasicHelper then
848 typeDeclaration := ColorspaceInfo[Colorspace].Declaration+ '(' + ColorTypeName + 'BasicHelper) for ' + ColorTypeName
849 else
850 typeDeclaration := ColorspaceInfo[Colorspace].Declaration+ ' for ' + ColorTypeName;
851 end
852 else
853 begin
854 typeDeclaration := 'record helper for ' + ColorTypeName
855 end;
856 end else
857 begin
858 HelperName := ColorTypeName;
859 typeDeclaration := ColorspaceInfo[Colorspace].Declaration;
860 ColorTypeDefined[Colorspace] := true;
861 end;
862
863 Add('{ ' + HelperName + ' }');
864 Add('');
865 if not IsHelperOnly(Colorspace) and not AHelperOnly then
866 Add('P'+ColorspaceName+' = ^'+ColorTypeName+';');
867 Add(HelperName + ' = ' + typeDeclaration);
868
869 AddImp('{ ' + HelperName + ' }');
870 AddImp('');
871
872 if not IsHelperOnly(Colorspace) and not AHelperOnly then
873 begin
874 Add(' ' + ColorspaceInfo[Colorspace].VariableNames + ': ' + ChannelValueTypeName[ColorspaceInfo[Colorspace].ValueType] + ';');
875 end;
876
877 if not AHelperOnly or IsHelperOnly(Colorspace) then
878 begin
879 ov := ColorspaceInfo[Colorspace].HasAlpha;
880
881 s := '';
882 for i := 0 to Length(vsfm) - 1 do
883 begin
884 s += 'A'+vsfm[i];
885 if i <> Length(vsfm) - 1 then
886 s += ',';
887 end;
888 AddNew(s, ov);
889
890 if ColorspaceInfo[Colorspace].HasAlpha then
891 begin
892 s := '';
893 for i := 0 to Length(vsfm) - 2 do
894 begin
895 s += 'A'+vsfm[i];
896 if i <> Length(vsfm) - 2 then
897 s += ',';
898 end;
899 AddNew(s, ov);
900 end;
901 end;
902
903 if AHelperOnly then
904 begin
905 h := 'class function '+HelperName+'.Colorspace: TColorspaceAny; static;';
906 AddProcedureImp(h, 'result := T'+ColorspaceName+'Colorspace;');
907 Add(' ' + StringReplace(h, HelperName+'.', '', []));
908
909 if Colorspace = csColor then
910 begin
911 Add('private');
elperNamenull912 h := GetFunction(HelperName+'.GetRed', '', 'byte', false);
913 AddProcedureImp(h, 'result := {$IFDEF TCOLOR_BLUE_IN_LOW_BYTE}(self shr 16) and $ff{$ELSE}self and $ff{$ENDIF};');
914 Add(' ' + StringReplace(h, HelperName+'.', '', []));
elperNamenull915 h := GetFunction(HelperName+'.GetGreen', '', 'byte', false);
916 AddProcedureImp(h, 'result := (self shr 8) and $ff;');
917 Add(' ' + StringReplace(h, HelperName+'.', '', []));
elperNamenull918 h := GetFunction(HelperName+'.GetBlue', '', 'byte', false);
919 AddProcedureImp(h, 'result := {$IFDEF TCOLOR_BLUE_IN_LOW_BYTE}self and $ff{$ELSE}(self shr 16) and $ff{$ENDIF};');
920 Add(' ' + StringReplace(h, HelperName+'.', '', []));
921
922 h := GetProcedure(HelperName+'.SetRed', 'AValue: byte', false);
923 AddProcedureImp(h, 'self := {$IFDEF TCOLOR_BLUE_IN_LOW_BYTE}LongWord(self and $00ffff) or (AValue shl 16){$ELSE}LongWord(self and $ffff00) or AValue{$ENDIF};');
924 Add(' ' + StringReplace(h, HelperName+'.', '', []));
925 h := GetProcedure(HelperName+'.SetGreen', 'AValue: byte', false);
926 AddProcedureImp(h, 'self := LongWord(self and $ff00ff) or (AValue shl 8);');
927 Add(' ' + StringReplace(h, HelperName+'.', '', []));
928 h := GetProcedure(HelperName+'.SetBlue', 'AValue: byte', false);
929 AddProcedureImp(h, 'self := {$IFDEF TCOLOR_BLUE_IN_LOW_BYTE}LongWord(self and $ffff00) or AValue{$ELSE}LongWord(self and $00ffff) or (AValue shl 16){$ENDIF};');
930 Add(' ' + StringReplace(h, HelperName+'.', '', []));
931 add('public');
932 end;
933
934 if Colorspace = csXYZA then
935 begin
936 h := GetProcedure(HelperName+'.ChromaticAdapt', 'const AFrom, ATo: TXYZReferenceWhite', false);
937 AddProcedureImp(h, 'ChromaticAdaptXYZ(self.X,self.Y,self.Z, AFrom,ATo);');
938 Add(' ' + StringReplace(h, HelperName+'.', '', []));
939 end else
940 if Colorspace = csWordXYZA then
941 begin
942 h := GetProcedure(HelperName+'.ChromaticAdapt', 'const AFrom, ATo: TXYZReferenceWhite', false);
943 AddProcedureImp(h, 'ChromaticAdaptWordXYZ(self.X,self.Y,self.Z, AFrom,ATo);');
944 Add(' ' + StringReplace(h, HelperName+'.', '', []));
945 end;
946
947 for cs := Low(TColorspaceEnum) to High(TColorspaceEnum) do
948 begin
949 if (cs = Colorspace) or not ColorTypeDefined[cs] then Continue;
950 if ColorspaceInfo[Colorspace].BasicHelper and (ColorspaceInfo[cs].BasicHelper or (cs = csColor)) then continue;
951
952 n := ColorspaceInfo[cs].Name;
953 b := NeedXYZReferenceWhite(cs,Colorspace);
954 ba := not ColorspaceInfo[Colorspace].HasAlpha and ColorspaceInfo[cs].HasAlpha;
955
956 h := GetFunction('To' + n, '', 'T' + n, b or ba);
957 Add(' ' + h);
elperNamenull958 h := GetFunction(HelperName + '.To' + n, '', 'T' + n, b or ba);
959 AddProcedureImp(h, GetConvertProcedureImp(cs, ''));
960
961 if ba then
962 begin
963 h := GetFunction('To' + n, 'AAlpha: ' + ChannelValueTypeName[ColorspaceInfo[cs].ValueType], 'T' + n, b or ba);
964 Add(' ' + h);
elperNamenull965 h := GetFunction(HelperName + '.To' + n, 'AAlpha: ' + ChannelValueTypeName[ColorspaceInfo[cs].ValueType], 'T' + n, b or ba);
olorspacenull966 GetConversionFunction(Colorspace, cs, handlesExtraAlpha);
967 if handlesExtraAlpha then
968 AddProcedureImp(h, 'result := '+GetConversionFunctionRec(ColorSpace, cs, 'Self, AAlpha', '')+';')
969 else
970 begin
971 vn2 := Split(ColorspaceInfo[cs].VariableNames);
972 AddProcedureImp(h, [GetConvertProcedureImp(cs, ''), 'result.'+vn2[high(vn2)]+' := AAlpha;']);
973 end;
974 end;
975
976 if b then
977 begin
978 h := GetFunction('To' + n, 'const AReferenceWhite: TXYZReferenceWhite', 'T' + n, b or ba);
979 Add(' ' + h);
elperNamenull980 h := GetFunction(HelperName + '.To' + n, 'const AReferenceWhite: TXYZReferenceWhite', 'T' + n, b or ba);
981 AddProcedureImp(h, GetConvertProcedureImp(cs, 'AReferenceWhite'));
982 end;
983 end;
984
985 for cs := Low(TColorspaceEnum) to High(TColorspaceEnum) do
986 begin
987 if (cs = Colorspace) or not ColorTypeDefined[cs] then Continue;
988 if ColorspaceInfo[Colorspace].BasicHelper and (ColorspaceInfo[cs].BasicHelper or (cs = csColor)) then continue;
989
990 n := ColorspaceInfo[cs].Name;
991 nt := 'T' + n;
992 b := NeedXYZReferenceWhite(cs,Colorspace);
993 h := GetProcedure('From' + n, 'AValue: ' + nt, b);
994 Add(' ' + h);
995 h := GetProcedure(HelperName + '.From' + n, 'AValue: ' + nt, b);
996 AddProcedureImp(h, GetFromConvertProcedureImp(cs, ''));
997 if b then
998 begin
999 h := GetProcedure('From' + n, 'AValue: ' + nt + '; ' + 'const AReferenceWhite: TXYZReferenceWhite', b);
1000 Add(' ' + h);
1001 h := GetProcedure(HelperName + '.From' + n, 'AValue: ' + nt + '; ' + 'const AReferenceWhite: TXYZReferenceWhite', b);
1002 AddProcedureImp(h, GetFromConvertProcedureImp(cs, 'AReferenceWhite'));
1003 end;
1004 end;
1005
1006 if Colorspace = csColor then
1007 begin
1008 Add(' property red: byte read GetRed write SetRed;');
1009 Add(' property green: byte read GetGreen write SetGreen;');
1010 Add(' property blue: byte read GetBlue write SetBlue;');
1011 end;
1012 end;
1013
1014 Add('end;');
1015 Add('');
1016 end;
1017
1018 procedure MakeHelpers;
1019 var
1020 cs: TColorspaceEnum;
1021 begin
1022 for cs := Low(TColorspaceEnum) to High(TColorspaceEnum) do
1023 ColorTypeDefined[cs] := IsHelperOnly(cs);
1024 InfSpaceAdd := ' ';
1025 for cs := Low(TColorspaceEnum) to High(TColorspaceEnum) do
1026 if not IsHelperOnly(cs) then
1027 MakeHelper(cs, false, false);
1028 for cs := Low(TColorspaceEnum) to High(TColorspaceEnum) do
1029 MakeHelper(cs, false, true);
1030 for cs := Low(TColorspaceEnum) to High(TColorspaceEnum) do
1031 MakeHelper(cs, true, false);
1032 InfSpaceAdd := '';
1033 end;
1034
1035 procedure MakeOperators;
1036
1037 procedure AddOperator(c1, c2: TColorspaceEnum);
1038 var
1039 h, ls: string;
1040 begin
1041 h := 'operator := (const AValue: T' + ColorspaceInfo[c1].Name + '): T' + ColorspaceInfo[c2].Name + ';';
1042 ls := 'Result := ' + GetConversionFunctionRec(c1,c2,'AValue') + ';';
1043 Add(h);
1044 AddProcedureImp(h, ls);
1045 end;
1046
1047 var
1048 i, j: TColorspaceEnum;
1049 begin
1050 AddImp('{Operators}');
1051 AddImp('');
1052 for i := Low(TColorspaceEnum) to High(TColorspaceEnum) do
1053 for j := Low(TColorspaceEnum) to High(TColorspaceEnum) do
1054 if (i <> j) and not ([i,j] <= [csHSLAPixel,csGSBAPixel]) and
1055 not ((ColorspaceInfo[i].BasicHelper or (i = csColor)) and (ColorspaceInfo[j].BasicHelper or (j = csColor))) then
1056 AddOperator(i, j);
1057 end;
1058
1059 procedure RegisterColorspaces;
1060 var
1061 i,j: TColorspaceEnum;
1062 begin
1063 for i := Low(TColorspaceEnum) to High(TColorspaceEnum) do
1064 AddImp(' ColorspaceCollection.Add(T' + ColorspaceInfo[i].Name +'Colorspace);');
1065
1066 for i := Low(TColorspaceEnum) to High(TColorspaceEnum) do
1067 for j := Low(TColorspaceEnum) to High(TColorspaceEnum) do
1068 if (i <> j) and (ConvMatrix[i,j]) then
1069 AddImp(' ColorspaceCollection.AddConversion(T' + ColorspaceInfo[i].Name +'Colorspace, T' + ColorspaceInfo[j].Name +'Colorspace,'
1070 +' @Convert' + ColorspaceInfo[i].Name +'ArrayTo' + ColorspaceInfo[j].Name +'Array);');
1071 end;
1072
1073 begin
1074 writeln('Generating colorspaces...');
1075 SetLength(PairsList, 0);
1076
1077 //direct conversions (using single predefined function)
1078 //TExpandedPixel is the first bridge between colorspaces
1079
1080 AddColorPair(csBGRAPixel, csColor, 'ColorToBGRA', 'BGRAToColor');
1081 AddColorPair(csBGRAPixel, csExpandedPixel, 'GammaCompression', 'GammaExpansion');
1082
1083 AddColorPair(csFPColor, csBGRAPixel, 'BGRAToFPColor', 'FPColorToBGRA');
1084 AddColorPair(csFPColor, csExpandedPixel, 'ExpandedToFPColor', 'FPColorToExpanded', true, 2);
1085
1086 {AddColorPair(csHSLAPixel, csBGRAPixel, 'BGRAToHSLA', 'HSLAToBGRA', true, 2);
1087 AddColorPair(csGSBAPixel, csBGRAPixel, 'BGRAToGSBA', 'GSBAToBGRA', true, 2);}
1088 AddColorPair(csHSLAPixel, csGSBAPixel, 'GSBAToHSLA', 'HSLAToGSBA');
1089 AddColorPair(csHSLAPixel, csExpandedPixel, 'ExpandedToHSLA', 'HSLAToExpanded');
1090 AddColorPair(csGSBAPixel, csExpandedPixel, 'ExpandedToGSBA', 'GSBAToExpanded');
1091
1092 AddColorPair(csStdRGBA, csBGRAPixel);
1093 AddColorPair(csStdHSLA, csStdRGBA);
1094 AddColorPair(csStdHSVA, csStdRGBA);
1095 AddColorPair(csStdHSLA, csStdHSVA);
1096 AddColorPair(csStdCMYKA, csStdRGBA);
1097 AddColorPair(csStdRGBA, csExpandedPixel, '','',true, 2);
1098
1099 { AddColorPair(csWordMask, csExpandedPixel, 'ExpandedToWordMask', 'WordMaskToExpanded');
1100 AddColorPair(csByteMask, csWordMask, 'MaskWordToByte', 'MaskByteToWord');}
1101 AddColorPair(csByteMask, csBGRAPixel, 'BGRAToMask', 'MaskToBGRA', true, 3);
1102 AddColorPair(csByteMask, csExpandedPixel, 'ExpandedPixelToByteMask', 'ByteMaskToExpandedPixel', true, 2);
1103
1104 //the other bridge is TXYZA
1105 //TLinearRGBA is between TExpandedPixel and TXYZA
1106 //there two paths to linear RGBA
1107 AddColorPair(csExpandedPixel, csLinearRGBA);
1108 //AddColorPair(csStdRGBA, csLinearRGBA, '','',true, 2);
1109
1110 AddColorPair(csExpandedPixel, csWordXYZA);
1111 AddColorPair(csXYZA, csWordXYZA);
1112
1113 AddColorPair(csXYZA, csLinearRGBA);
1114 AddColorPair(csLabA, csXYZA, '','',true, 2);
1115 AddColorPair(csLabA, csLChA);
1116 AddColorPair(csAdobeRGBA, csXYZA);
1117
1118 //Add pairs for color spaces with and without alpha support
1119 AddAlphaPairs;
1120
1121 //Make all possible paths
1122 MakePathMatrix;
1123
1124 //Write unit
1125 intsl := TStringList.Create;
1126 impsl := TStringList.Create;
1127 Add('{ This file is generated by dev/colorspace/UnitMaker program }');
1128 Add('');
1129 Add('{$IFDEF INCLUDE_INTERFACE}');
1130 Add('{$UNDEF INCLUDE_INTERFACE}');
1131 Add('type');
1132 Add('');
1133 AddImp('{$IFDEF INCLUDE_IMPLEMENTATION}');
1134 AddImp('{$UNDEF INCLUDE_IMPLEMENTATION}');
1135 AddImp('');
1136 MakeConverters;
1137 MakeHelpers;
1138 MakeOperators;
1139 Add('{$ENDIF}');
1140 AddImp('{$ENDIF}');
1141
1142 AddImp('{$IFDEF INCLUDE_INITIALIZATION}');
1143 AddImp('{$UNDEF INCLUDE_INITIALIZATION}');
1144 RegisterColorspaces;
1145 AddImp('{$ENDIF}');
1146 //Save
1147 intsl.AddStrings(impsl);
1148 intsl.SaveToFile('generatedcolorspace.inc');
1149 intsl.Free;
1150 impsl.Free;
1151 WriteLn('Done generating colorspaces.');
1152 end;
1153
1154 end.
1155