1 unit ucube3d;
2 
3 {$mode objfpc}
4 
5 interface
6 
7 uses
8   Classes, SysUtils, BGRAScene3D, BGRABitmapTypes;
9 
10 type
11 
12   { TCubeScene3D }
13 
14   TCubeScene3D = class(TBGRAScene3D)
15     cube: IBGRAObject3D;
16     constructor Create;
17     procedure SetCubeTexture(ATexture: TBGRACustomBitmap);
18     procedure SetCubeTexture(ATexture: IBGRAScanner; tx,ty: single);
19   end;
20 
21 implementation
22 
23 { TCubeScene3D }
24 
25 constructor TCubeScene3D.Create;
26 var v: arrayOfIBGRAVertex3D;
27 begin
28   inherited Create;
29 
30   cube := CreateObject;
31   v := cube.MainPart.Add([-1,-1,-1, 1,-1,-1, 1,1,-1, -1,1,-1,
32                           -1,-1,+1, 1,-1,+1, 1,1,+1, -1,1,+1]);
33 
34   cube.AddFace([v[0],v[1],v[2],v[3]],BGRA(255,0,0));
35   cube.AddFace([v[4],v[5],v[1],v[0]],BGRA(128,160,255));
36   cube.AddFace([v[7],v[6],v[5],v[4]],BGRA(96,224,0));
37   cube.AddFace([v[3],v[2],v[6],v[7]],BGRA(192,0,255));
38   cube.AddFace([v[1],v[5],v[6],v[2]],BGRA(255,192,0));
39   cube.AddFace([v[4],v[0],v[3],v[7]],BGRAWhite);
40 
41   cube.MainPart.Scale(20);
42 
43   AmbiantLightness := 0.5;
44   AddDirectionalLight(Point3D(1,1,1),1,-0.5);
45 end;
46 
47 procedure TCubeScene3D.SetCubeTexture(ATexture: TBGRACustomBitmap);
48 begin
49   SetCubeTexture(ATexture,ATexture.Width-1,ATexture.Height-1);
50 end;
51 
52 procedure TCubeScene3D.SetCubeTexture(ATexture: IBGRAScanner; tx, ty: single);
53 var
54   i: Integer;
55 begin
56   for i := 0 to cube.FaceCount-1 do
57   with cube.Face[i] do
58   begin
59     Texture := ATexture;
60     TexCoord[0] := PointF(0,0);
61     TexCoord[1] := PointF(tx,0);
62     TexCoord[2] := PointF(tx,ty);
63     TexCoord[3] := PointF(0,ty);
64   end;
65 end;
66 
67 end.
68 
69