ArenaZ

1
unit uNavCube;
2

3
{$IFDEF FPC}
4
  {$MODE Delphi}
5
{$ENDIF}
6

7
interface
8

9
uses
10
  {$ifdef Windows}windows, {$endif}lcltype, lclintf, Classes, SysUtils,
11
  Graphics, Forms, Controls,
12
  // GLS
13
  GLScene, GLObjects, GLHUDObjects, GLGeomObjects, GLMaterial, GLTexture,
14
  GLTextureFormat, GLVectorGeometry, GLKeyboard, GLContext, GLBaseClasses,
15
  GLLCLViewer, GLRenderContextInfo, keyboard;
16

17
type
18
  TGLNavCube = class(TGLBaseSceneObject)
19
  private
20
    FDelta, FFps, FTimer, FInactiveTime: single;
21
    FCube: TGLDummyCube;
22
    FSel: Integer;
23
    FSelPos: TVector;
24
    FCam, FNavCam: TGLCamera;
25
    FHud: TGLHUDSprite;
26
    FMem: TGLMemoryViewer;
27
    FViewer: TGLSceneViewer;
28
    FReady, FMouse: boolean;
29
    FMouseRotation: boolean;
30
    FAutoRotate : Boolean;
31
    FMousePos: TPoint;
32

33
    FPosAnimationStart: TVector;
34
    FPosAnimationEnd: TVector;
35

36
  public
37
    constructor CreateAsChild(aParentOwner: TGLBaseSceneObject); reintroduce;
38
    procedure DoProgress(const pt: TProgressTimes); override;
39
    procedure DoRender(var ARci: TGLRenderContextInfo;
40
      ARenderSelf, ARenderChildren: boolean); override;
41

42
    property SceneViewer: TGLSceneViewer read FViewer write FViewer;
43
    property Camera: TGLCamera read FCam write FCam;
44
    property FPS: single read FFps write FFps;
45

46
    property ActiveMouse: boolean read FMouse write FMouse;
47
    property AutoRotate: boolean read FAutoRotate write FAutoRotate;
48
    property InactiveTime: single read FInactiveTime write FInactiveTime;
49
  end;
50

51
var
52
  sW2, sH2: Integer;
53

54
implementation
55

56
// constructor
57
//
58
constructor TGLNavCube.CreateAsChild(aParentOwner: TGLBaseSceneObject);
59

60
procedure genTex(s: string; mat: TGLMaterial);
61
var
62
  bmp: TBitmap;
63
begin
64
  bmp := TBitmap.Create;
65
  bmp.Width := 64;
66
  bmp.Height := 64;
67
  with bmp.Canvas do
68
  begin
69
    Font.Name := 'Verdana';
70
    Font.Size := 10;
71
    TextOut(32 - TextWidth(s) div 2, 24, s);
72
  end;
73
  mat.FrontProperties.Diffuse.SetColor(1, 1, 1);
74
  mat.Texture.Image.Assign(bmp);
75
  mat.Texture.Disabled := false;
76
  mat.Texture.FilteringQuality := tfAnisotropic;
77
  mat.Texture.TextureMode := tmModulate;
78
  bmp.Free;
79
end;
80

81
procedure SetColor(m: TGLMaterial; c: single);
82
begin
83
  m.FrontProperties.Diffuse.SetColor(c, c, 1);
84
end;
85

86
procedure addPlane(t: Integer; ttl: string; c, x, y, z, dx, dy, dz: single);
87
begin
88
  with TGLPlane.CreateAsChild(FCube) do
89
  begin
90
    tag := t;
91
    tagfloat := c;
92
    Position.SetPoint(x, y, z);
93
    Direction.SetVector(dx, dy, dz);
94
    genTex(ttl, Material);
95
  end;
96
end;
97

98
procedure addCube(t: Integer; c, x, y, z, sx, sy, sz: single);
99
begin
100
  with TGLCube.CreateAsChild(FCube) do
101
  begin
102
    tag := t;
103
    tagfloat := c;
104
    Position.SetPoint(x, y, z);
105
    Scale.SetVector(sx, sy, sz);
106
    SetColor(Material, c);
107
  end;
108
end;
109

110
begin
111
  inherited CreateAsChild(aParentOwner);
112
  FDelta := 2;
113
  FFps := 30;
114
  FTimer := 10;
115
  FMouse := True;
116
  FAutoRotate := False;
117
  FInactiveTime := 0;
118

119
  FHud := TGLHUDSprite.CreateAsChild(self);
120
  FHud.Width := 128;
121
  FHud.Height := 128;
122
  FHud.Material.BlendingMode := bmTransparency;
123
  with FHud.Material.Texture do
124
  begin
125
    Disabled := false;
126
    ImageClassName := 'TGLBlankImage';
127
    MinFilter := miNearest;
128
    TGLBlankImage(Image).Width := 128;
129
    TGLBlankImage(Image).Height := 128;
130
    TextureMode := tmReplace;
131
  end;
132
  FHud.Position.SetPoint(-200, 50, 0);
133

134
  FNavCam := TGLCamera.CreateAsChild(self);
135
  FNavCam.FocalLength := 55;
136
  FNavCam.TargetObject := self;
137

138
  FMem := TGLMemoryViewer.Create(aParentOwner);
139
  FMem.Width := 128;
140
  FMem.Height := 128;
141
  FMem.Camera := FNavCam;
142
  with FMem.Buffer do
143
  begin
144
    BackgroundAlpha := 0;
145
    Antialiasing := aa6x;
146
    ContextOptions := [roDestinationAlpha];
147
    Lighting := false;
148
  end;
149

150
  FCube := TGLDummyCube.CreateAsChild(self);
151
  FCube.Visible := false;
152

153
  with TGLDisk.CreateAsChild(FCube) do
154
  begin
155
    Position.SetPoint(0, -0.805, 0);
156
    Direction.SetVector(0, 1, 0);
157
    InnerRadius := 0.9;
158
    OuterRadius := 1.3;
159
    Slices := 60;
160
    Loops := 1;
161
    SetColor(Material, 0.6);
162
  end;
163

164
  with TGLDisk.CreateAsChild(FCube) do
165
  begin
166
    Position.SetPoint(0, -0.8, 0);
167
    Direction.SetVector(0, 1, 0);
168
    InnerRadius := 0.95;
169
    OuterRadius := 1.25;
170
    Slices := 60;
171
    Loops := 1;
172
    SetColor(Material, 1);
173
  end;
174

175
  addPlane(0, 'FRONT', 1, 0, 0, 0.7, 0, 0, 1);
176
  addPlane(1, 'RIGHT', 1, 0.7, 0, 0, 1, 0, 0);
177
  addPlane(2, 'LEFT', 1, -0.7, 0, 0, -1, 0, 0);
178
  addPlane(3, 'BACK', 1, 0, 0, -0.7, 0, 0, -1);
179
  addPlane(4, 'TOP', 1, 0, 0.7, 0, 0, 1, 0);
180
  addPlane(5, 'BOTTOM', 1, 0, -0.7, 0, 0, -1, 0);
181

182
  addCube(6, 0.9, 0, 0.6, 0.6, 1, 0.2, 0.2);
183
  addCube(7, 0.9, 0, 0.6, -0.6, 1, 0.2, 0.2);
184
  addCube(8, 0.9, 0, -0.6, 0.6, 1, 0.2, 0.2);
185
  addCube(9, 0.9, 0, -0.6, -0.6, 1, 0.2, 0.2);
186

187
  addCube(10, 0.9, 0.6, 0.6, 0, 0.2, 0.2, 1);
188
  addCube(11, 0.9, 0.6, -0.6, 0, 0.2, 0.2, 1);
189
  addCube(12, 0.9, -0.6, 0.6, 0, 0.2, 0.2, 1);
190
  addCube(13, 0.9, -0.6, -0.6, 0, 0.2, 0.2, 1);
191

192
  addCube(14, 0.9, 0.6, 0, 0.6, 0.2, 1, 0.2);
193
  addCube(15, 0.9, 0.6, 0, -0.6, 0.2, 1, 0.2);
194
  addCube(16, 0.9, -0.6, 0, 0.6, 0.2, 1, 0.2);
195
  addCube(17, 0.9, -0.6, 0, -0.6, 0.2, 1, 0.2);
196

197
  addCube(18, 0.8, 0.6, 0.6, 0.6, 0.2, 0.2, 0.2);
198
  addCube(19, 0.8, 0.6, 0.6, -0.6, 0.2, 0.2, 0.2);
199
  addCube(20, 0.8, 0.6, -0.6, 0.6, 0.2, 0.2, 0.2);
200
  addCube(21, 0.8, -0.6, 0.6, 0.6, 0.2, 0.2, 0.2);
201
  addCube(22, 0.8, 0.6, -0.6, -0.6, 0.2, 0.2, 0.2);
202
  addCube(23, 0.8, -0.6, -0.6, 0.6, 0.2, 0.2, 0.2);
203
  addCube(24, 0.8, -0.6, 0.6, -0.6, 0.2, 0.2, 0.2);
204
  addCube(25, 0.8, -0.6, -0.6, -0.6, 0.2, 0.2, 0.2);
205

206
end;
207

208
// DoProgress
209
//
210
procedure TGLNavCube.DoProgress(const pt: TProgressTimes);
211
const
212
  tb: array [0 .. 1] of array [0 .. 3] of TVector = (((x: 0; y: 20; z: 1;
213
    W: 0), (x: 1; y: 20; z: 0; W: 0), (x: 0; y: 20; z: - 1; W: 0), (x: - 1;
214
    y: 20; z: 0; W: 0)), ((x: 0; y: - 20; z: 1; W: 0), (x: 1; y: - 20; z: 0;
215
    W: 0), (x: 0; y: - 20; z: - 1; W: 0), (x: - 1; y: - 20; z: 0; W: 0)));
216
var
217
  mp: TPoint;
218
  mover: boolean;
219
  i: Integer;
220
  v0, v1, v2, v: TVector;
221
  obj: TGLBaseSceneObject;
222

223
procedure moveTo(trgv: TVector);
224
begin
225
  FPosAnimationStart := FCam.Position.AsVector;
226
  FPosAnimationEnd := FCam.TargetObject.AbsoluteToLocal
227
    (VectorScale(VectorNormalize(trgv), FCam.DistanceToTarget));
228
  FDelta := 0;
229
end;
230

231
begin
232
//  if not (csloading in componentstate) then
233
//  begin
234
  mp := FViewer.ScreenToClient(mouse.CursorPos);
235
  mover := (mp.x > FHud.Position.x - 64) and (mp.x < FHud.Position.x + 64) and
236
    (mp.y > FHud.Position.y - 64) and (mp.y < FHud.Position.y + 64);
237
  // mouse Down/Up
238
  if (mp.y<FViewer.Top) or (mp.x<FViewer.Left) or (mp.y>FViewer.Top+FViewer.Height) or (mp.x>FViewer.Left+FViewer.Width) then exit;
239
  if FDelta > 1 then
240
  begin
241
    if iskeydown(VK_LBUTTON) and (not FMouseRotation) then
242
    begin
243
      // selection > start auto rotation
244
      if mover and (FSel >= 0) then
245
      begin
246

247
        v := FCam.AbsoluteVectorToTarget;
248
        v.y := 0;
249
        if v.x < 0 then
250
          i := -1
251
        else
252
          i := 1;
253
        i := round((ArcCos(VectorAngleCosine(v, ZHmgPoint)) * i + PI) / PI
254
          * 2) mod 4;
255
        if (FSel = 4) or (FSel = 5) then
256
          moveTo(tb[FSel - 4][i])
257
        else
258
          moveTo(FSelPos);
259
        FInactiveTime := 0;
260
      end // start manual rotation
261
      else if FMouse then
262
      begin
263

264
        FMouseRotation := true;
265
        FMousePos := mouse.CursorPos;
266
        //FMousePos := point(sW2, sH2);
267
       // mouse.CursorPos := point(sW2, sH2);
268
        FInactiveTime := 0;
269
      end;
270
    end;
271
    // stop rotation, restore cursor
272
    if (not iskeydown(VK_LBUTTON)) and FMouseRotation and FMouse then
273
    begin
274
      FMouseRotation := false;
275
     // FMousePos := mouse.CursorPos;
276
     // mouse.CursorPos := FMousePos;
277

278
      FInactiveTime := 0;
279
    end;
280
  end
281
  // auto rotation progress
282
  else
283
  begin
284
    FDelta := FDelta + pt.deltaTime * 2;
285
    v := VectorLerp(FPosAnimationStart, FPosAnimationEnd,
286
      FDelta * FDelta * (3 - 2 * FDelta));
287
    v := VectorScale(VectorNormalize(v), VectorLength(FPosAnimationStart));
288
    if FDelta < 1 then
289
      FCam.Position.SetPoint(v)
290
    else
291
      FCam.Position.SetPoint(FPosAnimationEnd);
292

293
    v := VectorScale(VectorNormalize(v), 10);
294
    if FDelta < 1 then
295
      v := VectorScale(VectorNormalize(v), 10)
296
    else
297
      v := VectorScale(VectorNormalize(FPosAnimationEnd), 10);
298
    FNavCam.Position.SetPoint(v);
299

300
    for i := 2 to FCube.Count - 1 do
301
      with TGLSceneObject(FCube.Children[i]) do
302
        Material.FrontProperties.Diffuse.SetColor(tagfloat, tagfloat, 1);
303
    FInactiveTime := 0;
304
  end;
305
  FSel := -1;
306
  // manual rotation progress
307
  if FMouseRotation and FMouse then
308
  begin
309

310
    mp := mouse.CursorPos;
311
    if FCam <> nil then
312
    begin
313
      FCam.MoveAroundTarget((FMousePos.y - mp.y) * 0.02, (FMousePos.x - mp.x) * 0.02);
314
      FNavCam.MoveAroundTarget((FMousePos.y - mp.y) * 0.02, (FMousePos.x - mp.x) * 0.02);
315
//    FCam.MoveAroundTarget((sH2 - mp.y) * 0.2, (sW2 - mp.x) * 0.2);
316
//  FNavCam.MoveAroundTarget((sH2 - mp.y) * 0.2, (sW2 - mp.x) * 0.2);
317
    end;
318

319
   // mouse.CursorPos := point(sW2, sH2);
320

321
   FInactiveTime := 0;
322
  end
323
  else if FReady then
324
  begin
325
    // selection
326
    if mover and (FDelta > 1) then
327
    begin
328
      v0 := FNavCam.AbsolutePosition;
329
      v1 := FMem.Buffer.ScreenToVector(mp.x - round(FHud.Position.x) + 64,
330
        round(FHud.Position.y) - mp.y + 64);
331
      SetVector(v2, 99999, 99999, 99999);
332

333
      obj := nil;
334
      for i := 2 to FCube.Count - 1 do
335
        with TGLSceneObject(FCube.Children[i]) do
336
        begin
337
          Material.FrontProperties.Diffuse.SetColor(tagfloat, tagfloat, 1);
338
          if RayCastIntersect(v0, v1, @v) then
339
            if VectorDistance2(v2, v0) > VectorDistance2(v, v0) then
340
            begin
341
              SetVector(v2, v);
342
              FSel := FCube.Children[i].tag;
343
              FSelPos := FCube.Children[i].Position.AsVector;
344
              obj := FCube.Children[i];
345
            end;
346
        end;
347
      if FSel >= 0 then
348
      begin
349
        FViewer.cursor := -21;
350
        TGLSceneObject(obj).Material.FrontProperties.Diffuse.SetColor
351
          (1, 0.6, 0);
352
      end
353
      else
354
        FViewer.cursor := 0;
355
    end;
356
    v := VectorScale(VectorNormalize(FCam.AbsoluteVectorToTarget), 10);
357
    FNavCam.Position.SetPoint(VectorNegate(v));
358
    FInactiveTime := FInactiveTime + pt.deltaTime;
359
  end;
360
  // rendering
361
  FTimer := FTimer + pt.deltaTime;
362
  if FTimer > 1 / FFps then
363
  begin
364
    FTimer := FTimer - floor(FTimer * FFps) / FFps;
365
    FMem.Render(FCube);
366
    FMem.CopyToTexture(FHud.Material.Texture);
367
    FReady := true;
368
  end;
369
 // end;
370
end;
371

372
// DoRender (setup)
373
//
374
procedure TGLNavCube.DoRender(var ARci: TGLRenderContextInfo;
375
  ARenderSelf, ARenderChildren: boolean);
376
begin
377
  inherited;
378
  if (FCam = nil) and (scene.CurrentGLCamera <> nil) then
379
  begin
380
    FCam := scene.CurrentGLCamera;
381
    FNavCam.Position.SetPoint
382
      (VectorScale(VectorNormalize(FCam.Position.AsVector), 10));
383
  end;
384
  if FViewer <> nil then
385
    FHud.Position.SetPoint(FViewer.Width - 80, 50, 0);
386
end;
387

388
initialization
389

390
sW2 := screen.Width div 2;
391
sH2 := screen.Height div 2;
392

393
end.
394

395