{ Apophysis Copyright (C) 2001-2004 Mark Townsend Apophysis Copyright (C) 2005-2006 Ronald Hordijk, Piotr Borys, Peter Sdobnov Apophysis Copyright (C) 2007-2008 Piotr Borys, Peter Sdobnov Apophysis "3D hack" Copyright (C) 2007-2008 Peter Sdobnov Apophysis "7X" Copyright (C) 2009-2010 Georg Kiehne 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 Global; interface uses Windows, SysUtils, Classes, SyncObjs, Controls, Graphics, Math, cmap, ControlPoint, Xform, CommDlg; type EFormatInvalid = class(Exception); { Weight manipulation } { Triangle transformations } function triangle_area(t: TTriangle): double; function transform_affine(const t: TTriangle; const Triangles: TTriangles): boolean; function line_dist(x, y, x1, y1, x2, y2: double): double; function dist(x1, y1, x2, y2: double): double; { Parsing functions } function GetVal(token: string): string; function ReplaceTabs(str: string): string; { Palette and gradient functions } //function GetGradient(FileName, Entry: string): string; { Misc } function det(a, b, c, d: double): double; function solve3(x1, x2, x1h, y1, y2, y1h, z1, z2, z1h: double; var a, b, e: double): double; function OpenSaveFileDialog(Parent: TWinControl; const DefExt, Filter, InitialDir, Title: string; var FileName: string; MustExist, OverwritePrompt, NoChangeDir, DoOpen: Boolean): Boolean; procedure LoadThumbnailPlaceholder(ThumbnailSize : integer); function GetEnvVarValue(const VarName: string): string; const APP_NAME: string = 'Apophysis 7x'; {$ifdef Apo7X64} APP_BUILD: string = '64 bit'; {$else} APP_BUILD: string = '32 bit'; {$endif} MAX_TRANSFORMS: integer = 100; prefilter_white: integer = 1024; eps: double = 1E-10; White_level = 200; clyellow1 = TColor($17FCFF); clplum2 = TColor($ECA9E6); clSlateGray = TColor($837365); FT_BMP = 1; FT_PNG = 2; FT_JPG = 3; const crEditArrow = 20; crEditMove = 21; crEditRotate = 22; crEditScale = 23; const SingleBuffer : boolean = {$ifdef Apo7X64} false {$else} true {$endif}; var MainSeed: integer; MainTriangles: TTriangles; Transforms: integer; // Count of Tranforms EnableFinalXform: boolean; AppPath: string; // Path of applicatio file OpenFile: string; // Name of currently open file CanDrawOnResize: boolean; PreserveWeights: boolean; AlwaysCreateBlankFlame : boolean; StartupCheckForUpdates : boolean; TBWidth1 : integer; TBWidth2 : integer; TBWidth3 : integer; TBWidth4 : integer; TBWidth5 : integer; ThumbnailPlaceholder : TBitmap; WarnOnMissingPlugin : boolean; EmbedThumbnails : boolean; LanguageFile : string; AvailableLanguages : TStringList; PluginPath : string; { UPR Options } UPRSampleDensity: integer; UPRFilterRadius: double; UPROversample: integer; UPRAdjustDensity: boolean; UPRColoringIdent: string; UPRColoringFile: string; UPRFormulaIdent: string; UPRFormulaFile: string; UPRWidth: Integer; UPRHeight: Integer; ImageFolder: string; UPRPath: string; // Name and folder of last UPR file cmap_index: integer; // Index to current gradient Variation: TVariation; // Current variation NumTries, TryLength: integer; // Settings for smooth palette SmoothPaletteFile: string; { Editor } UseFlameBackground, UseTransformColors: boolean; HelpersEnabled: boolean; EditorBkgColor, ReferenceTriangleColor: integer; GridColor1, GridColor2, HelpersColor: integer; ExtEditEnabled, TransformAxisLock, RebuildXaosLinks: boolean; ShowAllXforms: boolean; EditorPreviewTransparency: integer; EnableEditorPreview: boolean; { Display } defSampleDensity, defPreviewDensity: Double; defGamma, defBrightness, defVibrancy, defFilterRadius, defGammaThreshold: Double; defOversample: integer; { Render } renderDensity, renderFilterRadius: double; renderOversample, renderWidth, renderHeight: integer; renderBitsPerSample: integer; renderPath: string; JPEGQuality: integer; renderFileFormat: integer; InternalBitsPerSample: integer; NrTreads: Integer; UseNrThreads: integer; PNGTransparency: integer; ShowTransparency: boolean; MainPreviewScale: double; ExtendMainPreview: boolean; StoreEXIF : boolean; StoreParamsEXIF : boolean; ExifAuthor : string; { Defaults } LastOpenFile: string; LastOpenFileEntry: integer; RememberLastOpenFile: boolean; UseSmallThumbnails: boolean; ClassicListMode: boolean; ConfirmDelete: boolean; // Flag confirmation of entry deletion OldPaletteFormat: boolean; ConfirmExit: boolean; ConfirmStopRender: boolean; SavePath, SmoothPalettePath: string; RandomPrefix, RandomDate: string; RandomIndex: integer; FlameFile, GradientFile, GradientEntry, FlameEntry: string; ParamFolder: string; prevLowQuality, prevMediumQuality, prevHighQuality: double; defSmoothPaletteFile: string; BrowserPath: string; // Stored path of browser open dialog EditPrevQual, MutatePrevQual, AdjustPrevQual: Integer; randMinTransforms, randMaxTransforms: integer; mutantMinTransforms, mutantMaxTransforms: integer; KeepBackground: boolean; randGradient: Integer; randGradientFile: string; defFlameFile: string; PlaySoundOnRenderComplete: boolean; RenderCompleteSoundFile: string; SaveIncompleteRenders: boolean; ShowRenderStats: boolean; LowerRenderPriority: boolean; SymmetryType: integer; SymmetryOrder: integer; SymmetryNVars: integer; Variations: array of boolean; //VariationOptions: int64; MainForm_RotationMode: integer; PreserveQuality: boolean; { For random gradients } MinNodes, MaxNodes, MinHue, MaxHue, MinSat, MaxSat, MinLum, MaxLum: integer; //ReferenceMode: integer; BatchSize: Integer; Compatibility: integer; //0 = original, 1 = Drave's Favorites: TStringList; Script: string; ScriptPath: string; SheepServer, SheepNick, SheepURL, SheepPW, flam3Path, helpPath: string; ExportBatches, ExportOversample, ExportWidth, ExportHeight, ExportFileFormat: Integer; ExportFilter, ExportDensity: Double; ExportEstimator, ExportEstimatorMin, ExportEstimatorCurve: double; ExportJitters: integer; ExportGammaTreshold: double; OpenFileType: TFileType; // ResizeOnLoad: Boolean; ShowProgress: Boolean; defLibrary: string; LimitVibrancy: Boolean; DefaultPalette: TColorMap; AutoOpenLog: Boolean; AutoSaveEnabled: Boolean; AutoSaveFreq: integer; AutoSavePath: string; LineCenterColor : integer; LineThirdsColor : integer; LineGRColor : integer; EnableGuides : boolean; function Round6(x: double): double; implementation function GetEnvVarValue(const VarName: string): string; var BufSize: Integer; // buffer size required for value begin // Get required buffer size (inc. terminal #0) BufSize := GetEnvironmentVariable( PChar(VarName), nil, 0); if BufSize > 0 then begin // Read env var value into result string SetLength(Result, BufSize - 1); GetEnvironmentVariable(PChar(VarName), PChar(Result), BufSize); end else // No such environment variable Result := ''; end; procedure LoadThumbnailPlaceholder(ThumbnailSize : integer); var placeholder: TBitmap; placeholderIcon: TBitmap; const pi_width = 48; pi_height = 48; begin placeholder := TBitmap.Create; placeholderIcon := TBitmap.Create; placeholderIcon.Handle := LoadBitmap(hInstance, 'THUMB_PLACEHOLDER'); placeholder.PixelFormat := pf32bit; placeholder.HandleType := bmDIB; placeholder.Width := ThumbnailSize; placeholder.Height := ThumbnailSize; with placeholder.Canvas do begin Brush.Color := $000000; FillRect(Rect(0, 0, placeholder.Width, placeholder.Height)); Draw(round(ThumbnailSize / 2 - pi_width / 2), round(ThumbnailSize / 2 - pi_height / 2), placeholderIcon); end; placeholderIcon.Free; ThumbnailPlaceholder := placeholder; end; { IFS } function det(a, b, c, d: double): double; begin Result := (a * d - b * c); end; function Round6(x: double): double; // Really ugly, but it works begin // --Z-- this is ridiculous: // Result := StrToFloat(Format('%.6f', [x])); // and yes, this is REALLY ugly :-\ Result := RoundTo(x, -6); end; function solve3(x1, x2, x1h, y1, y2, y1h, z1, z2, z1h: double; var a, b, e: double): double; var det1: double; begin det1 := x1 * det(y2, 1.0, z2, 1.0) - x2 * det(y1, 1.0, z1, 1.0) + 1 * det(y1, y2, z1, z2); if (det1 = 0.0) then begin Result := det1; EXIT; end else begin a := (x1h * det(y2, 1.0, z2, 1.0) - x2 * det(y1h, 1.0, z1h, 1.0) + 1 * det(y1h, y2, z1h, z2)) / det1; b := (x1 * det(y1h, 1.0, z1h, 1.0) - x1h * det(y1, 1.0, z1, 1.0) + 1 * det(y1, y1h, z1, z1h)) / det1; e := (x1 * det(y2, y1h, z2, z1h) - x2 * det(y1, y1h, z1, z1h) + x1h * det(y1, y2, z1, z2)) / det1; a := Round6(a); b := Round6(b); e := Round6(e); Result := det1; end; end; function dist(x1, y1, x2, y2: double): double; //var // d2: double; begin (* { From FDesign source { float pt_pt_distance(float x1, float y1, float x2, float y2) } d2 := (x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2); if (d2 = 0.0) then begin Result := 0.0; exit; end else Result := sqrt(d2); *) // --Z-- This is just amazing... :-\ // Someone needed an 'FDesign source' - to compute distance between two points??!? Result := Hypot(x2-x1, y2-y1); end; function line_dist(x, y, x1, y1, x2, y2: double): double; var a, b, e, c: double; begin if ((x = x1) and (y = y1)) then a := 0.0 else a := sqrt((x - x1) * (x - x1) + (y - y1) * (y - y1)); if ((x = x2) and (y = y2)) then b := 0.0 else b := sqrt((x - x2) * (x - x2) + (y - y2) * (y - y2)); if ((x1 = x2) and (y1 = y2)) then e := 0.0 else e := sqrt((x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2)); if ((a * a + e * e) < (b * b)) then Result := a else if ((b * b + e * e) < (a * a)) then Result := b else if (e <> 0.0) then begin c := (b * b - a * a - e * e) / (-2 * e); if ((a * a - c * c) < 0.0) then Result := 0.0 else Result := sqrt(a * a - c * c); end else Result := a; end; function transform_affine(const t: TTriangle; const Triangles: TTriangles): boolean; var ra, rb, rc, a, b, c: double; begin Result := True; ra := dist(Triangles[-1].y[0], Triangles[-1].x[0], Triangles[-1].y[1], Triangles[-1].x[1]); rb := dist(Triangles[-1].y[1], Triangles[-1].x[1], Triangles[-1].y[2], Triangles[-1].x[2]); rc := dist(Triangles[-1].y[2], Triangles[-1].x[2], Triangles[-1].y[0], Triangles[-1].x[0]); a := dist(t.y[0], t.x[0], t.y[1], t.x[1]); b := dist(t.y[1], t.x[1], t.y[2], t.x[2]); c := dist(t.y[2], t.x[2], t.y[0], t.x[0]); if (a > ra) then Result := False else if (b > rb) then Result := False else if (c > rc) then Result := False else if ((a = ra) and (b = rb) and (c = rc)) then Result := False; end; function triangle_area(t: TTriangle): double; var base, height: double; begin try base := dist(t.x[0], t.y[0], t.x[1], t.y[1]); height := line_dist(t.x[2], t.y[2], t.x[1], t.y[1], t.x[0], t.y[0]); if (base < 1.0) then Result := height else if (height < 1.0) then Result := base else Result := 0.5 * base * height; except on E: EMathError do Result := 0; end; end; { Parse } 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; (* { Palette and gradient functions } function RGBToColor(Pal: TMapPalette; index: integer): Tcolor; begin { Converts the RGB values from a palette index to the TColor type ... could maybe change it to SHLs } Result := (Pal.Blue[index] * 65536) + (Pal.Green[index] * 256) + Pal.Red[index]; end; 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 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; 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 ReplaceStr(Str, SearchStr, ReplaceStr: string): string; begin while Pos(SearchStr, Str) <> 0 do begin Insert(ReplaceStr, Str, Pos(SearchStr, Str)); system.Delete(Str, Pos(SearchStr, Str), Length(SearchStr)); end; Result := Str; end; function SplitFilter(const fText: String; const fSep: Char; fTrim: Boolean=false; fQuotes: Boolean=false):TStringList; var vI: Integer; vBuffer: String; vOn: Boolean; begin Result:=TStringList.Create; vBuffer:=''; vOn:=true; for vI:=1 to Length(fText) do begin if (fQuotes and(fText[vI]=fSep)and vOn)or(Not(fQuotes) and (fText[vI]=fSep)) then begin if fTrim then vBuffer:=Trim(vBuffer); if vBuffer='' then vBuffer:=fSep; // !!! e.g. split(',**',',')... if vBuffer[1]=fSep then vBuffer:=Copy(vBuffer,2,Length(vBuffer)); Result.Add(vBuffer); vBuffer:=''; end; if fQuotes then begin if fText[vI]='"' then begin vOn:=Not(vOn); Continue; end; if (fText[vI]<>fSep)or((fText[vI]=fSep)and(vOn=false)) then vBuffer:=vBuffer+fText[vI]; end else if fText[vI]<>fSep then vBuffer:=vBuffer+fText[vI]; end; if vBuffer<>'' then begin if fTrim then vBuffer:=Trim(vBuffer); Result.Add(vBuffer); end; end; function OpenSaveFileDialog(Parent: TWinControl; const DefExt, Filter, InitialDir, Title: string; var FileName: string; MustExist, OverwritePrompt, NoChangeDir, DoOpen: Boolean): Boolean; // uses commdlg var ofn: TOpenFileName; szFile: array[0..260] of Char; fa, fa2: TStringList; h,i,j,k,c : integer; cs, s : string; begin Result := False; FillChar(ofn, SizeOf(TOpenFileName), 0); with ofn do begin lStructSize := SizeOf(TOpenFileName); hwndOwner := Parent.Handle; lpstrFile := szFile; nMaxFile := SizeOf(szFile); if (Title <> '') then lpstrTitle := PChar(Title); if (InitialDir <> '') then lpstrInitialDir := PChar(InitialDir); StrPCopy(lpstrFile, FileName); lpstrFilter := PChar(ReplaceStr(Filter, '|', #0)+#0#0); fa := splitFilter(Filter, '|'); k := 0; c := (fa.Count div 2); for i := 0 to c - 1 do begin j := 2 * i + 1; cs := LowerCase(fa.Strings[j]); fa2 := splitFilter(cs, ';'); for h := 0 to fa2.Count - 1 do begin cs := fa2.Strings[h]; s := '*.' + LowerCase(DefExt); if (cs = s) then k := i; end; end; nFilterIndex := k + 1; if DefExt <> '' then lpstrDefExt := PChar(DefExt); end; if MustExist then ofn.Flags := ofn.Flags or OFN_FILEMUSTEXIST; if OverwritePrompt then ofn.Flags := ofn.Flags or OFN_OVERWRITEPROMPT; if NoChangeDir then ofn.Flags := ofn.Flags or OFN_NOCHANGEDIR; if DoOpen then begin if GetOpenFileName(ofn) then begin Result := True; FileName := StrPas(szFile); end; end else begin if GetSaveFileName(ofn) then begin Result := True; FileName := StrPas(szFile); end; end end; // function OpenSaveFileDialog end.