Shared code snippets!

[JernejL]

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]

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&#40;a&#41; < 3 then
    result &#58;= 0
  else
    if length&#40;a&#41; = 3 then
      result &#58;= area&#40;a&#91;0&#93;, a&#91;1&#93;, a&#91;2&#93;&#41;
    else
    begin
      result &#58;= 0;
      m &#58;= center&#40;a&#41;;
      
      for i &#58;= 0 to high&#40;a&#41;-1 do
        result &#58;= result + area&#40;a&#91;i&#93;, a&#91;i+1&#93;, m&#41;;
        
      result &#58;= result + area&#40;a&#91;high&#40;a&#41;&#93;, a&#91;0&#93;, m&#41;;
    end;
end;

end.

[NecroDOME]

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]

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 &#58;= 0
  else
    Result &#58;= n;
end;

function fraction&#40;maxnew, maxold, val&#58; single&#41;&#58; single;
begin
  if maxnew = 0 then
    Result &#58;= 0
  else
    Result &#58;= &#40;val * maxold&#41; / maxnew;
end;

function ColorLERP&#40;src, dest&#58; TColor; min, max, val&#58; single&#41;&#58; TColor; // Linear interpolation between two colors
var
  interp&#58; integer;
begin

  interp &#58;= trunc&#40;fraction&#40;max, 255, val&#41;&#41;;

  Result&#91;0&#93; &#58;= ClampB&#40;ClampB&#40;src&#91;0&#93; - interp&#41; + ClampB&#40;dest&#91;0&#93; - 255 + interp&#41;&#41;;
  Result&#91;1&#93; &#58;= ClampB&#40;ClampB&#40;src&#91;1&#93; - interp&#41; + ClampB&#40;dest&#91;1&#93; - 255 + interp&#41;&#41;;
  Result&#91;2&#93; &#58;= ClampB&#40;ClampB&#40;src&#91;2&#93; - interp&#41; + ClampB&#40;dest&#91;2&#93; - 255 + interp&#41;&#41;;
  Result&#91;3&#93; &#58;= ClampB&#40;ClampB&#40;src&#91;3&#93; - interp&#41; + ClampB&#40;dest&#91;3&#93; - 255 + interp&#41;&#41;;
end;

[Mirage]

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]

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.

[pascal]
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;
[/pascal]

[chronozphere]

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)

[pascal]
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;
[/pascal]

Great thread! Would love to see some more snippets.

[Traveler]

[pascal]
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;
[/pascal]

Hmm,.. doesn't this always perform the last statement, regardless of what x and y are?

[JSoftware]

Yeah, in general the scoping of that snippet could result in different pieces of code on different compilers

Looks like it's been converted directly from C code

[User137]

[pascal]// 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;[/pascal]

[pascal]// 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;[/pascal]