{ 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 Browser; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, ComCtrls, ControlPoint, ToolWin, ImgList, StdCtrls, Cmap, Menus, Global, Buttons, Translation, RenderingInterface; const PixelCountMax = 32768; PaletteTooltipTimeout = 1500; type TGradientBrowser = class(TForm) SmallImages: TImageList; pnlMain: TPanel; PopupMenu: TPopupMenu; DeleteItem: TMenuItem; RenameItem: TMenuItem; OpenDialog: TOpenDialog; LargeImages: TImageList; TooltipTimer: TTimer; ListView: TListView; pnlPreview: TPanel; Image: TImage; btnDefGradient: TSpeedButton; procedure FormResize(Sender: TObject); procedure ListViewChange(Sender: TObject; Item: TListItem; Change: TItemChange); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormShow(Sender: TObject); procedure DeleteItemClick(Sender: TObject); procedure RenameItemClick(Sender: TObject); procedure ListViewEdited(Sender: TObject; Item: TListItem; var S: string); procedure btnDefGradientClick(Sender: TObject); procedure SpeedButton1Click(Sender: TObject); procedure ListViewKeyPress(Sender: TObject; var Key: Char); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure ListViewInfoTip(Sender: TObject; Item: TListItem; var InfoTip: String); procedure TooltipTimerTimer(Sender: TObject); private procedure DrawPalette; procedure Apply; public PreviewDensity: double; FlameIndex, GradientIndex: Integer; Extension, Identifier, Filename: string; cp: TControlPoint; Palette: TColorMap; zoom: double; Center: array[0..1] of double; Render: TRenderer; procedure ListFileContents; function LoadFractintMap(filen: string): TColorMap; end; type EFormatInvalid = class(Exception); pRGBTripleArray = ^TRGBTripleArray; TRGBTripleArray = array[0..PixelCountMax - 1] of TRGBTriple; var GradientBrowser: TGradientBrowser; FlameString: string; function CreatePalette(strng: string): TColorMap; implementation uses Main, Options, Editor, {Gradient,} Registry, Adjust, Mutate; {$R *.DFM} 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; function TGradientBrowser.LoadFractintMap(filen: string): TColorMap; var i: integer; s: string; pal: TColorMap; MapFile: TextFile; begin { Load a map file } AssignFile(MapFile, Filen); try Reset(MapFile); for i := 0 to 255 do begin Read(MapFile, Pal[i][0]); Read(MapFile, Pal[i][1]); Read(MapFile, Pal[i][2]); Read(MapFile, s); end; CloseFile(MapFile); Result := Pal; except on EInOutError do Application.MessageBox(PChar(Format(TextByKey('common-genericopenfailure'), [FileName])), PCHAR('Apophysis'), 16); end; end; function CreatePalette(strng: string): TColorMap; { 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 EFormatInvalid.Create('No closing brace'); if Pos('{', Strings[0]) = 0 then raise EFormatInvalid.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 EFormatInvalid.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); Result[index][0] := StrToInt(Colors[i]) mod 256; Result[index][1] := trunc(StrToInt(Colors[i]) / 256) mod 256; Result[index][2] := trunc(StrToInt(Colors[i]) / 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 EFormatInvalid do begin // Result := False; end; end; finally Tokens.Free; Strings.Free; Indices.Free; Colors.Free; end; end; procedure TGradientBrowser.DrawPalette; var i, j: integer; Row: pRGBTripleArray; BitMap: TBitMap; begin BitMap := TBitMap.Create; try Bitmap.PixelFormat := pf24bit; BitMap.Width := 256; BitMap.Height := 1; for j := 0 to Bitmap.Height - 1 do begin Row := Bitmap.Scanline[j]; for i := 0 to Bitmap.Width - 1 do begin with Row[i] do begin rgbtRed := Palette[i][0]; rgbtGreen := Palette[i][1]; rgbtBlue := Palette[i][2]; end end end; Image.Picture.Graphic := Bitmap; Image.Refresh; finally BitMap.Free; end; end; procedure TGradientBrowser.ListFileContents; { List identifiers in file } var i, p: integer; Title: string; ListItem: TListItem; FStrings: TStringList; begin FStrings := TStringList.Create; FStrings.LoadFromFile(filename); try ListView.Items.BeginUpdate; ListView.Items.Clear; if Lowercase(ExtractFileExt(filename)) = '.map' then begin ListItem := ListView.Items.Add; Listitem.Caption := Trim(filename); end else if (Pos('{', FStrings.Text) <> 0) then begin for i := 0 to FStrings.Count - 1 do begin p := Pos('{', FStrings[i]); if (p <> 0) and (Pos('(3D)', FStrings[i]) = 0) then begin Title := Trim(Copy(FStrings[i], 1, p - 1)); if Title <> '' then begin { Otherwise bad format } ListItem := ListView.Items.Add; Listitem.Caption := Trim(Copy(FStrings[i], 1, p - 1)); end; end; end; end; ListView.Items.EndUpdate; ListView.Selected := ListView.Items[0]; finally FStrings.Free; end; end; procedure TGradientBrowser.ListViewChange(Sender: TObject; Item: TListItem; Change: TItemChange); var Tokens, FStrings: TStringList; EntryStrings: TStringList; i: integer; begin Application.ProcessMessages; FStrings := TStringList.Create; EntryStrings := TStringList.Create; Tokens := TStringList.Create; try if Lowercase(ExtractFileExt(filename)) = '.map' then begin Palette := LoadFractintMap(filename); DrawPalette; end else if (ListView.SelCount <> 0) and (ListView.Selected.Caption <> Identifier) then begin Identifier := ListView.Selected.Caption; FStrings.LoadFromFile(Filename); for i := 0 to FStrings.count - 1 do if Pos(Lowercase(ListView.Selected.Caption) + ' ', Trim(Lowercase(FStrings[i]))) = 1 then break; EntryStrings.Add(FStrings[i]); repeat inc(i); EntryStrings.Add(FStrings[i]); until Pos('}', FStrings[i]) <> 0; Palette := CreatePalette(EntryStrings.Text); DrawPalette; end; finally EntryStrings.Free; FStrings.Free; Tokens.Free; end; end; procedure TGradientBrowser.FormCreate(Sender: TObject); begin self.Caption := TextByKey('gradientbrowser-title'); btnDefGradient.Hint := TextByKey('common-browse'); DeleteItem.Caption := TextByKey('common-delete'); RenameItem.Caption := TextByKey('common-rename'); PreviewDensity := prevMediumQuality; cp := TControlPoint.Create; cp.gamma := defGamma; cp.brightness := defBrightness; cp.vibrancy := defVibrancy; cp.spatial_oversample := defOversample; cp.spatial_filter_radius := defFilterRadius; Render := TRenderer.Create; FlameIndex := 0; GradientIndex := 0; end; procedure TGradientBrowser.FormDestroy(Sender: TObject); begin Render.Free; cp.Free; end; procedure TGradientBrowser.FormShow(Sender: TObject); var Registry: TRegistry; begin { Read posution from registry } Registry := TRegistry.Create; try Registry.RootKey := HKEY_CURRENT_USER; if Registry.OpenKey('Software\' + APP_NAME + '\Forms\Browser', False) then begin if Registry.ValueExists('Left') then GradientBrowser.Left := Registry.ReadInteger('Left'); if Registry.ValueExists('Top') then GradientBrowser.Top := Registry.ReadInteger('Top'); if Registry.ValueExists('Width') then GradientBrowser.Width := Registry.ReadInteger('Width'); if Registry.ValueExists('Height') then GradientBrowser.Height := Registry.ReadInteger('Height'); end; Registry.CloseKey; finally Registry.Free; end; if FileExists(filename) then ListFileContents; end; procedure TGradientBrowser.DeleteItemClick(Sender: TObject); var c: boolean; begin if ListView.SelCount <> 0 then begin if ConfirmDelete then c := Application.MessageBox( PChar(Format(TextByKey('common-confirmdelete'), [ListView.Selected.Caption])), 'Apophysis', 36) = IDYES else c := True; if c then if ListView.Focused and (ListView.SelCount <> 0) then begin Application.ProcessMessages; if DeleteEntry(ListView.Selected.Caption, Filename) then begin ListView.Items.Delete(ListView.Selected.Index); ListView.Selected := ListView.ItemFocused; end; end; end; end; procedure TGradientBrowser.RenameItemClick(Sender: TObject); begin if ListView.SelCount <> 0 then ListView.Items[ListView.Selected.Index].EditCaption; end; procedure TGradientBrowser.ListViewEdited(Sender: TObject; Item: TListItem; var S: string); begin // if s <> Item.Caption then // if not RenameIFS(Item.Caption, s, Filename) then // s := Item.Caption; end; procedure TGradientBrowser.btnDefGradientClick(Sender: TObject); var fn:string; begin OpenDialog.InitialDir := BrowserPath; OpenDialog.Filter := Format('%s|*.gradient;*.ugr|%s|*.map|%s|*.*', [TextByKey('common-filter-gradientfiles'), TextByKey('common-filter-fractintfiles'), TextByKey('common-filter-allfiles')]); OpenDialog.FileName := ''; if OpenSaveFileDialog(GradientBrowser, OpenDialog.DefaultExt, OpenDialog.Filter, OpenDialog.InitialDir, TextByKey('common-browse'), fn, true, false, false, true) then //if OpenDialog.Execute then begin Filename := fn; //OpenDialog.FileName; GradientFile := Filename; BrowserPath := ExtractFilePath(fn); //ExtractFilePath(OpenDialog.FileName); ListFileContents; end; end; procedure TGradientBrowser.Apply; begin MainForm.StopThread; MainForm.UpdateUndo; MainCp.cmap := Palette; MainCP.cmapindex := -1; if EditForm.Visible then EditForm.UpdateDisplay; if AdjustForm.Visible then AdjustForm.UpdateDisplay; if MutateForm.Visible then MutateForm.UpdateDisplay; MainForm.RedrawTimer.enabled := true; end; procedure TGradientBrowser.SpeedButton1Click(Sender: TObject); begin Apply; end; procedure TGradientBrowser.ListViewKeyPress(Sender: TObject; var Key: Char); begin if Key = #13 then Apply; end; procedure TGradientBrowser.FormClose(Sender: TObject; var Action: TCloseAction); var Registry: TRegistry; begin { Write position to registry } Registry := TRegistry.Create; try Registry.RootKey := HKEY_CURRENT_USER; { Defaults } if Registry.OpenKey('\Software\' + APP_NAME + '\Forms\Browser', True) then begin Registry.WriteInteger('Top', GradientBrowser.Top); Registry.WriteInteger('Left', GradientBrowser.Left); Registry.WriteInteger('Width', GradientBrowser.Width); Registry.WriteInteger('Height', GradientBrowser.Height); end; finally Registry.Free; end; end; procedure TGradientBrowser.ListViewInfoTip(Sender: TObject; Item: TListItem; var InfoTip: String); var i, j: integer; Row: pRGBTripleArray; Bitmap: TBitmap; pal: TColorMap; EntryStrings, FStrings: TStringList; rect: TRect; begin BitMap := TBitMap.create; Bitmap.PixelFormat := pf24bit; BitMap.Width := 256; BitMap.Height := 100; FStrings := TStringList.Create; EntryStrings := TStringList.Create; try if Lowercase(ExtractFileExt(filename)) = '.map' then begin pal := LoadFractintMap(filename); end else begin Identifier := Item.Caption; FStrings.LoadFromFile(Filename); for i := 0 to FStrings.count - 1 do if Pos(Lowercase(Item.Caption) + ' ', Trim(Lowercase(FStrings[i]))) = 1 then break; EntryStrings.Add(FStrings[i]); repeat inc(i); EntryStrings.Add(FStrings[i]); until Pos('}', FStrings[i]) <> 0; pal := CreatePalette(EntryStrings.Text); end; finally EntryStrings.Free; FStrings.Free; end; for j := 0 to Bitmap.Height - 1 do begin Row := Bitmap.Scanline[j]; for i := 0 to Bitmap.Width - 1 do begin with Row[i] do begin rgbtRed := pal[i][0]; rgbtGreen := pal[i][1]; rgbtBlue := pal[i][2]; end end end; rect.TopLeft := Item.Position; rect.BottomRight.X := rect.TopLeft.X + 100; rect.BottomRight.Y := rect.TopLeft.Y + 16; with ListView do begin Canvas.Rectangle(Rect); //Canvas.TextOut(Rect.Left, Rect.Top, Item.Caption); //Rect.Left := (Rect.Left + rect.Right) div 3; Canvas.StretchDraw(Rect, Bitmap); end; BitMap.Free; InfoTip := ''; TooltipTimer.Interval := PaletteTooltipTimeout; TooltipTimer.Enabled := true; end; procedure TGradientBrowser.TooltipTimerTimer(Sender: TObject); begin ListView.Repaint; TooltipTimer.Enabled := false; end; procedure TGradientBrowser.FormResize(Sender: TObject); begin Listview.Width := self.ClientWidth - 4; btnDefGradient.Left := self.ClientWidth - 2 - btnDefGradient.Width; ListView.Height := self.ClientHeight - pnlPreview.Height - 6; btnDefGradient.Top := self.ClientHeight - pnlPreview.Height - 2 + pnlPreview.Height div 2 - btnDefGradient.Height div 2; ListView.Top := 2; ListView.Left := 2; pnlPreview.Top := self.ClientHeight - pnlPreview.Height - 2; pnlPreview.Left := 2; pnlPreview.Width := self.ClientWidth - btnDefGradient.Width - 6; end; end.