OpenGLCore/ugluMatrixExHelper.pas

unit ugluMatrixExHelper;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  ugluVectorExHelper;

type
  generic TgluMatrixHelper<T> = class
  public type
    TVectorHelper = specialize TgluVectorHelper<T>;
    TVectorHelperF = specialize TgluVectorHelperF<T>;
    TBaseType = T;
    PBaseType = ^T;

    TMat2 = array[0..1] of TVectorHelper.TVector2;
    TMat3 = array[0..2] of TVectorHelper.TVector3;
    TMat4 = array[0..3] of TVectorHelper.TVector4;

    PMat2 = ^TMat2;
    PMat3 = ^TMat3;
    PMat4 = ^TMat4;

  public
    class function Equals(const m1, m2: TMat2): Boolean; overload; inline;
    class function Equals(const m1, m2: TMat3): Boolean; overload; inline;
    class function Equals(const m1, m2: TMat4): Boolean; overload; inline;

    class function ToString(const m: TMat2; const aRound: Integer = -3): String; overload; inline;
    class function ToString(const m: TMat3; const aRound: Integer = -3): String; overload; inline;
    class function ToString(const m: TMat4; const aRound: Integer = -3): String; overload; inline;

    class function TryFromString(const s: String; out m: TMat2): Boolean; overload; inline;
    class function TryFromString(const s: String; out m: TMat3): Boolean; overload; inline;
    class function TryFromString(const s: String; out m: TMat4): Boolean; overload; inline;

    class function Transpose(const m: TMat2): TMat2; overload; inline;
    class function Transpose(const m: TMat3): TMat3; overload; inline;
    class function Transpose(const m: TMat4): TMat4; overload; inline;

    class function Sub(const m: TMat2; const c, r: Integer): TBaseType; overload; inline;
    class function Sub(const m: TMat3; const c, r: Integer): TMat2; overload; inline;
    class function Sub(const m: TMat4; const c, r: Integer): TMat3; overload; inline;

    class function Determinant(const m: TMat2): Double; overload; inline;
    class function Determinant(const m: TMat3): Double; overload; inline;
    class function Determinant(const m: TMat4): Double; overload;

    class function Adjoint(const m: TMat3): TMat3; overload;
    class function Adjoint(const m: TMat4): TMat4; overload;

    class function Multiply(const m1, m2: TMat2): TMat2; overload; inline;
    class function Multiply(const m1, m2: TMat3): TMat3; overload; inline;
    class function Multiply(const m1, m2: TMat4): TMat4; overload; inline;

    class function Multiply(const m: TMat2; const v: TVectorHelper.TVector2): TVectorHelper.TVector2; overload; inline;
    class function Multiply(const m: TMat3; const v: TVectorHelper.TVector3): TVectorHelper.TVector3; overload; inline;
    class function Multiply(const m: TMat4; const v: TVectorHelper.TVector4): TVectorHelper.TVector4; overload; inline;

    class function Multiply(const m: TMat2; const v: TBaseType): TMat2; overload; inline;
    class function Multiply(const m: TMat3; const v: TBaseType): TMat3; overload; inline;
    class function Multiply(const m: TMat4; const v: TBaseType): TMat4; overload; inline;

    class function Invert(m: TMat2): TMat2; overload; inline;
    class function Invert(m: TMat3): TMat3; overload; inline;
    class function Invert(m: TMat4): TMat4; overload; inline;

    class function Create(const x, y, z: TVectorHelper.TVector3): TMat3;
    class function Create(const x, y, z, w: TVectorHelper.TVector4): TMat4;

    class function CreateTranslate(const v: TVectorHelper.TVector2): TMat3;
    class function CreateTranslate(const v: TVectorHelper.TVector3): TMat4;

    class function CreateScale(const v: TVectorHelper.TVector2): TMat3;
    class function CreateScale(const v: TVectorHelper.TVector3): TMat4;

    class function CreateRotate(a: Double): TMat3;
    class function CreateRotate(axis: TVectorHelper.TVector3; a: Double): TMat4;

    class function CreateShear(const v: TVectorHelper.TVector2): TMat3;
    class function CreateShear(const x, y, z: TVectorHelper.TVector2): TMat4;
  private
    class function GetElement(p: PBaseType; x, y, sz: Integer): TBaseType; inline;
    class procedure SetElement(p: PBaseType; x, y, sz: Integer; v: TBaseType); inline;

    class procedure Transpose(src, dst: PBaseType; sz: Integer);
    class procedure Sub(src, dst: PBaseType; sz, c, r: Integer);
    class procedure Mult(p1, p2, r: PBaseType; c1r2, r1, c2: Integer);
    class procedure Mult(src, dst: PBaseType; c, r: Integer; v: TBaseType);

    class function TryFromString(const s: String; p: PBaseType; r, c: Integer): Boolean;
  end;

  TgluMatrixF = specialize TgluMatrixHelper<Single>;
  TgluMatrixD = specialize TgluMatrixHelper<Double>;

implementation

uses
  Math;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TgluMatrixHelper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TgluMatrixHelper.Equals(const m1, m2: TMat2): Boolean;
begin
  result :=
    TVectorHelper.Equals(m1[0], m2[0]) and
    TVectorHelper.Equals(m1[1], m2[1]);
end;

class function TgluMatrixHelper.Equals(const m1, m2: TMat3): Boolean;
begin
  result :=
    TVectorHelper.Equals(m1[0], m2[0]) and
    TVectorHelper.Equals(m1[1], m2[1]) and
    TVectorHelper.Equals(m1[2], m2[2]);
end;

class function TgluMatrixHelper.Equals(const m1, m2: TMat4): Boolean;
begin
  result :=
    TVectorHelper.Equals(m1[0], m2[0]) and
    TVectorHelper.Equals(m1[1], m2[1]) and
    TVectorHelper.Equals(m1[2], m2[2]) and
    TVectorHelper.Equals(m1[3], m2[3]);
end;

class function TgluMatrixHelper.ToString(const m: TMat2; const aRound: Integer): String;
begin
  result := format('(%s); (%s)', [
    TVectorHelper.ToString(m[0], aRound),
    TVectorHelper.ToString(m[1], aRound)]);
end;

class function TgluMatrixHelper.ToString(const m: TMat3; const aRound: Integer): String;
begin
  result := format('(%s); (%s); (%s)', [
    TVectorHelper.ToString(m[0], aRound),
    TVectorHelper.ToString(m[1], aRound),
    TVectorHelper.ToString(m[2], aRound)]);
end;

class function TgluMatrixHelper.ToString(const m: TMat4; const aRound: Integer): String;
begin
  result := format('(%s); (%s); (%s); (%s)', [
    TVectorHelper.ToString(m[0], aRound),
    TVectorHelper.ToString(m[1], aRound),
    TVectorHelper.ToString(m[2], aRound),
    TVectorHelper.ToString(m[3], aRound)]);
end;

class function TgluMatrixHelper.TryFromString(const s: String; out m: TMat2): Boolean;
begin
  result := TryFromString(s, @m[0,0], 2, 2);
end;

class function TgluMatrixHelper.TryFromString(const s: String; out m: TMat3): Boolean;
begin
  result := TryFromString(s, @m[0,0], 3, 3);
end;

class function TgluMatrixHelper.TryFromString(const s: String; out m: TMat4): Boolean;
begin
  result := TryFromString(s, @m[0,0], 4, 4);
end;

class function TgluMatrixHelper.Transpose(const m: TMat2): TMat2;
begin
  Transpose(@m[0,0], @result[0,0], Length(m));
end;

class function TgluMatrixHelper.Transpose(const m: TMat3): TMat3;
begin
  Transpose(@m[0,0], @result[0,0], Length(m));
end;

class function TgluMatrixHelper.Transpose(const m: TMat4): TMat4;
begin
  Transpose(@m[0,0], @result[0,0], Length(m));
end;

class function TgluMatrixHelper.Sub(const m: TMat2; const c, r: Integer): TBaseType;
begin
  Sub(@m[0,0], @result, 2, c, r);
end;

class function TgluMatrixHelper.Sub(const m: TMat3; const c, r: Integer): TMat2;
begin
  Sub(@m[0,0], @result[0,0], 3, c, r);
end;

class function TgluMatrixHelper.Sub(const m: TMat4; const c, r: Integer): TMat3;
begin
  Sub(@m[0,0], @result[0,0], 4, c, r);
end;

class function TgluMatrixHelper.Determinant(const m: TMat2): Double;
begin
  result := m[0,0] * m[1,1] - m[1,0] * m[0,1];
end;

class function TgluMatrixHelper.Determinant(const m: TMat3): Double;
begin
  result :=
    m[0,0] * m[1,1] * m[2,2] +
    m[1,0] * m[2,1] * m[0,2] +
    m[2,0] * m[0,1] * m[1,2] -
    m[2,0] * m[1,1] * m[0,2] -
    m[1,0] * m[0,1] * m[2,2] -
    m[0,0] * m[2,1] * m[1,2];
end;

class function TgluMatrixHelper.Determinant(const m: TMat4): Double;
var
  i: Integer;
begin
  result := 0.0;
  for i := 0 to 3 do
    result := result + power(-1, i) * m[i,0] * Determinant(Sub(m, i, 0));
end;

class function TgluMatrixHelper.Adjoint(const m: TMat3): TMat3;
var
  i, j: Integer;
begin
  for i := 0 to 2 do
    for j := 0 to 2 do
      result[i,j] := power(-1, i+j) * Determinant(Sub(m, i, j));
  result := Transpose(result{%H-});
end;

class function TgluMatrixHelper.Adjoint(const m: TMat4): TMat4;
var
  i, j: Integer;
begin
  for i := 0 to 3 do
    for j := 0 to 3 do
      result[i,j] := power(-1, i+j) * Determinant(Sub(m, i, j));
  result := Transpose(result{%H-});
end;

class function TgluMatrixHelper.Multiply(const m1, m2: TMat2): TMat2;
begin
  Mult(@m1[0,0], @m2[0,0], @result[0,0], 2, 2, 2);
end;

class function TgluMatrixHelper.Multiply(const m1, m2: TMat3): TMat3;
begin
  Mult(@m1[0,0], @m2[0,0], @result[0,0], 3, 3, 3);
end;

class function TgluMatrixHelper.Multiply(const m1, m2: TMat4): TMat4;
begin
  Mult(@m1[0,0], @m2[0,0], @result[0,0], 4, 4, 4);
end;

class function TgluMatrixHelper.Multiply(const m: TMat2; const v: TVectorHelper.TVector2): TVectorHelper.TVector2;
begin
  Mult(@m[0,0], @v[0], @result[0], 2, 2, 1);
end;

class function TgluMatrixHelper.Multiply(const m: TMat3; const v: TVectorHelper.TVector3): TVectorHelper.TVector3;
begin
  Mult(@m[0,0], @v[0], @result[0], 3, 3, 1);
end;

class function TgluMatrixHelper.Multiply(const m: TMat4; const v: TVectorHelper.TVector4): TVectorHelper.TVector4;
begin
  Mult(@m[0,0], @v[0], @result[0], 4, 4, 1);
end;

class function TgluMatrixHelper.Multiply(const m: TMat2; const v: TBaseType): TMat2;
begin
  Mult(@m[0,0], @result[0,0], 2, 2, v);
end;

class function TgluMatrixHelper.Multiply(const m: TMat3; const v: TBaseType): TMat3;
begin
  Mult(@m[0,0], @result[0,0], 3, 3, v);
end;

class function TgluMatrixHelper.Multiply(const m: TMat4; const v: TBaseType): TMat4;
begin
  Mult(@m[0,0], @result[0,0], 4, 4, v);
end;

class function TgluMatrixHelper.Invert(m: TMat2): TMat2;
begin
  result[0,0] :=  m[1,1];
  result[0,1] := -m[0,1];
  result[1,0] := -m[1,0];
  result[1,1] :=  m[0,0];
  m := result;
  Mult(@m[0,0], @result[0,0], 2, 2, 1 / Determinant(m));
end;

class function TgluMatrixHelper.Invert(m: TMat3): TMat3;
var d: TBaseType;
begin
  d := Determinant(m);
  m := Adjoint(m);
  Mult(@m[0,0], @result[0,0], 3, 3, 1 / d);
end;

class function TgluMatrixHelper.Invert(m: TMat4): TMat4;
var d: TBaseType;
begin
  d := Determinant(m);
  result := Adjoint(m);
  Mult(@m[0,0], @result[0,0], 4, 4, 1 / d);
end;

class function TgluMatrixHelper.Create(const x, y, z: TVectorHelper.TVector3): TMat3;
begin
  Result[0]:= x;
  Result[1]:= y;
  Result[2]:= z;
end;

class function TgluMatrixHelper.Create(const x, y, z, w: TVectorHelper.TVector4): TMat4;
begin
  Result[0]:= x;
  Result[1]:= y;
  Result[2]:= z;
  Result[3]:= w;
end;

class function TgluMatrixHelper.CreateTranslate(const v: TVectorHelper.TVector2): TMat3;
begin
  result[0, 0] := 1.0;
  result[0, 1] := 0.0;
  result[0, 2] := 0.0;
  result[1, 0] := 0.0;
  result[1, 1] := 1.0;
  result[1, 2] := 0.0;
  result[2, 0] := v[0];
  result[2, 1] := v[1];
  result[2, 2] := 1.0;
end;

class function TgluMatrixHelper.CreateTranslate(const v: TVectorHelper.TVector3): TMat4;
begin
  result[0, 0] := 1.0;
  result[0, 1] := 0.0;
  result[0, 2] := 0.0;
  result[0, 3] := 0.0;
  result[1, 0] := 0.0;
  result[1, 1] := 1.0;
  result[1, 2] := 0.0;
  result[1, 3] := 0.0;
  result[2, 0] := 0.0;
  result[2, 1] := 0.0;
  result[2, 2] := 1.0;
  result[2, 3] := 0.0;
  result[3, 0] := v[0];
  result[3, 1] := v[1];
  result[3, 2] := v[2];
  result[3, 3] := 1.0;
end;

class function TgluMatrixHelper.CreateScale(const v: TVectorHelper.TVector2): TMat3;
begin
  result[0, 0] := v[0];
  result[0, 1] := 0.0;
  result[0, 2] := 0.0;
  result[1, 0] := 0.0;
  result[1, 1] := v[1];
  result[1, 2] := 0.0;
  result[2, 0] := 0.0;
  result[2, 1] := 0.0;
  result[2, 2] := 1.0;
end;

class function TgluMatrixHelper.CreateScale(const v: TVectorHelper.TVector3): TMat4;
begin
  result[0, 0] := v[0];
  result[0, 1] := 0.0;
  result[0, 2] := 0.0;
  result[0, 3] := 0.0;
  result[1, 0] := 0.0;
  result[1, 1] := v[1];
  result[1, 2] := 0.0;
  result[1, 3] := 0.0;
  result[2, 0] := 0.0;
  result[2, 1] := 0.0;
  result[2, 2] := v[2];
  result[2, 3] := 0.0;
  result[3, 0] := 0.0;
  result[3, 1] := 0.0;
  result[3, 2] := 0.0;
  result[3, 3] := 1.0;
end;

class function TgluMatrixHelper.CreateRotate(a: Double): TMat3;
begin
  a := DegToRad(a);
  result[0, 0] :=  cos(a);
  result[0, 1] := -sin(a);
  result[0, 2] :=  0.0;
  result[1, 0] :=  sin(a);
  result[1, 1] :=  cos(a);
  result[1, 2] :=  0.0;
  result[2, 0] :=  0.0;
  result[2, 1] :=  0.0;
  result[2, 2] :=  1.0;
end;

class function TgluMatrixHelper.CreateRotate(axis: TVectorHelper.TVector3; a: Double): TMat4;
var
  X, Y, Z, s, c: Single;
begin
  a := DegToRad(a);
  axis := TVectorHelperF.Normalize(axis);
  X := axis[0];
  Y := axis[1];
  Z := axis[2];
  s := sin(a);
  c := cos(a);
  result[0,0] := SQR(X) + (1-SQR(X))*c;
  result[0,1] := X*Y*(1-c) + Z*s;
  result[0,2] := X*Z*(1-c) - Y*s;
  result[0,3] := 0.0;
  result[1,0] := X*Y*(1-c) - Z*s;
  result[1,1] := SQR(Y) + (1-SQR(Y))*c;
  result[1,2] := Y*Z*(1-c) + X*s;
  result[1,3] := 0.0;
  result[2,0] := X*Z*(1-c) + Y*s;
  result[2,1] := Y*Z*(1-c) - X*s;
  result[2,2] := SQR(Z) + (1-SQR(Z))*c;
  result[2,3] := 0.0;
  result[3,0] := 0.0;
  result[3,1] := 0.0;
  result[3,2] := 0.0;
  result[3,3] := 1.0;
end;

class function TgluMatrixHelper.CreateShear(const v: TVectorHelper.TVector2): TMat3;
begin
  result[0, 0] := 1.0;
  result[0, 1] := v[1];
  result[0, 2] := 0.0;
  result[1, 0] := v[0];
  result[1, 1] := 1.0;
  result[1, 2] := 0.0;
  result[2, 0] := 0.0;
  result[2, 1] := 0.0;
  result[2, 2] := 1.0;
end;

class function TgluMatrixHelper.CreateShear(const x, y, z: TVectorHelper.TVector2): TMat4;
begin
  result[0,0] := 1.0;
  result[0,1] := y[0];
  result[0,2] := z[0];
  result[0,3] := 0.0;
  result[1,0] := x[0];
  result[1,1] := 1.0;
  result[1,2] := z[1];
  result[1,3] := 0.0;
  result[2,0] := x[1];
  result[2,1] := y[1];
  result[2,2] := 1.0;
  result[2,3] := 0.0;
  result[3,0] := 0.0;
  result[3,1] := 0.0;
  result[3,2] := 0.0;
  result[3,3] := 1.0;
end;

class function TgluMatrixHelper.GetElement(p: PBaseType; x, y, sz: Integer): TBaseType;
begin
  result := (p + (x * sz) + y)^;
end;

class procedure TgluMatrixHelper.SetElement(p: PBaseType; x, y, sz: Integer; v: TBaseType);
begin
  (p + (x * sz) + y)^ := v;
end;

class procedure TgluMatrixHelper.Transpose(src, dst: PBaseType; sz: Integer);
var
  i, j: Integer;
begin
  for i := 0 to sz-1 do
    for j := 0 to sz-1 do
      SetElement(dst, i, j, sz, GetElement(src, j, i, sz));
end;

class procedure TgluMatrixHelper.Sub(src, dst: PBaseType; sz, c, r: Integer);
var
  x, y, i, j: Integer;
begin
  for i := 0 to sz-1 do begin
    for j := 0 to sz-1 do begin
      x := i;
      y := j;
      if (i >= c) then inc(x);
      if (j >= r) then inc(y);
      SetElement(dst, i, j, sz-1, GetElement(src, x, y, sz));
    end;
  end;
end;

class procedure TgluMatrixHelper.Mult(p1, p2, r: PBaseType; c1r2, r1, c2: Integer);
var
  x, y, i: Integer;
  sum: TBaseType;
begin
  for x := 0 to c2-1 do begin
    for y := 0 to r1-1 do begin
      sum := 0;
      for i := 0 to c1r2-1 do
        sum := sum + GetElement(p1, i, y, c1r2) * GetElement(p2, x, i, c2);
      SetElement(r, x, y, c2, sum);
    end;
  end;
end;

class procedure TgluMatrixHelper.Mult(src, dst: PBaseType; c, r: Integer; v: TBaseType);
var
  i, j: Integer;
begin
  for i := 0 to c-1 do
    for j := 0 to r-1 do
      SetElement(dst, i, j, c, v * GetElement(src, i, j, c));
end;

class function TgluMatrixHelper.TryFromString(const s: String; p: PBaseType; r, c: Integer): Boolean;
var
  i, j, l: Integer;
begin
  result := true;
  l := Length(s);
  i := 1;
  j := l;
  while (i <= l) and (c > 0) and result do begin
    if (s[i] = '(') then begin
      j := i+1;
    end else if (s[i] = ')') then begin
      result := TVectorHelper.TryFromString(trim(copy(s, j, i-j)), p, r);
      j := l;
      inc(p, r);
      dec(c);
    end;
    inc(i);
  end;

  result := (c = 0);
  while (c > 0) do begin
    for i := 0 to r-1 do begin
      p^ := 0;
      inc(p);
    end;
    dec(c);
  end;
end;

end.