mirror-github-bspeice/apophysis
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Show the callstack when exception occures

Browse Source
This commit is contained in:
ronaldhordijk 2005-09-11 10:25:42 +00:00
parent b8ea205da3
commit 41a160f51c
4 changed files with 235 additions and 98 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
2.10/Source/Main.dfm
View File

@ -27,7 +27,7 @@ object MainForm: TMainForm
Left = 160 Left = 160
Top = 28 Top = 28
Width = 4 Width = 4
Height = 480 Height = 494
end end
object ToolBar: TToolBar object ToolBar: TToolBar
Left = 0 Left = 0
@ -283,7 +283,7 @@ object MainForm: TMainForm
Left = 0 Left = 0
Top = 28 Top = 28
Width = 160 Width = 160
Height = 480 Height = 494
Align = alLeft Align = alLeft
Columns = < Columns = <
item item
@ -302,7 +302,7 @@ object MainForm: TMainForm
Left = 164 Left = 164
Top = 28 Top = 28
Width = 433 Width = 433
Height = 480 Height = 494
Align = alClient Align = alClient
BevelInner = bvLowered BevelInner = bvLowered
BevelOuter = bvNone BevelOuter = bvNone
@ -326,7 +326,7 @@ object MainForm: TMainForm
end end
object StatusBar: TStatusBar object StatusBar: TStatusBar
Left = 0 Left = 0
Top = 508 Top = 522
Width = 597 Width = 597
Height = 19 Height = 19
Panels = < Panels = <

236
2.10/Source/Main.pas
View File

@ -27,9 +27,7 @@ uses
ToolWin, StdCtrls, Classes, Messages, ExtCtrls, ImgList, controlpoint, ToolWin, StdCtrls, Classes, Messages, ExtCtrls, ImgList, controlpoint,
Jpeg, SyncObjs, SysUtils, ClipBrd, Graphics, Math, Global, MyTypes, Jpeg, SyncObjs, SysUtils, ClipBrd, Graphics, Math, Global, MyTypes,
Registry, RenderThread, Cmap, ExtDlgs, AppEvnts, ShellAPI, Registry, RenderThread, Cmap, ExtDlgs, AppEvnts, ShellAPI,
// IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, LibXmlParser, LibXmlComps, Xform, XFormMan;
// IdBaseComponent, IdIntercept, IdLogBase, IdLogFile,
LibXmlParser, LibXmlComps, Xform;
const const
PixelCountMax = 32768; PixelCountMax = 32768;
@ -311,7 +309,7 @@ type
Remainder: TDateTime; Remainder: TDateTime;
AnimPal: TColorMap; AnimPal: TColorMap;
VarMenus: array[0..NRVISVAR] of TMenuItem; VarMenus: array of TMenuItem;
procedure LoadXMLFlame(filename, name: string); procedure LoadXMLFlame(filename, name: string);
procedure DisableFavorites; procedure DisableFavorites;
@ -336,6 +334,10 @@ type
procedure RandomBatch; procedure RandomBatch;
procedure GetScripts; procedure GetScripts;
function ApplicationOnHelp(Command: Word; Data: Integer; var CallHelp: Boolean): Boolean; function ApplicationOnHelp(Command: Word; Data: Integer; var CallHelp: Boolean): Boolean;
{$IFDEF DEBUG}
procedure AppException(Sender: TObject; E: Exception);
{$ENDIF}
end; end;
procedure ListXML(FileName: string; sel: integer); procedure ListXML(FileName: string; sel: integer);
@ -369,10 +371,14 @@ var
implementation implementation
uses Editor, Options, Regstry, {Gradient,} Render, uses
{$IFDEF DEBUG}
JclDebug, ExceptForm,
{$ENDIF}
Editor, Options, Regstry, Render,
FullScreen, FormRender, Mutate, Adjust, Browser, Save, About, CmapData, FullScreen, FormRender, Mutate, Adjust, Browser, Save, About, CmapData,
HtmlHlp, ScriptForm, FormFavorites, {Size,} FormExport, msMultiPartFormData, HtmlHlp, ScriptForm, FormFavorites, Size, FormExport, msMultiPartFormData,
{Sheep,} ImageColoring, RndFlame; ImageColoring, RndFlame;
{$R *.DFM} {$R *.DFM}
@ -626,10 +632,10 @@ begin
for j := 0 to NRVAR - 1 do for j := 0 to NRVAR - 1 do
cp.xform[i].vars[j] := 0; cp.xform[i].vars[j] := 0;
repeat repeat
a := random(NRVISVAR); a := random(NRVAR);
until Variations[a]; until Variations[a];
repeat repeat
b := random(NRVISVAR); b := random(NRVAR);
until Variations[b]; until Variations[b];
if (a = b) then if (a = b) then
begin begin
@ -1346,10 +1352,10 @@ end;
function FlameToXML(const cp1: TControlPoint; sheep: boolean; compact: boolean = false): string; function FlameToXML(const cp1: TControlPoint; sheep: boolean; compact: boolean = false): string;
var var
t, i, j: integer; t, i{, j}: integer;
FileList: TStringList; FileList: TStringList;
x, y, a, b, cc, d, e, f: double; x, y{, a, b, cc, d, e, f}: double;
varlist, nick, url, pal, hue: string; {varlist,} nick, url, pal, hue: string;
begin begin
FileList := TStringList.create; FileList := TStringList.create;
x := cp1.center[0]; x := cp1.center[0];
@ -1380,27 +1386,27 @@ begin
format('vibrancy="%g" ', [cp1.vibrancy]) + hue + url + nick + '>'); format('vibrancy="%g" ', [cp1.vibrancy]) + hue + url + nick + '>');
{ Write transform parameters } { Write transform parameters }
t := NumXForms(cp1); t := NumXForms(cp1);
for i := 0 to t - 1 do for i := 0 to t - 1 do begin
begin FileList.Add(cp1.xform[i].ToXMLString);
with cp1.xform[i] do // with cp1.xform[i] do
begin // begin
a := c[0][0]; // a := c[0][0];
b := c[1][0]; // b := c[1][0];
cc := c[0][1]; // cc := c[0][1];
d := c[1][1]; // d := c[1][1];
e := c[2][0]; // e := c[2][0];
f := c[2][1]; // f := c[2][1];
varlist := ''; // varlist := '';
for j := 0 to NRVAR - 1 do // for j := 0 to NRVAR - 1 do
begin // begin
if vars[j] <> 0 then // if vars[j] <> 0 then
begin // begin
varlist := varlist + varnames[j] + format('="%f" ', [vars[j]]); // varlist := varlist + varnames(j) + format('="%f" ', [vars[j]]);
end; // end;
end; // end;
FileList.Add(Format(' <xform weight="%g" color="%g" symmetry="%g" ', [density, color, symmetry]) + // FileList.Add(Format(' <xform weight="%g" color="%g" symmetry="%g" ', [density, color, symmetry]) +
varlist + Format('coefs="%g %g %g %g %g %g"/>', [a, cc, b, d, e, f])); // varlist + Format('coefs="%g %g %g %g %g %g"/>', [a, cc, b, d, e, f]));
end; // end;
end; end;
{ Write palette data } { Write palette data }
if not sheep then begin if not sheep then begin
@ -1416,64 +1422,64 @@ begin
end; end;
end; end;
function FlameToXMLSheep(const cp1: TControlPoint): string; //function FlameToXMLSheep(const cp1: TControlPoint): string;
var //var
t, i, j: integer; // t, i, j: integer;
FileList: TStringList; // FileList: TStringList;
x, y, a, b, cc, d, e, f: double; // x, y, a, b, cc, d, e, f: double;
varlist, pal, hue: string; // varlist, pal, hue: string;
begin //begin
FileList := TStringList.create; // FileList := TStringList.create;
x := cp1.center[0]; // x := cp1.center[0];
y := cp1.center[1]; // y := cp1.center[1];
pal := ''; hue := ''; // pal := ''; hue := '';
pal := 'palette="' + IntToStr(cp1.cmapindex) + '" '; // pal := 'palette="' + IntToStr(cp1.cmapindex) + '" ';
// if cp1.hue_rotation = 0 then cp1.hue_rotation := 1; //// if cp1.hue_rotation = 0 then cp1.hue_rotation := 1;
hue := ' hue="' + format('%g', [cp1.hue_rotation]) + '"'; // hue := ' hue="' + format('%g', [cp1.hue_rotation]) + '"';
try // try
FileList.Add('<flame' + format(' time="%g" ', [cp1.time]) + // FileList.Add('<flame' + format(' time="%g" ', [cp1.time]) +
pal + 'size="' + IntToStr(cp1.width) + ' ' + IntToStr(cp1.height) + // pal + 'size="' + IntToStr(cp1.width) + ' ' + IntToStr(cp1.height) +
format('" center="%g %g" ', [x, y]) + // format('" center="%g %g" ', [x, y]) +
format('scale="%g" ', [cp1.pixels_per_unit]) + // format('scale="%g" ', [cp1.pixels_per_unit]) +
format('zoom="%g" ', [cp1.zoom]) + // format('zoom="%g" ', [cp1.zoom]) +
'oversample="' + IntToStr(cp1.spatial_oversample) + // 'oversample="' + IntToStr(cp1.spatial_oversample) +
format('" filter="%g" ', [cp1.spatial_filter_radius]) + // format('" filter="%g" ', [cp1.spatial_filter_radius]) +
format('quality="%g" ', [cp1.sample_density]) + // format('quality="%g" ', [cp1.sample_density]) +
'batches="' + IntToStr(cp1.nbatches) + // 'batches="' + IntToStr(cp1.nbatches) +
format('" background="%g %g %g" ', [cp1.background[0] / 255, cp1.background[1] / 255, cp1.background[2] / 255]) + // format('" background="%g %g %g" ', [cp1.background[0] / 255, cp1.background[1] / 255, cp1.background[2] / 255]) +
format('brightness="%g" ', [cp1.brightness]) + // format('brightness="%g" ', [cp1.brightness]) +
format('gamma="%g" ', [cp1.gamma]) + // format('gamma="%g" ', [cp1.gamma]) +
format('vibrancy="%g"', [cp1.vibrancy]) + hue + '>'); // format('vibrancy="%g"', [cp1.vibrancy]) + hue + '>');
{ Write transform parameters } // { Write transform parameters }
t := NumXForms(cp1); // t := NumXForms(cp1);
for i := 0 to t - 1 do // for i := 0 to t - 1 do
begin // begin
with cp1.xform[i] do // with cp1.xform[i] do
begin // begin
a := c[0][0]; // a := c[0][0];
b := c[1][0]; // b := c[1][0];
cc := c[0][1]; // cc := c[0][1];
d := c[1][1]; // d := c[1][1];
e := c[2][0]; // e := c[2][0];
f := c[2][1]; // f := c[2][1];
varlist := ''; // varlist := '';
for j := 0 to NRVAR - 1 do // for j := 0 to NRVAR - 1 do
begin // begin
if vars[j] <> 0 then // if vars[j] <> 0 then
begin // begin
varlist := varlist + varnames[j] + format('="%f" ', [vars[j]]); // varlist := varlist + varnames(j) + format('="%f" ', [vars[j]]);
end; // end;
end; // end;
FileList.Add(Format(' <xform weight="%g" color="%g" symmetry="%g" ', [density, color, symmetry]) + // FileList.Add(Format(' <xform weight="%g" color="%g" symmetry="%g" ', [density, color, symmetry]) +
varlist + Format('coefs="%g %g %g %g %g %g"/>', [a, cc, b, d, e, f])); // varlist + Format('coefs="%g %g %g %g %g %g"/>', [a, cc, b, d, e, f]));
end; // end;
end; // end;
FileList.Add('</flame>'); // FileList.Add('</flame>');
result := FileList.text; // result := FileList.text;
finally // finally
FileList.free // FileList.free
end; // end;
end; //end;
function RemoveExt(filename: string): string; function RemoveExt(filename: string): string;
@ -2540,6 +2546,17 @@ procedure TMainForm.FormCreate(Sender: TObject);
var var
dte: string; dte: string;
begin begin
{$IFDEF DEBUG}
// Enable raw mode (default mode uses stack frames which aren't always generated by the compiler)
Include(JclStackTrackingOptions, stRawMode);
// Disable stack tracking in dynamically loaded modules (it makes stack tracking code a bit faster)
Include(JclStackTrackingOptions, stStaticModuleList);
// Initialize Exception tracking
JclStartExceptionTracking;
Application.OnException := AppException;
{$ENDIF}
FMouseMoveState := msDrag; // --Z-- was: msZoomWindow; FMouseMoveState := msDrag; // --Z-- was: msZoomWindow;
LimitVibrancy := True; LimitVibrancy := True;
Favorites := TStringList.Create; Favorites := TStringList.Create;
@ -4093,6 +4110,7 @@ procedure TMainForm.XMLScannerEmptyTag(Sender: TObject; TagName: string;
var var
i: integer; i: integer;
v: string; v: string;
d: double;
Tokens: TStringList; Tokens: TStringList;
begin begin
Tokens := TStringList.Create; Tokens := TStringList.Create;
@ -4121,7 +4139,7 @@ begin
for i := 0 to NRVAR - 1 do for i := 0 to NRVAR - 1 do
begin begin
Parsecp.xform[nxform].vars[i] := 0; Parsecp.xform[nxform].vars[i] := 0;
v := Attributes.Value(varnames[i]); v := Attributes.Value(varnames(i));
if v <> '' then if v <> '' then
Parsecp.xform[nxform].vars[i] := StrToFloat(v); Parsecp.xform[nxform].vars[i] := StrToFloat(v);
end; end;
@ -4143,6 +4161,15 @@ begin
for i := 0 to Tokens.Count - 1 do for i := 0 to Tokens.Count - 1 do
Parsecp.xform[nxform].vars[i] := StrToFloat(Tokens[i]); Parsecp.xform[nxform].vars[i] := StrToFloat(Tokens[i]);
end; end;
for i := 0 to GetNrVariableNames - 1 do begin
v := Attributes.Value(GetVariableNameAt(i));
if v <> '' then begin
d := StrToFloat(v);
Parsecp.xform[nxform].SetVariable(GetVariableNameAt(i), d);
end;
end;
inc(nxform); inc(nxform);
end; end;
if TagName = 'color' then if TagName = 'color' then
@ -4451,11 +4478,15 @@ end;
procedure TMainForm.FillVariantMenu; procedure TMainForm.FillVariantMenu;
var var
i: integer; i: integer;
s: string;
NewMenuItem : TMenuItem; NewMenuItem : TMenuItem;
begin begin
for i := 0 to NRVISVAR - 1 do begin SetLength(VarMenus, NrVar);
for i := 0 to NRVAR - 1 do begin
NewMenuItem := TMenuItem.Create(self); NewMenuItem := TMenuItem.Create(self);
NewMenuItem.Caption := uppercase(varnames[i][0]) + copy(varnames[i], 2, length(varnames[i])-1); s := varnames(i);
NewMenuItem.Caption := uppercase(s[1]) + copy(s, 2, length(s)-1);
NewMenuItem.OnClick := VariantMenuClick; NewMenuItem.OnClick := VariantMenuClick;
NewMenuItem.Enabled := True; NewMenuItem.Enabled := True;
NewMenuItem.Name := 'var' + intTostr(i); NewMenuItem.Name := 'var' + intTostr(i);
@ -4573,5 +4604,22 @@ begin
end; end;
} }
end; end;
{$IFDEF DEBUG}
///////////////////////////////////////////////////////////////////////////////
procedure TMainForm.AppException(Sender: TObject; E: Exception);
var
frmException: TfrmException;
begin
frmException := TfrmException.Create(nil);
JclLastExceptStackListToStrings(frmException.Memo1.Lines, False, True, True, False);
frmException.Memo1.Lines.Insert(0,e.Message);
frmException.Memo1.Lines.Insert(1,'');
frmException.ShowModal;
end;
{$ENDIF}
///////////////////////////////////////////////////////////////////////////////
end. end.

45
2.10/Source/exceptform.dfm Normal file
View File

@ -0,0 +1,45 @@
object frmException: TfrmException
Left = 475
Top = 337
Width = 611
Height = 453
Caption = 'An exception occured'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
DesignSize = (
603
419)
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 148
Top = 380
Width = 263
Height = 13
Anchors = [akLeft, akTop, akBottom]
Caption = 'Please mail this message to Ronald.Hordijk@gmail.com'
end
object Button1: TButton
Left = 16
Top = 376
Width = 75
Height = 25
Anchors = [akLeft, akTop, akBottom]
Caption = 'Exit'
TabOrder = 0
OnClick = Button1Click
end
object Memo1: TMemo
Left = 8
Top = 8
Width = 585
Height = 353
Anchors = [akLeft, akTop, akRight, akBottom]
TabOrder = 1
end
end

44
2.10/Source/exceptform.pas Normal file
View File

@ -0,0 +1,44 @@
unit exceptform;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TfrmException = class(TForm)
Button1: TButton;
Memo1: TMemo;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
procedure AddLine(s: string);
end;
var
frmException: TfrmException;
implementation
{$R *.dfm}
{ TForm1 }
procedure TfrmException.AddLine(s: string);
begin
Memo1.Lines.Add(s);
end;
procedure TfrmException.Button1Click(Sender: TObject);
begin
Halt;
end;
initialization
frmException := TfrmException.Create(nil);
finalization
frmException.Free;
end.