Changeset 494 for GraphicTest/Packages/bgrabitmap/face3d.inc

Timestamp:

Dec 22, 2016, 8:49:19 PM (7 years ago)

Author:

chronos

Message:

• Modified: Updated BGRABitmap package.

File:

• GraphicTest/Packages/bgrabitmap/face3d.inc (modified) (17 diffs)

GraphicTest/Packages/bgrabitmap/face3d.inc

@@ -8 +8 @@
        ColorOverride: boolean;
        TexCoordOverride: boolean;
+       ActualColor: TBGRAPixel;
+       ActualTexCoord: TPointF;
      end;
 
@@ -16 +18 @@
     FVertices: packed array of TBGRAFaceVertexDescription;
     FVertexCount: integer;
-    FTexture: IBGRAScanner;
+    FTexture, FActualTexture: IBGRAScanner;
     FMaterial: IBGRAMaterial3D;
+    FActualMaterial: TBGRAMaterial3D;
     FMaterialName: string;
     FParentTexture: boolean;
@@ -30 +33 @@
     function GetVertexDescription(AIndex : integer): PBGRAFaceVertexDescription;
     procedure SetCustomFlags(AValue: DWord);
+    procedure ComputeActualVertexColor(AIndex: integer);
+    procedure ComputeActualTexCoord(AMinIndex, AMaxIndex: integer);
+    procedure UpdateTexture;
   public
     function GetObject3D: IBGRAObject3D;
     constructor Create(AObject3D: IBGRAObject3D; AVertices: array of IBGRAVertex3D);
     destructor Destroy; override;
+    procedure ComputeVertexColors;
+    procedure UpdateMaterial;
+    procedure FlipFace;
     function AddVertex(AVertex: IBGRAVertex3D): integer;
     function GetParentTexture: boolean;
@@ -89 +98 @@
     property LightThroughFactorOverride: boolean read GetLightThroughFactorOverride write SetLightThroughFactorOverride;
     property Material: IBGRAMaterial3D read GetMaterial write SetMaterial;
+    property ActualMaterial: TBGRAMaterial3D read FActualMaterial;
+    property ActualTexture: IBGRAScanner read FActualTexture;
     property VertexDescription[AIndex : integer]: PBGRAFaceVertexDescription read GetVertexDescription;
     property CustomFlags: DWord read GetCustomFlags write SetCustomFlags;
@@ -114 +125 @@
 begin
   FCustomFlags:= AValue;
+end;
+
+procedure TBGRAFace3D.ComputeActualVertexColor(AIndex: integer);
+begin
+  with FVertices[AIndex] do
+  begin
+    if ColorOverride then
+      ActualColor := Color
+    else
+    if Vertex.ParentColor then
+      ActualColor := FObject3D.Color
+    else
+      ActualColor := Vertex.Color;
+  end;
+end;
+
+procedure TBGRAFace3D.ComputeActualTexCoord(AMinIndex, AMaxIndex: integer);
+var
+  i: Integer;
+  zoom: TPointF;
+  m: IBGRAMaterial3D;
+begin
+  m := ActualMaterial;
+  if m <> nil then zoom := m.TextureZoom
+  else zoom := PointF(1,1);
+  for i := AMinIndex to AMaxIndex do
+    with FVertices[i] do
+    begin
+      if TexCoordOverride then
+        ActualTexCoord := TexCoord
+      else
+        ActualTexCoord := Vertex.TexCoord;
+      ActualTexCoord.x *= zoom.x;
+      ActualTexCoord.y *= zoom.y;
+    end;
+end;
+
+procedure TBGRAFace3D.UpdateTexture;
+begin
+  if FParentTexture then
+  begin
+    FActualTexture := nil;
+    if FActualMaterial <> nil then
+      FActualTexture := FActualMaterial.GetTexture;
+    if FActualTexture = nil then
+      FActualTexture := FObject3D.Texture
+  end
+  else
+    FActualTexture := FTexture;
 end;
 
@@ -131 +191 @@
   i: Integer;
 begin
-  SetLength(FVertices, length(AVertices));
-  for i:= 0 to high(AVertices) do
-    AddVertex(AVertices[i]);
   FObject3D := AObject3D;
   FBiface := false;
@@ -139 +196 @@
   FLightThroughFactor:= 0;
   FLightThroughFactorOverride:= false;
+
+  UpdateMaterial;
+
+  SetLength(FVertices, length(AVertices));
+  for i:= 0 to high(AVertices) do
+    AddVertex(AVertices[i]);
 end;
 
 destructor TBGRAFace3D.Destroy;
 begin
+  FMaterial := nil;
   fillchar(FTexture,sizeof(FTexture),0);
+  fillchar(FActualTexture,sizeof(FActualTexture),0);
   inherited Destroy;
+end;
+
+procedure TBGRAFace3D.ComputeVertexColors;
+var
+  i: Integer;
+begin
+  for i := 0 to FVertexCount-1 do
+    ComputeActualVertexColor(i);
+end;
+
+procedure TBGRAFace3D.UpdateMaterial;
+begin
+  if Material <> nil then
+    FActualMaterial := TBGRAMaterial3D(Material.GetAsObject)
+  else if FObject3D.Material <> nil then
+    FActualMaterial := TBGRAMaterial3D(FObject3D.Material.GetAsObject)
+  else if TBGRAScene3D(FObject3D.Scene).DefaultMaterial <> nil then
+    FActualMaterial := TBGRAMaterial3D(TBGRAScene3D(FObject3D.Scene).DefaultMaterial.GetAsObject);
+
+  UpdateTexture;
+
+  ComputeActualTexCoord(0,FVertexCount-1);
+end;
+
+procedure TBGRAFace3D.FlipFace;
+var i: integer;
+  temp: TBGRAFaceVertexDescription;
+begin
+  for i := 0 to (VertexCount div 2)-1 do
+  begin
+    temp := FVertices[i];
+    FVertices[i] := FVertices[VertexCount-1-i];
+    FVertices[VertexCount-1-i] := temp;
+  end;
 end;
 
@@ -161 +260 @@
     Normal := nil;
   end;
+  ComputeActualVertexColor(result);
+  ComputeActualTexCoord(result,result);
   inc(FVertexCount);
 end;
@@ -186 +287 @@
     raise Exception.Create('Index out of bounds');
   FVertices[AIndex].Vertex := AValue;
+  ComputeActualVertexColor(AIndex);
 end;
 
@@ -192 +294 @@
   if (AIndex < 0) or (AIndex >= FVertexCount) then
     raise Exception.Create('Index out of bounds');
-  result := FVertices[AIndex].Color;
+  result := FVertices[AIndex].ActualColor;
 end;
 
@@ -220 +322 @@
 begin
   FParentTexture := AValue;
+  UpdateTexture;
 end;
 
@@ -226 +329 @@
   FTexture := AValue;
   FParentTexture := false;
+  UpdateTexture;
 end;
 
@@ -245 +349 @@
     ColorOverride := true;
   end;
+  ComputeActualVertexColor(AIndex);
 end;
 
@@ -253 +358 @@
     raise Exception.Create('Index out of bounds');
   FVertices[AIndex].ColorOverride := AValue;
+  ComputeActualVertexColor(AIndex);
 end;
 
@@ -275 +381 @@
   FVertices[AIndex].TexCoord := AValue;
   FVertices[AIndex].TexCoordOverride := true;
+  ComputeActualTexCoord(AIndex, AIndex);
 end;
 
@@ -374 +481 @@
 procedure TBGRAFace3D.SetMaterial(const AValue: IBGRAMaterial3D);
 begin
-  FMaterial := AValue;
+  if AValue <> FMaterial then
+  begin
+    FMaterial := AValue;
+    UpdateMaterial;
+  end;
 end;
 
@@ -382 +493 @@
   begin
     FMaterialName := AValue;
-    FObject3D.Scene.UseMaterial(FMaterialName, self);
+    TBGRAScene3D(FObject3D.Scene).UseMaterial(FMaterialName, self);
   end;
 end;