new version 2.02h
This commit is contained in:
ronaldhordijk
359
2.10/Source/cmap.pas
Normal file
359
2.10/Source/cmap.pas
Normal file
@ -0,0 +1,359 @@
|
||||
{
|
||||
Flame screensaver Copyright (C) 2002 Ronald Hordijk
|
||||
Apophysis Copyright (C) 2001-2004 Mark Townsend
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation; either version 2 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program; if not, write to the Free Software
|
||||
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
||||
}
|
||||
unit Cmap;
|
||||
|
||||
interface
|
||||
|
||||
uses sysutils, classes;
|
||||
|
||||
type
|
||||
TColorMap = array[0..255, 0..3] of integer;
|
||||
|
||||
type
|
||||
EFormatInvalid = class(Exception);
|
||||
|
||||
const
|
||||
RANDOMCMAP = -1;
|
||||
NRCMAPS = 701;
|
||||
|
||||
procedure GetCmap(var Index: integer; const hue_rotation: double; out cmap: TColorMap);
|
||||
procedure GetCmapName(var Index: integer; out Name: string);
|
||||
procedure rgb2hsv(const rgb: array of double; out hsv: array of double);
|
||||
procedure hsv2rgb(const hsv: array of double; out rgb: array of double);
|
||||
function GetGradient(FileName, Entry: string): string;
|
||||
function GetPalette(strng: string; var Palette: TColorMap): boolean;
|
||||
procedure GetTokens(s: string; var mlist: TStringList);
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
cmapdata, Math;
|
||||
|
||||
procedure rgb2hsv(const rgb: array of double; out hsv: array of double);
|
||||
var
|
||||
maxval, minval: double;
|
||||
del: double;
|
||||
begin
|
||||
Maxval := Max(rgb[0], Max(rgb[1], rgb[2]));
|
||||
Minval := Min(rgb[0], Min(rgb[1], rgb[2]));
|
||||
|
||||
hsv[2] := maxval; // v
|
||||
|
||||
if (Maxval > 0) and (maxval <> minval) then begin
|
||||
del := maxval - minval;
|
||||
hsv[1] := del / Maxval; //s
|
||||
|
||||
hsv[0] := 0;
|
||||
if (rgb[0] > rgb[1]) and (rgb[0] > rgb[2]) then begin
|
||||
hsv[0] := (rgb[1] - rgb[2]) / del;
|
||||
end else if (rgb[1] > rgb[2]) then begin
|
||||
hsv[0] := 2 + (rgb[2] - rgb[0]) / del;
|
||||
end else begin
|
||||
hsv[0] := 4 + (rgb[0] - rgb[1]) / del;
|
||||
end;
|
||||
|
||||
if hsv[0] < 0 then
|
||||
hsv[0] := hsv[0] + 6;
|
||||
|
||||
end else begin
|
||||
hsv[0] := 0;
|
||||
hsv[1] := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure hsv2rgb(const hsv: array of double; out rgb: array of double);
|
||||
var
|
||||
j: integer;
|
||||
f, p, q, t, v: double;
|
||||
begin
|
||||
try
|
||||
j := floor(hsv[0]);
|
||||
f := hsv[0] - j;
|
||||
v := hsv[2];
|
||||
p := hsv[2] * (1 - hsv[1]);
|
||||
q := hsv[2] * (1 - hsv[1] * f);
|
||||
t := hsv[2] * (1 - hsv[1] * (1 - f));
|
||||
case j of
|
||||
0: begin rgb[0] := v; rgb[1] := t; rgb[2] := p; end;
|
||||
1: begin rgb[0] := q; rgb[1] := v; rgb[2] := p; end;
|
||||
2: begin rgb[0] := p; rgb[1] := v; rgb[2] := t; end;
|
||||
3: begin rgb[0] := p; rgb[1] := q; rgb[2] := v; end;
|
||||
4: begin rgb[0] := t; rgb[1] := p; rgb[2] := v; end;
|
||||
5: begin rgb[0] := v; rgb[1] := p; rgb[2] := t; end;
|
||||
end;
|
||||
except on EMathError do
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure GetCmap(var Index: integer; const hue_rotation: double; out cmap: TColorMap);
|
||||
var
|
||||
i: Integer;
|
||||
rgb: array[0..2] of double;
|
||||
hsv: array[0..2] of double;
|
||||
begin
|
||||
if Index = RANDOMCMAP then
|
||||
Index := Random(NRCMAPS);
|
||||
|
||||
if (Index < 0) or (Index >= NRCMAPS) then
|
||||
Index := 0;
|
||||
|
||||
for i := 0 to 255 do begin
|
||||
rgb[0] := cmaps[Index][i][0] / 255.0;
|
||||
rgb[1] := cmaps[Index][i][1] / 255.0;
|
||||
rgb[2] := cmaps[Index][i][2] / 255.0;
|
||||
|
||||
rgb2hsv(rgb, hsv);
|
||||
hsv[0] := hsv[0] + hue_rotation * 6;
|
||||
hsv2rgb(hsv, rgb);
|
||||
|
||||
cmap[i][0] := Round(rgb[0] * 255);
|
||||
cmap[i][1] := Round(rgb[1] * 255);
|
||||
cmap[i][2] := Round(rgb[2] * 255);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure GetCmapName(var Index: integer; out Name: string);
|
||||
begin
|
||||
if Index = RANDOMCMAP then
|
||||
Index := Random(NRCMAPS);
|
||||
|
||||
if (Index < 0) or (Index >= NRCMAPS) then
|
||||
Index := 0;
|
||||
|
||||
Name := CMapNames[Index];
|
||||
end;
|
||||
|
||||
|
||||
procedure RGBBlend(a, b: integer; var Palette: TColorMap);
|
||||
{ Linear blend between to indices of a palette }
|
||||
var
|
||||
c, v: real;
|
||||
vrange, range: real;
|
||||
i: integer;
|
||||
begin
|
||||
if a = b then
|
||||
begin
|
||||
Exit;
|
||||
end;
|
||||
range := b - a;
|
||||
vrange := Palette[b mod 256][0] - Palette[a mod 256][0];
|
||||
c := Palette[a mod 256][0];
|
||||
v := vrange / range;
|
||||
for i := (a + 1) to (b - 1) do
|
||||
begin
|
||||
c := c + v;
|
||||
Palette[i mod 256][0] := Round(c);
|
||||
end;
|
||||
vrange := Palette[b mod 256][1] - Palette[a mod 256][1];
|
||||
c := Palette[a mod 256][1];
|
||||
v := vrange / range;
|
||||
for i := a + 1 to b - 1 do
|
||||
begin
|
||||
c := c + v;
|
||||
Palette[i mod 256][1] := Round(c);
|
||||
end;
|
||||
vrange := Palette[b mod 256][2] - Palette[a mod 256][2];
|
||||
c := Palette[a mod 256][2];
|
||||
v := vrange / range;
|
||||
for i := a + 1 to b - 1 do
|
||||
begin
|
||||
c := c + v;
|
||||
Palette[i mod 256][2] := Round(c);
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetVal(token: string): string;
|
||||
var
|
||||
p: integer;
|
||||
begin
|
||||
p := Pos('=', token);
|
||||
Delete(Token, 1, p);
|
||||
Result := Token;
|
||||
end;
|
||||
|
||||
function ReplaceTabs(str: string): string;
|
||||
{Changes tab characters in a string to spaces}
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
for i := 1 to Length(str) do
|
||||
begin
|
||||
if str[i] = #9 then
|
||||
begin
|
||||
Delete(str, i, 1);
|
||||
Insert(#32, str, i);
|
||||
end;
|
||||
end;
|
||||
Result := str;
|
||||
end;
|
||||
|
||||
procedure GetTokens(s: string; var mlist: TStringList);
|
||||
var
|
||||
test, token: string;
|
||||
begin
|
||||
mlist.clear;
|
||||
test := s;
|
||||
while (Length(Test) > 0) do
|
||||
begin
|
||||
while (Length(Test) > 0) and (test[1] in [#32]) do
|
||||
Delete(test, 1, 1);
|
||||
if (Length(Test) = 0) then
|
||||
exit;
|
||||
token := '';
|
||||
while (Length(Test) > 0) and (not (test[1] in [#32])) do
|
||||
begin
|
||||
token := token + test[1];
|
||||
Delete(test, 1, 1);
|
||||
end;
|
||||
mlist.add(token);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function GetPalette(strng: string; var Palette: TColorMap): boolean;
|
||||
{ Loads a palette from a gradient string }
|
||||
var
|
||||
Strings: TStringList;
|
||||
index, i: integer;
|
||||
Tokens: TStringList;
|
||||
Indices, Colors: TStringList;
|
||||
a, b: integer;
|
||||
begin
|
||||
GetPalette := True;
|
||||
Strings := TStringList.Create;
|
||||
Tokens := TStringList.Create;
|
||||
Indices := TStringList.Create;
|
||||
Colors := TStringList.Create;
|
||||
try
|
||||
try
|
||||
Strings.Text := strng;
|
||||
if Pos('}', Strings.Text) = 0 then raise EFormatInvalid.Create('No closing brace');
|
||||
if Pos('{', Strings[0]) = 0 then raise EFormatInvalid.Create('No opening brace.');
|
||||
GetTokens(ReplaceTabs(Strings.Text), Tokens);
|
||||
i := 0;
|
||||
while (Pos('}', Tokens[i]) = 0) and (Pos('opacity:', Lowercase(Tokens[i])) = 0) do
|
||||
begin
|
||||
if Pos('index=', LowerCase(Tokens[i])) <> 0 then
|
||||
Indices.Add(GetVal(Tokens[i]))
|
||||
else if Pos('color=', LowerCase(Tokens[i])) <> 0 then
|
||||
Colors.Add(GetVal(Tokens[i]));
|
||||
inc(i)
|
||||
end;
|
||||
for i := 0 to 255 do
|
||||
begin
|
||||
Palette[i][0] := 0;
|
||||
Palette[i][1] := 0;
|
||||
Palette[i][2] := 0;
|
||||
end;
|
||||
if Indices.Count = 0 then raise EFormatInvalid.Create('No color info');
|
||||
for i := 0 to Indices.Count - 1 do
|
||||
begin
|
||||
index := StrToInt(Indices[i]);
|
||||
index := Round(Index * (255 / 399));
|
||||
indices[i] := IntToStr(index);
|
||||
Palette[index][0] := StrToInt(Colors[i]) mod 256;
|
||||
Palette[index][1] := trunc(StrToInt(Colors[i]) / 256) mod 256;
|
||||
Palette[index][2] := trunc(StrToInt(Colors[i]) / 65536);
|
||||
end;
|
||||
i := 1;
|
||||
repeat
|
||||
a := StrToInt(Indices[i - 1]);
|
||||
b := StrToInt(Indices[i]);
|
||||
RGBBlend(a, b, Palette);
|
||||
inc(i);
|
||||
until i = Indices.Count;
|
||||
if (Indices[0] <> '0') or (Indices[Indices.Count - 1] <> '255') then
|
||||
begin
|
||||
a := StrToInt(Indices[Indices.Count - 1]);
|
||||
b := StrToInt(Indices[0]) + 256;
|
||||
RGBBlend(a, b, Palette);
|
||||
end;
|
||||
except on EFormatInvalid do
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
Tokens.Free;
|
||||
Strings.Free;
|
||||
Indices.Free;
|
||||
Colors.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetGradient(FileName, Entry: string): string;
|
||||
var
|
||||
FileStrings: TStringList;
|
||||
GradStrings: TStringList;
|
||||
i: integer;
|
||||
begin
|
||||
FileStrings := TStringList.Create;
|
||||
GradStrings := TStringList.Create;
|
||||
try
|
||||
try
|
||||
FileStrings.LoadFromFile(FileName);
|
||||
for i := 0 to FileStrings.count - 1 do
|
||||
if Pos(Entry + ' ', Trim(FileStrings[i])) = 1 then break;
|
||||
GradStrings.Add(FileStrings[i]);
|
||||
repeat
|
||||
inc(i);
|
||||
GradStrings.Add(FileStrings[i]);
|
||||
until Pos('}', FileStrings[i]) <> 0;
|
||||
GetGradient := GradStrings.Text;
|
||||
except on exception do
|
||||
Result := '';
|
||||
end;
|
||||
finally
|
||||
GradStrings.Free;
|
||||
FileStrings.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function LoadGradient(FileName, Entry: string; var gString: string; var Pal: TColorMap): boolean;
|
||||
var
|
||||
FileStrings: TStringList;
|
||||
GradStrings: TStringList;
|
||||
i: integer;
|
||||
begin
|
||||
FileStrings := TStringList.Create;
|
||||
GradStrings := TStringList.Create;
|
||||
try
|
||||
try
|
||||
FileStrings.LoadFromFile(FileName);
|
||||
for i := 0 to FileStrings.count - 1 do
|
||||
if Pos(Entry + ' ', Trim(FileStrings[i])) = 1 then break;
|
||||
GradStrings.Add(FileStrings[i]);
|
||||
repeat
|
||||
inc(i);
|
||||
GradStrings.Add(FileStrings[i]);
|
||||
until Pos('}', FileStrings[i]) <> 0;
|
||||
gString := GradStrings.Text;
|
||||
Result := GetPalette(GradStrings.Text, Pal);
|
||||
except on exception do
|
||||
Result := False;
|
||||
end;
|
||||
finally
|
||||
GradStrings.Free;
|
||||
FileStrings.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user