[lddp-cvs-commits] SF.net SVN: lddp:[373] trunk
Brought to you by:
billthefish,
c_schmitz
Menu
▾
▴
[lddp-cvs-commits] SF.net SVN: lddp:[373] trunk
|
From: <bil...@us...> - 2009-09-16 16:24:59
|
Revision: 373
http://lddp.svn.sourceforge.net/lddp/?rev=373&view=rev
Author: billthefish
Date: 2009-09-16 16:24:36 +0000 (Wed, 16 Sep 2009)
Log Message:
-----------
It's been a while since the last commit and I've lost track of what I've changed
Modified Paths:
--------------
trunk/Current Build/LDDesignPad.exe
trunk/Custom Controls/ScintillaLDDP/ScintillaLDDP.bdsproj
trunk/Custom Controls/ScintillaLDDP/ScintillaLDDP.dpk
trunk/DAT Tools/DATBase.pas
trunk/DAT Tools/DATCheck.pas
trunk/DAT Tools/DATErrorFix.pas
trunk/DAT Tools/DATFlexObject.pas
trunk/DAT Tools/DATMath.pas
trunk/DAT Tools/DATModel.pas
trunk/DAT Tools/DATUtils.pas
trunk/lddp/LDDesignPad.bdsproj
trunk/lddp/about.dfm
trunk/lddp/commonprocs.pas
trunk/lddp/errorbar.dfm
trunk/lddp/errorbar.pas
trunk/lddp/main.dfm
trunk/lddp/main.pas
trunk/lddp/options.dfm
trunk/lddp/options.pas
trunk/lddp/sorting.dfm
trunk/lddp/sorting.pas
trunk/lddp/windowsspecific.pas
Modified: trunk/Current Build/LDDesignPad.exe
===================================================================
(Binary files differ)
Modified: trunk/Custom Controls/ScintillaLDDP/ScintillaLDDP.bdsproj
===================================================================
--- trunk/Custom Controls/ScintillaLDDP/ScintillaLDDP.bdsproj 2009-06-10 07:43:44 UTC (rev 372)
+++ trunk/Custom Controls/ScintillaLDDP/ScintillaLDDP.bdsproj 2009-09-16 16:24:36 UTC (rev 373)
@@ -120,9 +120,9 @@
</Linker>
<Directories>
<Directories Name="OutputDir"></Directories>
- <Directories Name="UnitOutputDir">C:\Documents and Settings\Orion\My Documents\Lego\LDDP\Current Build\DCU</Directories>
- <Directories Name="PackageDLLOutputDir">C:\Documents and Settings\Orion\My Documents\Lego\LDDP\Current Build</Directories>
- <Directories Name="PackageDCPOutputDir">C:\Documents and Settings\Orion\My Documents\Lego\LDDP\Current Build\DCU</Directories>
+ <Directories Name="UnitOutputDir">C:\Users\Orion Pobursky\Documents\Lego\LDDP\Current Build\DCU</Directories>
+ <Directories Name="PackageDLLOutputDir">C:\Users\Orion Pobursky\Documents\Lego\LDDP\Current Build</Directories>
+ <Directories Name="PackageDCPOutputDir">C:\Users\Orion Pobursky\Documents\Lego\LDDP\Current Build\DCU</Directories>
<Directories Name="SearchPath"></Directories>
<Directories Name="Packages"></Directories>
<Directories Name="Conditionals"></Directories>
Modified: trunk/Custom Controls/ScintillaLDDP/ScintillaLDDP.dpk
===================================================================
--- trunk/Custom Controls/ScintillaLDDP/ScintillaLDDP.dpk 2009-06-10 07:43:44 UTC (rev 372)
+++ trunk/Custom Controls/ScintillaLDDP/ScintillaLDDP.dpk 2009-09-16 16:24:36 UTC (rev 373)
@@ -33,6 +33,8 @@
SciScintillaLDDP in 'SciScintillaLDDP.pas',
DATBase in '..\..\DAT Tools\DATBase.pas',
DATUtils in '..\..\DAT Tools\DATUtils.pas',
- DATModel in '..\..\DAT Tools\DATModel.pas';
+ DATModel in '..\..\DAT Tools\DATModel.pas',
+ DATMath in '..\..\DAT Tools\DATMath.pas',
+ DATColour in '..\..\DAT Tools\DATColour.pas';
end.
Modified: trunk/DAT Tools/DATBase.pas
===================================================================
--- trunk/DAT Tools/DATBase.pas 2009-06-10 07:43:44 UTC (rev 372)
+++ trunk/DAT Tools/DATBase.pas 2009-09-16 16:24:36 UTC (rev 373)
@@ -20,20 +20,16 @@
interface
uses
- SysUtils,
- Classes,
- Math,
- Graphics,
- Contnrs;
+ Classes, SysUtils;
type
-// EInvalidDATLine = class(Exception);
+ EInvalidDATLine = class(Exception);
(* These types allow passing of fixed arrays between procedures
instead of varible length arrays *)
- TDATPoint = array[1..3] of Extended;
- TDATMatrix = array[1..4,1..4] of Extended;
- TDATRotationMatrix = array[1..3,1..3] of Extended;
+ TDATPoint = array[1..3] of Double;
+ TDATMatrix = array[1..4,1..4] of Double;
+ TDATRotationMatrix = array[1..3,1..3] of Double;
// For operations involving axis
TDATAxis = (axisX = 1, axisY = 2, axisZ = 3);
@@ -44,7 +40,10 @@
//License Type
TDATLicenseType = (ltCA, ltNonCA);
-
+
+ //Line Type
+ TDATLineType = (ltNil = -1, ltComment = 0, ltSubpart = 1,
+ ltLine = 2, ltTriangle = 3, ltQuad = 4, ltOpLine = 5);
(*
The general structure of the DAT Classes is:
@@ -64,27 +63,30 @@
/ \ ----TDATOpLine
TDATTriangle--- ---TDATQuad
*)
- TDATType=class(TPersistent)
- private
- FLine: string;
-
+ TDATType=class(TObject)
protected
- intLineType: Byte;
- function GetDATString:string; virtual;
- procedure ProcessDATLine(strText:string); virtual;
+ FLineType: TDATLineType;
+ function GetDATString: string; virtual; abstract;
+ procedure ProcessDATLine(strText: string); virtual; abstract;
public
constructor Create; virtual;
(* Returns the linetype of the object *)
- property LineType: Byte read intLineType;
+ property LineType: TDATLineType read FLineType;
(* Get or set a properly formatted DAT text line that represents
the DAT Object's values *)
property DATString: string read GetDATString write ProcessDATLine;
end;
- TDATInvalidLine = TDATType;
+ (* Represent a line with an error *)
+ TDATInvalidLine = class(TDATType)
+ protected
+ FLine: string;
+ function GetDATString:string; override;
+ procedure ProcessDATLine(strText:string); override;
+ end;
(* Represents LineType 0 *)
TDATComment=class(TDATType)
@@ -96,7 +98,8 @@
procedure ProcessDATLine(strText:string); override;
public
- constructor Create; override;
+ constructor Create; overload; override;
+ constructor Create(comment: string); reintroduce; overload;
published
(* Get or Set the Comment portion of the DAT text*)
@@ -107,6 +110,7 @@
TDATBlankLine=class(TDATType)
protected
function GetDATString:string; override;
+ procedure ProcessDATLine(strText:string); override;
end;
TDATElement=class(TDATType)
@@ -116,10 +120,10 @@
protected
FPntAcc, FRotAcc: ShortInt;
FDATMatrix: TDATMatrix;
- function GetCoordinate(Index: Integer): Extended;
- procedure SetCoordinate(Index: Integer; Value: Extended);
- function GetMatrixVal(idx1,idx2: Integer): Extended;
- procedure SetMatrixVal(idx1,idx2: Integer; Value: Extended);
+ function GetCoordinate(Index: Integer): Double;
+ procedure SetCoordinate(Index: Integer; Value: Double);
+ function GetMatrixVal(idx1,idx2: Integer): Double;
+ procedure SetMatrixVal(idx1,idx2: Integer; Value: Double);
public
constructor Create; override;
@@ -130,24 +134,23 @@
(* Use this property to set individual numbers in the matrix (Linetype 1)
or point set (Linetypes 2-5) *)
- property MatrixVals[idx1,idx2: Integer]: Extended read GetMatrixVal write SetMatrixVal;
+ property MatrixVals[idx1,idx2: Integer]: Double read GetMatrixVal write SetMatrixVal;
+ property Color: Integer read FColor write FColor default 0;
+ property RotationDecimalPlaces: ShortInt read FRotAcc write FRotAcc default 15;
+ property PositionDecimalPlaces: ShortInt read FPntAcc write FPntAcc default 15;
+
(* Multiply the current Object by the given Matrix *)
procedure Transform(M: TDATMatrix;
Reverse: Boolean = false); virtual; abstract;
(* Translate the current Object by x,y,z*)
- procedure Translate(x,y,z: Extended);
+ procedure Translate(x,y,z: Double);
(* Rotate the current Object by w around the vector [x,y,z,1] *)
- procedure Rotate(w,x,y,z: Extended);
+ procedure Rotate(w,x,y,z: Double);
(* Mirror the part on specified axis *)
procedure Mirror(axis: TDATAxis); virtual;
-
- published
- property Color: Integer read FColor write FColor default 0;
- property RotationDecimalPlaces: ShortInt read FRotAcc write FRotAcc default 15;
- property PositionDecimalPlaces: ShortInt read FPntAcc write FPntAcc default 15;
end;
TDATSubPart=class(TDATElement)
@@ -172,9 +175,9 @@
procedure Transform(M: TDATMatrix; Reverse: Boolean = false); override;
property RotationMatrix: TDATRotationMatrix read GetRotationMatrix write SetRotationMatrix;
- property X: Extended index 13 read GetCoordinate write SetCoordinate;
- property Y: Extended index 14 read GetCoordinate write SetCoordinate;
- property Z: Extended index 15 read GetCoordinate write SetCoordinate;
+ property X: Double index 13 read GetCoordinate write SetCoordinate;
+ property Y: Double index 14 read GetCoordinate write SetCoordinate;
+ property Z: Double index 15 read GetCoordinate write SetCoordinate;
procedure Mirror(axis: TDATAxis); override;
end;
@@ -184,23 +187,23 @@
protected
function GetPoint(idx: Integer): TDATPoint;
procedure SetPoint(idx: Integer; Value: TDATPoint);
- function GetExtremeValue(Index: Integer): Extended;
- function GetCenterValue(Index: Integer): Extended;
+ function GetExtremeValue(Index: Integer): Double;
+ function GetCenterValue(Index: Integer): Double;
public
(* Use this property to get or set the individual points of the Line,
Triangle, Quad or Optional Line as a TDATPoint type. To set individual
values (e.g. x1 only) use the RM property *)
property Point[idx: Integer]: TDATPoint read GetPoint write SetPoint;
- property MaxX: Extended index 1 read GetExtremeValue;
- property MinX: Extended index 2 read GetExtremeValue;
- property MaxY: Extended index 3 read GetExtremeValue;
- property MinY: Extended index 4 read GetExtremeValue;
- property MaxZ: Extended index 5 read GetExtremeValue;
- property MinZ: Extended index 6 read GetExtremeValue;
- property CenterX: Extended index 1 read GetCenterValue;
- property CenterY: Extended index 2 read GetCenterValue;
- property CenterZ: Extended index 3 read GetCenterValue;
+ property MaxX: Double index 1 read GetExtremeValue;
+ property MinX: Double index 2 read GetExtremeValue;
+ property MaxY: Double index 3 read GetExtremeValue;
+ property MinY: Double index 4 read GetExtremeValue;
+ property MaxZ: Double index 5 read GetExtremeValue;
+ property MinZ: Double index 6 read GetExtremeValue;
+ property CenterX: Double index 1 read GetCenterValue;
+ property CenterY: Double index 2 read GetCenterValue;
+ property CenterZ: Double index 3 read GetCenterValue;
procedure Transform(M: TDATMatrix; Reverse: Boolean = false); override;
end;
@@ -214,12 +217,12 @@
constructor Create; override;
published
- property x1: Extended index 1 read GetCoordinate write SetCoordinate;
- property y1: Extended index 2 read GetCoordinate write SetCoordinate;
- property z1: Extended index 3 read GetCoordinate write SetCoordinate;
- property x2: Extended index 4 read GetCoordinate write SetCoordinate;
- property y2: Extended index 5 read GetCoordinate write SetCoordinate;
- property z2: Extended index 6 read GetCoordinate write SetCoordinate;
+ property x1: Double index 1 read GetCoordinate write SetCoordinate;
+ property y1: Double index 2 read GetCoordinate write SetCoordinate;
+ property z1: Double index 3 read GetCoordinate write SetCoordinate;
+ property x2: Double index 4 read GetCoordinate write SetCoordinate;
+ property y2: Double index 5 read GetCoordinate write SetCoordinate;
+ property z2: Double index 6 read GetCoordinate write SetCoordinate;
end;
TDATOpLine=class(TDATGeometric)
@@ -231,18 +234,18 @@
constructor Create; override;
published
- property x1: Extended index 1 read GetCoordinate write SetCoordinate;
- property y1: Extended index 2 read GetCoordinate write SetCoordinate;
- property z1: Extended index 3 read GetCoordinate write SetCoordinate;
- property x2: Extended index 4 read GetCoordinate write SetCoordinate;
- property y2: Extended index 5 read GetCoordinate write SetCoordinate;
- property z2: Extended index 6 read GetCoordinate write SetCoordinate;
- property x3: Extended index 7 read GetCoordinate write SetCoordinate;
- property y3: Extended index 8 read GetCoordinate write SetCoordinate;
- property z3: Extended index 9 read GetCoordinate write SetCoordinate;
- property x4: Extended index 10 read GetCoordinate write SetCoordinate;
- property y4: Extended index 11 read GetCoordinate write SetCoordinate;
- property z4: Extended index 12 read GetCoordinate write SetCoordinate;
+ property x1: Double index 1 read GetCoordinate write SetCoordinate;
+ property y1: Double index 2 read GetCoordinate write SetCoordinate;
+ property z1: Double index 3 read GetCoordinate write SetCoordinate;
+ property x2: Double index 4 read GetCoordinate write SetCoordinate;
+ property y2: Double index 5 read GetCoordinate write SetCoordinate;
+ property z2: Double index 6 read GetCoordinate write SetCoordinate;
+ property x3: Double index 7 read GetCoordinate write SetCoordinate;
+ property y3: Double index 8 read GetCoordinate write SetCoordinate;
+ property z3: Double index 9 read GetCoordinate write SetCoordinate;
+ property x4: Double index 10 read GetCoordinate write SetCoordinate;
+ property y4: Double index 11 read GetCoordinate write SetCoordinate;
+ property z4: Double index 12 read GetCoordinate write SetCoordinate;
end;
TDATPolygon=class(TDATGeometric)
@@ -259,15 +262,15 @@
constructor Create; override;
published
- property x1: Extended index 1 read GetCoordinate write SetCoordinate;
- property y1: Extended index 2 read GetCoordinate write SetCoordinate;
- property z1: Extended index 3 read GetCoordinate write SetCoordinate;
- property x2: Extended index 4 read GetCoordinate write SetCoordinate;
- property y2: Extended index 5 read GetCoordinate write SetCoordinate;
- property z2: Extended index 6 read GetCoordinate write SetCoordinate;
- property x3: Extended index 7 read GetCoordinate write SetCoordinate;
- property y3: Extended index 8 read GetCoordinate write SetCoordinate;
- property z3: Extended index 9 read GetCoordinate write SetCoordinate;
+ property x1: Double index 1 read GetCoordinate write SetCoordinate;
+ property y1: Double index 2 read GetCoordinate write SetCoordinate;
+ property z1: Double index 3 read GetCoordinate write SetCoordinate;
+ property x2: Double index 4 read GetCoordinate write SetCoordinate;
+ property y2: Double index 5 read GetCoordinate write SetCoordinate;
+ property z2: Double index 6 read GetCoordinate write SetCoordinate;
+ property x3: Double index 7 read GetCoordinate write SetCoordinate;
+ property y3: Double index 8 read GetCoordinate write SetCoordinate;
+ property z3: Double index 9 read GetCoordinate write SetCoordinate;
end;
@@ -280,22 +283,22 @@
constructor Create; override;
published
- property x1: Extended index 1 read GetCoordinate write SetCoordinate;
- property y1: Extended index 2 read GetCoordinate write SetCoordinate;
- property z1: Extended index 3 read GetCoordinate write SetCoordinate;
- property x2: Extended index 4 read GetCoordinate write SetCoordinate;
- property y2: Extended index 5 read GetCoordinate write SetCoordinate;
- property z2: Extended index 6 read GetCoordinate write SetCoordinate;
- property x3: Extended index 7 read GetCoordinate write SetCoordinate;
- property y3: Extended index 8 read GetCoordinate write SetCoordinate;
- property z3: Extended index 9 read GetCoordinate write SetCoordinate;
- property x4: Extended index 10 read GetCoordinate write SetCoordinate;
- property y4: Extended index 11 read GetCoordinate write SetCoordinate;
- property z4: Extended index 12 read GetCoordinate write SetCoordinate;
+ property x1: Double index 1 read GetCoordinate write SetCoordinate;
+ property y1: Double index 2 read GetCoordinate write SetCoordinate;
+ property z1: Double index 3 read GetCoordinate write SetCoordinate;
+ property x2: Double index 4 read GetCoordinate write SetCoordinate;
+ property y2: Double index 5 read GetCoordinate write SetCoordinate;
+ property z2: Double index 6 read GetCoordinate write SetCoordinate;
+ property x3: Double index 7 read GetCoordinate write SetCoordinate;
+ property y3: Double index 8 read GetCoordinate write SetCoordinate;
+ property z3: Double index 9 read GetCoordinate write SetCoordinate;
+ property x4: Double index 10 read GetCoordinate write SetCoordinate;
+ property y4: Double index 11 read GetCoordinate write SetCoordinate;
+ property z4: Double index 12 read GetCoordinate write SetCoordinate;
end;
var
- LDrawBasePath: string = 'C:\Lego\LDRAW\';
+ LDrawBasePath: string = 'C:\Lego\LDRAW';
const
FDATIdentityMatrix: TDATMatrix = ((1,0,0,0),
@@ -312,30 +315,20 @@
implementation
uses
- DATMath;
+ Math, DATMath, DATUtils;
{TDATType}
-constructor TDATType.Create;
+constructor TDATType.Create();
begin
inherited Create;
+ FLineType := ltNil;
end;
-function TDATType.GetDATString: string;
-
-begin
- Result := FLine;
-end;
-
-procedure TDATType.ProcessDATLine(strText:string);
-begin
- FLine := strText;
-end;
-
{TDATComment}
-procedure TDATComment.ProcessDATLine(strText:string);
+procedure TDATComment.ProcessDATLine(strText: string);
begin
strText := Trim(strText);
if strText <> '' then
@@ -343,20 +336,36 @@
FComment := Trim(Copy(strText,2,Length(strText)))
else
FComment := '';
- intLineType := 0;
end;
-constructor TDATComment.Create;
+constructor TDATComment.Create();
begin
inherited Create;
- intLineType := 0;
+ FLineType := ltComment;
end;
-function TDATComment.GetDATString:string;
+constructor TDATComment.Create(comment: string);
begin
- result := '0 ' + FComment;
+ Create;
+ FComment := Trim(comment);
end;
+function TDATComment.GetDATString: string;
+begin
+ Result := '0 ' + FComment;
+end;
+
+{TDATInvalidLine}
+procedure TDATInvalidLine.ProcessDATLine(strText: string);
+begin
+ Fline := strText;
+end;
+
+function TDATInvalidLine.GetDATString: string;
+begin
+ Result := FLine;
+end;
+
{TDATBlankLine}
function TDATBlankLine.GetDATString: string;
@@ -365,6 +374,11 @@
Result := '';
end;
+procedure TDATBlankLine.ProcessDATLine(strText: string);
+begin
+// do nothing
+end;
+
{TDATElement}
constructor TDATElement.Create;
@@ -376,7 +390,7 @@
FDATMatrix[4,4] := 1;
end;
-function TDATElement.GetMatrixVal(idx1,idx2: Integer): Extended;
+function TDATElement.GetMatrixVal(idx1,idx2: Integer): Double;
begin
Result := FDATMatrix[idx1,idx2];
end;
@@ -389,12 +403,12 @@
FDATMatrix[4, Ord(axis)] := -FDATMatrix[4, Ord(axis)];
end;
-procedure TDATElement.SetMatrixVal(idx1,idx2: Integer; Value: Extended);
+procedure TDATElement.SetMatrixVal(idx1,idx2: Integer; Value: Double);
begin
FDATMatrix[idx1,idx2] := Value;
end;
-function TDATElement.GetCoordinate(Index: Integer): Extended;
+function TDATElement.GetCoordinate(Index: Integer): Double;
begin
case Index of
@@ -417,7 +431,7 @@
end
end;
-procedure TDATElement.SetCoordinate(Index: Integer; Value: Extended);
+procedure TDATElement.SetCoordinate(Index: Integer; Value: Double);
begin
case Index of
@@ -439,7 +453,7 @@
end;
end;
-procedure TDATElement.Translate(x,y,z: Extended);
+procedure TDATElement.Translate(x,y,z: Double);
var
R: TDATMatrix;
@@ -455,11 +469,11 @@
end;
-procedure TDATElement.Rotate(w,x,y,z: Extended);
+procedure TDATElement.Rotate(w,x,y,z: Double);
var
R: TDATMatrix;
- t: Extended;
+ t: Double;
begin
R := FDATIdentityMatrix;
@@ -503,13 +517,13 @@
FDATMatrix := M4Multiply(M, FDATMatrix);
end;
-constructor TDATSubPart.Create;
+constructor TDATSubPart.Create();
begin
inherited Create;
- intLineType := 1;
+ FLineType := ltSubpart;
Matrix := FDATIdentityMatrix;
- SubPart := 'dummy.dat'
+ SubPart := 'dummy.dat';
end;
procedure TDATSubPart.SetPosition(posit:TDATPoint);
@@ -562,7 +576,7 @@
begin
strSep := DecimalSeparator;
- Result := IntToStr(LineType) + ' ' +
+ Result := '1 ' +
IntToStr(Color) + ' ' +
FloatToStr(RoundTo(Matrix[1,4], -Abs(PositionDecimalPlaces))) + ' ' +
FloatToStr(RoundTo(MatrixVals[2,4], -Abs(PositionDecimalPlaces))) + ' ' +
@@ -584,50 +598,50 @@
procedure TDATSubPart.ProcessDATLine(strText:string);
var
- TmpMatrix: TDATRotationMatrix;
- TmpPosit: TDATPoint;
+ TmpMatrix: TDATMatrix;
TmpLnType, TmpColor: Integer;
TempList: TStringList;
TmpSubpart: string;
begin
+ TmpMatrix := FDATIdentityMatrix;
+
TempList:= TStringList.Create;
- TmpMatrix := FDATIdentityRotationMatrix;
- TmpPosit := FDATOriginPoint;
-
try
ExtractStrings([#9,#32], [#9,#32], PChar(Trim(strText)), TempList);
- try
- TmpLnType := StrToInt(TempList[0]);
- if TmpLnType = 1 then
+ if TempList.Count <> 15 then
+ raise EInvalidDATLine.Create('Invalid LDraw line: ' + strText)
+ else
+ try
+ TmpLnType := StrToInt(TempList[0]);
+ TmpColor := StrToInt(TempList[1]);
+ except
+ on E: Exception do
+ raise EInvalidDATLine.Create('Invalid LDraw line: ' + strText);
+ end;
+ if (TmpLnType = 1) and (TmpColor >= 0) then
begin
- TmpColor := StrToInt(TempList[1]);
-
- TmpPosit[1] := StrToFloat(TempList[2]);
- TmpPosit[2] := StrToFloat(TempList[3]);
- TmpPosit[3] := StrToFloat(TempList[4]);
-
- TmpMatrix[1,1] := StrToFloat(TempList[5]);
- TmpMatrix[1,2] := StrToFloat(TempList[6]);
- TmpMatrix[1,3] := StrToFloat(TempList[7]);
- TmpMatrix[2,1] := StrToFloat(TempList[8]);
- TmpMatrix[2,2] := StrToFloat(TempList[9]);
- TmpMatrix[2,3] := StrToFloat(TempList[10]);
- TmpMatrix[3,1] := StrToFloat(TempList[11]);
- TmpMatrix[3,2] := StrToFloat(TempList[12]);
- TmpMatrix[3,3] := StrToFloat(TempList[13]);
-
+ try
+ TmpMatrix := DATMatrix(StrToFloat(TempList[5]), StrToFloat(TempList[6]),
+ StrToFloat(TempList[7]), StrToFloat(TempList[2]),
+ StrToFloat(TempList[8]), StrToFloat(TempList[9]),
+ StrToFloat(TempList[10]), StrToFloat(TempList[3]),
+ StrToFloat(TempList[11]), StrToFloat(TempList[12]),
+ StrToFloat(TempList[13]), StrToFloat(TempList[4]),
+ 0,0,0,1);
+ except
+ on E: Exception do
+ raise EInvalidDATLine.Create('Invalid LDraw line: ' + strText);
+ end;
TmpSubpart := TempList[14];
- intLineType := TmpLnType;
Color := TmpColor;
- RotationMatrix := TmpMatrix;
- Position := TmpPosit;
+ Matrix := TmpMatrix;
SubPart := TmpSubpart;
- end;
- except
- end;
+ end
+ else
+ raise EInvalidDATLine.Create('Invalid LDraw line: ' + strText);
finally
TempList.Free;
end;
@@ -647,7 +661,7 @@
FDATMatrix[idx,3] := Value[3];
end;
-function TDATGeometric.GetExtremeValue(Index: Integer): Extended;
+function TDATGeometric.GetExtremeValue(Index: Integer): Double;
var
coord, i, j: Integer;
@@ -661,7 +675,7 @@
coord := 1;
end;
- j := LineType;
+ j := Integer(LineType);
if j = 5 then j := 2;
@@ -674,13 +688,13 @@
end;
end;
-function TDATGeometric.GetCenterValue(Index: Integer): Extended;
+function TDATGeometric.GetCenterValue(Index: Integer): Double;
begin
case LineType of
- 2,5: Result := (MatrixVals[1,Index] + MatrixVals[2,Index]) / 2;
- 3: Result := (MatrixVals[1,Index] + MatrixVals[2,Index] + MatrixVals[3,Index]) / 3;
- 4: Result := (MatrixVals[1,Index] + MatrixVals[2,Index] + MatrixVals[3,Index] + MatrixVals[4,Index]) / 4;
+ ltLine,ltOpLine: Result := (MatrixVals[1,Index] + MatrixVals[2,Index]) / 2;
+ ltTriangle: Result := (MatrixVals[1,Index] + MatrixVals[2,Index] + MatrixVals[3,Index]) / 3;
+ ltQuad: Result := (MatrixVals[1,Index] + MatrixVals[2,Index] + MatrixVals[3,Index] + MatrixVals[4,Index]) / 4;
else
result := 0;
end;
@@ -689,7 +703,7 @@
procedure TDATGeometric.Transform(M: TDATMatrix; Reverse: Boolean = false);
var
- M1: array[1..3] of Extended;
+ M1: array[1..3] of Double;
i: Byte;
begin
@@ -713,12 +727,12 @@
constructor TDATLine.Create;
begin
inherited Create;
- intLineType := 2;
+ FLineType := ltLine;
end;
function TDATLine.GetDATString:string;
begin
- Result := IntToStr(LineType) + ' ' +
+ Result := '2 ' +
IntToStr(Color) + ' ' +
FloatToStr(RoundTo(MatrixVals[1,1], -Abs(PositionDecimalPlaces))) + ' ' +
FloatToStr(RoundTo(MatrixVals[1,2], -Abs(PositionDecimalPlaces))) + ' ' +
@@ -755,7 +769,6 @@
TmpMatrix[2,2] := StrToFloat(TempList[6]);
TmpMatrix[2,3] := StrToFloat(TempList[7]);
- intLineType := TmpLnType;
Color := TmpColor;
Matrix := TmpMatrix;
end;
@@ -770,12 +783,12 @@
constructor TDATOpLine.Create;
begin
inherited Create;
- intLineType := 5;
+ FLineType := ltOpLine;
end;
function TDATOpLine.GetDATString:string;
begin
- Result := IntToStr(LineType) + ' ' +
+ Result := '5 ' +
IntToStr(Color) + ' ' +
FloatToStr(RoundTo(MatrixVals[1,1], -Abs(PositionDecimalPlaces))) + ' ' +
FloatToStr(RoundTo(MatrixVals[1,2], -Abs(PositionDecimalPlaces))) + ' ' +
@@ -824,7 +837,6 @@
TmpMatrix[4,2] := StrToFloat(TempList[12]);
TmpMatrix[4,3] := StrToFloat(TempList[13]);
- intLineType := TmpLnType;
Color := TmpColor;
Matrix := TmpMatrix;
end;
@@ -843,8 +855,8 @@
i,j: Integer;
begin
- j:=intLineType;
- for i := 1 to intLineType do
+ j := Integer(FLineType);
+ for i := 1 to j do
begin
tempArray[j,1] := FDATMatrix[i,1];
tempArray[j,2] := FDATMatrix[i,2];
@@ -857,12 +869,12 @@
constructor TDATTriangle.Create;
begin
inherited Create;
- intLineType := 3;
+ FLineType := ltTriangle;
end;
function TDATTriangle.GetDATString:string;
begin
- Result := IntToStr(LineType) + ' ' +
+ Result := '3 ' +
IntToStr(Color) + ' ' +
FloatToStr(RoundTo(MatrixVals[1,1], -Abs(PositionDecimalPlaces))) + ' ' +
FloatToStr(RoundTo(MatrixVals[1,2], -Abs(PositionDecimalPlaces))) + ' ' +
@@ -905,7 +917,6 @@
TmpMatrix[3,2] := StrToFloat(TempList[9]);
TmpMatrix[3,3] := StrToFloat(TempList[10]);
- intLineType := TmpLnType;
Color := TmpColor;
Matrix := TmpMatrix;
end;
@@ -920,12 +931,12 @@
constructor TDATQuad.Create;
begin
inherited Create;
- intLineType := 4;
+ FLineType := ltQuad;
end;
function TDATQuad.GetDATString:string;
begin
- Result := IntToStr(LineType) + ' ' +
+ Result := '4 ' +
IntToStr(Color) + ' ' +
FloatToStr(RoundTo(MatrixVals[1,1], -Abs(PositionDecimalPlaces))) + ' ' +
FloatToStr(RoundTo(MatrixVals[1,2], -Abs(PositionDecimalPlaces))) + ' ' +
@@ -974,7 +985,6 @@
TmpMatrix[4,2] := StrToFloat(TempList[12]);
TmpMatrix[4,3] := StrToFloat(TempList[13]);
- intLineType := TmpLnType;
Color := TmpColor;
Matrix := TmpMatrix;
end;
Modified: trunk/DAT Tools/DATCheck.pas
===================================================================
--- trunk/DAT Tools/DATCheck.pas 2009-06-10 07:43:44 UTC (rev 372)
+++ trunk/DAT Tools/DATCheck.pas 2009-09-16 16:24:36 UTC (rev 373)
@@ -1,546 +1,452 @@
-unit DATCheck;
-(*
- Copyright (C) 2003-2009 Orion Pobursky
-
- This file is derived from:
- L3Input.cpp and L3Math.cpp
- Part of the L3 project for handling LDraw *.dat files
- Copyright (C) 1997-1999 Lars C. Hassing (lc...@cc...)
-
- Plane normal check derived from code by:
- Philippe "Philo" Hurbain - 2007 - www.philohome.com
-
- This file 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 file 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-*)
-
-interface
-
-uses
- Contnrs;
-
-type
- TDATErrorType = (deRow1AllZeros, deRow2AllZeros, deRow3AllZeros,
- deYColumnAllZeros, deSigularMatrix,
- deCollinearVertices123, deCollinearVertices124,
- deCollinearVertices134, deCollinearVertices234,
- deCollinearVerticesAll, deIdenticalVertices,
- deConcaveQuadSplit13, deConcaveQuadSplit24,
- deBowtieQuad1423, deBowtieQuad1243, deNonCoplanerVerticesDet,
- deNonCoplanerVerticesDist, deNonCoplanerVerticesNormAngle,
- deIdenticalLine, deColor24Illegal, deNil);
-
- TDATCoplanerType = (ctDet, ctDist, ctNormalAngle);
-
- TDATError = class(TObject)
- ErrorType: TDATErrorType;
- ErrorValue: Extended;
- procedure Assign(AError: TDATError);
- end;
-
-const
- strRow1AllZeros = 'Row 1 all zeros';
- strRow2AllZeros = 'Row 2 all zeros';
- strRow3AllZeros = 'Row 3 all zeros';
- strYColumnAllZeros = 'Y column all zeros';
- strSingularMatrix = 'Singular Matrix';
- strCollinearVertices = 'Collinear Vertices';
- strIdenticalVertices = 'Identical Vertices';
- strConcaveSplit13 = 'Concave quad, split on diagonal of points 1 and 3';
- strConcaveSplit24 = 'Concave quad, split on diagonal of points 2 and 4';
- strBowtie1423 = 'Bowtie quad, reorder points to sequence 1, 4, 2, 3';
- strBowtie1243 = 'Bowtie quad, reorder points to sequence 1, 2, 4, 3';
- strNonCoplanerVertices = 'Quad points not coplaner';
- strIdenticalLine = 'Identical to line';
- strColor24Illegal = 'Color 24 illegal for this linetype';
-
-var
- DetThreshold: Extended = 0;
- DistThreshold: Extended = 0;
- PlaneNormalAngleLimit: Extended = 0;
- CollinearPointsThreshold: Extended = 0.0001;
-
-function L3CheckLine(const Line: string): TObjectList;
-function GetErrorString(error: TDATError): string;
-
-implementation
-
-uses
- DATModel, DATBase, DATMath, DATUtils, SysUtils, Math;
-
-procedure TDATError.Assign(AError: TDATError);
-begin
- ErrorType := AError.ErrorType;
- ErrorValue := AError.ErrorValue;
-end;
-
-function SubPartIsXZPrimitive(const Subp: string): Boolean;
-begin
- Result := (Pos('disc', Subp) > 0) or
- (Pos('ndis', Subp) > 0) or
- (Pos('rect', Subp) > 0) or
- (Pos('rin', Subp) > 0) or
- (Pos('axleend', Subp) > 0) or
- (Pos('axlehol2', Subp) > 0) or
- (Pos('axlehol3', Subp) > 0) or
- (Pos('axlehol9', Subp) > 0) or
- (Pos('axleho10', Subp) > 0) or
- (Pos('edge', Subp) > 0) or
- (Pos('chrd', Subp) > 0) or
- (Pos('tang', Subp) > 0);
-end;
-
-function CheckLinearPoints(const p1,p2,p3: TDATPoint): Extended;
-
-var
- cp1: TDATPoint;
-
-begin
- cp1 := PointCrossProduct(PointSubtract(p1,p2),PointSubtract(p2,p3));
- Result := abs(PointDotProduct(cp1,cp1));
-end;
-
-function CoPlanarCheckDet(const m: TDATMatrix): Extended;
-
-var
- i: Integer;
- TempMatrix: TDATMatrix;
-
-begin
- for i := 1 to 3 do
- begin
- TempMatrix[i,1] := m[i,1] - m[4,1];
- TempMatrix[i,2] := m[i,2] - m[4,2];
- TempMatrix[i,3] := m[i,3] - m[4,3];
- end;
- Result := abs(MatrixDet(TempMatrix));
-end;
-
-function CoPlanerCheckDist(const m: TDATMatrix): Extended;
-
-var
- det, maxdist, dist: Extended;
- i,j: Integer;
- TempMatrix: TDATMatrix;
- TempPoint, TempPoint2: TDATPoint;
-
-begin
- det := CoPlanarCheckDet(m);
-
- for i := 1 to 4 do
- begin
- j := (i and 3) + 1;
- TempMatrix[i,1] := m[i,1] - m[j,1];
- TempMatrix[i,2] := m[i,2] - m[j,2];
- TempMatrix[i,3] := m[i,3] - m[j,3];
- end;
-
- maxdist := 0;
-
- for i := 1 to 4 do
- begin
- j := ((i+2) and 3) + 1;
- TempPoint[1] := TempMatrix[i,1];
- TempPoint[2] := TempMatrix[i,2];
- TempPoint[3] := TempMatrix[i,3];
- TempPoint2[1] := TempMatrix[j,1];
- TempPoint2[2] := TempMatrix[j,2];
- TempPoint2[3] := TempMatrix[j,3];
- dist := PointLength(PointCrossProduct(TempPoint, TempPoint2));
- if (dist <> 0) and ((det / dist) > maxdist) then
- maxdist := det / dist;
- end;
-
- Result := maxdist;
-end;
-
-function CoPlanerCheckNormalAngle(const m: TDATMatrix): Extended;
-
-var
- A,B,C,D, norm1, norm2, temp: TDATPoint;
- Angle1, Angle2: Extended;
-
-begin
- A := PointSubtract(DATPoint(m[1,1], m[1,2], m[1,3]), DATPoint(m[2,1], m[2,2], m[2,3]));
- B := PointSubtract(DATPoint(m[2,1], m[2,2], m[2,3]), DATPoint(m[3,1], m[3,2], m[3,3]));
- C := PointSubtract(DATPoint(m[3,1], m[3,2], m[3,3]), DATPoint(m[4,1], m[4,2], m[4,3]));
- D := PointSubtract(DATPoint(m[4,1], m[4,2], m[4,3]), DATPoint(m[1,1], m[1,2], m[1,3]));
-
- temp := PointCrossProduct(A, D);
- norm1 := PointMultiply(temp, 1 / sqrt(PointDotProduct(temp, temp)));
- temp := PointCrossProduct(B, C);
- norm2 := PointMultiply(temp, 1 / sqrt(PointDotProduct(temp, temp)));
- temp := PointCrossProduct(norm1, norm2);
- Angle1 := 180/pi*arcsin(sqrt(PointDotProduct(temp, temp)));
-
- temp := PointCrossProduct(A, B);
- norm1 := PointMultiply(temp, 1 / sqrt(PointDotProduct(temp, temp)));
- temp := PointCrossProduct(D, C);
- norm2 := PointMultiply(temp, 1 / sqrt(PointDotProduct(temp, temp)));
- temp := PointCrossProduct(norm1, norm2);
- Angle2 := 180/pi*arcsin(sqrt(PointDotProduct(temp, temp)));
-
- if Angle1 > Angle2 then
- Result := Angle1
- else
- Result := Angle2;
-end;
-
-function CheckSubPart(datsubpart: TDATSubPart): TObjectList;
-
-var
- det, tempval: Extended;
- i: Integer;
- error: TDATError;
-
-begin
- Result := TObjectList.Create;
- Result.Clear;
- with datsubpart do
- begin
- det := MatrixDet(Matrix);
- if (det = 0) then
- if SubPartIsXZPrimitive(SubPart) then
- begin
- for i := 1 to 3 do
- if (MatrixVals[i,1] = 0) and (MatrixVals[i,2] = 0) and (MatrixVals[i,3] = 0) then
- begin
- MatrixVals[i,2] := 1;
- det := MatrixDet(Matrix);
- if det <> 0 then
- begin
- error := TDATError.Create;
- case i of
- 1: error.ErrorType := deRow1AllZeros;
- 2: error.ErrorType := deRow1AllZeros;
- 3: error.ErrorType := deRow1AllZeros;
- end;
- Result.Add(error);
- Break;
- end;
- end;
- if (det = 0) and (MatrixVals[1,2] = 0) and (MatrixVals[2,2] = 0) and (MatrixVals[3,2] = 0) then
- for i := 1 to 3 do
- begin
- tempval := MatrixVals[i,2];
- MatrixVals[i,2] := 1;
- det := MatrixDet(Matrix);
- if det <> 0 then
- begin
- error := TDATError.Create;
- error.ErrorType := deYColumnAllZeros;
- Result.Add(error);
- Break;
- end
- else
- MatrixVals[i,2] := tempval;
- end;
- if det = 0 then
- begin
- error := TDATError.Create;
- error.ErrorType := deSigularMatrix;
- Result.Add(error);
- end;
- end
- else
- begin
- error := TDATError.Create;
- error.ErrorType := deSigularMatrix;
- Result.Add(error);
- end;
- if Color = 24 then
- begin
- error := TDATError.Create;
- error.ErrorType := deColor24Illegal;
- Result.Add(error);
- end;
- end;
-end;
-
-function CheckLine2(const line: TDATLine): TObjectList;
-
-var
- error: TDATError;
-
-begin
- Result := TObjectList.Create;
- Result.Clear;
- with line do
- if CheckSamePoint(Point[1],Point[2]) then
- begin
- error := TDATError.Create;
- error.ErrorType := deIdenticalVertices;
- Result.Add(error);
- end;
-end;
-
-function CheckTri(const tri: TDATTriangle): TObjectList;
-
-var
- dp: Extended;
- error: TDATError;
-
-begin
- Result := TObjectList.Create;
- Result.Clear;
- with tri do
- begin
- if CheckSamePoint(Point[1],Point[2]) or
- CheckSamePoint(Point[2],Point[3]) or
- CheckSamePoint(Point[3],Point[1]) then
- begin
- error := TDATError.Create;
- error.ErrorType := deIdenticalVertices;
- Result.Add(error);
- end;
-
- dp := CheckLinearPoints(Point[1],Point[2],Point[3]);
- if dp < CollinearPointsThreshold then
- begin
- error := TDATError.Create;
- error.ErrorType := deCollinearVerticesAll;
- error.ErrorValue := dp;
- Result.Add(error);
- end;
- end;
-end;
-
-function CheckQuad(const quad: TDATQuad): TObjectList;
-
-var
- det, maxdist, maxangle, cp: Extended;
- A,B,C: Boolean;
- v01, v02, v03, v12, v13, v23: TDATPoint;
- error: TDATError;
-begin
- Result := TObjectList.Create;
- Result.Clear;
- with quad do
- begin
- if CheckSamePoint(Point[1],Point[2]) or
- CheckSamePoint(Point[2],Point[3]) or
- CheckSamePoint(Point[3],Point[4]) or
- CheckSamePoint(Point[4],Point[1]) or
- CheckSamePoint(Point[1],Point[3]) or
- CheckSamePoint(Point[4],Point[2]) then
- begin
- error := TDATError.Create;;
- error.ErrorType := deIdenticalVertices;
- Result.Add(error);
- Exit;
- end;
-
- cp := CheckLinearPoints(Point[1],Point[2],Point[3]);
- if cp < CollinearPointsThreshold then
- begin
- error := TDATError.Create;;
- error.ErrorType := deCollinearVertices123;
- error.ErrorValue := cp;
- Result.Add(error);
- Exit;
- end;
-
- cp := CheckLinearPoints(Point[1],Point[2],Point[4]);
- if cp < CollinearPointsThreshold then
- begin
- error := TDATError.Create;;
- error.ErrorType := deCollinearVertices124;
- error.ErrorValue := cp;
- Result.Add(error);
- Exit;
- end;
-
- cp := CheckLinearPoints(Point[1],Point[3],Point[4]);
- if cp < CollinearPointsThreshold then
- begin
- error := TDATError.Create;;
- error.ErrorType := deCollinearVertices134;
- error.ErrorValue := cp;
- Result.Add(error);
- Exit;
- end;
-
- cp := CheckLinearPoints(Point[2],Point[3],Point[4]);
- if cp < CollinearPointsThreshold then
- begin
- error := TDATError.Create;;
- error.ErrorType := deCollinearVertices234;
- error.ErrorValue := cp;
- Result.Add(error);
- Exit;
- end;
-
- v01 := PointSubtract(Point[2], Point[1]);
- v02 := PointSubtract(Point[3], Point[1]);
- v03 := PointSubtract(Point[4], Point[1]);
- v12 := PointSubtract(Point[3], Point[2]);
- v13 := PointSubtract(Point[4], Point[2]);
- v23 := PointSubtract(Point[4], Point[3]);
-
- A := PointDotProduct(PointCrossProduct(v01, v02), PointCrossProduct(v02, v03)) > 0;
- B := PointDotProduct(PointCrossProduct(v12, v01), PointCrossProduct(v01, v13)) > 0;
- C := -PointDotProduct(PointCrossProduct(v02, v12), PointCrossProduct(v12, v23)) > 0;
-
- if A then
- begin
- if (B and (not C)) or (C and (not B)) then
- begin
- error := TDATError.Create;;
- error.ErrorType := deConcaveQuadSplit13;
- Result.Add(error);
- end;
- end
- else
- if B then
- if C then
- begin
- error := TDATError.Create;;
- error.ErrorType := deConcaveQuadSplit24;
- Result.Add(error);
- end
- else
- begin
- error := TDATError.Create;;
- error.ErrorType := deBowtieQuad1423;
- Result.Add(error);
- end
- else
- if C then
- begin
- error := TDATError.Create;;
- error.ErrorType := deBowtieQuad1243;
- Result.Add(error);
- end
- else
- begin
- error := TDATError.Create;;
- error.ErrorType := deConcaveQuadSplit24;
- Result.Add(error);
- end;
-
- if (DetThreshold > 0) then
- begin
- det := CoPlanarCheckDet(Matrix);
- if det > DetThreshold then
- begin
- error := TDATError.Create;;
- error.ErrorType := deNonCoplanerVerticesDet;
- error.ErrorValue := det;
- Result.Add(error);
- end;
- end;
-
- if (DistThreshold > 0) then
- begin
- maxdist := CoPlanerCheckDist(Matrix);
- if maxdist > DistThreshold then
- begin
- error := TDATError.Create;;
- error.ErrorType := deNonCoplanerVerticesDist;
- error.ErrorValue := maxdist;
- Result.Add(error);
- end;
- end;
-
- if (PlaneNormalAngleLimit > 0) then
- begin
- maxangle := CoPlanerCheckNormalAngle(Matrix);
- if maxangle > PlaneNormalAngleLimit then
- begin
- error := TDATError.Create;;
- error.ErrorType := deNonCoplanerVerticesNormAngle;
- error.ErrorValue := maxangle;
- Result.Add(error);
- end;
- end;
-
- end;
-end;
-
-function CheckOpLine(const opline: TDATOpline): TObjectList;
-
-var
- error: TDATError;
-
-begin
- Result := TObjectList.Create;
- Result.Clear;
- with opline do
- if CheckSamePoint(Point[1],Point[2]) or CheckSamePoint(Point[3],Point[4]) then
- begin
- error := TDATError.Create;;
- error.ErrorType := deIdenticalVertices;
- Result.Add(error);
- end;
-end;
-
-function L3CheckLine(const Line: string): TObjectList;
-
-var
- DLine: TDATType;
-
-begin
- DLine := StrToDAT(Line);
- case DLine.LineType of
- 1: Result := CheckSubPart(DLine as TDATSubPart);
- 2: Result := CheckLine2(DLine as TDATLine);
- 3: Result := CheckTri(DLine as TDATTriangle);
- 4: Result := CheckQuad(DLine as TDATQuad);
- 5: Result := CheckOpLine(DLine as TDATOpline);
- else Result := nil;
- end;
-
- DLine.Free;
-end;
-
-function GetErrorString(error: TDATError): string;
-begin
- case error.ErrorType of
- deRow1AllZeros: Result := strRow1AllZeros;
- deRow2AllZeros: Result := strRow1AllZeros;
- deRow3AllZeros: Result := strRow1AllZeros;
- deYColumnAllZeros: Result := strYColumnAllZeros;
- deSigularMatrix: Result := strSingularMatrix;
- deIdenticalVertices: Result := strIdenticalVertices;
- deCollinearVertices123: Result := 'Points 1, 2, and 3 have ' +
- strCollinearVertices + ' (' +
- FloatToStr(error.ErrorValue) + ')';
- deCollinearVertices124: Result := 'Points 1, 2, and 4 have ' +
- strCollinearVertices + ' (' +
- FloatToStr(error.ErrorValue) + ')';
- deCollinearVertices134: Result := 'Points 1, 3, and 4 have ' +
- strCollinearVertices + ' (' +
- FloatToStr(error.ErrorValue) + ')';
- deCollinearVertices234: Result := 'Points 2, 3, and 4 have ' +
- strCollinearVertices + ' (' +
- FloatToStr(error.ErrorValue) + ')';
- deCollinearVerticesAll: Result := strCollinearVertices + ' (' +
- FloatToStr(error.ErrorValue) + ')';
- deConcaveQuadSplit24: Result := strConcaveSplit24;
- deConcaveQuadSplit13: Result := strConcaveSplit13;
- deBowtieQuad1423: Result := strBowtie1423;
- deBowtieQuad1243: Result := strBowtie1243;
- deNonCoplanerVerticesDet: Result := strNonCoplanerVertices +
- ' (det = ' + FloatToStr(error.ErrorValue) + ')';
- deNonCoplanerVerticesDist: Result := strNonCoplanerVertices +
- ' (dist = ' + FloatToStr(error.ErrorValue) + ')';
- deNonCoplanerVerticesNormAngle: Result := strNonCoplanerVertices +
- ' (angle = ' + FloatToStr(error.ErrorValue) + ')';
- deIdenticalLine: Result := strIdenticalLine + ' ' + IntToStr(Trunc(error.ErrorValue));
- deColor24Illegal: Result := strColor24Illegal;
- else Result := '';
- end;
-end;
-
-end.
+unit DATCheck;
+(*
+ Copyright (C) 2003-2009 Orion Pobursky
+
+ This file is derived from:
+ L3Input.cpp and L3Math.cpp
+ Part of the L3 project for handling LDraw *.dat files
+ Copyright (C) 1997-1999 Lars C. Hassing (lc...@cc...)
+
+ Plane normal check derived from code by:
+ Philippe "Philo" Hurbain - 2007 - www.philohome.com
+
+ This file 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 file 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+*)
+
+interface
+
+uses
+ Contnrs;
+
+type
+ TDATErrorType = (deRow1AllZeros, deRow2AllZeros, deRow3AllZeros,
+ deYColumnAllZeros, deSigularMatrix, deTriangleCollinear,
+ deQuadCollinear, deIdenticalVertices, deConcaveQuadSplit13,
+ deConcaveQuadSplit24, deBowtieQuad1423, deBowtieQuad1243,
+ deNonCoplanerVerticesNormAngle, deIdenticalLine,
+ deColor24Illegal, deBadSyntax, deNil);
+
+ TDATError = class(TObject)
+ FErrorType: TDATErrorType;
+ FErrorValue: Double;
+ constructor Create(EType: TDATErrorType; EVal: Double = 0);
+ procedure Assign(AError: TDATError);
+ property ErrorType: TDATErrorType read FErrorType write FErrorType;
+ property ErrorValue: Double read FErrorValue write FErrorValue;
+ end;
+
+const
+ strRow1AllZeros = 'Row 1 all zeros';
+ strRow2AllZeros = 'Row 2 all zeros';
+ strRow3AllZeros = 'Row 3 all zeros';
+ strYColumnAllZeros = 'Y column all zeros';
+ strSingularMatrix = 'Singular Matrix';
+ strTriangleCollinear = 'Triangle collinear';
+ strQuadCollinear = 'Quad collinear';
+ strIdenticalVertices = 'Identical Vertices';
+ strConcaveSplit13 = 'Concave quad, split on diagonal of points 1 and 3';
+ strConcaveSplit24 = 'Concave quad, split on diagonal of points 2 and 4';
+ strBowtie1423 = 'Bowtie quad, reorder points to sequence 1, 4, 2, 3';
+ strBowtie1243 = 'Bowtie quad, reorder points to sequence 1, 2, 4, 3';
+ strNonCoplanerVertices = 'Quad points not coplaner';
+ strIdenticalLine = 'Identical to line';
+ strColor24Illegal = 'Color 24 illegal for this linetype';
+ strBadSyntax = 'Syntax Error';
+
+var
+ PlaneNormalAngleLimit: Double = 1;
+ CollinearMaxAngle: Double = 179.9;
+ CollinearMinAngle: Double = 0.025;
+
+function L3CheckLine(const Line: string): TObjectList;
+function GetErrorString(error: TDATError): string;
+
+implementation
+
+uses
+ DATModel, DATBase, DATMath, DATUtils, SysUtils, Math;
+
+{TDATError}
+procedure TDATError.Assign(AError: TDATError);
+begin
+ ErrorType := AError.ErrorType;
+ ErrorValue := AError.ErrorValue;
+end;
+
+constructor TDATError.Create(EType: TDATErrorType; EVal: Double);
+begin
+ inherited Create;
+ ErrorType := EType;
+ ErrorValue := EVal;
+end;
+
+function SubPartIsXZPrimitive(const Subp: string): Boolean;
+begin
+ Result := (Pos('disc', Subp) > 0) or
+ (Pos('ndis', Subp) > 0) or
+ (Pos('rect', Subp) > 0) or
+ (Pos('rin', Subp) > 0) or
+ (Pos('axleend', Subp) > 0) or
+ (Pos('axlehol2', Subp) > 0) or
+ (Pos('axlehol3', Subp) > 0) or
+ (Pos('axlehol9', Subp) > 0) or
+ (Pos('axleho10', Subp) > 0) or
+ (Pos('edge', Subp) > 0) or
+ (Pos('chrd', Subp) > 0) or
+ (Pos('tang', Subp) > 0);
+end;
+
+function CheckPointsCollinear(const p1, p2, p3: TDATPoint): Double;
+
+var
+ a, b: TDATPoint;
+ n, t: Double;
+
+begin
+
+ a := PointSubtract(p2, p1);
+ b := PointSubtract(p2, p3);
+ n := 1 / PointNorm(a);
+ a := PointMultiply(a, n);
+ n := 1 / PointNorm(b);
+ b := PointMultiply(b, n);
+ t := PointNorm(PointCrossProduct(a, b));
+ if t >= 1 then
+ Result := 90
+ else
+ if (PointDotProduct(a, b) < 0) then
+ Result := 180-(180/Pi * ArcSin(t))
+ else
+ Result := 180/Pi * ArcSin(t);
+end;
+
+function CoPlanerCheckNormalAngle(const m: TDATMatrix): Double;
+
+var
+ A, B, C, D, norm1, norm2: TDATPoint;
+ Angle1, Angle2, temp: Double;
+
+begin
+ A := PointSubtract(DATPoint(m[1,1], m[1,2], m[1,3]), DATPoint(m[2,1], m[2,2], m[2,3]));
+ B := PointSubtract(DATPoint(m[2,1], m[2,2], m[2,3]), DATPoint(m[3,1], m[3,2], m[3,3]));
+ C := PointSubtract(DATPoint(m[3,1], m[3,2], m[3,3]), DATPoint(m[4,1], m[4,2], m[4,3]));
+ D := PointSubtract(DATPoint(m[4,1], m[4,2], m[4,3]), DATPoint(m[1,1], m[1,2], m[1,3]));
+
+ norm1 := PointMultiply(PointCrossProduct(A, D), 1 / PointNorm(PointCrossProduct(A, D)));
+ norm2 := PointMultiply(PointCrossProduct(B, C), 1 / PointNorm(PointCrossProduct(B, C)));
+ temp := PointNorm(PointCrossProduct(norm1, norm2));
+ if temp >= 1 then
+ Angle1 := Pi/2
+ else
+ Angle1 := 180/Pi*ArcSin(temp);
+
+ norm1 := PointMultiply(PointCrossProduct(A, B), 1 / PointNorm(PointCrossProduct(A, B)));
+ norm2 := PointMultiply(PointCrossProduct(D, C), 1 / PointNorm(PointCrossProduct(D, C)));
+ temp := PointNorm(PointCrossProduct(norm1, norm2));
+ if temp >= 1 then
+ Angle2 := Pi/2
+ else
+ Angle2 := 180/Pi*ArcSin(temp);
+
+ if Angle1 > Angle2 then
+ Result := Angle1
+ else
+ Result := Angle2;
+end;
+
+function CheckSubPart(datsubpart: TDATSubPart): TObjectList;
+
+var
+ det, tempval: Double;
+ i: Integer;
+ error: TDATError;
+
+begin
+ Result := TObjectList.Create;
+ Result.Clear;
+ with datsubpart do
+ begin
+ det := MatrixDet(Matrix);
+ if (det = 0) then
+ if SubPartIsXZPrimitive(SubPart) then
+ begin
+ for i := 1 to 3 do
+ if (MatrixVals[i,1] = 0) and (MatrixVals[i,2] = 0) and (MatrixVals[i,3] = 0) then
+ begin
+ MatrixVals[i,2] := 1;
+ det := MatrixDet(Matrix);
+ if det <> 0 then
+ begin
+ case i of
+ 1: error := TDATError.Create(deRow1AllZeros);
+ 2: error := TDATError.Create(deRow2AllZeros);
+ 3: error := TDATError.Create(deRow3AllZeros);
+ else error := TDATError.Create(deNil);
+ end;
+ Result.Add(error);
+ Break;
+ end;
+ end;
+ if (det = 0) and (MatrixVals[1,2] = 0) and (MatrixVals[2,2] = 0) and (MatrixVals[3,2] = 0) then
+ for i := 1 to 3 do
+ begin
+ tempval := MatrixVals[i,2];
+ MatrixVals[i,2] := 1;
+ det := MatrixDet(Matrix);
+ if det <> 0 then
+ begin
+ error := TDATError.Create(deYColumnAllZeros);
+ Result.Add(error);
+ Break;
+ end
+ else
+ MatrixVals[i,2] := tempval;
+ end;
+ if det = 0 then
+ begin
+ error := TDATError.Create(deSigularMatrix);
+ Result.Add(error);
+ end;
+ end
+ else
+ begin
+ error := TDATError.Create(deSigularMatrix);
+ Result.Add(error);
+ end;
+ if Color = 24 then
+ begin
+ error := TDATError.Create(deColor24Illegal);
+ Result.Add(error);
+ end;
+ end;
+end;
+
+function CheckLine2(const line: TDATLine): TObjectList;
+
+var
+ error: TDATError;
+
+begin
+ Result := TObjectList.Create;
+ Result.Clear;
+ with line do
+ if CheckSamePoint(Point[1],Point[2]) then
+ begin
+ error := TDATError.Create(deIdenticalVertices);
+ Result.Add(error);
+ end;
+end;
+
+function CheckTri(const tri: TDATTriangle): TObjectList;
+
+var
+ angle1, angle2, angle3: Double;
+ error: TDATError;
+
+begin
+ Result := TObjectList.Create;
+ Result.Clear;
+ with tri do
+ begin
+ if CheckSamePoint(Point[1],Point[2]) or
+ CheckSamePoint(Point[2],Point[3]) or
+ CheckSamePoint(Point[3],Point[1]) then
+ begin
+ error := TDATError.Create(deIdenticalVertices);
+ Result.Add(error);
+ end;
+
+ angle1 := CheckPointsCollinear(Point[1],Point[2],Point[3]);
+ angle2 := CheckPointsCollinear(Point[2],Point[3],Point[1]);
+ angle3 := CheckPointsCollinear(Point[3],Point[1],Point[2]);
+
+ if (MinValue([angle1, angle2, angle3]) < CollinearMinAngle) or
+ (MaxValue([angle1, angle2, angle3]) > CollinearMaxAngle) then
+ begin
+ if MaxValue([angle1, angle2, angle3]) > CollinearMaxAngle then
+ error := TDATError.Create(deTriangleCollinear, MaxValue([angle1, angle2, angle3]))
+ else
+ error := TDATError.Create(deTriangleCollinear, MinValue([angle1, angle2, angle3]));
+ Result.Add(error);
+ end;
+ end;
+end;
+
+function CheckQuad(const quad: TDATQuad): TObjectList;
+
+var
+ maxangle, angle1, angle2, angle3, angle4: Double;
+ A,B,C: Boolean;
+ v01, v02, v03, v12, v13, v23: TDATPoint;
+ error: TDATError;
+begin
+ Result := TObjectList.Create;
+ Result.Clear;
+ with quad do
+ begin
+ if CheckSamePoint(Point[1],Point[2]) or
+ CheckSamePoint(Point[2],Point[3]) or
+ CheckSamePoint(Point[3],Point[4]) or
+ CheckSamePoint(Point[4],Point[1]) or
+ CheckSamePoint(Point[1],Point[3]) or
+ CheckSamePoint(Point[4],Point[2]) then
+ begin
+ error := TDATError.Create(deIdenticalVertices);
+ Result.Add(error);
+ Exit;
+ end;
+
+ angle1 := CheckPointsCollinear(Point[1],Point[2],Point[3]);
+ angle2 := CheckPointsCollinear(Point[2],Point[3],Point[4]);
+ angle3 := CheckPointsCollinear(Point[3],Point[4],Point[1]);
+ angle4 := CheckPointsCollinear(Point[4],Point[1],Point[2]);
+
+ if (MinValue([angle1, angle2, angle3, angle4]) < CollinearMinAngle) or
+ (MaxValue([angle1, angle2, angle3, angle4]) > CollinearMaxAngle) then
+ begin
+ if MaxValue([angle1, angle2, angle3, angle4]) > CollinearMaxAngle then
+ error := TDATError.Create(deQuadCollinear, MaxValue([angle1, angle2, angle3, angle4]))
+ else
+ error := TDATError.Create(deQuadCollinear, MinValue([angle1, angle2, angle3, angle4]));
+ Result.Add(error);
+ end;
+
+ v01 := PointSubtract(Point[2], Point[1]);
+ v02 := PointSubtract(Point[3], Point[1]);
+ v03 := PointSubtract(Point[4], Point[1]);
+ v12 := PointSubtract(Point[3], Point[2]);
+ v13 := PointSubtract(Point[4], Point[2]);
+ v23 := PointSubtract(Point[4], Point[3]);
+
+ A := PointDotProduct(PointCrossProduct(v01, v02), PointCrossProduct(v02, v03)) > 0;
+ B := PointDotProduct(PointCrossProduct(v12, v01), PointCrossProduct(v01, v13)) > 0;
+ C := -PointDotProduct(PointCrossProduct(v02, v12), PointCrossProduct(v12, v23)) > 0;
+
+ if A then
+ begin
+ if (B and (not C)) or (C and (not B)) then
+ begin
+ error := TDATError.Create(deConcaveQuadSplit13);
+ Result.Add(error);
+ end;
+ end
+ else
+ if B then
+ if C then
+ begin
+ error := TDATError.Create(deConcaveQuadSplit24);
+ Result.Add(error);
+ end
+ else
+ begin
+ error := TDATError.Create(deBowtieQuad1423);
+ Result.Add(error);
+ end
+ else
+ if C then
+ begin
+ error := TDATError.Create(deBowtieQuad1243);
+ Result.Add(error);
+ end
+ else
+ begin
+ error := TDATError.Create(deConcaveQuadSplit24);
+ Result.Add(error);
+ end;
+
+ maxangle := CoPlanerCheckNormalAngle(Matrix);
+ if maxangle > PlaneNormalAngleLimit then
+ begin
+ error := TDATError.Create(deNonCoplanerVerticesNormAngle, maxangle);
+ Result.Add(error);
+ end;
+
+ end;
+end;
+
+function CheckOpLine(const opline: TDATOpline): TObjectList;
+
+var
+ error: TDATError;
+
+begin
+ Result := TObjectList.Create;
+ Result.Clear;
+ with opline do
+ if CheckSamePoint(Point[1],Point[2]) or CheckSamePoint(Point[3],Point[4]) then
+ begin
+ error := TDATError.Create(deIdenticalVertices);
+ Result.Add(error);
+ end;
+end;
+
+function L3CheckLine(const Line: string): TObjectList;
+
+var
+ DLine: TDATType;
+ error: TDATError;
+
+begin
+ DLine := StrToDAT(Line);
+ case DLine.LineType of
+ ltSubPart: Result := CheckSubPart(DLine as TDATSubPart);
+ ltLine: Result := CheckLine2(DLine as TDATLine);
+ ltTriangle: Result := CheckTri(DLine as TDATTriangle);
+ ltQuad: Result := CheckQuad(DLine as TDATQuad);
+ ltOpLine: Result := CheckOpLine(DLine as TDATOpline);
+ else
+ begin
+ if DLine is TDATInvalidLine then
+ begin
+ Result := TObjectList.Create;
+ Result.Clear;
+ error := TDATError.Create(deBadSyntax);
+ Result.Add(error);
+ end
+ else
+ Result := TObjectList.Create;
+ end;
+ end;
+
+ DLine.Free;
+end;
+
+function GetErrorString(error: TDATError): string;
+begin
+ case error.ErrorType of
+ deRow1AllZeros: Result := strRow1AllZeros;
+ deRow2AllZeros: Result := strRow2AllZeros;
+ deRow3AllZeros: Result := strRow3AllZeros;
+ deYColumnAllZeros: Result := strYColumnAllZeros;
+ deSigularMatrix: Result := strSingularMatrix;
+ deIdenticalVertices: Result := strIdenticalVertices;
+ deTriangleCollinear: Result := strTriangleCollinear + ' (angle = ' +
+ FloatToStr(error.ErrorValue) + ')';
+ deQuadCollinear: Result := strQuadCollinear + ' (angle = ' +
+ FloatToStr(error.ErrorValue) + ')';
+ deConcaveQuadSplit24: Result := strConcaveSplit24;
+ deConcaveQuadSplit13: Result := strConcaveSplit13;
+ deBowtieQuad1423: Result := strBowtie1423;
+ deBowtieQuad1243: Result := strBowtie1243;
+ deNonCoplanerVerticesNormAngle: Result := strNonCoplanerVertices +
+ ' (angle = ' + FloatToStr(error.ErrorValue) + ')';
+ deIdenticalLine: Result := strIdenticalLine + ' ' + IntToStr(Trunc(error.ErrorValue));
+ deColor24Illegal: Result := strColor24Illegal;
+ deBadSyntax: Result := strBadSyntax;
+ else Result := '';
+ end;
+end;
+
+end.
Modified: trunk/DAT Tools/DATErrorFix.pas
===================================================================
--- trunk/DAT Tools/DATErrorFix.pas 2009-06-10 07:43:44 UTC (rev 372)
+++ trunk/DAT Tools/DATErrorFix.pas 2009-09-16 16:24:36 UTC (rev 373)
@@ -24,8 +24,8 @@
procedure FixBowtieQuad1243(quad: TDATQuad);
procedure FixBowtieQuad1423(quad: TDATQuad);
-procedure SplitConcaveQuad13(quad: TDATQuad; out tri1, tri2: TDATTriangle);
-procedure SplitConcaveQuad24(quad: TDATQuad; out tri1, tri2: TDATTriangle);
+procedure SplitConcaveQuad13(const quad: TDATQuad; out tri1, tri2: TDATTriangle);
+procedure SplitConcaveQuad24(const quad: TDATQuad; out tri1, tri2: TDATTriangle);
procedure FixRowAllZeros(subp: TDATSubPart; const Row: Integer);
procedure FixYColumnAllZeros(subp: TDATSubPart);
@@ -34,7 +34,7 @@
procedure FixBowtieQuad1243(quad: TDATQuad);
var
- tx,ty,tz: Extended;
+ tx,ty,tz: Double;
begin
with quad do
@@ -54,7 +54,7 @@
procedure FixBowtieQuad1423(quad: TDATQuad);
var
- tx,ty,tz: Extended;
+ tx,ty,tz: Double;
begin
with quad do
@@ -84,7 +84,7 @@
subp.MatrixVals[2,2] := 1;
end;
-procedure SplitConcaveQuad13(quad: ...
[truncated message content] |