Statistics
| Branch: | Tag: | Revision:

root / Client / UfrmMain.pas @ 13:c78b5eafa10e

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