stud_22-365/GLXEngine: GaLaXy Engine - пакеты компонентов GLScene & GXScene для Object Pascal и C++. Включает иерархию классов для создания 3D сцен с менеджерами поддержки физики Newton, звука BASS и шейдеров GLSL. Кросс-платформенный фреймворк с объектами на базе OpenGL и Vulkan.

Source/GLS.XOpenGL.pas
866 строк21 KB
GLScene
Updated sources for v.2023
27 дек 2022, 21:44
27 дек 2022, 21:44324b206
//
// The multimedia graphics platform GLScene https://github.com/glscene
//
unit GLS.XOpenGL;

(*
   "Alternate" OpenGL functions to handle multi-texturing.

   Using this functions allows specifying none/one/multiple ARB multi-texture
   coordinates with standard texture specification call.
   Before using any of the xglTexCoordXxxx fonctions, call one of the
   xglMapTexCoordToXxxx functions to establish the redirectors.
*)

interface

{$I GLScene.inc}

uses
  Winapi.OpenGLext,

  GLS.VectorTypes,
  GLS.OpenGLTokens,
  GLS.State;

type
  TMapTexCoordMode = (mtcmUndefined, mtcmNull, mtcmMain, mtcmDual, mtcmSecond,
    mtcmArbitrary);

  TGLMultitextureCoordinator = class
  private
    FMapTexCoordMode: TMapTexCoordMode;
    FSecondTextureUnitForbidden: Boolean;
    FUpdCount: Integer;
    FUpdNewMode: TMapTexCoordMode;
    FStateStack: array of TMapTexCoordMode;
    FComplexMapping: array of Cardinal;
    FComplexMappingN: Integer;
  public
    // Explicit texture coordinates specification
    TexCoord2f: procedure(s, t: TGLfloat);stdcall;
    TexCoord2fv: procedure(v: PGLfloat);stdcall;
    TexCoord3f: procedure(s, t, r: TGLfloat);stdcall;
    TexCoord3fv: procedure(v: PGLfloat);stdcall;
    TexCoord4f: procedure(s, t, r, q: TGLfloat);stdcall;
    TexCoord4fv: procedure(v: PGLfloat);stdcall;

    // TexGen texture coordinates specification
    TexGenf: procedure(coord, pname: Cardinal; param: TGLfloat);stdcall;
    TexGenfv: procedure(coord, pname: Cardinal; params: PGLfloat);stdcall;
    TexGeni: procedure(coord, pname: Cardinal; param: TGLint);stdcall;
    TexGeniv: procedure(coord, pname: Cardinal; params: PGLint);stdcall;

    // Vertex Arrays texture coordinates specification
    TexCoordPointer: procedure(size: TGLint; atype: Cardinal; stride: TGLsizei; data: pointer);stdcall;
    EnableClientState: procedure(aarray: Cardinal);stdcall;
    DisableClientState: procedure(aarray: Cardinal);stdcall;
    // Misc
    Enable: procedure(cap: Cardinal);stdcall;
    Disable: procedure(cap: Cardinal);stdcall;
    constructor Create;
    // TexCoord functions will be ignored.
    procedure MapTexCoordToNull;
    // TexCoord functions will define the main texture coordinates.
    procedure MapTexCoordToMain;
    // TexCoord functions will define the second texture unit coordinates.
    procedure MapTexCoordToSecond;
    // TexCoord functions will define the two first texture units coordinates.
    procedure MapTexCoordToDual;
    // TexCoord functions will define the specified texture units coordinates.
    procedure MapTexCoordToArbitrary(const units: array of Cardinal); overload;
    procedure MapTexCoordToArbitrary(const bitWiseUnits: Cardinal); overload;
    procedure MapTexCoordToArbitraryAdd(const bitWiseUnits: Cardinal);
    (* Defers Map calls execution until EndUpdate is met.
       Calls to Begin/EndUpdate may be nested. *)
    procedure BeginUpdate; inline;
    (* Applies Map calls if there were any since BeginUpdate was invoked.
       Calls to Begin/EndUpdate may be nested. *)
    procedure EndUpdate; inline;
    // Saves XOpenGL State on the stack.
    procedure PushState;
    // Restores XOpenGL State from the stack.
    procedure PopState;
    (* Whenever called, 2nd texture units changes will be forbidden to .
       Use this function when you're using the 2nd texture unit for your own
       purposes and don't want XOpenGL to alter it. *)
    procedure ForbidSecondTextureUnit;
    // Allow XOpenGL to use the second texture unit again.
    procedure AllowSecondTextureUnit;
    // Returns the complex mapping in bitwise form.
    function GetBitWiseMapping: Cardinal;
    property MapTexCoordMode: TMapTexCoordMode read FMapTexCoordMode write FMapTexCoordMode;
    property SecondTextureUnitForbidden: Boolean read FSecondTextureUnitForbidden;
  end;

// ------------------------------------------------------------------
implementation
// ------------------------------------------------------------------

uses
  GLS.Context;

// ------------------------------------------------------------------
// Multitexturing coordinates duplication functions
// ------------------------------------------------------------------

// --------- Complex (arbitrary) mapping

procedure TexCoord2f_Arbitrary(s, t: TGLfloat);stdcall;
var
  i: Integer;
begin
  for i := 0 to xgl.FComplexMappingN do
    gl.MultiTexCoord2f(xgl.FComplexMapping[i], s, t);
end;

procedure TexCoord2fv_Arbitrary(v: PGLfloat);stdcall;
var
  i: Integer;
begin
  for i := 0 to xgl.FComplexMappingN do
    gl.MultiTexCoord2fv(xgl.FComplexMapping[i], v);
end;

procedure TexCoord3f_Arbitrary(s, t, r: TGLfloat);stdcall;
var
  i: Integer;
begin
  for i := 0 to xgl.FComplexMappingN do
    gl.MultiTexCoord3f(xgl.FComplexMapping[i], s, t, r);
end;

procedure TexCoord3fv_Arbitrary(v: PGLfloat);stdcall;
var
  i: Integer;
begin
  for i := 0 to xgl.FComplexMappingN do
    gl.MultiTexCoord3fv(xgl.FComplexMapping[i], v);
end;

procedure TexCoord4f_Arbitrary(s, t, r, q: TGLfloat);stdcall;
var
  i: Integer;
begin
  for i := 0 to xgl.FComplexMappingN do
    gl.MultiTexCoord4f(xgl.FComplexMapping[i], s, t, r, q);
end;

procedure TexCoord4fv_Arbitrary(v: PGLfloat);stdcall;
var
  i: Integer;
begin
  for i := 0 to xgl.FComplexMappingN do
    gl.MultiTexCoord4fv(xgl.FComplexMapping[i], v);
end;

procedure TexGenf_Arbitrary(coord, pname: Cardinal; param: TGLfloat);stdcall;
var
  i: Integer;
begin
  for i := 0 to xgl.FComplexMappingN do
  begin
    CurrentGLContext.GLStates.ActiveTexture := xgl.FComplexMapping[i];
    gl.TexGenf(coord, pname, param);
  end;
end;

procedure TexGenfv_Arbitrary(coord, pname: Cardinal; params: PGLfloat);stdcall;
var
  i: Integer;
begin
  for i := 0 to xgl.FComplexMappingN do
  begin
    CurrentGLContext.GLStates.ActiveTexture := xgl.FComplexMapping[i];
    gl.TexGenfv(coord, pname, params);
  end;
end;

procedure TexGeni_Arbitrary(coord, pname: Cardinal; param: TGLint);stdcall;
var
  i: Integer;
begin
  for i := 0 to xgl.FComplexMappingN do
  begin
    CurrentGLContext.GLStates.ActiveTexture := xgl.FComplexMapping[i];
    gl.TexGeni(coord, pname, param);
  end;
end;

procedure TexGeniv_Arbitrary(coord, pname: Cardinal; params: PGLint);stdcall;
var
  i: Integer;
begin
  for i := 0 to xgl.FComplexMappingN do
  begin
    CurrentGLContext.GLStates.ActiveTexture := xgl.FComplexMapping[i];
    gl.TexGeniv(coord, pname, params);
  end;
end;

procedure Enable_Arbitrary(cap: Cardinal);stdcall;
var
  i: Integer;
begin
  for i := 0 to xgl.FComplexMappingN do
  begin
    CurrentGLContext.GLStates.ActiveTexture := xgl.FComplexMapping[i];
    gl.Enable(cap);
  end;
end;

procedure Disable_Arbitrary(cap: Cardinal);stdcall;
var
  i: Integer;
begin
  for i := 0 to xgl.FComplexMappingN do
  begin
    CurrentGLContext.GLStates.ActiveTexture := xgl.FComplexMapping[i];
    gl.Disable(cap);
  end;
end;

procedure TexCoordPointer_Arbitrary(size: TGLint; atype: Cardinal; stride: TGLsizei; data: pointer);
stdcall;
var
  i: Integer;
begin
  for i := 0 to xgl.FComplexMappingN do
  begin
    gl.ClientActiveTexture(xgl.FComplexMapping[i]);
    gl.TexCoordPointer(size, atype, stride, data);
  end;
end;

procedure EnableClientState_Arbitrary(aArray: Cardinal);stdcall;
var
  i: Integer;
begin
  for i := 0 to xgl.FComplexMappingN do
  begin
    gl.ClientActiveTexture(xgl.FComplexMapping[i]);
    gl.EnableClientState(aArray);
  end;
end;

procedure DisableClientState_Arbitrary(aArray: Cardinal);stdcall;
var
  i: Integer;
begin
  for i := 0 to xgl.FComplexMappingN do
  begin
    gl.ClientActiveTexture(xgl.FComplexMapping[i]);
    gl.DisableClientState(aArray);
  end;
end;

// --------- Second unit Texturing

procedure TexCoord2f_Second(s, t: TGLfloat);stdcall;
begin
  gl.MultiTexCoord2f(GL_TEXTURE1, s, t);
end;

procedure TexCoord2fv_Second(v: PGLfloat);stdcall;
begin
  gl.MultiTexCoord2fv(GL_TEXTURE1, v);
end;

procedure TexCoord3f_Second(s, t, r: TGLfloat);stdcall;
begin
  gl.MultiTexCoord3f(GL_TEXTURE1, s, t, r);
end;

procedure TexCoord3fv_Second(v: PGLfloat);stdcall;
begin
  gl.MultiTexCoord3fv(GL_TEXTURE1, v);
end;

procedure TexCoord4f_Second(s, t, r, q: TGLfloat);stdcall;
begin
  gl.MultiTexCoord4f(GL_TEXTURE1, s, t, r, q);
end;

procedure TexCoord4fv_Second(v: PGLfloat);stdcall;
begin
  gl.MultiTexCoord4fv(GL_TEXTURE1, v);
end;

procedure TexGenf_Second(coord, pname: Cardinal; param: TGLfloat);stdcall;
begin
  CurrentGLContext.GLStates.ActiveTexture := 1;
  gl.TexGenf(coord, pname, param);
end;

procedure TexGenfv_Second(coord, pname: Cardinal; params: PGLfloat);stdcall;
begin
  CurrentGLContext.GLStates.ActiveTexture := 1;
  gl.TexGenfv(coord, pname, params);
end;

procedure TexGeni_Second(coord, pname: Cardinal; param: TGLint);stdcall;
begin
  CurrentGLContext.GLStates.ActiveTexture := 1;
  gl.TexGeni(coord, pname, param);
end;

procedure TexGeniv_Second(coord, pname: Cardinal; params: PGLint);stdcall;
begin
  CurrentGLContext.GLStates.ActiveTexture := 1;
  gl.TexGeniv(coord, pname, params);
end;

procedure Enable_Second(cap: Cardinal);stdcall;
begin
  CurrentGLContext.GLStates.ActiveTexture := 1;
  gl.Enable(cap);
end;

procedure Disable_Second(cap: Cardinal);stdcall;
begin
  CurrentGLContext.GLStates.ActiveTexture := 1;
  gl.Disable(cap);
end;

procedure TexCoordPointer_Second(size: TGLint; atype: Cardinal; stride:
  TGLsizei; data: pointer);stdcall;
begin
  gl.ClientActiveTexture(GL_TEXTURE1);
  gl.TexCoordPointer(size, atype, stride, data);
  gl.ClientActiveTexture(GL_TEXTURE0);
end;

procedure EnableClientState_Second(aArray: Cardinal);stdcall;
begin
  gl.ClientActiveTexture(GL_TEXTURE1);
  gl.EnableClientState(aArray);
  gl.ClientActiveTexture(GL_TEXTURE0);
end;

procedure DisableClientState_Second(aArray: Cardinal);stdcall;
begin
  gl.ClientActiveTexture(GL_TEXTURE1);
  gl.DisableClientState(aArray);
  gl.ClientActiveTexture(GL_TEXTURE0);
end;

// --------- Dual Texturing

procedure TexCoord2f_Dual(s, t: TGLfloat);stdcall;
begin
  gl.TexCoord2f(s, t);
  gl.MultiTexCoord2f(GL_TEXTURE1, s, t);
end;

procedure TexCoord2fv_Dual(v: PGLfloat);stdcall;
begin
  gl.TexCoord2fv(v);
  gl.MultiTexCoord2fv(GL_TEXTURE1, v);
end;

procedure TexCoord3f_Dual(s, t, r: TGLfloat);stdcall;
begin
  gl.TexCoord3f(s, t, r);
  gl.MultiTexCoord3f(GL_TEXTURE1, s, t, r);
end;

procedure TexCoord3fv_Dual(v: PGLfloat);stdcall;
begin
  gl.TexCoord3fv(v);
  gl.MultiTexCoord3fv(GL_TEXTURE1, v);
end;

procedure TexCoord4f_Dual(s, t, r, q: TGLfloat);stdcall;
begin
  gl.TexCoord4f(s, t, r, q);
  gl.MultiTexCoord4f(GL_TEXTURE1, s, t, r, q);
end;

procedure TexCoord4fv_Dual(v: PGLfloat);stdcall;
begin
  gl.TexCoord4fv(v);
  gl.MultiTexCoord4fv(GL_TEXTURE1, v);
end;

procedure TexGenf_Dual(coord, pname: Cardinal; param: TGLfloat);stdcall;
begin
  with CurrentGLContext.GLStates do
  begin
    ActiveTexture := 0;
    gl.TexGenf(coord, pname, param);
    ActiveTexture := 1;
    gl.TexGenf(coord, pname, param);
  end;
end;

procedure TexGenfv_Dual(coord, pname: Cardinal; params: PGLfloat);
stdcall;
begin
  with CurrentGLContext.GLStates do
  begin
    ActiveTexture := 0;
    gl.TexGenfv(coord, pname, params);
    ActiveTexture := 1;
    gl.TexGenfv(coord, pname, params);
  end;
end;

procedure TexGeni_Dual(coord, pname: Cardinal; param: TGLint);stdcall;
begin
  with CurrentGLContext.GLStates do
  begin
    ActiveTexture := 0;
    gl.TexGeni(coord, pname, param);
    ActiveTexture := 1;
    gl.TexGeni(coord, pname, param);
  end;
end;

procedure TexGeniv_Dual(coord, pname: Cardinal; params: PGLint);stdcall;
begin
  with CurrentGLContext.GLStates do
  begin
    ActiveTexture := 0;
    gl.TexGeniv(coord, pname, params);
    ActiveTexture := 1;
    gl.TexGeniv(coord, pname, params);
  end;
end;

procedure Enable_Dual(cap: Cardinal);stdcall;
begin
  with CurrentGLContext.GLStates do
  begin
    ActiveTexture := 0;
    gl.Enable(cap);
    ActiveTexture := 1;
    gl.Enable(cap);
  end;
end;

procedure Disable_Dual(cap: Cardinal);stdcall;
begin
  with CurrentGLContext.GLStates do
  begin
    ActiveTexture := 0;
    gl.Disable(cap);
    ActiveTexture := 1;
    gl.Disable(cap);
  end;
end;

procedure TexCoordPointer_Dual(size: TGLint; atype: Cardinal; stride:
  TGLsizei; data: pointer);stdcall;
begin
  gl.TexCoordPointer(size, atype, stride, data);
  gl.ClientActiveTexture(GL_TEXTURE1);
  gl.TexCoordPointer(size, atype, stride, data);
  gl.ClientActiveTexture(GL_TEXTURE0);
end;

procedure EnableClientState_Dual(aArray: Cardinal);stdcall;
begin
  gl.EnableClientState(aArray);
  gl.ClientActiveTexture(GL_TEXTURE1);
  gl.EnableClientState(aArray);
  gl.ClientActiveTexture(GL_TEXTURE0);
end;

procedure DisableClientState_Dual(aArray: Cardinal);stdcall;
begin
  gl.DisableClientState(aArray);
  gl.ClientActiveTexture(GL_TEXTURE1);
  gl.DisableClientState(aArray);
  gl.ClientActiveTexture(GL_TEXTURE0);
end;

// --------- Null Texturing

procedure TexCoord2f_Null(s, t: TGLfloat);stdcall;
begin
end;

procedure TexCoord2fv_Null(v: PGLfloat);stdcall;
begin
end;

procedure TexCoord3f_Null(s, t, r: TGLfloat);stdcall;
begin
end;

procedure TexCoord3fv_Null(v: PGLfloat);stdcall;
begin
end;

procedure TexCoord4f_Null(s, t, r, q: TGLfloat);stdcall;
begin
end;

procedure TexCoord4fv_Null(v: PGLfloat);stdcall;
begin
end;

procedure TexGenf_Null(coord, pname: Cardinal; param: TGLfloat);stdcall;
begin
end;

procedure TexGenfv_Null(coord, pname: Cardinal; params: PGLfloat);stdcall;
begin
end;

procedure TexGeni_Null(coord, pname: Cardinal; param: TGLint);stdcall;
begin
end;

procedure TexGeniv_Null(coord, pname: Cardinal; params: PGLint);stdcall;
begin
end;

procedure Enable_Null(cap: Cardinal);stdcall;
begin
end;

procedure Disable_Null(cap: Cardinal);stdcall;
begin
end;

procedure TexCoordPointer_Null(size: TGLint; atype: Cardinal; stride: TGLsizei; data: pointer);stdcall;
begin
end;

procedure EnableClientState_Null(aArray: Cardinal);stdcall;
begin
end;

procedure DisableClientState_Null(aArray: Cardinal);stdcall;
begin
end;

// ------------------------------------------------------------------
// Redirections management functions
// ------------------------------------------------------------------


procedure TGLMultitextureCoordinator.BeginUpdate;
begin
  if FUpdCount = 0 then
  begin
    FUpdCount := 1;
    FUpdNewMode := MapTexCoordMode;
  end
  else
    Inc(FUpdCount);
end;


procedure TGLMultitextureCoordinator.EndUpdate;
begin
  Dec(FUpdCount);
  if (FUpdCount = 0) and (FUpdNewMode <> MapTexCoordMode) then
  begin
    case FUpdNewMode of
      mtcmNull: MapTexCoordToNull;
      mtcmMain: MapTexCoordToMain;
      mtcmDual: MapTexCoordToDual;
      mtcmSecond: MapTexCoordToSecond;
      mtcmArbitrary: MapTexCoordToArbitrary(FComplexMapping);
    else
      Assert(False);
    end;
  end;
end;


procedure TGLMultitextureCoordinator.PushState;
var
  i: Integer;
begin
  Assert(FUpdCount = 0);
  i := Length(FStateStack);
  SetLength(FStateStack, i + 1);
  FStateStack[i] := MapTexCoordMode;
end;


procedure TGLMultitextureCoordinator.PopState;
var
  i: Integer;
begin
  Assert(FUpdCount = 0);
  i := Length(FStateStack) - 1;
  Assert(i >= 0);
  case FStateStack[i] of
    mtcmNull: MapTexCoordToNull;
    mtcmMain: MapTexCoordToMain;
    mtcmDual: MapTexCoordToDual;
    mtcmSecond: MapTexCoordToSecond;
    mtcmArbitrary: MapTexCoordToArbitrary(FComplexMapping);
  else
    Assert(False);
  end;
  SetLength(FStateStack, i);
end;


procedure TGLMultitextureCoordinator.ForbidSecondTextureUnit;
begin
  FSecondTextureUnitForbidden := True;
end;


procedure TGLMultitextureCoordinator.AllowSecondTextureUnit;
begin
  FSecondTextureUnitForbidden := False;
end;

constructor TGLMultitextureCoordinator.Create;
begin
  inherited;
  FMapTexCoordMode := mtcmUndefined;
  MapTexCoordToNull;
end;


procedure TGLMultitextureCoordinator.MapTexCoordToNull;
begin
  if FUpdCount <> 0 then
    FUpdNewMode := mtcmNull
  else if MapTexCoordMode <> mtcmNull then
  begin
    MapTexCoordMode := mtcmNull;

    TexCoord2f := TexCoord2f_Null;
    TexCoord2fv := TexCoord2fv_Null;
    TexCoord3f := TexCoord3f_Null;
    TexCoord3fv := TexCoord3fv_Null;
    TexCoord4f := TexCoord4f_Null;
    TexCoord4fv := TexCoord4fv_Null;

    TexGenf := TexGenf_Null;
    TexGenfv := TexGenfv_Null;
    TexGeni := TexGeni_Null;
    TexGeniv := TexGeniv_Null;

    TexCoordPointer := TexCoordPointer_Null;
    EnableClientState := EnableClientState_Null;
    DisableClientState := DisableClientState_Null;

    Enable := Enable_Null;
    Disable := Disable_Null;
  end;
end;


procedure TGLMultitextureCoordinator.MapTexCoordToMain;
begin
  if FUpdCount <> 0 then
    FUpdNewMode := mtcmMain
  else if MapTexCoordMode <> mtcmMain then
  begin
    MapTexCoordMode := mtcmMain;

    TexCoord2f := gl.TexCoord2f;
    TexCoord2fv := gl.TexCoord2fv;
    TexCoord3f := gl.TexCoord3f;
    TexCoord3fv := gl.TexCoord3fv;
    TexCoord4f := gl.TexCoord4f;
    TexCoord4fv := gl.TexCoord4fv;

    TexGenf := gl.TexGenf;
    TexGenfv := gl.TexGenfv;
    TexGeni := gl.TexGeni;
    TexGeniv := gl.TexGeniv;

    TexCoordPointer := gl.TexCoordPointer;
    EnableClientState := gl.EnableClientState;
    DisableClientState := gl.DisableClientState;

    Enable := gl.Enable;
    Disable := gl.Disable;
  end;
end;


procedure TGLMultitextureCoordinator.MapTexCoordToSecond;
begin
  if FSecondTextureUnitForbidden then
  begin
    MapTexCoordToNull;
    Exit;
  end;
  if FUpdCount <> 0 then
    FUpdNewMode := mtcmSecond
  else if MapTexCoordMode <> mtcmSecond then
  begin
    MapTexCoordMode := mtcmSecond;
    Assert(gl.ARB_multitexture);

    TexCoord2f := TexCoord2f_Second;
    TexCoord2fv := TexCoord2fv_Second;
    TexCoord3f := TexCoord3f_Second;
    TexCoord3fv := TexCoord3fv_Second;
    TexCoord4f := TexCoord4f_Second;
    TexCoord4fv := TexCoord4fv_Second;

    TexGenf := TexGenf_Second;
    TexGenfv := TexGenfv_Second;
    TexGeni := TexGeni_Second;
    TexGeniv := TexGeniv_Second;

    TexCoordPointer := TexCoordPointer_Second;
    EnableClientState := EnableClientState_Second;
    DisableClientState := DisableClientState_Second;

    Enable := Enable_Second;
    Disable := Disable_Second;
  end;
end;


procedure TGLMultitextureCoordinator.MapTexCoordToDual;
begin
  if FSecondTextureUnitForbidden then
  begin
    MapTexCoordToMain;
    Exit;
  end;
  if FUpdCount <> 0 then
    FUpdNewMode := mtcmDual
  else if MapTexCoordMode <> mtcmDual then
  begin
    MapTexCoordMode := mtcmDual;
    Assert(GL.ARB_multitexture);

    TexCoord2f := TexCoord2f_Dual;
    TexCoord2fv := TexCoord2fv_Dual;
    TexCoord3f := TexCoord3f_Dual;
    TexCoord3fv := TexCoord3fv_Dual;
    TexCoord4f := TexCoord4f_Dual;
    TexCoord4fv := TexCoord4fv_Dual;

    TexGenf := TexGenf_Dual;
    TexGenfv := TexGenfv_Dual;
    TexGeni := TexGeni_Dual;
    TexGeniv := TexGeniv_Dual;

    TexCoordPointer := TexCoordPointer_Dual;
    EnableClientState := EnableClientState_Dual;
    DisableClientState := DisableClientState_Dual;

    Enable := Enable_Dual;
    Disable := Disable_Dual;
  end;
end;


procedure TGLMultitextureCoordinator.MapTexCoordToArbitrary(const units: array of Cardinal);
var
  i, j, n: Integer;
begin
  n := Length(units);
  SetLength(FComplexMapping, n);
  j := 0;
  FComplexMappingN := n - 1;
  for i := 0 to FComplexMappingN do
  begin
    if (not FSecondTextureUnitForbidden) or (units[i] <> GL_TEXTURE1) then
    begin
      FComplexMapping[j] := units[i];
      Inc(j);
    end;
  end;

  if FUpdCount <> 0 then
    FUpdNewMode := mtcmArbitrary
  else if MapTexCoordMode <> mtcmArbitrary then
  begin

    MapTexCoordMode := mtcmArbitrary;
    Assert(GL.ARB_multitexture);

    TexCoord2f := TexCoord2f_Arbitrary;
    TexCoord2fv := TexCoord2fv_Arbitrary;
    TexCoord3f := TexCoord3f_Arbitrary;
    TexCoord3fv := TexCoord3fv_Arbitrary;
    TexCoord4f := TexCoord4f_Arbitrary;
    TexCoord4fv := TexCoord4fv_Arbitrary;

    TexGenf := TexGenf_Arbitrary;
    TexGenfv := TexGenfv_Arbitrary;
    TexGeni := TexGeni_Arbitrary;
    TexGeniv := TexGeniv_Arbitrary;

    TexCoordPointer := TexCoordPointer_Arbitrary;
    EnableClientState := EnableClientState_Arbitrary;
    DisableClientState := DisableClientState_Arbitrary;

    Enable := Enable_Arbitrary;
    Disable := Disable_Arbitrary;
  end;
end;


procedure TGLMultitextureCoordinator.MapTexCoordToArbitrary(const bitWiseUnits: Cardinal);
var
  i, n: Integer;
  units: array of Cardinal;
begin
  n := 0;
  for i := 0 to 7 do
  begin
    if (bitWiseUnits and (1 shl i)) <> 0 then
      Inc(n);
  end;
  SetLength(units, n);
  n := 0;
  for i := 0 to 7 do
  begin
    if (bitWiseUnits and (1 shl i)) <> 0 then
    begin
      units[n] := GL_TEXTURE0 + i;
      Inc(n);
    end;
  end;
  MapTexCoordToArbitrary(units);
end;


procedure TGLMultitextureCoordinator.MapTexCoordToArbitraryAdd(const bitWiseUnits: Cardinal);
var
  n: Cardinal;
begin
  n := GetBitWiseMapping;
  MapTexCoordToArbitrary(n or bitWiseUnits);
end;


function TGLMultitextureCoordinator.GetBitWiseMapping: Cardinal;
var
  i, n: Cardinal;
  mode: TMapTexCoordMode;
begin
  if FUpdCount > 0 then
    mode := FUpdNewMode
  else
    mode := MapTexCoordMode;
  n := 0;
  case mode of
    mtcmMain: n := 1;
    mtcmDual: n := 3;
    mtcmSecond: n := 2;
    mtcmArbitrary:
      begin
        for i := 0 to FComplexMappingN do
          n := n or (1 shl (FComplexMapping[i] - GL_TEXTURE0));
      end;
  else
    Assert(False);
  end;
  Result := n;
end;

// ------------------------------------------------------------------------
initialization
// ------------------------------------------------------------------------

end.