View Full Version : Shared code snippets!
JernejL
30-06-2008, 04:56 PM
Okay, the rule of this is simple, you can post a reply, but you need to reply with a piece of useful code that you wrote and that everyone can use.
For example, this function rotates a vector around the Z axis, and works on any vector type (be it glscene Tvector or tvector3f or some other vector type..) as long as it consists of 3 sequential 32 bit floats it will work.
procedure RotateVertexXY(var vector; const angle: single);
var
COORDS: array[0..1] of single absolute vector;
TEMP: array[0..1] of single;
AFUNC: array[0..1] of single;
anglerad: single;
begin
TEMP[0] := COORDS[0];
TEMP[1] := COORDS[1];
anglerad := degtorad(angle);
AFUNC[0] := Cos(anglerad);
AFUNC[1] := Sin(anglerad);
COORDS[0] := TEMP[0] * AFUNC[0] - TEMP[1] * AFUNC[1];
COORDS[1] := TEMP[0] * AFUNC[1] + TEMP[1] * AFUNC[0];
end;
waran
30-06-2008, 05:21 PM
function area(const a: array of TV2): single
provides you the area of any convex point-field. Its determined
by splitting the field into a triangle fan and summing the discrete
triangle-areas.
Did it mainly to escape boredom; got the idea when I saw a document
by some bank calculating the value of a parcel with a computer (in a
hand-drawn polygon).
unit uGeo;
interface
type
TV2 = record
x, y: single;
end;
// cut out the function declarations here to reduce post size
implementation
function v2(const x, y: single): TV2;
begin
result.x := x;
result.y := y;
end;
function dist(const p1, p2: TV2): single;
begin
result := sqrt(sqr(p2.x-p1.x)+sqr(p2.y-p1.y));
end;
function area(const p1, p2, p3: TV2): single;
var
a, b, c, s: single;
begin
a := dist(p1, p2);
b := dist(p2, p3);
c := dist(p3, p1);
s := (a + b + c) / 2;
result := sqrt(s * (s-a) * (s-b) * (s-c));
end;
function center(const a: array of TV2): TV2;
var
i: dword;
begin
if length(a) = 0 then result := v2(0,0)
else
begin
result.x := a[0].x;
result.y := a[0].y;
for i := 1 to high(a) do
begin
result.x := result.x + a[i].x;
result.y := result.y + a[i].y;
end;
result.x := result.x / length(a);
result.y := result.y / length(a);
end;
end;
function area(const a: array of TV2): single;
var
m: TV2;
i: dword;
begin
if length(a) < 3 then
result := 0
else
if length(a) = 3 then
result := area(a[0], a[1], a[2])
else
begin
result := 0;
m := center(a);
for i := 0 to high(a)-1 do
result := result + area(a[i], a[i+1], m);
result := result + area(a[high(a)], a[0], m);
end;
end;
end.
NecroDOME
30-06-2008, 05:58 PM
function IntersectRaySphere(const Ray: TNecro3D_Ray; const Sphere: TNecro3D_Sphere): boolean;
Check if a ray intersects from a certain point with a direction with a sphere.
Input param 1 - Ray: Position (Origin), Direction
Input param 2 - Sphere: Radius, Position
Output: Returns true if intersected with sphere otherwise it returns false.
TNecro3D_Ray = record
Position : T3DVector;
Direction : T3DVector;
end;
TNecro3D_Sphere = record
Radius: single;
Position : T3DVector;
end;
function IntersectRaySphere(const Ray: TNecro3D_Ray; const Sphere: TNecro3D_Sphere): boolean;
var Q : T3DVector;
RayDir : T3DVector;
b, c, d : single;
begin
RayDir := Ray.Direction;
Vector3DNormalize(RayDir);
Q := Vector3DSub(Sphere.Position, Ray.Position);
B := Vector3DDot(Q, RayDir);
C := Vector3DDot(Q, Q) - (Sphere.Radius*Sphere.Radius);
D := B*B - C;
Result := (D > 0);
end;
JernejL
30-06-2008, 09:38 PM
This code performs linear interpolation between two colors, could be probably optimized to smaller function (any volunteers? ):
type
TColor = array[0..3] of byte;
function ClampB(n: integer): byte;
begin
if n > 255 then
Result := 255
else
if n < 0 then
Result := 0
else
Result := n;
end;
function fraction(maxnew, maxold, val: single): single;
begin
if maxnew = 0 then
Result := 0
else
Result := (val * maxold) / maxnew;
end;
function ColorLERP(src, dest: TColor; min, max, val: single): TColor; // Linear interpolation between two colors
var
interp: integer;
begin
interp := trunc(fraction(max, 255, val));
Result[0] := ClampB(ClampB(src[0] - interp) + ClampB(dest[0] - 255 + interp));
Result[1] := ClampB(ClampB(src[1] - interp) + ClampB(dest[1] - 255 + interp));
Result[2] := ClampB(ClampB(src[2] - interp) + ClampB(dest[2] - 255 + interp));
Result[3] := ClampB(ClampB(src[3] - interp) + ClampB(dest[3] - 255 + interp));
end;
Mirage
01-07-2008, 04:57 AM
Returns inversion of a matrix which contains only rotations and translations
type
TMatrix4s = packed record
_11, _12, _13, _14: Single;
_21, _22, _23, _24: Single;
_31, _32, _33, _34: Single;
_41, _42, _43, _44: Single;
end;
function InvertRotTransMatrix(const M: TMatrix4s): TMatrix4s;
begin
// Inverse rotation
Result._11 := M._11;
Result._12 := M._21;
Result._13 := M._31;
Result._21 := M._12;
Result._22 := M._22;
Result._23 := M._32;
Result._31 := M._13;
Result._32 := M._23;
Result._33 := M._33;
// Inverse translation
Result._41 := -M._41 * M._11 - M._42 * M._12 - M._43 * M._13;
Result._42 := -M._41 * M._21 - M._42 * M._22 - M._43 * M._23;
Result._43 := -M._41 * M._31 - M._42 * M._32 - M._43 * M._33;
// Fill other values
Result._14 := M._14;
Result._24 := M._24;
Result._34 := M._34;
Result._44 := M._44;
end;
paul_nicholls
01-07-2008, 06:24 AM
The code below will convert any 'number' starting in base [2..36] to base [2..36]
Example:
BaseToBaseConversion('49152',10,16,8) would return '0000FFFF'
common bases (if you are rusty):
base 2 = binary
base 8= octal
base 10 = decimal
base 16 = hexadecimal
or some not yet used base of your own (between 2 and 36) to encode values or similar.
Function BaseToBaseConversion(Const AInNumber : String;
Const AInBase,AOutBase : Byte;
Const AMinOutBaseDigits : Byte) : String;
// Inputs:
// AInNumber = input number to convert from (base 2 - 36)
// AInBase = input base number (2 - 36)
// AOutBase = input base number (2 - 36)
// AMinOutBaseDigits = minimum number of 'digits' to use in the output
string
//
// Outputs:
// Result = the AInNumber converted to the AOutBase base (if possible)
Const
cDigits = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
Var
Decimal : LongInt;
Remainder : LongInt;
Power : Integer;
DigitValue : Integer;
Index : Integer;
Begin
Result := '';
If Not(AInBase In[2..36]) Then Exit;
If Not(AOutBase In[2..36]) Then Exit;
If AInNumber = '' Then Exit;
Decimal := 0;
Power := 1;
For Index := Length(AInNumber) Downto 1 Do
Begin
DigitValue := Pos(AInNumber[Index],cDigits) - 1;
If DigitValue < 0 Then Exit; // illegal input digit found so bomb out
Decimal := Decimal + Power * DigitValue;
Power := Power * AInBase;
End;
If Decimal = 0 Then
Result := cDigits[1]
Else
While Decimal <> 0 Do
Begin
Remainder := Decimal Mod AOutBase;
Decimal := Decimal Div AOutBase;
Result := cDigits[Remainder + 1] + Result;
End;
For Index := 1 To (AMinOutBaseDigits - Length(Result)) Do
Result := cDigits[1] + Result;
End;
chronozphere
28-07-2008, 08:42 AM
This snippet will return the angle of a vector, relative to the origin.
[0,-1] = 0 degrees (pointing up)
[1,0] = 90 degrees (pointing right)
[0,1] = 180 degrees (pointing down)
[-1,0] = 270 degrees (pointing left)
function Angle(X,Y: single): single;
begin
Result := 0;
if X = 0 then
if Y > 0 then Result := 180
else Result := 0;
Result := 180+RadToDeg(Arctan2(-X,Y));
end;
Great thread! :) Would love to see some more snippets.
Traveler
28-07-2008, 10:21 AM
function Angle(X,Y: single): single;
begin
Result := 0;
if X = 0 then
if Y > 0 then Result := 180
else Result := 0;
Result := 180+RadToDeg(Arctan2(-X,Y));
end;
Hmm,.. doesn't this always perform the last statement, regardless of what x and y are?
JSoftware
28-07-2008, 10:44 AM
Yeah, in general the scoping of that snippet could result in different pieces of code on different compilers :P
Looks like it's been converted directly from C code :)
User137
28-07-2008, 10:59 AM
// Angle between 2 vectors, given as angles
function Angle3(src,dest: double): double;
begin
result:=src-dest;
while result<-180 do result:=result+360;
while result>180 do result:=result-360;
end;
// Give parameter for example 300 and result is 512, which is
// a fitting power of 2 (useful with dynamic arrays, textures or other data)
function Pow2fit(n: integer): integer;
var neg: boolean;
begin
if n<0 then begin
n:=-n; neg:=true;
end else neg:=false;
if n<3 then result:=n
else result:=round(intpower(2,ceil(log2(n))));
if neg then result:=-result;
end;
chronozphere
28-07-2008, 12:41 PM
Yeah, in general the scoping of that snippet could result in different pieces of code on different compilers Razz
Looks like it's been converted directly from C code Smile
Can you elaborate a little more on this? Is it because i allready assigned a result before the last statement is executed?
This would probably be better:
function Angle(X,Y: single): single;
begin
if X = 0 then
begin
if Y > 0 then Result := 180
else Result := 0;
end else
Result := 180+RadToDeg(Arctan2(-X,Y));
end;
User137
28-07-2008, 03:05 PM
This is perfectly functional at least in Delphi7. Arctan2() is defined to handle the divide by zero case in itself. If you do it yourself it's double code (slower ofc).
// Result = ]-180, 180]
const
ToRad = 0.0174532925199432; // PI / 180 = Deg to Rad
ToDeg = 57.295779513082320; // 180 / PI = Rad to Deg
function Angle(px1,py1,px2,py2: double): double;
begin
result:=ToDeg*arctan2(py2-py1,px2-px1);
// Add if result<0 then result:=result+360;
// if you want range to be [0..360[
end;
I also noticed that you negate X, which is false.
JernejL
28-07-2008, 05:02 PM
Sometimes you need the angles to be represented only between 0..360, you probably seen functions like this one:
function OLDclamp360(angle: single): single;
begin
Result := angle;
while Result <0> 360 do
Result := Result - 360;
end;
Not only it's a bad code with a lot of branching that gets slower the bigger / smaller the numbers are, but there is a better / proper way:
function clamp360(angle: single): single;
begin
Result := angle;
if result > 360 then result:= result - (round(result) div 360 * 360);
if result < 0 then result:= 360 + result - (round(result) div 360 * 360);
end;
JSoftware
28-07-2008, 05:15 PM
Yeah, in general the scoping of that snippet could result in different pieces of code on different compilers Razz
Looks like it's been converted directly from C code Smile
Can you elaborate a little more on this? Is it because i allready assigned a result before the last statement is executed?
[ code ]
Yes, that code is perfect. Indeed, your last assignment would override any previous assignment effectively making the first 3 lines do nothing.
The scoping would be a problem because the following piece of code would be syntactically identical as your initial piece of code
function Angle(X,Y: single): single;
begin
Result := 0;
if X = 0 then
begin
if Y > 0 then
Result := 180
end
else
Result := 0;
Result := 180+RadToDeg(Arctan2(-X,Y));
end;
Brainer
28-07-2008, 07:15 PM
My snippet is helpful when formatting data sizes. :)
{ .: FormatSize :. }
function FormatSize(const Size: Integer): String;
const
KB = 1024;
MB = KB * KB;
GB = MB * KB;
begin
case Size of
0..KB -1: Result := IntToStr(Size) + ' B';
KB..MB -1: Result := Format('%.2f KB', [Size / KB]);
MB..GB -1: Result := Format('%.2f MB', [Size / MB]);
else
Result := Format('%.2f GB', [Size / GB]);
end;
end;
chronozphere
10-08-2008, 10:27 AM
Okay... let's keep this topic alive shall we. :D
I just baked this piece of code...
Use this routine to read a Null-Terminated String from a MemoryStream. The function reads MaxLength - 1 Characters from the stream and adds the null-Char at the end. If the function encounters a NullChar while reading, Buffer will only contain the characters precending the NullChar and the NullChar itsself. The routine returns the ammount of bytes read.
var
Stream: TMemoryStream; //Global stream
function ReadStr(Buffer: PChar; MaxLength: Integer): Integer;
type
TCharArray = array [0..MaxInt-1] of Char;
PCharArray = ^TCharArray;
var
I: Integer;
Chars: PCharArray;
begin
Result := 0;
if (Stream.Size - Stream.Position <= 0) then Exit;
Chars := Stream.Memory;
I := -1;
repeat
Inc(I);
if Chars[Stream.Position+I] = #0 then Break;
until (I = MaxLength -1);
Result := Stream.Read( Buffer^, I ) + 1;
Buffer[Result-1] := #0;
end;
I have tested this code, and it's working correctly AFAIK. :)
Might become handy when you are trying to make a C compatible API wich relies on Null-Terminated strings. ;)
chronozphere
10-08-2008, 11:00 AM
Okay... Here is a similair routine, but now to write a string.
Writes MaxLength characters of a Null-Terminated String to a MemoryStream. The routine doesn't write the NullChar. If a NullChar is found in the string, Only the precending Chars are written. Returns the number of bytes written.
function WriteStr(Buffer: PChar; MaxLength: Integer): Integer;
type
TCharArray = array [0..MaxInt-1] of Char;
PCharArray = ^TCharArray;
var
I: Integer;
Chars: PCharArray;
begin
Chars := Pointer(Buffer);
for I:=0 to MaxLength-1 do
if Chars[I] = #0 then Break;
Result := Stream.Write( Buffer^, I );
end;
Brainer
10-08-2008, 07:49 PM
This piece of code converts seconds into "hours:minutes:seconds" format.
{ .: FormatTime :. }
function FormatTime(const TheTime: Integer): String;
var
Hours, Mins, Secs: Integer;
begin
if (TheTime > 0) then
begin
Mins := (TheTime div 60);
Secs := (TheTime mod 60);
Hours := (Mins div 60);
Mins := (Mins mod 60);
Result := Format('%.2d:%.2d:%.2d', [Hours, Mins, Secs]);
end else
Result := '00:00:00';
end;
chronozphere
21-07-2010, 01:01 PM
Hi guys, No more new snippets these days? :P
I've got a new one. This routine concatenates two paths. The first is the basePath and the second is a path relative to this basepath. It handles "../" to jump to the parent directory.
My string programming skills are not that great, so I guess there's room for improvement. ;)
function ConcatenatePaths(aBasePath, aRelativePath: String): String;
const
SEPARATORS = ['\','/'];
SEPARATOR = '/';
var
Name: String;
I: Integer;
begin
//Trim redundant slashes
if aRelativePath[1] in SEPARATORS then
aRelativePath := RightStr(aRelativePath, Length(aRelativePath)-1 );
if aBasePath[Length(aBasePath)] in SEPARATORS then
aBasePath := LeftStr(aBasePath, Length(aBasePath)-1 );
while Length(aRelativePath) > 0 do
begin
Name := Copy(aRelativePath, 1, 3);
if (Name = '../') or (Name = '..\') then
begin
for I := Length(aBasePath) downto 1 do
if aBasePath[I] in SEPARATORS then
begin
aBasePath := Copy(aBasePath, 1, I-1);
Break;
end;
aRelativePath := Copy(aRelativePath, 4, Length(aRelativePath)-3);
end
else
Break;
end;
Result := aBasePath + SEPARATOR + aRelativePath;
end;
For example:
E:\some\groovy\file\path\to\somewhere + '..\..\..\myfile.txt'
results in:
E:\some\groovy\file\myfile.txt'
Now it's your turn again. :)
User137
21-07-2010, 04:08 PM
There's few in nxMath i could show up:
n is any floating point number. It gives a result that is always between 0 and 1, but most interesting thing happens when n is 0..1; it smoothens the pattern to match "top to low peak" of cosine wave.
function Smoothen(n: single): single;
begin
if n<0 then n:=0
else if n>1 then n:=1;
Smoothen:=0.5-cos(n*pi)*0.5;
end;
Simply modulus, but this handles also negative numbers so that it remains continuous pattern at 0 point. 11 mod2 10 = 1 , -11 mod2 10 = -9
function Mod2(a,b: integer): integer;
begin
if b=0 then result:=0
else begin
b:=abs(b);
result:=abs(a) mod b;
if (a<0) and (result>0) then result:=result-b;
end;
end;
And 1 more...
If you need to get power of 2 number that your current fits in, this is the function.
Giving n = 140 or 220 would result in 256.
function Pow2fit(n: integer): integer;
var neg: boolean;
begin
if n<0 then begin
n:=-n; neg:=true;
end else neg:=false;
if n<3 then result:=n
else result:=round(intpower(2,ceil(log2(n))));
if neg then result:=-result;
end;
There's still Pow2near() which would give the nearest fit which would result in 128 in case of 140. These are all part of Next3D.
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.