Statistics
| Branch: | Tag: | Revision:

root / Client / UfrmMain.pas @ 0:95bd93c28625

History | View | Annotate | Download (64.4 kB)

1
(*
2
 * CDDL HEADER START
3
 *
4
 * The contents of this file are subject to the terms of the
5
 * Common Development and Distribution License, Version 1.0 only
6
 * (the "License").  You may not use this file except in compliance
7
 * with the License.
8
 *
9
 * You can obtain a copy of the license at
10
 * http://www.opensource.org/licenses/cddl1.php.
11
 * See the License for the specific language governing permissions
12
 * and limitations under the License.
13
 *
14
 * When distributing Covered Code, include this CDDL HEADER in each
15
 * file and include the License file at
16
 * http://www.opensource.org/licenses/cddl1.php.  If applicable,
17
 * add the following below this CDDL HEADER, with the fields enclosed
18
 * by brackets "[]" replaced with your own identifying * information:
19
 *      Portions Copyright [yyyy] [name of copyright owner]
20
 *
21
 * CDDL HEADER END
22
 *
23
 *
24
 *      Portions Copyright 2007 Andreas Schneider
25
 *)
26
unit UfrmMain;
27
28
{$mode objfpc}{$H+}
29
30
interface
31
32
uses
33
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Menus,
34
  ComCtrls, OpenGLContext, GL, GLU, UGameResources, ULandscape, ExtCtrls,
35
  StdCtrls, Spin, UEnums, VTHeaderPopup, VirtualTrees, Buttons, UMulBlock,
36
  UWorldItem, math, LCLIntf, UOverlayUI, UStatics, UEnhancedMemoryStream,
37
  ActnList, ImagingClasses, contnrs, dateutils, UPlatformTypes;
38
39
type
40
41
  TVirtualTile = class(TStaticItem)
42
  end;
43
  TVirtualTileArray = array of TVirtualTile;
44
45
  { TfrmMain }
46
47
  TfrmMain = class(TForm)
48
    acSelect: TAction;
49
    acDraw: TAction;
50
    acMove: TAction;
51
    acElevate: TAction;
52
    acDelete: TAction;
53
    acHue: TAction;
54
    acBoundaries: TAction;
55
    acFilter: TAction;
56
    acFlat: TAction;
57
    acNoDraw: TAction;
58
    acVirtualLayer: TAction;
59
    ActionList1: TActionList;
60
    ApplicationProperties1: TApplicationProperties;
61
    btnAddLocation: TSpeedButton;
62
    btnClearLocations: TSpeedButton;
63
    btnDeleteLocation: TSpeedButton;
64
    btnGoTo: TButton;
65
    cbRandomPreset: TComboBox;
66
    cbTerrain: TCheckBox;
67
    cbStatics: TCheckBox;
68
    edFilter: TEdit;
69
    edChat: TEdit;
70
    edSearchID: TEdit;
71
    gbRandom: TGroupBox;
72
    ImageList1: TImageList;
73
    lblChatHeaderCaption: TLabel;
74
    lblTipC: TLabel;
75
    lblTip: TLabel;
76
    lblTileInfo: TLabel;
77
    lblFilter: TLabel;
78
    lblX: TLabel;
79
    lblY: TLabel;
80
    lbClients: TListBox;
81
    MainMenu1: TMainMenu;
82
    mnuVirtualLayer: TMenuItem;
83
    mnuGrabTileID: TMenuItem;
84
    mnuGrabHue: TMenuItem;
85
    mnuLargeScaleCommands: TMenuItem;
86
    mnuSetHue: TMenuItem;
87
    mnuGoToClient: TMenuItem;
88
    mnuAbout: TMenuItem;
89
    mnuHelp: TMenuItem;
90
    mnuSeparator3: TMenuItem;
91
    mnuBoundaries: TMenuItem;
92
    mnuSelect: TMenuItem;
93
    mnuDraw: TMenuItem;
94
    mnuMove: TMenuItem;
95
    mnuElevate: TMenuItem;
96
    mnuDelete: TMenuItem;
97
    mnuAddToRandom: TMenuItem;
98
    mnuFlush: TMenuItem;
99
    mnuShutdown: TMenuItem;
100
    mnuSeparator2: TMenuItem;
101
    mnuAccountControl: TMenuItem;
102
    mnuAdministration: TMenuItem;
103
    mnuSeparator1: TMenuItem;
104
    mnuExit: TMenuItem;
105
    mnuDisconnect: TMenuItem;
106
    mnuCentrED: TMenuItem;
107
    oglGameWindow: TOpenGLControl;
108
    pnlRandomPreset: TPanel;
109
    pnlLocationControls: TPanel;
110
    pnlChat: TPanel;
111
    pnlChatHeader: TPanel;
112
    pnlMain: TPanel;
113
    pnlRandomControl: TPanel;
114
    pnlTileListSettings: TPanel;
115
    pcLeft: TPageControl;
116
    pnlBottom: TPanel;
117
    edX: TSpinEdit;
118
    edY: TSpinEdit;
119
    pmTileList: TPopupMenu;
120
    btnAddRandom: TSpeedButton;
121
    btnDeleteRandom: TSpeedButton;
122
    btnClearRandom: TSpeedButton;
123
    pmTools: TPopupMenu;
124
    pmClients: TPopupMenu;
125
    pmGrabTileInfo: TPopupMenu;
126
    spChat: TSplitter;
127
    btnRandomPresetSave: TSpeedButton;
128
    btnRandomPresetDelete: TSpeedButton;
129
    spTileList: TSplitter;
130
    tbFilter: TToolButton;
131
    tbFlat: TToolButton;
132
    tbNoDraw: TToolButton;
133
    tmTileHint: TTimer;
134
    tsLocations: TTabSheet;
135
    tbSetHue: TToolButton;
136
    tmGrabTileInfo: TTimer;
137
    tmMovement: TTimer;
138
    tbSeparator4: TToolButton;
139
    tbRadarMap: TToolButton;
140
    tbVirtualLayer: TToolButton;
141
    tsClients: TTabSheet;
142
    tbMain: TToolBar;
143
    tbDisconnect: TToolButton;
144
    tbSeparator1: TToolButton;
145
    tbSelect: TToolButton;
146
    tbDrawTile: TToolButton;
147
    tbMoveTile: TToolButton;
148
    tbElevateTile: TToolButton;
149
    tbDeleteTile: TToolButton;
150
    tbSeparator2: TToolButton;
151
    tbBoundaries: TToolButton;
152
    tbSeparator3: TToolButton;
153
    tbTerrain: TToolButton;
154
    tbStatics: TToolButton;
155
    tsTiles: TTabSheet;
156
    vdtTiles: TVirtualDrawTree;
157
    vdtRandom: TVirtualDrawTree;
158
    vstLocations: TVirtualStringTree;
159
    vstChat: TVirtualStringTree;
160
    procedure acBoundariesExecute(Sender: TObject);
161
    procedure acDeleteExecute(Sender: TObject);
162
    procedure acDrawExecute(Sender: TObject);
163
    procedure acElevateExecute(Sender: TObject);
164
    procedure acFilterExecute(Sender: TObject);
165
    procedure acFlatExecute(Sender: TObject);
166
    procedure acHueExecute(Sender: TObject);
167
    procedure acMoveExecute(Sender: TObject);
168
    procedure acNoDrawExecute(Sender: TObject);
169
    procedure acSelectExecute(Sender: TObject);
170
    procedure acVirtualLayerExecute(Sender: TObject);
171
    procedure ApplicationProperties1Idle(Sender: TObject; var Done: Boolean);
172
    procedure btnAddLocationClick(Sender: TObject);
173
    procedure btnAddRandomClick(Sender: TObject);
174
    procedure btnClearLocationsClick(Sender: TObject);
175
    procedure btnClearRandomClick(Sender: TObject);
176
    procedure btnDeleteLocationClick(Sender: TObject);
177
    procedure btnDeleteRandomClick(Sender: TObject);
178
    procedure btnGoToClick(Sender: TObject);
179
    procedure btnRandomPresetDeleteClick(Sender: TObject);
180
    procedure btnRandomPresetSaveClick(Sender: TObject);
181
    procedure cbRandomPresetChange(Sender: TObject);
182
    procedure cbStaticsChange(Sender: TObject);
183
    procedure cbTerrainChange(Sender: TObject);
184
    procedure edChatKeyPress(Sender: TObject; var Key: char);
185
    procedure edFilterEditingDone(Sender: TObject);
186
    procedure FormActivate(Sender: TObject);
187
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
188
    procedure FormCreate(Sender: TObject);
189
    procedure FormDestroy(Sender: TObject);
190
    procedure edSearchIDExit(Sender: TObject);
191
    procedure edSearchIDKeyPress(Sender: TObject; var Key: char);
192
    procedure lblChatHeaderCaptionClick(Sender: TObject);
193
    procedure lblChatHeaderCaptionMouseEnter(Sender: TObject);
194
    procedure lblChatHeaderCaptionMouseLeave(Sender: TObject);
195
    procedure mnuAboutClick(Sender: TObject);
196
    procedure mnuAccountControlClick(Sender: TObject);
197
    procedure mnuDisconnectClick(Sender: TObject);
198
    procedure mnuExitClick(Sender: TObject);
199
    procedure mnuFlushClick(Sender: TObject);
200
    procedure mnuGoToClientClick(Sender: TObject);
201
    procedure mnuGrabHueClick(Sender: TObject);
202
    procedure mnuGrabTileIDClick(Sender: TObject);
203
    procedure mnuLargeScaleCommandsClick(Sender: TObject);
204
    procedure mnuShutdownClick(Sender: TObject);
205
    procedure oglGameWindowDblClick(Sender: TObject);
206
    procedure oglGameWindowMouseDown(Sender: TObject; Button: TMouseButton;
207
      Shift: TShiftState; X, Y: Integer);
208
    procedure oglGameWindowMouseEnter(Sender: TObject);
209
    procedure oglGameWindowMouseLeave(Sender: TObject);
210
    procedure oglGameWindowMouseMove(Sender: TObject; Shift: TShiftState; X,
211
      Y: Integer);
212
    procedure oglGameWindowMouseUp(Sender: TObject; Button: TMouseButton;
213
      Shift: TShiftState; X, Y: Integer);
214
    procedure oglGameWindowMouseWheel(Sender: TObject; Shift: TShiftState;
215
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
216
    procedure oglGameWindowPaint(Sender: TObject);
217
    procedure pmGrabTileInfoPopup(Sender: TObject);
218
    procedure tbFilterMouseMove(Sender: TObject; Shift: TShiftState; X,
219
      Y: Integer);
220
    procedure tbRadarMapClick(Sender: TObject);
221
    procedure tmGrabTileInfoTimer(Sender: TObject);
222
    procedure tmMovementTimer(Sender: TObject);
223
    procedure tmTileHintTimer(Sender: TObject);
224
    procedure vdtRandomDragDrop(Sender: TBaseVirtualTree; Source: TObject;
225
      DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState;
226
      Pt: TPoint; var Effect: Integer; Mode: TDropMode);
227
    procedure vdtRandomDragOver(Sender: TBaseVirtualTree; Source: TObject;
228
      Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode;
229
      var Effect: Integer; var Accept: Boolean);
230
    procedure vdtRandomLoadNode(Sender: TBaseVirtualTree; Node: PVirtualNode;
231
      Stream: TStream);
232
    procedure vdtRandomSaveNode(Sender: TBaseVirtualTree; Node: PVirtualNode;
233
      Stream: TStream);
234
    procedure vdtRandomUpdating(Sender: TBaseVirtualTree; State: TVTUpdateState);
235
    procedure vdtTilesClick(Sender: TObject);
236
    procedure vdtTilesDrawNode(Sender: TBaseVirtualTree;
237
      const PaintInfo: TVTPaintInfo);
238
    procedure vdtTilesEnter(Sender: TObject);
239
    procedure vdtTilesExit(Sender: TObject);
240
    procedure vdtTilesHotChange(Sender: TBaseVirtualTree; OldNode,
241
      NewNode: PVirtualNode);
242
    procedure vdtTilesKeyPress(Sender: TObject; var Key: char);
243
    procedure vdtTilesMouseMove(Sender: TObject; Shift: TShiftState; X,
244
      Y: Integer);
245
    procedure vdtTilesScroll(Sender: TBaseVirtualTree; DeltaX, DeltaY: Integer);
246
    procedure vstChatClick(Sender: TObject);
247
    procedure vstChatGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
248
      Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
249
    procedure vstChatPaintText(Sender: TBaseVirtualTree;
250
      const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
251
      TextType: TVSTTextType);
252
    procedure vstLocationsDblClick(Sender: TObject);
253
    procedure vstLocationsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
254
      Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
255
    procedure vstLocationsLoadNode(Sender: TBaseVirtualTree;
256
      Node: PVirtualNode; Stream: TStream);
257
    procedure vstLocationsNewText(Sender: TBaseVirtualTree; Node: PVirtualNode;
258
      Column: TColumnIndex; NewText: WideString);
259
    procedure vstLocationsSaveNode(Sender: TBaseVirtualTree;
260
      Node: PVirtualNode; Stream: TStream);
261
  protected
262
    FX: Integer;
263
    FY: Integer;
264
    FLandscape: TLandscape;
265
    FTextureManager: TLandTextureManager;
266
    FScreenBuffer: TScreenBuffer;
267
    FCurrentTile: TWorldItem;
268
    FSelectedTile: TWorldItem;
269
    FGhostTile: TWorldItem;
270
    FVirtualLayer: array of TVirtualTileArray;
271
    FVLayerMaterial: TMaterial;
272
    FOverlayUI: TOverlayUI;
273
    FLocationsFile: string;
274
    FRandomPresetLocation: string;
275
    FLastDraw: TDateTime;
276
    procedure SetX(const AValue: Integer);
277
    procedure SetY(const AValue: Integer);
278
    procedure SetCurrentTile(const AValue: TWorldItem);
279
    procedure SetSelectedTile(const AValue: TWorldItem);
280
    procedure InitRender;
281
    procedure InitSize;
282
    procedure Render;
283
    procedure OnLandscapeChanged;
284
    procedure BuildTileList;
285
    procedure ProcessToolState;
286
    procedure ProcessAccessLevel;
287
    procedure UpdateCurrentTile;
288
    procedure UpdateCurrentTile(AX, AY: Integer);
289
    procedure TileRemoved(ATile: TMulBlock);
290
    procedure WriteChatMessage(ASender, AMessage: string);
291
    procedure PrepareVirtualLayer(AWidth, AHeight: Word);
292
    procedure OnClientHandlingPacket(ABuffer: TEnhancedMemoryStream);
293
    function GetInternalTileID(ATile: TWorldItem): Word;
294
    function GetSelectedRect: TRect;
295
    function ConfirmAction: Boolean;
296
    function CanBeModified(ATile: TWorldItem): Boolean;
297
  public
298
    property X: Integer read FX write SetX;
299
    property Y: Integer read FY write SetY;
300
    property Landscape: TLandscape read FLandscape;
301
    property CurrentTile: TWorldItem read FCurrentTile write SetCurrentTile;
302
    property SelectedTile: TWorldItem read FSelectedTile write SetSelectedTile;
303
    
304
    procedure SetPos(AX, AY: Word);
305
  end; 
306
307
var
308
  frmMain: TfrmMain;
309
310
implementation
311
312
uses
313
  UdmNetwork, UMap, UArt, UTiledata, UHue, UAdminHandling, UPackets,
314
  UfrmAccountControl, UGraphicHelper, ImagingComponents, UfrmDrawSettings,
315
  UfrmBoundaries, UfrmElevateSettings, UfrmConfirmation, UfrmMoveSettings,
316
  UfrmAbout, UPacketHandlers, UfrmHueSettings, UfrmRadar, UfrmLargeScaleCommand,
317
  UfrmLogin, UResourceManager, UfrmVirtualLayer, UfrmFilter, UfrmTileInfo;
318
319
type
320
  TGLArrayf4 = array[0..3] of GLfloat;
321
  PTileInfo = ^TTileInfo;
322
  TTileInfo = record
323
    ID: Word;
324
  end;
325
  PChatInfo = ^TChatInfo;
326
  TChatInfo = record
327
    Time: TDateTime;
328
    Sender: string;
329
    Msg: string;
330
  end;
331
  PLocationInfo = ^TLocationInfo;
332
  TLocationInfo = record
333
    X: Word;
334
    Y: Word;
335
    Name: string;
336
  end;
337
338
{ TfrmMain }
339
340
procedure TfrmMain.mnuExitClick(Sender: TObject);
341
begin
342
  Close;
343
end;
344
345
procedure TfrmMain.mnuFlushClick(Sender: TObject);
346
begin
347
  dmNetwork.Send(TFlushServerPacket.Create);
348
end;
349
350
procedure TfrmMain.mnuGoToClientClick(Sender: TObject);
351
begin
352
  if lbClients.ItemIndex > -1 then
353
    dmNetwork.Send(TGotoClientPosPacket.Create(lbClients.Items.Strings[lbClients.ItemIndex]));
354
end;
355
356
procedure TfrmMain.mnuGrabHueClick(Sender: TObject);
357
begin
358
  if CurrentTile is TStaticItem then
359
  begin
360
    frmHueSettings.lbHue.ItemIndex := TStaticItem(CurrentTile).Hue;
361
    frmFilter.JumpToHue(TStaticItem(CurrentTile).Hue);
362
  end;
363
end;
364
365
procedure TfrmMain.mnuGrabTileIDClick(Sender: TObject);
366
var
367
  internalTileID: Integer;
368
  node: PVirtualNode;
369
  tileInfo: PTileInfo;
370
begin
371
  if CurrentTile <> nil then
372
  begin
373
    internalTileID := GetInternalTileID(CurrentTile);
374
    node := vdtTiles.GetFirst;
375
    while node <> nil do
376
    begin
377
      tileInfo := vdtTiles.GetNodeData(node);
378
      if tileInfo^.ID = internalTileID then
379
      begin
380
        vdtTiles.ClearSelection;
381
        vdtTiles.Selected[node] := True;
382
        vdtTiles.FocusedNode := node;
383
        Break;
384
      end;
385
      node := vdtTiles.GetNext(node);
386
    end;
387
  end;
388
end;
389
390
procedure TfrmMain.mnuLargeScaleCommandsClick(Sender: TObject);
391
begin
392
  frmLargeScaleCommand.Show;
393
end;
394
395
procedure TfrmMain.mnuShutdownClick(Sender: TObject);
396
begin
397
  dmNetwork.Send(TQuitServerPacket.Create(''));
398
end;
399
400
procedure TfrmMain.oglGameWindowDblClick(Sender: TObject);
401
begin
402
  if (acSelect.Checked) and (CurrentTile <> nil) then
403
    btnAddRandomClick(Sender);
404
end;
405
406
procedure TfrmMain.oglGameWindowMouseDown(Sender: TObject;
407
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
408
begin
409
  if Button = mbRight then
410
    pmTools.PopUp(Mouse.CursorPos.X, Mouse.CursorPos.Y);
411
    
412
  if Button <> mbLeft then
413
    Exit;
414
415
  UpdateCurrentTile(X, Y);
416
  if FOverlayUI.ActiveArrow > -1 then
417
    tmMovement.Enabled := True;
418
  
419
  SelectedTile := CurrentTile;
420
  if CurrentTile = nil then Exit;
421
422
  if acSelect.Checked then                        //***** Selection Mode *****//
423
    tmGrabTileInfo.Enabled := True;
424
end;
425
426
procedure TfrmMain.oglGameWindowMouseEnter(Sender: TObject);
427
begin
428
  if Active then
429
    oglGameWindow.SetFocus;
430
431
  FOverlayUI.Visible := True;
432
433
  if frmFilter.Visible then
434
  begin
435
    frmFilter.Locked := True;
436
    frmFilter.Hide;
437
    frmFilter.Locked := False;
438
  end;
439
end;
440
441
procedure TfrmMain.oglGameWindowMouseLeave(Sender: TObject);
442
begin
443
  if not (frmConfirmation.Visible or
444
          (frmMoveSettings.Visible and (fsModal in frmMoveSettings.FormState))
445
         ) then //during confirmation the mouse would leave ...
446
  begin
447
    lblTileInfo.Caption := '';
448
    CurrentTile := nil;
449
    FOverlayUI.Visible := False;
450
  end;
451
end;
452
453
procedure TfrmMain.oglGameWindowMouseMove(Sender: TObject; Shift: TShiftState;
454
  X, Y: Integer);
455
var
456
  lastTile: TWorldItem;
457
  offsetX, offsetY: Integer;
458
begin
459
  lastTile := CurrentTile;
460
  
461
  if ssMiddle in Shift then
462
  begin
463
    UpdateCurrentTile(X, Y);
464
    if (lastTile <> nil) and (CurrentTile <> nil) and (lastTile <> CurrentTile) then
465
    begin
466
      offsetX := lastTile.X - CurrentTile.X;
467
      offsetY := lastTile.Y - CurrentTile.Y;
468
      if InRange(offsetX, -8, 8) and InRange(offsetY, -8, 8) then
469
        SetPos(FX - offsetX * 4, FY - offsetY * 4);
470
    end;
471
  end;
472
  
473
  lblTileInfo.Caption := '';
474
  CurrentTile := nil;
475
476
  UpdateCurrentTile(X, Y);
477
end;
478
479
procedure TfrmMain.oglGameWindowMouseUp(Sender: TObject; Button: TMouseButton;
480
  Shift: TShiftState; X, Y: Integer);
481
var
482
  node: PVirtualNode;
483
  tileInfo: PTileInfo;
484
  map: TMapCell;
485
  i: Integer;
486
  z: ShortInt;
487
  blockInfo: PBlockInfo;
488
  targetRect: TRect;
489
  tileX, tileY: Word;
490
  offsetX, offsetY: Integer;
491
  tile: TWorldItem;
492
  targetTiles: TList;
493
  targetTile: TWorldItem;
494
begin
495
  if Button <> mbLeft then
496
    Exit;
497
498
  UpdateCurrentTile(X, Y);
499
  tmMovement.Enabled := False;
500
  if CurrentTile = nil then Exit;
501
  targetTile := CurrentTile;
502
  
503
  if acSelect.Checked and tmGrabTileInfo.Enabled then
504
  begin
505
    tmGrabTileInfo.Enabled := False;
506
    mnuGrabTileIDClick(nil);
507
  end;
508
509
  if (not acSelect.Checked) and (targetTile <> nil) then
510
  begin
511
    targetRect := GetSelectedRect;
512
513
    if (SelectedTile = targetTile) or ConfirmAction then
514
    begin
515
      if acDraw.Checked then                        //***** Drawing Mode *****//
516
      begin
517
        if FGhostTile <> nil then
518
        begin
519
          for tileX := targetRect.Left to targetRect.Right - 1 do
520
          begin
521
            for tileY := targetRect.Top to targetRect.Bottom - 1 do
522
            begin
523
              tileInfo := nil;
524
              if frmDrawSettings.rbTileList.Checked then
525
              begin
526
                node := vdtTiles.GetFirstSelected;
527
                if node <> nil then
528
                  tileInfo := vdtTiles.GetNodeData(node);
529
              end else if frmDrawSettings.rbRandom.Checked then
530
              begin
531
                node := vdtRandom.GetFirst;
532
                for i := 1 to Random(vdtRandom.RootNodeCount) do
533
                  node := vdtRandom.GetNext(node);
534
535
                if node <> nil then
536
                  tileInfo := vdtRandom.GetNodeData(node);
537
              end;
538
539
              if tileInfo^.ID < $4000 then
540
              begin
541
                map := FLandscape.MapCell[tileX, tileY];
542
                if frmDrawSettings.cbForceAltitude.Checked then
543
                  map.Altitude := frmDrawSettings.seForceAltitude.Value;
544
                dmNetwork.Send(TDrawMapPacket.Create(map.X, map.Y, map.Z, tileInfo^.ID));
545
              end else
546
              begin
547
                dmNetwork.Send(TInsertStaticPacket.Create(tileX, tileY,
548
                  FGhostTile.Z, tileInfo^.ID - $4000,
549
                  TStaticItem(FGhostTile).Hue));
550
              end;
551
            end;
552
          end;
553
        end;
554
      end else if (SelectedTile <> targetTile) or CanBeModified(targetTile) then
555
      begin
556
        if (not acMove.Checked) or (SelectedTile <> targetTile) or
557
           (not frmMoveSettings.cbAsk.Checked) or ConfirmAction then
558
        begin
559
          targetTiles := TList.Create;
560
          if SelectedTile = targetTile then
561
          begin
562
            targetTiles.Add(targetTile)
563
          end else
564
          begin
565
            blockInfo := nil;
566
            while FScreenBuffer.Iterate(blockInfo) do
567
            begin
568
              if PtInRect(targetRect, Point(blockInfo^.Item.X, blockInfo^.Item.Y)) and
569
                CanBeModified(blockInfo^.Item) then
570
                targetTiles.Insert(0, blockInfo^.Item);
571
            end;
572
          end;
573
574
          if acMove.Checked then                       //***** Move tile *****//
575
          begin
576
            offsetX := frmMoveSettings.GetOffsetX;
577
            offsetY := frmMoveSettings.GetOffsetY;
578
            for i := 0 to targetTiles.Count - 1 do
579
            begin
580
              tile := TWorldItem(targetTiles.Items[i]);
581
582
              if tile is TStaticItem then
583
              begin
584
                dmNetwork.Send(TMoveStaticPacket.Create(TStaticItem(tile),
585
                  EnsureRange(tile.X + offsetX, 0, FLandscape.CellWidth - 1),
586
                  EnsureRange(tile.Y + offsetY, 0, FLandscape.CellHeight - 1)));
587
              end;
588
            end;
589
          end else if acElevate.Checked then        //***** Elevate tile *****//
590
          begin
591
            for i := 0 to targetTiles.Count - 1 do
592
            begin
593
              tile := TWorldItem(targetTiles.Items[i]);
594
595
              z := frmElevateSettings.seZ.Value;
596
              if frmElevateSettings.rbRaise.Checked then
597
                z := EnsureRange(tile.Z + z, -128, 127)
598
              else if frmElevateSettings.rbLower.Checked then
599
                z := EnsureRange(tile.Z - z, -128, 127);
600
601
              if tile is TMapCell then
602
              begin
603
                dmNetwork.Send(TDrawMapPacket.Create(tile.X, tile.Y,
604
                  z, tile.TileID));
605
              end else
606
              begin
607
                dmNetwork.Send(TElevateStaticPacket.Create(TStaticItem(tile), z));
608
              end;
609
            end;
610
          end else if acDelete.Checked then          //***** Delete tile *****//
611
          begin
612
            for i := 0 to targetTiles.Count - 1 do
613
            begin
614
              tile := TWorldItem(targetTiles.Items[i]);
615
616
              if tile is TStaticItem then
617
                dmNetwork.Send(TDeleteStaticPacket.Create(TStaticItem(tile)));
618
            end;
619
          end else if acHue.Checked then                //***** Hue tile *****//
620
          begin
621
            for i := 0 to targetTiles.Count - 1 do
622
            begin
623
              tile := TWorldItem(targetTiles.Items[i]);
624
625
              if (tile is TStaticItem) and
626
                (TStaticItem(tile).Hue <> frmHueSettings.lbHue.ItemIndex) then
627
              begin
628
                dmNetwork.Send(THueStaticPacket.Create(TStaticItem(tile),
629
                  frmHueSettings.lbHue.ItemIndex));
630
              end;
631
            end;
632
          end;
633
634
          targetTiles.Free;
635
        end;
636
      end;
637
    end;
638
  end;
639
  SelectedTile := nil;
640
end;
641
642
procedure TfrmMain.oglGameWindowMouseWheel(Sender: TObject; Shift: TShiftState;
643
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
644
var
645
  cursorNeedsUpdate: Boolean;
646
begin
647
  cursorNeedsUpdate := False;
648
  if (CurrentTile is TVirtualTile) or ((ssCtrl in Shift) and (frmVirtualLayer.cbShowLayer.Checked)) then
649
  begin
650
    frmVirtualLayer.seZ.Value := EnsureRange(frmVirtualLayer.seZ.Value + WheelDelta, -128, 127);
651
    cursorNeedsUpdate := True;
652
    Handled := True;
653
  end else if not (ssCtrl in Shift) then
654
  begin
655
    if CurrentTile is TStaticItem then
656
    begin
657
      dmNetwork.Send(TElevateStaticPacket.Create(TStaticItem(CurrentTile),
658
        EnsureRange(CurrentTile.Z + WheelDelta, -128, 127)));
659
      cursorNeedsUpdate := True;
660
      Handled := True;
661
    end else if CurrentTile is TMapCell then
662
    begin
663
      dmNetwork.Send(TDrawMapPacket.Create(CurrentTile.X, CurrentTile.Y,
664
        EnsureRange(CurrentTile.Z + WheelDelta, -128, 127), CurrentTile.TileID));
665
      Handled := True;
666
    end;
667
  end;
668
  
669
  if cursorNeedsUpdate then
670
  begin
671
    SetCursorPos(Mouse.CursorPos.X, Mouse.CursorPos.Y - 4 * WheelDelta);
672
    UpdateCurrentTile(MousePos.X, MousePos.Y - 4 * WheelDelta);
673
  end;
674
end;
675
676
procedure TfrmMain.FormCreate(Sender: TObject);
677
var
678
  virtualLayerGraphic: TSingleImage;
679
  searchRec: TSearchRec;
680
begin
681
  FLandscape := ResMan.Landscape;
682
  FLandscape.OnChange := @OnLandscapeChanged;
683
  FTextureManager := TLandTextureManager.Create;
684
  FScreenBuffer := TScreenBuffer.Create;
685
  X := 0;
686
  Y := 0;
687
  edX.MaxValue := FLandscape.CellWidth;
688
  edY.MaxValue := FLandscape.CellHeight;
689
  FOverlayUI := TOverlayUI.Create;
690
  
691
  ProcessAccessLevel;
692
  
693
  vdtTiles.NodeDataSize := SizeOf(TTileInfo);
694
  vdtRandom.NodeDataSize := SizeOf(TTileInfo);
695
  BuildTileList;
696
  Randomize;
697
  
698
  vstChat.NodeDataSize := SizeOf(TChatInfo);
699
  
700
  FLocationsFile := IncludeTrailingPathDelimiter(ExtractFilePath(
701
                    Application.ExeName)) + 'Locations.dat';
702
  vstLocations.NodeDataSize := SizeOf(TLocationInfo);
703
  if FileExists(FLocationsFile) then vstLocations.LoadFromFile(FLocationsFile);
704
705
  RegisterPacketHandler($0C, TPacketHandler.Create(0, @OnClientHandlingPacket));
706
707
  virtualLayerGraphic := TSingleImage.CreateFromStream(ResourceManager.GetResource(2));
708
  FVLayerMaterial := TMaterial.Create(virtualLayerGraphic.Width, virtualLayerGraphic.Height,
709
    virtualLayerGraphic);
710
  virtualLayerGraphic.Free;
711
  
712
  FRandomPresetLocation := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName)) + 'RandomPresets' + PathDelim;
713
  if not DirectoryExists(FRandomPresetLocation) then CreateDir(FRandomPresetLocation);
714
  if FindFirst(FRandomPresetLocation + '*.dat', faAnyFile, searchRec) = 0 then
715
  begin
716
    repeat
717
      cbRandomPreset.Items.Add(ChangeFileExt(searchRec.Name, ''));
718
    until FindNext(searchRec) <> 0;
719
  end;
720
  FindClose(searchRec);
721
  
722
  FLastDraw := Now;
723
end;
724
725
procedure TfrmMain.btnGoToClick(Sender: TObject);
726
begin
727
  SetPos(edX.Value, edY.Value);
728
end;
729
730
procedure TfrmMain.btnRandomPresetDeleteClick(Sender: TObject);
731
begin
732
  if cbRandomPreset.ItemIndex > -1 then
733
  begin
734
    DeleteFile(FRandomPresetLocation + cbRandomPreset.Text + '.dat');
735
    cbRandomPreset.Items.Delete(cbRandomPreset.ItemIndex);
736
    cbRandomPreset.ItemIndex := -1;
737
  end;
738
end;
739
740
procedure TfrmMain.btnRandomPresetSaveClick(Sender: TObject);
741
var
742
  fileName: string;
743
  index: Integer;
744
begin
745
  fileName := cbRandomPreset.Text;
746
  if InputQuery('Save Preset', 'Enter the name of the preset:', fileName) then
747
  begin
748
    vdtRandom.SaveToFile(FRandomPresetLocation + fileName + '.dat');;
749
    index := cbRandomPreset.Items.IndexOf(fileName);
750
    if index = -1 then
751
    begin
752
      cbRandomPreset.Items.Add(fileName);
753
      index := cbRandomPreset.Items.Count - 1;
754
    end;
755
    cbRandomPreset.ItemIndex := index;
756
  end;
757
end;
758
759
procedure TfrmMain.cbRandomPresetChange(Sender: TObject);
760
begin
761
  if cbRandomPreset.ItemIndex > -1 then
762
    vdtRandom.LoadFromFile(FRandomPresetLocation + cbRandomPreset.Text + '.dat');
763
end;
764
765
procedure TfrmMain.btnAddRandomClick(Sender: TObject);
766
var
767
  selected, node: PVirtualNode;
768
  sourceTileInfo, targetTileInfo: PTileInfo;
769
begin
770
  vdtRandom.BeginUpdate;
771
  selected := vdtTiles.GetFirstSelected;
772
  while selected <> nil do
773
  begin
774
    sourceTileInfo := vdtTiles.GetNodeData(selected);
775
    node := vdtRandom.AddChild(nil);
776
    targetTileInfo := vdtRandom.GetNodeData(node);
777
    targetTileInfo^.ID := sourceTileInfo^.ID;
778
    selected := vdtTiles.GetNextSelected(selected);
779
  end;
780
  vdtRandom.EndUpdate;
781
end;
782
783
procedure TfrmMain.btnClearLocationsClick(Sender: TObject);
784
begin
785
  if MessageDlg('Are you sure you want to delete all saved locations?', mtConfirmation,
786
    [mbYes, mbNo], 0) = mrYes then
787
  begin
788
    vstLocations.Clear;
789
  end;
790
end;
791
792
procedure TfrmMain.ApplicationProperties1Idle(Sender: TObject; var Done: Boolean);
793
begin
794
  if MilliSecondsBetween(FLastDraw, Now) > 30 then
795
  begin
796
    oglGameWindow.Repaint;
797
    FLastDraw := Now;
798
  end;
799
end;
800
801
procedure TfrmMain.btnAddLocationClick(Sender: TObject);
802
var
803
  locationName: string;
804
  locationInfo: PLocationInfo;
805
begin
806
  locationName := '';
807
  if InputQuery('New Location', 'Enter the name of the new location:', locationName) then
808
  begin
809
    locationInfo := vstLocations.GetNodeData(vstLocations.AddChild(nil));
810
    locationInfo^.X := X;
811
    locationInfo^.Y := Y;
812
    locationInfo^.Name := locationName;
813
  end;
814
end;
815
816
procedure TfrmMain.acSelectExecute(Sender: TObject);
817
begin
818
  acSelect.Checked := True;
819
  tbSelect.Down := True;
820
  mnuSelect.Checked := True;
821
  ProcessToolState;
822
end;
823
824
procedure TfrmMain.acVirtualLayerExecute(Sender: TObject);
825
begin
826
  frmVirtualLayer.Left := Mouse.CursorPos.x - 8;
827
  frmVirtualLayer.Top := Mouse.CursorPos.y - 8;
828
  frmVirtualLayer.Show;
829
end;
830
831
procedure TfrmMain.acDrawExecute(Sender: TObject);
832
begin
833
  acDraw.Checked := True;
834
  tbDrawTile.Down := True;
835
  mnuDraw.Checked := True;
836
  frmDrawSettings.Left := Mouse.CursorPos.x - 8;
837
  frmDrawSettings.Top := Mouse.CursorPos.y - 8;
838
  frmDrawSettings.ShowModal;
839
  ProcessToolState;
840
end;
841
842
procedure TfrmMain.acDeleteExecute(Sender: TObject);
843
begin
844
  acDelete.Checked := True;
845
  tbDeleteTile.Down := True;
846
  mnuDelete.Checked := True;
847
  ProcessToolState;
848
end;
849
850
procedure TfrmMain.acBoundariesExecute(Sender: TObject);
851
begin
852
  frmBoundaries.Left := Mouse.CursorPos.x - 8;
853
  frmBoundaries.Top := Mouse.CursorPos.y - 8;
854
  frmBoundaries.Show;
855
end;
856
857
procedure TfrmMain.acElevateExecute(Sender: TObject);
858
begin
859
  acElevate.Checked := True;
860
  tbElevateTile.Down := True;
861
  mnuElevate.Checked := True;
862
  ProcessToolState;
863
  frmElevateSettings.Left := Mouse.CursorPos.x - 8;
864
  frmElevateSettings.Top := Mouse.CursorPos.y - 8;
865
  frmElevateSettings.Show;
866
end;
867
868
procedure TfrmMain.acFilterExecute(Sender: TObject);
869
begin
870
  if acFilter.Checked then
871
  begin
872
    frmFilter.Show;
873
    frmFilter.Locked := False;
874
  end else
875
    frmFilter.Hide;
876
end;
877
878
procedure TfrmMain.acFlatExecute(Sender: TObject);
879
begin
880
  acFlat.Checked := not acFlat.Checked;
881
end;
882
883
procedure TfrmMain.acHueExecute(Sender: TObject);
884
begin
885
  acHue.Checked := True;
886
  tbSetHue.Down := True;
887
  mnuSetHue.Checked := True;
888
  ProcessToolState;
889
  frmHueSettings.Left := Mouse.CursorPos.x - 8;
890
  frmHueSettings.Top := Mouse.CursorPos.y - 8;
891
  frmHueSettings.Show;
892
end;
893
894
procedure TfrmMain.acMoveExecute(Sender: TObject);
895
begin
896
  acMove.Checked := True;
897
  tbMoveTile.Down := True;
898
  mnuMove.Checked := True;
899
  ProcessToolState;
900
  frmMoveSettings.Left := Mouse.CursorPos.x - 8;
901
  frmMoveSettings.Top := Mouse.CursorPos.y - 8;
902
  frmMoveSettings.Show;
903
end;
904
905
procedure TfrmMain.acNoDrawExecute(Sender: TObject);
906
begin
907
  acNoDraw.Checked := not acNoDraw.Checked;
908
end;
909
910
procedure TfrmMain.btnClearRandomClick(Sender: TObject);
911
begin
912
  vdtRandom.BeginUpdate;
913
  vdtRandom.Clear;
914
  vdtRandom.EndUpdate;
915
end;
916
917
procedure TfrmMain.btnDeleteLocationClick(Sender: TObject);
918
begin
919
  vstLocations.DeleteSelectedNodes;
920
end;
921
922
procedure TfrmMain.btnDeleteRandomClick(Sender: TObject);
923
begin
924
  vdtRandom.BeginUpdate;
925
  vdtRandom.DeleteSelectedNodes;
926
  vdtRandom.EndUpdate;
927
end;
928
929
procedure TfrmMain.cbStaticsChange(Sender: TObject);
930
begin
931
  if (not cbStatics.Checked) and (not cbTerrain.Checked) then
932
    cbTerrain.Checked := True;
933
  BuildTileList;
934
end;
935
936
procedure TfrmMain.cbTerrainChange(Sender: TObject);
937
begin
938
  if (not cbTerrain.Checked) and (not cbStatics.Checked) then
939
    cbStatics.Checked := True;
940
  BuildTileList;
941
end;
942
943
procedure TfrmMain.edChatKeyPress(Sender: TObject; var Key: char);
944
begin
945
  if Key = #13 then
946
  begin
947
    Key := #0;
948
    if edChat.Text <> '' then
949
    begin
950
      dmNetwork.Send(TChatMessagePacket.Create(edChat.Text));
951
      edChat.Text := '';
952
    end;
953
  end;
954
end;
955
956
procedure TfrmMain.edFilterEditingDone(Sender: TObject);
957
begin
958
  BuildTileList;
959
end;
960
961
procedure TfrmMain.FormActivate(Sender: TObject);
962
begin
963
  if oglGameWindow.MouseEntered then
964
    oglGameWindowMouseEnter(Sender);
965
end;
966
967
procedure TfrmMain.FormClose(Sender: TObject; var CloseAction: TCloseAction);
968
begin
969
  dmNetwork.CheckClose(Self);
970
end;
971
972
procedure TfrmMain.FormDestroy(Sender: TObject);
973
begin
974
  CurrentTile := nil;
975
  SelectedTile := nil;
976
  
977
  vstLocations.SaveToFile(FLocationsFile);
978
979
  if FTextureManager <> nil then FreeAndNil(FTextureManager);
980
  if FScreenBuffer <> nil then FreeAndNil(FScreenBuffer);
981
  if FOverlayUI <> nil then FreeAndNil(FOverlayUI);
982
  if FGhostTile <> nil then FreeAndNil(FGhostTile);
983
  if FVLayerMaterial <> nil then FreeAndNil(FVLayerMaterial);
984
  PrepareVirtualLayer(0, 0); //Clear
985
  
986
  RegisterPacketHandler($0C, nil);
987
end;
988
989
procedure TfrmMain.edSearchIDExit(Sender: TObject);
990
begin
991
  edSearchID.Visible := False;
992
  edSearchID.Text := '';
993
  //edSearchID.Font.Color := clWindowText;
994
end;
995
996
procedure TfrmMain.edSearchIDKeyPress(Sender: TObject; var Key: char);
997
var
998
  enteredText: String;
999
  tileID: Integer;
1000
  tileType: Char;
1001
  node: PVirtualNode;
1002
  tileInfo: PTileInfo;
1003
begin
1004
  if Key = #13 then
1005
  begin
1006
    Key := #0;
1007
    enteredText := edSearchID.Text;
1008
    tileType := #0;
1009
    if Length(enteredText) > 1 then
1010
      tileType := enteredText[Length(enteredText)];
1011
1012
    if not (tileType in ['S', 'T']) then
1013
    begin
1014
      if cbTerrain.Checked then
1015
        tileType := 'T'
1016
      else
1017
        tileType := 'S';
1018
    end else
1019
      Delete(enteredText, Length(enteredText), 1);
1020
    
1021
    if not TryStrToInt(enteredText, tileID) then
1022
    begin
1023
      //edSearchID.Font.Color := clRed;
1024
      MessageDlg('Error', 'The specified TileID is invalid.', mtError, [mbOK], 0);
1025
      vdtTiles.SetFocus;
1026
      Exit;
1027
    end;
1028
    
1029
    if tileType = 'S' then
1030
      Inc(tileID, $4000);
1031
      
1032
    node := vdtTiles.GetFirst;
1033
    while node <> nil do
1034
    begin
1035
      tileInfo := vdtTiles.GetNodeData(node);
1036
      if tileInfo^.ID = tileID then
1037
      begin
1038
        vdtTiles.ClearSelection;
1039
        vdtTiles.Selected[node] := True;
1040
        vdtTiles.FocusedNode := node;
1041
        Break;
1042
      end;
1043
      node := vdtTiles.GetNext(node);
1044
    end;
1045
    
1046
    if node = nil then
1047
    begin
1048
      //edSearchID.Font.Color := clRed;
1049
      MessageDlg('Error', 'The tile with the specified ID could not be found.' + LineEnding +
1050
        'Check for conflicting filter settings.', mtError, [mbOK], 0);
1051
      vdtTiles.SetFocus;
1052
      Exit;
1053
    end;
1054
    //edSearchID.Font.Color := clWindowText;
1055
    edSearchID.Visible := False;
1056
  end else if Key = #27 then
1057
  begin
1058
    edSearchID.Visible := False;
1059
    //edSearchID.Font.Color := clWindowText;
1060
    Key := #0;
1061
  end else if not (Key in ['$', '0'..'9', 'a'..'f', 'A'..'F', 's', 'S', 't', 'T', #8]) then
1062
    Key := #0;
1063
end;
1064
1065
procedure TfrmMain.lblChatHeaderCaptionClick(Sender: TObject);
1066
begin
1067
  if pnlChat.Visible then
1068
  begin
1069
    pnlChat.Visible := False;
1070
    spChat.Visible := False;
1071
  end else
1072
  begin
1073
    spChat.Visible := True;
1074
    pnlChat.Visible := True;
1075
    spChat.Top := pnlChatHeader.Top + pnlChatHeader.Height;
1076
    pnlChat.Top := spChat.Top + spChat.Height;
1077
    
1078
    lblChatHeaderCaption.Font.Bold := False;
1079
    lblChatHeaderCaption.Font.Italic := False;
1080
    lblChatHeaderCaption.Font.Color := clWindowText;
1081
    
1082
    edChat.SetFocus;
1083
  end;
1084
end;
1085
1086
procedure TfrmMain.lblChatHeaderCaptionMouseEnter(Sender: TObject);
1087
begin
1088
  lblChatHeaderCaption.Font.Underline := True;
1089
end;
1090
1091
procedure TfrmMain.lblChatHeaderCaptionMouseLeave(Sender: TObject);
1092
begin
1093
  lblChatHeaderCaption.Font.Underline := False;
1094
end;
1095
1096
procedure TfrmMain.mnuAboutClick(Sender: TObject);
1097
begin
1098
  frmAbout.ShowModal;
1099
end;
1100
1101
procedure TfrmMain.mnuAccountControlClick(Sender: TObject);
1102
begin
1103
  frmAccountControl.Show;
1104
end;
1105
1106
procedure TfrmMain.mnuDisconnectClick(Sender: TObject);
1107
begin
1108
  dmNetwork.Disconnect;
1109
end;
1110
1111
procedure TfrmMain.oglGameWindowPaint(Sender: TObject);
1112
begin
1113
  glClear(GL_COLOR_BUFFER_BIT);
1114
1115
  InitRender;
1116
  InitSize;
1117
  
1118
  if FVLayerMaterial.Texture = 0 then
1119
    FVLayerMaterial.UpdateTexture;
1120
1121
  glDisable(GL_DEPTH_TEST);
1122
  Render;
1123
1124
  oglGameWindow.SwapBuffers;
1125
end;
1126
1127
procedure TfrmMain.pmGrabTileInfoPopup(Sender: TObject);
1128
begin
1129
  mnuGrabHue.Enabled := CurrentTile is TStaticItem;
1130
end;
1131
1132
procedure TfrmMain.tbFilterMouseMove(Sender: TObject; Shift: TShiftState; X,
1133
  Y: Integer);
1134
begin
1135
  if acFilter.Checked and (not frmFilter.Visible) then
1136
    frmFilter.Show;
1137
end;
1138
1139
procedure TfrmMain.tbRadarMapClick(Sender: TObject);
1140
begin
1141
  frmRadarMap.Show;
1142
  frmRadarMap.BringToFront;
1143
end;
1144
1145
procedure TfrmMain.tmGrabTileInfoTimer(Sender: TObject);
1146
begin
1147
  tmGrabTileInfo.Enabled := False;
1148
  if CurrentTile <> nil then
1149
    pmGrabTileInfo.PopUp(Mouse.CursorPos.X, Mouse.CursorPos.Y);
1150
    
1151
  SelectedTile := nil;
1152
end;
1153
1154
procedure TfrmMain.tmMovementTimer(Sender: TObject);
1155
1156
  procedure MoveBy(AOffsetX, AOffsetY: Integer);
1157
  begin
1158
    SetPos(EnsureRange(FX + AOffsetX, 0, FLandscape.CellWidth - 1),
1159
           EnsureRange(FY + AOffsetY, 0, FLandscape.CellHeight - 1));
1160
  end;
1161
1162
begin
1163
  case FOverlayUI.ActiveArrow of
1164
    0: MoveBy(-8, 0);
1165
    1: MoveBy(-8, -8);
1166
    2: MoveBy(0, -8);
1167
    3: MoveBy(8, -8);
1168
    4: MoveBy(8, 0);
1169
    5: MoveBy(8, 8);
1170
    6: MoveBy(0, 8);
1171
    7: MoveBy(-8, 8);
1172
  end;
1173
end;
1174
1175
procedure TfrmMain.tmTileHintTimer(Sender: TObject);
1176
begin
1177
  frmTileInfo.Show;
1178
  tmTileHint.Enabled := False;
1179
end;
1180
1181
procedure TfrmMain.vdtRandomDragDrop(Sender: TBaseVirtualTree; Source: TObject;
1182
  DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState;
1183
  Pt: TPoint; var Effect: Integer; Mode: TDropMode);
1184
begin
1185
  if Source = vdtTiles then
1186
    btnAddRandomClick(Sender);
1187
end;
1188
1189
procedure TfrmMain.vdtRandomDragOver(Sender: TBaseVirtualTree; Source: TObject;
1190
  Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode;
1191
  var Effect: Integer; var Accept: Boolean);
1192
begin
1193
  if source = vdtTiles then Accept := True;
1194
end;
1195
1196
procedure TfrmMain.vdtRandomLoadNode(Sender: TBaseVirtualTree;
1197
  Node: PVirtualNode; Stream: TStream);
1198
var
1199
  tileInfo: PTileInfo;
1200
begin
1201
  tileInfo := Sender.GetNodeData(Node);
1202
  Stream.Read(tileInfo^.ID, SizeOf(tileInfo^.ID));
1203
end;
1204
1205
procedure TfrmMain.vdtRandomSaveNode(Sender: TBaseVirtualTree;
1206
  Node: PVirtualNode; Stream: TStream);
1207
var
1208
  tileInfo: PTileInfo;
1209
begin
1210
  tileInfo := Sender.GetNodeData(Node);
1211
  Stream.Write(tileInfo^.ID, SizeOf(tileInfo^.ID));
1212
end;
1213
1214
procedure TfrmMain.vdtRandomUpdating(Sender: TBaseVirtualTree;
1215
  State: TVTUpdateState);
1216
begin
1217
  if acDraw.Checked then
1218
    ProcessToolState;
1219
end;
1220
1221
procedure TfrmMain.vdtTilesClick(Sender: TObject);
1222
begin
1223
  {if vdtTiles.GetFirstSelected <> nil then
1224
  begin
1225
    if not tbDrawTile.Down then
1226
    begin
1227
      frmDrawSettings.rbTileList.Checked := True;
1228
      tbDrawTileClick(Sender);
1229
    end else
1230
      ProcessToolState;
1231
  end;}
1232
  if acDraw.Checked then
1233
    ProcessToolState;
1234
end;
1235
1236
procedure TfrmMain.vdtTilesDrawNode(Sender: TBaseVirtualTree;
1237
  const PaintInfo: TVTPaintInfo);
1238
var
1239
  tileInfo: PTileInfo;
1240
  textStyle: TTextStyle;
1241
  artEntry: TArt;
1242
  tileData: TTileData;
1243
  id: Integer;
1244
begin
1245
  tileInfo := Sender.GetNodeData(PaintInfo.Node);
1246
  textStyle := PaintInfo.Canvas.TextStyle;
1247
  textStyle.Alignment := taCenter;
1248
  textStyle.Layout := tlCenter;
1249
  textStyle.Wordbreak := True;
1250
  case PaintInfo.Column of
1251
    0:
1252
      begin
1253
        id := tileInfo^.ID;
1254
        if id > $3FFF then
1255
          Dec(id, $4000);
1256
        PaintInfo.Canvas.TextRect(PaintInfo.CellRect, 0, 0, Format('$%x', [id]), textStyle);
1257
      end;
1258
    1:
1259
      begin
1260
        if ResMan.Art.Exists(tileInfo^.ID) then
1261
        begin
1262
          artEntry := ResMan.Art.GetArt(tileInfo^.ID, RGB2ARGB(PaintInfo.Canvas.Pixels[PaintInfo.CellRect.Left, PaintInfo.CellRect.Top]), nil, False);
1263
          DisplayImage(PaintInfo.Canvas, PaintInfo.CellRect, artEntry.Graphic);
1264
          artEntry.Free;
1265
        end;
1266
      end;
1267
    2:
1268
      begin
1269
        tileData := TTileData(ResMan.Tiledata.Block[tileInfo^.ID]);
1270
        PaintInfo.Canvas.TextRect(PaintInfo.CellRect, PaintInfo.CellRect.Left, PaintInfo.CellRect.Top, Trim(tileData.TileName), textStyle);
1271
        tileData.Free;
1272
      end;
1273
  end;
1274
end;
1275
1276
procedure TfrmMain.vdtTilesEnter(Sender: TObject);
1277
begin
1278
  if acFilter.Checked and (not frmFilter.Visible) and (not frmFilter.Locked) then
1279
  begin
1280
    frmFilter.Locked := True;
1281
    frmFilter.Show;
1282
    frmMain.SetFocus;
1283
    frmFilter.Locked := False;
1284
  end;
1285
end;
1286
1287
procedure TfrmMain.vdtTilesExit(Sender: TObject);
1288
begin
1289
  {TODO : Fix mouse over on !Windows platforms}
1290
  {$IFDEF Windows}
1291
  tmTileHint.Enabled := False;
1292
  {$ENDIF Windows}
1293
end;
1294
1295
procedure TfrmMain.vdtTilesHotChange(Sender: TBaseVirtualTree; OldNode,
1296
  NewNode: PVirtualNode);
1297
var
1298
  tileInfo: PTileInfo;
1299
begin
1300
  {TODO : Fix mouse over on !Windows platforms}
1301
  {$IFDEF Windows}
1302
  if NewNode <> nil then
1303
  begin
1304
    tileInfo := vdtTiles.GetNodeData(NewNode);
1305
    frmTileInfo.Update(tileInfo^.ID);
1306
    tmTileHint.Enabled := True;
1307
  end else
1308
  begin
1309
    frmTileInfo.Hide;
1310
    tmTileHint.Enabled := False;
1311
  end;
1312
  {$ENDIF Windows}
1313
end;
1314
1315
procedure TfrmMain.vdtTilesKeyPress(Sender: TObject; var Key: char);
1316
begin
1317
  if Key in ['$', '0'..'9'] then
1318
  begin
1319
    edSearchID.Top := vdtTiles.Top + vdtTiles.Height - edSearchID.Height - 4;
1320
    edSearchID.Left := vdtTiles.Left + vdtTiles.Width - edSearchID.Width - 4;
1321
    edSearchID.Text := Key;
1322
    edSearchID.Visible := True;
1323
    edSearchID.SetFocus;
1324
    edSearchID.SelStart := 1;
1325
    Key := #0;
1326
  end;
1327
end;
1328
1329
procedure TfrmMain.vdtTilesMouseMove(Sender: TObject; Shift: TShiftState; X,
1330
  Y: Integer);
1331
begin
1332
  if tmTileHint.Enabled then
1333
  begin
1334
    tmTileHint.Enabled := False;
1335
    tmTileHint.Enabled := True; //Restart timer
1336
  end;
1337
  
1338
  if frmTileInfo.Visible then
1339
  begin
1340
    frmTileInfo.Hide;
1341
    tmTileHint.Enabled := True;
1342
  end;
1343
end;
1344
1345
procedure TfrmMain.vdtTilesScroll(Sender: TBaseVirtualTree; DeltaX,
1346
  DeltaY: Integer);
1347
begin
1348
  if Sender.CanFocus and Sender.MouseEntered then
1349
    Sender.SetFocus;
1350
end;
1351
1352
procedure TfrmMain.vstChatClick(Sender: TObject);
1353
begin
1354
  edChat.SetFocus;
1355
end;
1356
1357
procedure TfrmMain.vstChatGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
1358
  Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
1359
var
1360
  chatInfo: PChatInfo;
1361
begin
1362
  chatInfo := Sender.GetNodeData(Node);
1363
  case Column of
1364
    0: CellText := TimeToStr(chatInfo^.Time);
1365
    1: CellText := chatInfo^.Sender;
1366
    2: CellText := chatInfo^.Msg;
1367
  end;
1368
end;
1369
1370
procedure TfrmMain.vstChatPaintText(Sender: TBaseVirtualTree;
1371
  const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
1372
  TextType: TVSTTextType);
1373
var
1374
  chatInfo: PChatInfo;
1375
begin
1376
  chatInfo := Sender.GetNodeData(Node);
1377
  if chatInfo^.Sender = 'System' then
1378
  begin
1379
    if Column = 1 then
1380
      TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsItalic, fsBold]
1381
    else
1382
      TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsItalic];
1383
  end;
1384
end;
1385
1386
procedure TfrmMain.vstLocationsDblClick(Sender: TObject);
1387
var
1388
  node: PVirtualNode;
1389
  locationInfo: PLocationInfo;
1390
begin
1391
  node := vstLocations.GetFirstSelected;
1392
  if node <> nil then
1393
  begin
1394
    locationInfo := vstLocations.GetNodeData(node);
1395
    SetPos(locationInfo^.X, locationInfo^.Y);
1396
  end;
1397
end;
1398
1399
procedure TfrmMain.vstLocationsGetText(Sender: TBaseVirtualTree;
1400
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
1401
  var CellText: WideString);
1402
var
1403
  locationInfo: PLocationInfo;
1404
begin
1405
  locationInfo := Sender.GetNodeData(Node);
1406
  case Column of
1407
    0: CellText := Format('%d, %d', [locationInfo^.X, locationInfo^.Y]);
1408
    1: CellText := locationInfo^.Name;
1409
  end;
1410
end;
1411
1412
procedure TfrmMain.vstLocationsLoadNode(Sender: TBaseVirtualTree;
1413
  Node: PVirtualNode; Stream: TStream);
1414
var
1415
  locationInfo: PLocationInfo;
1416
  stringLength: Integer;
1417
  s: string;
1418
begin
1419
  locationInfo := Sender.GetNodeData(Node);
1420
  Stream.Read(locationInfo^.X, SizeOf(Word));
1421
  Stream.Read(locationInfo^.Y, SizeOf(Word));
1422
  Stream.Read(stringLength, SizeOf(Integer));
1423
  SetLength(s, stringLength);
1424
  Stream.Read(s[1], stringLength);
1425
  locationInfo^.Name := s;
1426
end;
1427
1428
procedure TfrmMain.vstLocationsNewText(Sender: TBaseVirtualTree;
1429
  Node: PVirtualNode; Column: TColumnIndex; NewText: WideString);
1430
var
1431
  locationInfo: PLocationInfo;
1432
begin
1433
  if Column = 1 then
1434
  begin
1435
    locationInfo := Sender.GetNodeData(Node);
1436
    locationInfo^.Name := NewText;
1437
  end;
1438
end;
1439
1440
procedure TfrmMain.vstLocationsSaveNode(Sender: TBaseVirtualTree;
1441
  Node: PVirtualNode; Stream: TStream);
1442
var
1443
  locationInfo: PLocationInfo;
1444
  stringLength: Integer;
1445
begin
1446
  locationInfo := Sender.GetNodeData(Node);
1447
  Stream.Write(locationInfo^.X, SizeOf(Word));
1448
  Stream.Write(locationInfo^.Y, SizeOf(Word));
1449
  stringLength := Length(locationInfo^.Name);
1450
  Stream.Write(stringLength, SizeOf(Integer));
1451
  Stream.Write(locationInfo^.Name[1], stringLength);
1452
end;
1453
1454
procedure TfrmMain.SetX(const AValue: Integer);
1455
begin
1456
  SetPos(AValue, FY);
1457
end;
1458
1459
procedure TfrmMain.SetY(const AValue: Integer);
1460
begin
1461
  SetPos(FX, AValue);
1462
end;
1463
1464
procedure TfrmMain.SetPos(AX, AY: Word);
1465
begin
1466
  if InRange(AX, 0, FLandscape.CellWidth - 1) and InRange(AY, 0, FLandscape.CellHeight - 1) then
1467
  begin
1468
    FX := AX;
1469
    edX.Value := FX;
1470
    FY := AY;
1471
    edY.Value := FY;
1472
    dmNetwork.Send(TUpdateClientPosPacket.Create(AX, AY));
1473
    Repaint;
1474
    if frmRadarMap <> nil then frmRadarMap.Repaint;
1475
  end;
1476
end;
1477
1478
procedure TfrmMain.SetCurrentTile(const AValue: TWorldItem);
1479
begin
1480
  if FCurrentTile <> nil then
1481
    FCurrentTile.OnDestroy.UnregisterEvent(@TileRemoved);
1482
  FCurrentTile := AValue;
1483
  if FCurrentTile <> nil then
1484
    FCurrentTile.OnDestroy.RegisterEvent(@TileRemoved);
1485
end;
1486
1487
procedure TfrmMain.SetSelectedTile(const AValue: TWorldItem);
1488
begin
1489
  if FSelectedTile <> nil then
1490
    FSelectedTile.OnDestroy.UnregisterEvent(@TileRemoved);
1491
  FSelectedTile := AValue;
1492
  if FSelectedTile <> nil then
1493
    FSelectedTile.OnDestroy.RegisterEvent(@TileRemoved);
1494
end;
1495
1496
procedure TfrmMain.InitRender;
1497
const
1498
  lightPosition: TGLArrayf4 = (-1, -1, 0.5, 0);
1499
  specular: TGLArrayf4 = (2, 2, 2, 1);
1500
  ambient: TGLArrayf4 = (1, 1, 1, 1);
1501
begin
1502
  glEnable(GL_ALPHA_TEST);
1503
  glAlphaFunc(GL_GREATER, 0.1);
1504
  glEnable(GL_TEXTURE_2D);
1505
  glDisable(GL_DITHER);
1506
  glEnable(GL_BLEND); // Enable alpha blending of textures
1507
  glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
1508
  glShadeModel(GL_SMOOTH); // Go with flat shading for now
1509
  glEnable(GL_NORMALIZE);
1510
1511
  glEnable(GL_LIGHT0);
1512
  glLightfv(GL_LIGHT0, GL_POSITION, @lightPosition);
1513
  glLightfv(GL_LIGHT0, GL_AMBIENT, @specular);
1514
  glLightModelfv(GL_LIGHT_MODEL_AMBIENT, @ambient);
1515
  glLightModeli(GL_LIGHT_MODEL_TWO_SIDE, GL_FALSE);
1516
end;
1517
1518
procedure TfrmMain.InitSize;
1519
begin
1520
  glViewport(0, 0, oglGameWindow.Width, oglGameWindow.Height);
1521
  glMatrixMode(GL_PROJECTION);
1522
  glLoadIdentity;
1523
  //glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST);
1524
  gluOrtho2D(0, oglGameWindow.Width, oglGameWindow.Height, 0);
1525
  glMatrixMode(GL_MODELVIEW);
1526
  glLoadIdentity;
1527
end;
1528
1529
procedure TfrmMain.Render;
1530
var
1531
  drawDistance: Integer;
1532
  offsetX, offsetY: Integer;
1533
  lowOffX, lowOffY, highOffX, highOffY: Integer;
1534
  z: ShortInt;
1535
  mat: TMaterial;
1536
  cell: TMapCell;
1537
  west, south, east: Single;
1538
  drawX, drawY: Single;
1539
  draw: TList;
1540
  staticItem: TStaticItem;
1541
  i, j, k: Integer;
1542
  startOffX, endOffX, rangeX, rangeY: Integer;
1543
  normals: TNormals;
1544
  staticTileData: TStaticTileData;
1545
  hue: THue;
1546
  highlight, singleTarget, multiTarget: Boolean;
1547
  ghostTile: TWorldItem;
1548
  tileRect: TRect;
1549
  virtualTile: TVirtualTile;
1550
  staticsFilter: TStaticFilter;
1551
1552
  procedure GetMapDrawOffset(x, y: Integer; var drawX, drawY: Single);
1553
  begin
1554
    drawX := (oglGameWindow.Width div 2) + (x - y) * 22;
1555
    drawY := (oglGamewindow.Height div 2) + (x + y) * 22;
1556
  end;
1557
begin
1558
  drawDistance := Trunc(Sqrt(oglGameWindow.Width * oglGameWindow.Width + oglGamewindow.Height * oglGamewindow.Height) / 44);
1559
1560
  if FX - drawDistance < 0 then lowOffX := -FX else lowOffX := -drawDistance;
1561
  if FY - drawDistance < 0 then lowOffY := -FY else lowOffY := -drawDistance;
1562
  if FX + drawDistance >= FLandscape.Width * 8 then highOffX := FLandscape.Width * 8 - FX - 1 else highOffX := drawDistance;
1563
  if FY + drawDistance >= FLandscape.Height * 8 then highOffY := FLandscape.Height * 8 - FY - 1 else highOffY := drawDistance;
1564
1565
  FLandscape.PrepareBlocks((FX + lowOffX) div 8, (FY + lowOffY) div 8, (FX + highOffX) div 8 + 1, (FY + highOffY) div 8 + 1);
1566
1567
  tileRect := GetSelectedRect;
1568
  FScreenBuffer.Clear;
1569
1570
  rangeX := highOffX - lowOffX;
1571
  rangeY := highOffY - lowOffY;
1572
  PrepareVirtualLayer(rangeX + 1, rangeY + 1);
1573
  
1574
  if acFilter.Checked then
1575
    staticsFilter := @frmFilter.Filter
1576
  else
1577
    staticsFilter := nil;
1578
  
1579
  for j := 0 to rangeX + rangeY - 2 do
1580
  begin
1581
    if j > rangeY then
1582
    begin
1583
      startOffX := j - rangeY + 1;
1584
      endOffX := rangeX;
1585
    end else
1586
    begin
1587
      startOffX := 0;
1588
      endOffX := j;
1589
    end;
1590
    for k := startOffX to endOffX do
1591
    begin
1592
      offsetY := j - k + lowOffY;
1593
      offsetX := k + lowOffX;
1594
      GetMapDrawOffset(offsetX, offsetY, drawX, drawY);
1595
1596
      singleTarget := (CurrentTile <> nil) and
1597
                      (FX + offsetX = CurrentTile.X) and
1598
                      (FY + offsetY = CurrentTile.Y);
1599
      multiTarget := (CurrentTile <> nil) and
1600
                     (SelectedTile <> nil) and
1601
                     (CurrentTile <> SelectedTile) and
1602
                     PtInRect(tileRect, Point(FX + offsetX, FY + offsetY));
1603
1604
      if acDraw.Checked and (singleTarget or multiTarget) then
1605
      begin
1606
        ghostTile := FGhostTile;
1607
        if (ghostTile is TMapCell) and (not frmDrawSettings.cbForceAltitude.Checked) then
1608
          ghostTile.Z := FLandscape.MapCell[FX + offsetX, FY + offsetY].Z;
1609
      end else
1610
        ghostTile := nil;
1611
      
1612
      if frmVirtualLayer.cbShowLayer.Checked then
1613
      begin
1614
        virtualTile := FVirtualLayer[k, j - k];
1615
        virtualTile.X := FX + offsetX;
1616
        virtualTile.Y := FY + offsetY;
1617
        virtualTile.Z := frmVirtualLayer.seZ.Value;
1618
      end else
1619
        virtualTile := nil;
1620
      
1621
      draw := FLandscape.GetDrawList(FX + offsetX, FY + offsetY,
1622
        frmBoundaries.tbMinZ.Position, frmBoundaries.tbMaxZ.Position,
1623
        ghostTile, virtualTile, tbTerrain.Down, tbStatics.Down,
1624
        acNoDraw.Checked, staticsFilter);
1625
        
1626
      for i := 0 to draw.Count - 1 do
1627
      begin
1628
        if TObject(draw[i]) = virtualTile then
1629
          highlight := False
1630
        else if acDelete.Checked and multiTarget and (TObject(draw[i]) is TStaticItem) then
1631
          highlight := True
1632
        else if ((acElevate.Checked) or (acMove.Checked)) and multiTarget then
1633
          highlight := True
1634
        else if (acHue.Checked and multiTarget and (TObject(draw[i]) is TMapCell)) then
1635
          highlight := True
1636
        else
1637
          highlight := (not acSelect.Checked) and
1638
                       (not acHue.Checked) and
1639
                       ((TObject(draw[i]) = CurrentTile) or
1640
                       ((TObject(draw[i]) is TMapCell) and (TObject(draw[i]) = ghostTile)));
1641
1642
        if highlight then
1643
        begin
1644
          glEnable(GL_COLOR_LOGIC_OP);
1645
          glLogicOp(GL_COPY_INVERTED);
1646
        end;
1647
        
1648
        if acFlat.Checked then
1649
          z := 0
1650
        else
1651
          z := TWorldItem(draw[i]).Z;
1652
          
1653
        glColor4f(1.0, 1.0, 1.0, 1.0);
1654
        
1655
        if TObject(draw[i]) = virtualTile then
1656
        begin
1657
          glBindTexture(GL_TEXTURE_2D, FVLayerMaterial.Texture);
1658
          glBegin(GL_QUADS);
1659
            glTexCoord2f(0, 0); glVertex2d(drawX - 22, drawY - z * 4);
1660
            glTexCoord2f(1, 0); glVertex2d(drawX - 22 + FVLayerMaterial.Width, drawY - z * 4);
1661
            glTexCoord2f(1, 1); glVertex2d(drawX - 22 + FVLayerMaterial.Width, drawY + FVLayerMaterial.Height - z * 4);
1662
            glTexCoord2f(0, 1); glVertex2d(drawX - 22, drawY + FVLayerMaterial.Height - z * 4);
1663
          glEnd;
1664
1665
          FScreenBuffer.Store(Bounds(Trunc(drawX - 22), Trunc(drawY - z * 4), 44, 44), virtualTile, FVLayerMaterial);
1666
        end else if TObject(draw[i]) is TMapCell then
1667
        begin
1668
          cell := TMapCell(draw[i]);
1669
          
1670
          {if ResMan.Tiledata.LandTiles[cell.TileID].HasFlag(tdfTranslucent) then
1671
            glColor4f(1.0, 1.0, 1.0, 0.5);} //Possible, but probably not like the OSI client
1672
1673
          mat := nil;
1674
1675
          if not acFlat.Checked then
1676
          begin
1677
            west := FLandscape.GetLandAlt(FX + offsetX, FY + offsetY + 1, z);
1678
            south := FLandscape.GetLandAlt(FX + offsetX + 1, FY + offsetY + 1, z);
1679
            east := FLandscape.GetLandAlt(FX + offsetX + 1, FY + offsetY, z);
1680
1681
            if  (west <> z) or (south <> z) or (east <> z) then
1682
            begin
1683
              mat := FTextureManager.GetTexMaterial(cell.TileID);
1684
            end;
1685
          end;
1686
1687
          if mat = nil then
1688
          begin
1689
            mat := FTextureManager.GetArtMaterial(cell.TileID);
1690
            if (not (ghostTile is TMapCell)) or
1691
               (TObject(draw[i]) = ghostTile) then //when we have a ghosttile, only draw that, but still store the real one
1692
            begin
1693
              glBindTexture(GL_TEXTURE_2D, mat.Texture);
1694
              glBegin(GL_QUADS);
1695
                glTexCoord2f(0, 0); glVertex2d(drawX - 22, drawY - z * 4);
1696
                glTexCoord2f(1, 0); glVertex2d(drawX - 22 + mat.Width, drawY - z * 4);
1697
                glTexCoord2f(1, 1); glVertex2d(drawX - 22 + mat.Width, drawY + mat.Height - z * 4);
1698
                glTexCoord2f(0, 1); glVertex2d(drawX - 22, drawY + mat.Height - z * 4);
1699
              glEnd;
1700
            end;
1701
            
1702
            if TObject(draw[i]) <> ghostTile then
1703
              FScreenBuffer.Store(Bounds(Trunc(drawX - 22), Trunc(drawY - z * 4), 44, 44), cell, mat);
1704
          end else // Texture found
1705
          begin
1706
            if (not (ghostTile is TMapCell)) or
1707
               (TObject(draw[i]) = ghostTile) then //when we have a ghosttile, only draw that, but still store the real one
1708
            begin
1709
              glBindTexture(GL_TEXTURE_2D, mat.Texture);
1710
              if not cell.Selected then
1711
                glEnable(GL_LIGHTING);
1712
              normals := FLandscape.Normals[offsetX, offsetY];
1713
              glBegin(GL_TRIANGLES);
1714
                glNormal3f(normals[3].X, normals[3].Y, normals[3].Z);
1715
                glTexCoord2f(0, 1); glVertex2d(drawX - 22, drawY + 22 - west * 4);
1716
                glNormal3f(normals[0].X, normals[0].Y, normals[0].Z);
1717
                glTexCoord2f(0, 0); glVertex2d(drawX, drawY - z * 4);
1718
                glNormal3f(normals[1].X, normals[1].Y, normals[1].Z);
1719
                glTexCoord2f(1, 0); glVertex2d(drawX + 22, drawY + 22 - east * 4);
1720
                glNormal3f(normals[1].X, normals[1].Y, normals[1].Z);
1721
                glTexCoord2f(1, 0); glVertex2d(drawX + 22, drawY + 22 - east * 4);
1722
                glNormal3f(normals[2].X, normals[2].Y, normals[2].Z);
1723
                glTexCoord2f(1, 1); glVertex2d(drawX, drawY + 44 - south * 4);
1724
                glNormal3f(normals[3].X, normals[3].Y, normals[3].Z);
1725
                glTexCoord2f(0, 1); glVertex2d(drawX - 22, drawY + 22 - west * 4);
1726
              glEnd;
1727
              if not cell.Selected then
1728
                glDisable(GL_LIGHTING);
1729
            end;
1730
              
1731
            if TObject(draw[i]) <> ghostTile then
1732
              FScreenBuffer.Store(Rect(Trunc(drawX - 22), Trunc(drawY - z * 4), Trunc(drawX + 22), Trunc(drawY + 44 - south * 4)), cell, mat);
1733
          end;
1734
        end else if TObject(draw[i]) is TStaticItem then
1735
        begin
1736
          staticItem := TStaticItem(draw[i]);
1737
1738
          staticTileData := ResMan.Tiledata.StaticTiles[staticItem.TileID];
1739
          if tbSetHue.Down and ((singleTarget and (TObject(draw[i]) = CurrentTile)) or multiTarget) then
1740
          begin
1741
            if frmHueSettings.lbHue.ItemIndex > 0 then
1742
              hue := ResMan.Hue.Hues[frmHueSettings.lbHue.ItemIndex - 1]
1743
            else
1744
              hue := nil;
1745
          end else if staticItem.Hue > 0 then
1746
            hue := ResMan.Hue.Hues[staticItem.Hue - 1]
1747
          else
1748
            hue := nil;
1749
            
1750
          if staticTileData.HasFlag(tdfTranslucent) then
1751
            glColor4f(1.0, 1.0, 1.0, 0.5);
1752
            
1753
          mat := FTextureManager.GetArtMaterial($4000 + staticItem.TileID, hue, (staticTileData.Flags and tdfPartialHue) = tdfPartialHue);
1754
          south := mat.RealHeight;
1755
          east := mat.RealWidth div 2;
1756
          glBindTexture(GL_TEXTURE_2D, mat.Texture);
1757
          glBegin(GL_QUADS);
1758
            glTexCoord2f(0, 0); glVertex2d(drawX - east, drawY + 44 - south - z * 4);
1759
            glTexCoord2f(1, 0); glVertex2d(drawX - east + mat.Width, drawY + 44 - south - z * 4);
1760
            glTexCoord2f(1, 1); glVertex2d(drawX - east + mat.Width, drawY + 44 - south + mat.Height - z * 4);
1761
            glTexCoord2f(0, 1); glVertex2d(drawX - east, drawY + 44 - south + mat.Height - z * 4);
1762
          glEnd;
1763
          
1764
          if TObject(draw[i]) <> ghostTile then
1765
            FScreenBuffer.Store(Bounds(Trunc(drawX - east), Trunc(drawY + 44 - south - z * 4), mat.RealWidth, Trunc(south)), staticItem, mat);
1766
        end;
1767
1768
        if highlight then
1769
          glDisable(GL_COLOR_LOGIC_OP);
1770
      end;
1771
      draw.Free;
1772
    end;
1773
  end;
1774
1775
  FOverlayUI.Draw(oglGameWindow);
1776
end;
1777
1778
procedure TfrmMain.OnLandscapeChanged;
1779
begin
1780
  oglGameWindow.Repaint;
1781
  UpdateCurrentTile;
1782
end;
1783
1784
procedure TfrmMain.BuildTileList;
1785
var
1786
  minID, maxID, i, lastID: Integer;
1787
  node: PVirtualNode;
1788
  tileInfo: PTileInfo;
1789
  filter: string;
1790
begin
1791
  if cbTerrain.Checked then minID := $0 else minID := $4000;
1792
  if cbStatics.Checked then maxID := $7FFF else maxID := $3FFF;
1793
  filter := AnsiLowerCase(edFilter.Text);
1794
  
1795
  node := vdtTiles.GetFirstSelected;
1796
  if node <> nil then
1797
  begin
1798
    tileInfo := vdtTiles.GetNodeData(node);
1799
    lastID := tileInfo^.ID;
1800
  end else
1801
    lastID := -1;
1802
  
1803
  vdtTiles.BeginUpdate;
1804
  vdtTiles.Clear;
1805
  
1806
  for i := minID to maxID do
1807
  begin
1808
    if ResMan.Art.Exists(i) then
1809
    begin
1810
      if (filter <> '') and (Pos(filter, AnsiLowerCase(TTileData(ResMan.Tiledata.Block[i]).TileName)) = 0) then Continue;
1811
      node := vdtTiles.AddChild(nil);
1812
      tileInfo := vdtTiles.GetNodeData(node);
1813
      tileInfo^.ID := i;
1814
      if i = lastID then
1815
        vdtTiles.Selected[node] := True;
1816
    end;
1817
  end;
1818
  
1819
  if vdtTiles.GetFirstSelected = nil then
1820
  begin
1821
    node := vdtTiles.GetFirst;
1822
    if node <> nil then
1823
      vdtTiles.Selected[node] := True;
1824
  end;
1825
  
1826
  vdtTiles.EndUpdate;
1827
  
1828
  node := vdtTiles.GetFirstSelected;
1829
  if node <> nil then
1830
    vdtTiles.FocusedNode := node;
1831
end;
1832
1833
procedure TfrmMain.ProcessToolState;
1834
var
1835
  node: PVirtualNode;
1836
  tileInfo: PTileInfo;
1837
  i: Integer;
1838
begin
1839
  if acSelect.Checked then
1840
  begin
1841
    //lblTip.Caption := 'Right click shows a menu with all the tools.';
1842
    lblTip.Caption := 'Press and hold the left mouse button to show a list with actions (eg. grab hue).';
1843
    oglGameWindow.Cursor := crDefault;
1844
  end else
1845
  begin
1846
    lblTip.Caption := 'Press and hold the left mouse button to target an area.';
1847
    oglGameWindow.Cursor := crHandPoint;
1848
  end;
1849
1850
  if FGhostTile <> nil then FreeAndNil(FGhostTile);
1851
1852
  if acDraw.Checked then
1853
  begin
1854
    tileInfo := nil;
1855
    if frmDrawSettings.rbTileList.Checked then
1856
    begin
1857
      node := vdtTiles.GetFirstSelected;
1858
      if node <> nil then
1859
        tileInfo := vdtTiles.GetNodeData(node);
1860
    end else if frmDrawSettings.rbRandom.Checked then
1861
    begin
1862
      node := vdtRandom.GetFirst;
1863
      for i := 1 to Random(vdtRandom.RootNodeCount) do
1864
        node := vdtRandom.GetNext(node);
1865
1866
      if node <> nil then
1867
        tileInfo := vdtRandom.GetNodeData(node);
1868
    end;
1869
1870
    if tileInfo <> nil then
1871
    begin
1872
      if tileInfo^.ID < $4000 then
1873
      begin
1874
        FGhostTile := TMapCell.Create(nil, nil, 0, 0);
1875
        FGhostTile.TileID := tileInfo^.ID;
1876
      end else
1877
      begin
1878
        FGhostTile := TStaticItem.Create(nil, nil, 0, 0);
1879
        FGhostTile.TileID := tileInfo^.ID - $4000;
1880
        TStaticItem(FGhostTile).Hue := frmHueSettings.lbHue.ItemIndex;
1881
      end;
1882
    end;
1883
  end;
1884
end;
1885
1886
procedure TfrmMain.ProcessAccessLevel;
1887
begin
1888
  mnuAdministration.Visible := (dmNetwork.AccessLevel >= alAdministrator);
1889
  acDraw.Enabled := (dmNetwork.AccessLevel >= alNormal);
1890
  acMove.Enabled := (dmNetwork.AccessLevel >= alNormal);
1891
  acElevate.Enabled := (dmNetwork.AccessLevel >= alNormal);
1892
  acDelete.Enabled := (dmNetwork.AccessLevel >= alNormal);
1893
  acHue.Enabled := (dmNetwork.AccessLevel >= alNormal);
1894
  Caption := Format('UO CentrED - [%s (%s)]', [dmNetwork.Username, GetAccessLevelString(dmNetwork.AccessLevel)]);
1895
end;
1896
1897
procedure TfrmMain.UpdateCurrentTile;
1898
var
1899
  localPos: TPoint;
1900
begin
1901
  if oglGameWindow.MouseEntered then
1902
  begin
1903
    localPos := oglGameWindow.ScreenToClient(Mouse.CursorPos);
1904
    UpdateCurrentTile(localPos.X, localPos.Y);
1905
  end;
1906
end;
1907
1908
procedure TfrmMain.UpdateCurrentTile(AX, AY: Integer);
1909
var
1910
  info: PBlockInfo;
1911
begin
1912
  FOverlayUI.ActiveArrow := FOverlayUI.HitTest(AX, AY);
1913
  if FOverlayUI.ActiveArrow > -1 then Exit;
1914
1915
  info := FScreenBuffer.Find(Point(AX, AY));
1916
  if info <> nil then
1917
  begin
1918
    CurrentTile := info^.Item;
1919
1920
    if CurrentTile is TVirtualTile then
1921
      lblTileInfo.Caption := Format('Virtual Layer: X: %d, Y: %d, Z: %d', [CurrentTile.X, CurrentTile.Y, CurrentTile.Z])
1922
    else if CurrentTile is TMapCell then
1923
      lblTileInfo.Caption := Format('Terrain TileID: $%x, X: %d, Y: %d, Z: %d', [CurrentTile.TileID, CurrentTile.X, CurrentTile.Y, CurrentTile.Z])
1924
    else
1925
      lblTileInfo.Caption := Format('Static TileID: $%x, X: %d, Y: %d, Z: %d, Hue: $%x', [CurrentTile.TileID, CurrentTile.X, CurrentTile.Y, CurrentTile.Z, TStaticItem(CurrentTile).Hue]);
1926
      
1927
    if (acDraw.Checked) and (SelectedTile = nil) then
1928
    begin
1929
      if FGhostTile <> nil then
1930
      begin
1931
        if (FGhostTile is TStaticItem) and (not frmDrawSettings.cbForceAltitude.Checked) then
1932
        begin
1933
          FGhostTile.Z := CurrentTile.Z;
1934
          if CurrentTile is TStaticItem then
1935
            Inc(FGhostTile.Z, ResMan.Tiledata.StaticTiles[CurrentTile.TileID].Height);
1936
        end else
1937
          FGhostTile.Z := frmDrawSettings.seForceAltitude.Value;
1938
      end;
1939
    end;
1940
  end;
1941
end;
1942
1943
procedure TfrmMain.TileRemoved(ATile: TMulBlock);
1944
begin
1945
  if ATile = FCurrentTile then
1946
    FCurrentTile := nil
1947
  else if ATile = FSelectedTile then
1948
    FSelectedTile := nil;
1949
end;
1950
1951
procedure TfrmMain.WriteChatMessage(ASender, AMessage: string);
1952
var
1953
  node: PVirtualNode;
1954
  chatInfo: PChatInfo;
1955
begin
1956
  node := vstChat.AddChild(nil);
1957
  chatInfo := vstChat.GetNodeData(node);
1958
  chatInfo^.Time := Now;
1959
  chatInfo^.Sender := ASender;
1960
  chatInfo^.Msg := AMessage;
1961
  if vstChat.RootNodeCount > 30 then
1962
    vstChat.DeleteNode(vstChat.GetFirst);
1963
  vstChat.ScrollIntoView(node, False);
1964
  
1965
  if not pnlChat.Visible then
1966
  begin
1967
    lblChatHeaderCaption.Font.Bold := True;
1968
    lblChatHeaderCaption.Font.Italic := True;
1969
    lblChatHeaderCaption.Font.Color := clRed;
1970
  end;
1971
end;
1972
1973
procedure TfrmMain.PrepareVirtualLayer(AWidth, AHeight: Word);
1974
var
1975
  oldWidth, oldHeight: Word;
1976
  i, j: Integer;
1977
begin
1978
  for i := Low(FVirtualLayer) to High(FVirtualLayer) do
1979
  begin
1980
    if AHeight < Length(FVirtualLayer[i]) then
1981
    begin
1982
      for j := AHeight to Length(FVirtualLayer[i]) - 1 do
1983
        FVirtualLayer[i][j].Free;
1984
      SetLength(FVirtualLayer[i], AHeight);
1985
    end else if AHeight > Length(FVirtualLayer[i]) then
1986
    begin
1987
      oldHeight := Length(FVirtualLayer[i]);
1988
      SetLength(FVirtualLayer[i], AHeight);
1989
      for j := oldHeight to AHeight - 1 do
1990
      begin
1991
        FVirtualLayer[i][j] := TVirtualTile.Create(nil, nil, 0, 0);
1992
        FVirtualLayer[i][j].TileID := 0;
1993
        FVirtualLayer[i][j].Hue := 0;
1994
      end;
1995
    end;
1996
  end;
1997
1998
  if AWidth < Length(FVirtualLayer) then
1999
  begin
2000
    for i := AWidth to Length(FVirtualLayer) - 1 do
2001
    begin
2002
      for j := Low(FVirtualLayer[i]) to High(FVirtualLayer[i]) do
2003
        FVirtualLayer[i][j].Free;
2004
    end;
2005
    SetLength(FVirtualLayer, AWidth);
2006
  end else if AWidth > Length(FVirtualLayer) then
2007
  begin
2008
    oldWidth := Length(FVirtualLayer);
2009
    SetLength(FVirtualLayer, AWidth);
2010
    for i := oldWidth to AWidth - 1 do
2011
    begin
2012
      SetLength(FVirtualLayer[i], AHeight);
2013
      for j := Low(FVirtualLayer[i]) to High(FVirtualLayer[i]) do
2014
      begin
2015
        FVirtualLayer[i][j] := TVirtualTile.Create(nil, nil, 0, 0);
2016
        FVirtualLayer[i][j].TileID := 0;
2017
        FVirtualLayer[i][j].Hue := 0;
2018
      end;
2019
    end;
2020
  end;
2021
end;
2022
2023
procedure TfrmMain.OnClientHandlingPacket(ABuffer: TEnhancedMemoryStream);
2024
var
2025
  sender, msg: string;
2026
begin
2027
  case ABuffer.ReadByte of
2028
    $01: //client connected
2029
      begin
2030
        sender := ABuffer.ReadStringNull;
2031
        lbClients.Items.Add(sender);
2032
        if sender <> dmNetwork.Username then
2033
          WriteChatMessage('System', Format('User "%s" has connected.', [sender]));
2034
      end;
2035
    $02:
2036
      begin
2037
        sender := ABuffer.ReadStringNull;
2038
        lbClients.Items.Delete(lbClients.Items.IndexOf(sender));
2039
        if sender <> dmNetwork.Username then
2040
          WriteChatMessage('System', Format('User "%s" has disconnected.', [sender]));
2041
      end;
2042
    $03: //Client list
2043
      begin
2044
        lbClients.Clear;
2045
        while ABuffer.Position < ABuffer.Size do
2046
          lbClients.Items.Add(ABuffer.ReadStringNull);
2047
      end;
2048
    $04: //Set pos
2049
      begin
2050
        FX := ABuffer.ReadWord;
2051
        FY := ABuffer.ReadWord;
2052
        SetPos(FX, FY);
2053
      end;
2054
    $05: //chat
2055
      begin
2056
        sender := ABuffer.ReadStringNull;
2057
        msg := ABuffer.ReadStringNull;
2058
        WriteChatMessage(sender, msg);
2059
      end;
2060
    $07: //access level changed
2061
      begin
2062
        dmNetwork.AccessLevel := TAccessLevel(ABuffer.ReadByte);
2063
        if dmNetwork.AccessLevel = alNone then
2064
        begin
2065
          MessageDlg('AccessLevel change', 'Your account has been locked.', mtWarning, [mbOK], 0);
2066
          mnuDisconnectClick(nil);
2067
        end else
2068
        begin
2069
          ProcessAccessLevel;
2070
          MessageDlg('AccessLevel change', Format('Your accesslevel has been changed to %s.', [GetAccessLevelString(dmNetwork.AccessLevel)]), mtWarning, [mbOK], 0);
2071
        end;
2072
      end;
2073
  end;
2074
end;
2075
2076
function TfrmMain.GetInternalTileID(ATile: TWorldItem): Word;
2077
begin
2078
  Result := ATile.TileID;
2079
  if ATile is TStaticItem then
2080
    Inc(Result, $4000);
2081
end;
2082
2083
function TfrmMain.GetSelectedRect: TRect;
2084
begin
2085
  if CurrentTile <> nil then
2086
  begin
2087
    if SelectedTile <> nil then
2088
    begin
2089
      Result.Left := Min(CurrentTile.X, SelectedTile.X);
2090
      Result.Top := Min(CurrentTile.Y, SelectedTile.Y);
2091
      Result.Right := Max(CurrentTile.X, SelectedTile.X) + 1;
2092
      Result.Bottom := Max(CurrentTile.Y, SelectedTile.Y) + 1;
2093
    end else
2094
    begin
2095
      Result.Left := CurrentTile.X;
2096
      Result.Top := CurrentTile.Y;
2097
      Result.Right := CurrentTile.X + 1;
2098
      Result.Bottom := CurrentTile.Y + 1;
2099
    end;
2100
  end;
2101
end;
2102
2103
function TfrmMain.ConfirmAction: Boolean;
2104
begin
2105
  if acMove.Checked and frmMoveSettings.cbAsk.Checked then
2106
  begin
2107
    frmMoveSettings.Left := Mouse.CursorPos.x - 8;
2108
    frmMoveSettings.Top := Mouse.CursorPos.y - 8;
2109
    Result := frmMoveSettings.ShowModal = mrYes;
2110
  end else
2111
  begin
2112
    frmConfirmation.Left := Mouse.CursorPos.x - frmConfirmation.btnYes.Left - frmConfirmation.btnYes.Width div 2;
2113
    frmConfirmation.Top := Mouse.CursorPos.y - frmConfirmation.btnYes.Top - frmConfirmation.btnYes.Height div 2;
2114
    Result := frmConfirmation.ShowModal = mrYes;
2115
  end;
2116
  if not oglGameWindow.MouseEntered then
2117
    oglGameWindowMouseLeave(nil);
2118
end;
2119
2120
function TfrmMain.CanBeModified(ATile: TWorldItem): Boolean;
2121
begin
2122
  Result := not (ATile is TVirtualTile);
2123
end;
2124
2125
initialization
2126
  {$I UfrmMain.lrs}
2127
2128
end.
2129