I have a record type
tLine = record
X, Y, Count : integer;
V : boolean;
end;
I have a
function fRotate(zLine: tLine; zAngle: double): tLine;
I want to pass zLine, but with its Y field reduced by 1. Is there a way to break a record down into its specific fields in a procedure or function? I tried
NewLine:=fRotate((zLine.X, zLine.Y-1, zLine.Count, zLine.V), zAngle);
which does not work.
Or do I have to do as follows:
dec(zLine.Y);
NewLine:=fRotate(zLine, zAngle);
inc(zLine.Y);
TIA
You would typically make a function for this. In modern Delphi with enhanced records, I like to use a static class function like this:
type
TLine = record
public
X: Integer;
Y: Integer;
Count: Integer;
V: Boolean;
public
class function New(X, Y, Count: Integer; V: Boolean): TLine; static;
end;
class function TLine.New(X, Y, Count: Integer; V: Boolean): TLine;
begin
Result.X := X;
Result.Y := Y;
Result.Count := Count;
Result.V := V;
end;
Then your function call becomes:
NewLine := fRotate(TLine.New(zLine.X, zLine.Y-1, zLine.Count, zLine.V), zAngle);
In older versions of Delphi you'd have to use a function at global scope.
For readability I like to use an alternative solution with record operators, like this: Note that this is updated in line with Kobik's suggestion
tLine = record
X, Y, Count : integer;
V : boolean;
class operator Subtract( a : tLine; b : TPoint ) : tLine;
end;
class operator tLine.Subtract(a: tLine; b : TPoint): tLine;
begin
Result.X := a.X - b.X;
Result.Y := a.Y - b.Y;
Result.Count := a.Count;
Result.V := a.V;
end;
This allows this type of construct:
fRotate( fLine - Point(0,1), fAngle );
which I think makes sense. You could obviously use a simple integer rather than an array if all you ever wanted to do was decrement Y, but this allows X and/or Y to be decremented at once.
Related
I have the following formula
X := X + F*(1-i div n);
Where
X, F, i, n: integer;
The code I'm using is this
F := 7; // the initial speed with no friction.
n := 10; // the animation number of steps.
Hn := n * 2 ;
X := 0; // first Pos
i := 1;
J := 1;
while J < Hn do
begin
X := X + F * (1 - i div n);
if X > Xmax then X := 0; <-- line (1).
if i >= n then Dec(i)
else Inc(i);
Inc(J);
end;
If it was possible I would like to use this but without class/record implementation(not inside a class/record implementation/method).not the exact syntax, just the same principle, instead of direct assignment to X the SetX is called then the result is assigned to X.
X: integer write SetX; // This is not a correct delphi syntax. I added it to explain the behavior I want.
function SetX(aValue: integer): integer;
const
Xmax: SomeIntegerValue;
begin
if aValue > Xmax then result := 0
else result := aValue;
end;
So I could omit Line (1). If this was possible, all the lines after the formula would be omitted and the while loop would look like this
while J < Hn do // J will be incremented each time the loop wants to read it.
begin
X := X + F * (1 - i div n);
end;
Is there anyway to use the property like behavior?
Note: I'm looking for a way to alter the assignment and reading ways of a variable like you do in a property of a record/class.
Is there anyway to use the property like approach outside a class/record?
No, property getters and setters can only be implemented in records and classes.
You can use local function like
procedure YourProcedure;
var
X: Integer;
LJ: Integer;
function J: Integer;
begin
Inc(LJ);
Result := LJ;
end;
procedure SetX(const AValue: Integer);
const
Xmax: SomeIntegerValue;
begin
if aValue > Xmax then X := 0
else X := aValue;
end;
//...
begin
while J < Hn do // J will be incremented each time the loop wants to read it.
begin
SetX(X + F * (1 - i div n));
end
end.
I found a way to do what I wanted. I know that overloading the := operator is not possible, However forcing the compiler to produce the same behavior as the overloaded operator would behave is possible.
The overloading would not let me control the LSA (Left Side Argument). but it gave full control to implicitly convert any TType (in my case it is an integer) to TXinteger. So all I had to do is make sure that every operator would result in a TType which will force the compiler to implicitly convert that to a TXinteger.
Forcing the compiler to use my implicit operator every time it wants to assign something to TXinteger means I control the assignment Hence I overloaded the := operator.
the following is a test example that makes omitting Line(1) possible.
program Project4;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils;
type
TXinteger = record
X: integer;
class operator Add(a, b: TXinteger): integer;
class operator Add(a: TXinteger; b:integer): integer;
class operator Add(a: integer; b:TXinteger): integer;
class operator Implicit(a: Integer): TXinteger;
class operator Implicit(a: TXinteger): Integer;
end;
// Example implementation of Add
class operator TXinteger.Add(a, b: TXinteger): integer;
begin
result := a.X + b.X;
end;(**)
class operator TXinteger.Add(a: TXinteger; b:integer): integer;
begin
result := a.X + b;
end;
class operator TXinteger.Add(a: integer; b:TXinteger): integer;
begin
result := a + b.X;
end;
class operator TXinteger.Implicit(a: Integer): TXinteger;
const
Xmax: integer = 10;
begin
if a > Xmax then result.X := 0 else result.X := a;
end;
class operator TXinteger.Implicit(a: TXinteger): Integer;
begin
result := a.X;
end;
var
X: TXinteger;
Hn, F, i,J, n: integer;
begin
try
F := 7;
n := 10;
Hn := n * 2 ;
X := 0;
i := 1;
J := 1;
while J < Hn do
begin
X := X + F * (1 - i div n);
// Line (1) is gone now.
if i >= n then Dec(i)
else Inc(i);
Inc(J);
end;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
Note: for this case it is pointless to do all of this just to omit one line of code. I wanted to share this because it gives an idea of how one could overload the := operator.
What I wanted is this:
Alter how X:Integer is read (value read from the variable x's storage).
Alter how X:Integer is assigned.
by overloading all the operators that use the value of X, I completed the first.
And by forcing the compiler as explained above, I completed the second.
Thank you all for your help.
AFAIK there's no built-in function for that. Searching the web I found this function and it works for me, but I prefer not to use it since it's assembly and I can't understand what it is doing. So I wrote this function that also works:
function Cardinality(const PSet: PByteArray;
const SizeOfSet(*in bytes*): Integer): Integer;
const
Masks: array[0..7] of Byte = (1, 2, 4, 8, 16, 32, 64, 128);
var
I, J: Integer;
begin
Result := 0;
for I := 0 to SizeOfSet - 1 do
for J := 0 to 7 do
if (PSet^[I] and Masks[J]) > 0 then
Inc(Result);
end;
Now, I want to know if I can rely on this function? Or maybe there's a trick behind the set data type and that's why delphi doesn't have a built-in method for that.
But if my function is reliable then how can I improve it to:
Pass constants to it
Do a type check and make sure that a set is passed to the function
Pass the value instead of its address
Get rid of SizeOfSet parameter
I want to call it like Cardinality(AnySet) instead of Cardinality(#AnySet, SizeOf(TAnySet)).
By the way, I need to compile this in both XE and XE5.
You can implement this with generics and RTTI. Like so:
uses
SysUtils, TypInfo;
type
ERuntimeTypeError = class(Exception);
TSet<T> = class
strict private
class function TypeInfo: PTypeInfo; inline; static;
public
class function IsSet: Boolean; static;
class function Cardinality(const Value: T): Integer; static;
end;
const
Masks: array[0..7] of Byte = (1, 2, 4, 8, 16, 32, 64, 128);
implementation
{ TSet<T> }
class function TSet<T>.TypeInfo: PTypeInfo;
begin
Result := System.TypeInfo(T);
end;
class function TSet<T>.IsSet: Boolean;
begin
Result := TypeInfo.Kind=tkSet;
end;
function GetCardinality(const PSet: PByteArray;
const SizeOfSet(*in bytes*): Integer): Integer; inline;
var
I, J: Integer;
begin
Result := 0;
for I := 0 to SizeOfSet - 1 do
for J := 0 to 7 do
if (PSet^[I] and Masks[J]) > 0 then
Inc(Result);
end;
class function TSet<T>.Cardinality(const Value: T): Integer;
var
EnumTypeData: PTypeData;
begin
if not IsSet then
raise ERuntimeTypeError.Create('Invalid type in TSet<T>, T must be a set');
Result := GetCardinality(PByteArray(#Value), SizeOf(Value));
end;
Usage:
Writeln(TSet<SomeSet>.Cardinality(Value));
In earlier version of Delphi you can do this :
function Card(ASet: TSet): Integer;
var
k: TSetElement;
begin
Result := 0;
for k in ASet do Inc(Result);
end;
I have an advanced record with a dynamic array field.
The record has a class operator for concatenation of a record and a byte. Also an Add method, adding a byte.
For what I'm about to use the record, the reference count of the dynamic array field is of importance. When running the two test procedures below, you can see that the concatenation results in a reference count of 2 while the add method results in a reference count of 1.
program TestReferenceCount;
{$APPTYPE CONSOLE}
uses
System.SysUtils;
Type
TRec = record
class operator Add(const a: TRec; b: Byte): TRec;
private type
PDynArrayRec = ^TDynArrayRec;
TDynArrayRec = packed record
{$IFDEF CPUX64}
_Padding: LongInt; // Make 16 byte align for payload..
{$ENDIF}
RefCnt: LongInt;
Length: NativeInt;
end;
private
FArr: TBytes;
function GetRefCnt: Integer;
public
procedure Add(b : Byte);
property RefCnt: Integer read GetRefCnt;
end;
procedure TRec.Add(b : Byte);
var
prevLen: Integer;
begin
prevLen := System.Length(Self.FArr);
SetLength(Self.FArr, prevLen + 1);
Self.FArr[prevLen] := b;
end;
class operator TRec.Add(const a: TRec; b: Byte): TRec;
var
aLen: Integer;
begin
aLen := System.Length(a.FArr);
SetLength(Result.FArr, aLen + 1);
System.Move(a.FArr[0], Result.FArr[0], aLen);
Result.FArr[aLen] := b;
end;
function TRec.GetRefCnt: Integer;
begin
if Assigned(FArr) then
Result := PDynArrayRec(NativeInt(FArr) - SizeOf(TDynArrayRec)).RefCnt
else
Result := 0;
end;
procedure TestConcatenation;
var
r1 : TRec;
begin
WriteLn('RC:', r1.RefCnt); // <-- Writes 0
r1 := r1 + 65;
WriteLn('RC:', r1.RefCnt); // <-- Writes 2
end;
procedure TestAdd;
var
r1 : TRec;
begin
WriteLn('RC:', r1.RefCnt); // <-- Writes 0
r1.Add(65);
WriteLn('RC:', r1.RefCnt); // <-- Writes 1
end;
begin
TestConcatenation;
TestAdd;
ReadLn;
end.
The compiler takes care of the extra reference count when the record variable goes out of scope, so no problem really at this point.
But can this behavior be explained? Is it an undocumented implementation detail? Is there a way to avoid the extra count?
Let's take a look at this function:
procedure TestConcatenation;
var
r1 : TRec;
begin
r1 := r1 + 65;
end;
The compiler actually implements it like this:
procedure TestConcatenation;
var
r1 : TRec;
tmp : TRec;
begin
tmp := r1 + 65;
r1 := tmp;
end;
The compiler introduces a temporary local to store the result of r1 + 65. There's a very good reason for that. If it did not, where would it write the result of your addition operator? Since the ultimate destination is r1, if your addition operator writes directly to r1 it is modifying its input variable.
There is no way to stop the compiler generating this temporary local.
I have a question. I am a newbie with Run Time Type Information from Delphi 2010. I need to set length to a dynamic array into a TValue. You can see the code.
Type TMyArray = array of integer;
TMyClass = class
publihed
function Do:TMyArray;
end;
function TMyClass.Do:TMyArray;
begin
SetLength(Result,5);
for i:=0 to 4 Result[i]=3;
end;
.......
.......
......
y:TValue;
Param:array of TValue;
.........
y=Methods[i].Invoke(Obj,Param);//delphi give me a DynArray type kind, is working, Param works to any functions.
if Method[i].ReturnType.TypeKind = tkDynArray then//is working...
begin
I want to set length for y to 10000//i don't know how to write.
end;
I don't like Generics Collections.
TValue wasn't designed for arbitrary manipulation of its contents (it would have more helpers for e.g. setting record fields etc. if so), but rather for transporting values between concrete static types and dynamic RTTI. In this respect, TValue.SetArrayElement is an anomaly, and in hindsight, perhaps should not have been included. However, what you ask is possible:
uses Rtti;
type
TMyArray = array of Integer;
TMyClass = class
function Go: TMyArray;
end;
function TMyClass.Go: TMyArray;
var
i: Integer;
begin
SetLength(Result, 5);
for i := 0 to 4 do
Result[i] := 3;
end;
procedure P;
var
ctx: TRttiContext;
v: TValue;
len: Longint;
i: Integer;
begin
v := ctx.GetType(TMyClass).GetMethod('Go').Invoke(TMyClass.Create, []);
Writeln(v.ToString);
len := 10;
DynArraySetLength(PPointer(v.GetReferenceToRawData)^, v.TypeInfo, 1, #len);
Writeln(v.GetArrayLength);
for i := 0 to v.GetArrayLength - 1 do
Writeln(v.GetArrayElement(i).ToString);
end;
begin
P;
end.
I have a very simple class definition for 3D Vectors, TVector3D, and a few methods used to implement the TVector3D.Normalise function. If I pass the Normalise function a vector that is already normalised, I want it to return the vector I passed it. Here I have used Result := Self but I am having some crazy returns.
The console application:
program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils;
type
TVector3D = Class
public
x : Single;
y : Single;
z : Single;
constructor Create(x : Single;
y : Single;
z : Single);
function GetMagnitude() : Single;
function IsUnitVector() : Boolean;
function Normalise() : TVector3D;
end;
constructor TVector3D.Create(x : Single;
y : Single;
z : Single);
begin
Self.x := x;
Self.y := y;
Self.z := z;
end;
function TVector3D.GetMagnitude;
begin
Result := Sqrt(Sqr(Self.x) + Sqr(Self.y) + Sqr(Self.z));
end;
function TVector3D.IsUnitVector;
begin
if Self.GetMagnitude = 1 then
Result := True
else
Result := False;
end;
function TVector3D.Normalise;
var
x : Single;
y : Single;
z : Single;
MagnitudeFactor : Single;
begin
if IsUnitVector then
Result := Self
else
MagnitudeFactor := 1/(Self.GetMagnitude);
x := Self.x*MagnitudeFactor;
y := Self.y*MagnitudeFactor;
z := Self.z*MagnitudeFactor;
Result := TVector3D.Create(x,
y,
z);
end;
procedure TestNormalise;
var
nonUnitVector : TVector3D;
unitVector : TVector3D;
nUVNormed : TVector3D;
uVNormed : TVector3D;
begin
//Setup Vectors for Test
nonUnitVector := TVector3D.Create(1,
1,
1);
unitVector := TVector3D.Create(1,
0,
0);
//Normalise Vectors & Free Memory
nUVNormed := nonUnitVector.Normalise;
nonUnitVector.Free;
uVNormed := unitVector.Normalise;
unitVector.Free;
//Print Output & Free Memory
WriteLn('nUVNormed = (' + FloatToStr(nUVNormed.x) + ', ' + FloatToStr(nUVNormed.y) + ', ' + FloatToStr(nUVNormed.z) + ')');
nUVNormed.Free;
WriteLn('uVNormed = (' + FloatToStr(uVNormed.x) + ', ' + FloatToStr(uVNormed.y) + ', ' + FloatToStr(uVNormed.z) + ')');
uVNormed.Free;
end;
begin
try
TestNormalise;
Sleep(10000);
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
Normalise works fine for non-unit vecors, i.e. IsUnitVector returns false. But for unit vectors, such as (1,0,0), instead of returning itself I get a result with very low nonzero numbers wherever there was a nonzero previously, such as (8.47122...E-38,0,0).
If I run this through the debugger with a breakpoint on the line Result := Self set to evaluate Self, Self is (1,0,0) yet result becomes (Very Low Number,0,0). Where Very Low Number changes each time I run the programme but always seems to be around E-38/E-39.
I do not understand why this happens. Why does it happen and how is it best to alter my Normalise function to avoid it.
Your current TVector3D.Normalise implementation has some issues:
The last 4 lines are always executed, because you have not used a begin-end block after the else,
So the routine never returns Self, but always a new instance,
The returned instance's memory is propably leaked because you lost ownership of it after the function call,
When IsUnitVector returns True, then the assignment of MagnitudeFactor will be skipped, and it will be a random value (currently present at that memory's address), which explains why you get rubish. You are also warned by the compiler for this: Variable MagnitudeFactor might not have been initialized.
Instead, I would rewrite the routine as follows:
function TVector3D.Normalise: TVector3D;
begin
if not IsUnitVector then
begin
x := x / GetMagnitude;
y := y / GetMagnitude;
z := z / GetMagnitude;
end;
Result := Self;
end;
The root of all your problems is that you are using a class, which is a reference type. Instead you need to make your vector be a value type. That means use a record.
In your code, even when you fix the problem identified by #NGLN, you have still destroyed all instances of your class by the time you start calling WriteLn.
Unless you grasp this issue soon, I fear that you will continue having problems. Switching to using a value type will make your coding trivially easy in comparison to your current approach.
Here's something to get you started:
type
TVector3 = record
public
class operator Negative(const V: TVector3): TVector3;
class operator Equal(const V1, V2: TVector3): Boolean;
class operator NotEqual(const V1, V2: TVector3): Boolean;
class operator Add(const V1, V2: TVector3): TVector3;
class operator Subtract(const V1, V2: TVector3): TVector3;
class operator Multiply(const V: TVector3; const D: Double): TVector3;
class operator Multiply(const D: Double; const V: TVector3): TVector3;
class operator Divide(const V: TVector3; const D: Double): TVector3;
class function New(const X, Y, Z: Double): TVector3; static;
function IsZero: Boolean;
function IsNonZero: Boolean;
function IsUnit: Boolean;
function Mag: Double;
function SqrMag: Double;
function Normalised: TVector3;
function ToString: string;
public
X, Y, Z: Double;
end;
const
ZeroVector3: TVector3=();
class operator TVector3.Negative(const V: TVector3): TVector3;
begin
Result.X := -V.X;
Result.Y := -V.Y;
Result.Z := -V.Z;
end;
class operator TVector3.Equal(const V1, V2: TVector3): Boolean;
begin
Result := (V1.X=V2.X) and (V1.Y=V2.Y) and (V1.Z=V2.Z);
end;
class operator TVector3.NotEqual(const V1, V2: TVector3): Boolean;
begin
Result := not (V1=V2);
end;
class operator TVector3.Add(const V1, V2: TVector3): TVector3;
begin
Result.X := V1.X + V2.X;
Result.Y := V1.Y + V2.Y;
Result.Z := V1.Z + V2.Z;
end;
class operator TVector3.Subtract(const V1, V2: TVector3): TVector3;
begin
Result.X := V1.X - V2.X;
Result.Y := V1.Y - V2.Y;
Result.Z := V1.Z - V2.Z;
end;
class operator TVector3.Multiply(const V: TVector3; const D: Double): TVector3;
begin
Result.X := D*V.X;
Result.Y := D*V.Y;
Result.Z := D*V.Z;
end;
class operator TVector3.Multiply(const D: Double; const V: TVector3): TVector3;
begin
Result.X := D*V.X;
Result.Y := D*V.Y;
Result.Z := D*V.Z;
end;
class operator TVector3.Divide(const V: TVector3; const D: Double): TVector3;
begin
Result := (1.0/D)*V;
end;
class function TVector3.New(const X, Y, Z: Double): TVector3;
begin
Result.X := X;
Result.Y := Y;
Result.Z := Z;
end;
function TVector3.IsZero: Boolean;
begin
Result := Self=ZeroVector3;
end;
function TVector3.IsNonZero: Boolean;
begin
Result := Self<>ZeroVector3;
end;
function TVector3.IsUnit: Boolean;
begin
Result := abs(1.0-Mag)<1.0e-5;
end;
function TVector3.Mag: Double;
begin
Result := Sqrt(X*X + Y*Y + Z*Z);
end;
function TVector3.SqrMag: Double;
begin
Result := X*X + Y*Y + Z*Z;
end;
function TVector3.Normalised;
begin
Result := Self/Mag;
end;
function TVector3.ToString: string;
begin
Result := Format('(%g, %g, %g)', [X, Y, Z]);
end;
This is extracted from my own codebase. I'm using Double, but if you really prefer to use Single, then you can readily change it.
The use of operator overloading makes the code you write so much more readable. Now you can write V3 := V1 + V2 and so on.
Here's what your test code looks like with this record:
var
nonUnitVector: TVector3;
unitVector: TVector3;
nUVNormed: TVector3;
uVNormed: TVector3;
begin
//Setup Vectors for Test
nonUnitVector := TVector3.New(1, 1, 1);
unitVector := TVector3.New(1, 0, 0);
//Normalise Vectors
nUVNormed := nonUnitVector.Normalised;
uVNormed := unitVector.Normalised;
//Print Output
WriteLn('nUVNormed = ' + nUVNormed.ToString);
WriteLn('uVNormed = ' + uVNormed.ToString);
Readln;
end.
Or if you want to compress it somewhat:
WriteLn('nUVNormed = ' + TVector3.New(1, 1, 1).Normalised.ToString);
WriteLn('uVNormed = ' + TVector3.New(1, 0, 0).Normalised.ToString);
A few hints:
First, I'd actually make the vector a record instead of a class if I were you, but YMMV. That would simplify a lot, since the compiler will manage the lifetime of every vector (you never need to worry about freeing things). Second,
function TVector3D.IsUnitVector;
begin
if self.GetMagnitude = 1 then
result := True
else
result := False;
end;
is normally written, syntactically and exactly equivalently,
function TVector3D.IsUnitVector;
begin
result := GetMagnitude = 1
end;
But even so, it is incorrect. Since you are dealing with floating-point numbers, you cannot reliably test equality. Instead, you should see if the magnitude is within some interval of unity, so that 'fuzz' do not interfere. For instance, you could do (uses Math)
function TVector3D.IsUnitVector;
begin
result := IsZero(GetMagnitude - 1)
end;
Third, your Normalize function returns a new vector object if it needs to normalize, and returns the same object if not. That's very confusing. You'd never know how many instances you have! Instead, make this a procedure:
procedure TVector3D.Normalize;
var
norm: single;
begin
norm := GetMagnitude;
x := x / norm;
y := y / norm;
z := z / norm;
end;
Fourth, why use single instead of double or real?
Fifth, as NGLN pointed out (please upvote his answer!), you forgot the begin...end block in the else part of your Normalize function, so the four last lines are always executed! Hence, you always create a new vector instance! Still, my point is very important: your original function 'intends' (if you just add the begin...end block) to return self or create a new instance depending on a condition, which is rather terrible, since then you do not know how many instances you have! (And so, you'll probably begin to leak vectors...)