Added transform syncronization, an animation module and made the app work faster

This commit is contained in:
Alice Vital
2022-06-23 13:22:32 +03:00
parent 25a72c3c86
commit b1552d0ebc
98 changed files with 11657 additions and 7788 deletions

View File

@ -5,7 +5,7 @@
Apophysis "3D hack" Copyright (C) 2007-2008 Peter Sdobnov
Apophysis "7X" Copyright (C) 2009-2010 Georg Kiehne
Apophysis AV "Phoenix Edition" Copyright (C) 2021 Alice V. Koryagina
Apophysis AV "Phoenix Edition" Copyright (C) 2021-2022 Alice V. Koryagina
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
@ -27,19 +27,12 @@ unit GradientHlpr;
interface
uses
windows, Graphics, Cmap;
const
PixelCountMax = 32768;
type
pRGBTripleArray = ^TRGBTripleArray;
TRGBTripleArray = array[0..PixelCountMax - 1] of TRGBTriple;
Graphics, Cmap;
type
TGradientHelper = class
private
procedure RGBBlend(a, b: integer; var Palette: TColorMap);
//procedure RGBBlend(a, b: integer; var Palette: TColorMap);
public
function GetGradientBitmap(Index: integer; const hue_rotation: double): TBitmap;
function RandomGradient: TColorMap;
@ -81,7 +74,7 @@ begin
Result := BitMap;
end;
///////////////////////////////////////////////////////////////////////////////
{//////////////////////////////////////////////////////////////////////////////}
function TGradientHelper.RandomGradient: TColorMap;
var
a, b, i, n, nodes: integer;
@ -143,7 +136,8 @@ begin
Result := Pal;
end;
///////////////////////////////////////////////////////////////////////////////
{//////////////////////////////////////////////////////////////////////////////}
(* // AV: how many duplicated code has this app...
procedure TGradientHelper.RGBBlend(a, b: integer; var Palette: TColorMap);
{ Linear blend between to indices of a palette }
var
@ -181,8 +175,8 @@ begin
Palette[i mod 256][2] := Round(c);
end;
end;
///////////////////////////////////////////////////////////////////////////////
*)
{//////////////////////////////////////////////////////////////////////////////}
initialization
GradientHelper := TGradientHelper.create;
finalization

View File

@ -5,7 +5,7 @@
Apophysis "3D hack" Copyright (C) 2007-2008 Peter Sdobnov
Apophysis "7X" Copyright (C) 2009-2010 Georg Kiehne
Apophysis AV "Phoenix Edition" Copyright (C) 2021 Alice V. Koryagina
Apophysis AV "Phoenix Edition" Copyright (C) 2021-2022 Alice V. Koryagina
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
@ -25,23 +25,32 @@ unit Cmap;
interface
uses sysutils, classes;
uses cmapdata, SysUtils, Classes, Windows;
// AV: moved following from Main unit and deleted all duplicates
const
PixelCountMax = 32768;
type
pRGBTripleArray = ^TRGBTripleArray;
TRGBTripleArray = array[0..PixelCountMax - 1] of TRGBTriple;
TColorMap = array[0..255, 0..3] of integer;
type
EFormatInvalid = class(Exception);
EPaletteInvalid = class(Exception); // AV: renamed due to name-space conflicts
const
RANDOMCMAP = -1;
NRCMAPS = 704;
NRCMAPS = NMAPS + 1; //704;
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 GetVal(token: string): string; // AV: make public
function ReplaceTabs(str: string): string; // AV: make public
function CreatePalette(strng: string): TColorMap; // AV: moved from RndFlame
function GetPalette(strng: string; var Palette: TColorMap): boolean;
procedure GetTokens(s: string; var mlist: TStringList);
procedure HSVBlend(a, b: integer; var Palette: TColorMap); // AV
@ -51,7 +60,7 @@ procedure Brighten(const n: byte; var r, g, b: byte); // AV
implementation
uses
cmapdata, Math;
Math;
procedure rgb2hsv(const rgb: array of double; out hsv: array of double);
var
@ -91,10 +100,6 @@ var
f, p, q, t, v: double;
begin
try
// rgb[0] := 0;
// rgb[1] := 0;
// rgb[2] := 0;
j := floor(hsv[0]);
f := hsv[0] - j;
@ -111,6 +116,11 @@ begin
5: begin rgb[0] := v; rgb[1] := p; rgb[2] := q; end;
end;
except on EMathError do
begin
rgb[0] := 0;
rgb[1] := 0;
rgb[2] := 0;
end;
end;
end;
@ -152,7 +162,6 @@ begin
Name := CMapNames[Index];
end;
procedure RGBBlend(a, b: integer; var Palette: TColorMap);
{ Linear blend between to indices of a palette }
var
@ -286,6 +295,83 @@ begin
end;
end;
function CreatePalette(strng: string): TColorMap; // AV: moved from RndFlame
{ Loads a palette from a gradient string }
var
Strings: TStringList;
index, i: integer;
Tokens: TStringList;
Indices, Colors: TStringList;
a, b: integer;
begin
Strings := TStringList.Create;
Tokens := TStringList.Create;
Indices := TStringList.Create;
Colors := TStringList.Create;
try
try
Strings.Text := strng;
if Pos('}', Strings.Text) = 0 then raise EPaletteInvalid.Create('No closing brace');
if Pos('{', Strings[0]) = 0 then raise EPaletteInvalid.Create('No opening brace.');
GetTokens(ReplaceTabs(strings.text), tokens);
Tokens.Text := Trim(Tokens.text);
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
Result[i][0] := 0;
Result[i][1] := 0;
Result[i][2] := 0;
end;
if Indices.Count = 0 then raise EPaletteInvalid.Create('No color info');
for i := 0 to Indices.Count - 1 do
begin
try
index := StrToInt(Indices[i]);
while index < 0 do inc(index, 400);
index := Round(Index * (255 / 399));
indices[i] := IntToStr(index);
assert(index >= 0);
assert(index < 256);
a := StrToInt(Colors[i]); // AV: added precalc
Result[index][0] := a mod 256;
Result[index][1] := trunc(a / 256) mod 256;
Result[index][2] := trunc(a / 65536);
except
end;
end;
i := 1;
repeat
a := StrToInt(Trim(Indices[i - 1]));
b := StrToInt(Trim(Indices[i]));
RGBBlend(a, b, Result);
inc(i);
until i = Indices.Count;
if (Indices[0] <> '0') or (Indices[Indices.Count - 1] <> '255') then
begin
a := StrToInt(Trim(Indices[Indices.Count - 1]));
b := StrToInt(Trim(Indices[0])) + 256;
RGBBlend(a, b, Result);
end;
except on EPaletteInvalid do
begin
//
end;
end;
finally
Tokens.Free;
Strings.Free;
Indices.Free;
Colors.Free;
end;
end;
function GetPalette(strng: string; var Palette: TColorMap): boolean;
{ Loads a palette from a gradient string }
@ -304,8 +390,10 @@ begin
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.');
if Pos('}', Strings.Text) = 0 then
raise EPaletteInvalid.Create('No closing brace');
if Pos('{', Strings[0]) = 0 then
raise EPaletteInvalid.Create('No opening brace.');
GetTokens(ReplaceTabs(Strings.Text), Tokens);
i := 0;
while (Pos('}', Tokens[i]) = 0) and (Pos('opacity:', Lowercase(Tokens[i])) = 0) do
@ -322,7 +410,8 @@ begin
Palette[i][1] := 0;
Palette[i][2] := 0;
end;
if Indices.Count = 0 then raise EFormatInvalid.Create('No color info');
if Indices.Count = 0 then
raise EPaletteInvalid.Create('No color info');
for i := 0 to Indices.Count - 1 do
begin
try
@ -330,8 +419,8 @@ begin
while index < 0 do inc(index, 400);
index := Round(Index * (255 / 399));
indices[i] := IntToStr(index);
assert(index>=0);
assert(index<256);
assert(index >= 0);
assert(index < 256);
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);
@ -351,7 +440,7 @@ begin
b := StrToInt(Indices[0]) + 256;
RGBBlend(a, b, Palette);
end;
except on EFormatInvalid do
except on EPaletteInvalid do
begin
Result := False;
end;

View File

@ -5,7 +5,7 @@
Apophysis "3D hack" Copyright (C) 2007-2008 Peter Sdobnov
Apophysis "7X" Copyright (C) 2009-2010 Georg Kiehne
Apophysis AV "Phoenix Edition" Copyright (C) 2021 Alice V. Koryagina
Apophysis AV "Phoenix Edition" Copyright (C) 2021-2022 Alice V. Koryagina
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
@ -31,7 +31,7 @@ interface
Const
NMAPS = 703;
cmaps : array[0..NMAPS,0..255,0..2] of byte =
cmaps : array[0..NMAPS, 0..255, 0..2] of byte =
(
// 0 south-sea-bather
((185, 234, 235), (193, 238, 235), (197, 242, 235), (201, 242, 235),