Statistics
| Branch: | Tag: | Revision:

root / Client / UfrmMain.pas @ 152:2c10e1ad6647

History | View | Annotate | Download (90.6 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 2009 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
  XMLPropStorage, fgl, ImagingClasses, dateutils, UPlatformTypes, UMap, UPacket,
38
  UGLFont, DOM, XMLRead, XMLWrite, strutils, ULightManager;
39
40
type
41
  TAccessChangedListener = procedure(AAccessLevel: TAccessLevel) of object;
42
  TSelectionListener = procedure(AWorldItem: TWorldItem) of object;
43
  TScreenBufferState = (sbsValid, sbsIndexed, sbsFiltered);
44
  TScreenBufferStates = set of TScreenBufferState;
45
46
  TGhostTile = class(TStaticItem);
47
  TPacketList = specialize TFPGObjectList<TPacket>;
48
  TAccessChangedListeners = specialize TFPGList<TAccessChangedListener>;
49
  TSelectionListeners = specialize TFPGList<TSelectionListener>;
50
51
  TTileHintInfo = record
52
    Name: String;
53
    Flags: String;
54
    NameRect: TRect;
55
    FlagsRect: TRect;
56
  end;
57
58
  { TfrmMain }
59
60
  TfrmMain = class(TForm)
61
    acSelect: TAction;
62
    acDraw: TAction;
63
    acMove: TAction;
64
    acElevate: TAction;
65
    acDelete: TAction;
66
    acHue: TAction;
67
    acBoundaries: TAction;
68
    acFilter: TAction;
69
    acFlat: TAction;
70
    acNoDraw: TAction;
71
    acLightlevel: TAction;
72
    acUndo: TAction;
73
    acVirtualLayer: TAction;
74
    ActionList1: TActionList;
75
    ApplicationProperties1: TApplicationProperties;
76
    btnAddLocation: TSpeedButton;
77
    btnAddRandom: TSpeedButton;
78
    btnClearLocations: TSpeedButton;
79
    btnClearRandom: TSpeedButton;
80
    btnDeleteLocation: TSpeedButton;
81
    btnDeleteRandom: TSpeedButton;
82
    btnGoTo: TButton;
83
    btnRandomPresetDelete: TSpeedButton;
84
    btnRandomPresetSave: TSpeedButton;
85
    cbRandomPreset: TComboBox;
86
    cbStatics: TCheckBox;
87
    cbTerrain: TCheckBox;
88
    edChat: TEdit;
89
    edFilter: TEdit;
90
    edSearchID: TEdit;
91
    gbRandom: TGroupBox;
92
    ImageList1: TImageList;
93
    lblChatHeaderCaption: TLabel;
94
    lblFilter: TLabel;
95
    lblTipC: TLabel;
96
    lblTip: TLabel;
97
    lblTileInfo: TLabel;
98
    lblX: TLabel;
99
    lblY: TLabel;
100
    lbClients: TListBox;
101
    MainMenu1: TMainMenu;
102
    mnuSecurityQuestion: TMenuItem;
103
    mnuShowAnimations: TMenuItem;
104
    mnuSettings: TMenuItem;
105
    mnuFlatShowHeight: TMenuItem;
106
    mnuGrabHue: TMenuItem;
107
    mnuGrabTileID: TMenuItem;
108
    mnuRegionControl: TMenuItem;
109
    mnuVirtualLayer: TMenuItem;
110
    mnuLargeScaleCommands: TMenuItem;
111
    mnuSetHue: TMenuItem;
112
    mnuGoToClient: TMenuItem;
113
    mnuAbout: TMenuItem;
114
    mnuHelp: TMenuItem;
115
    mnuSeparator3: TMenuItem;
116
    mnuBoundaries: TMenuItem;
117
    mnuSelect: TMenuItem;
118
    mnuDraw: TMenuItem;
119
    mnuMove: TMenuItem;
120
    mnuElevate: TMenuItem;
121
    mnuDelete: TMenuItem;
122
    mnuAddToRandom: TMenuItem;
123
    mnuFlush: TMenuItem;
124
    mnuShutdown: TMenuItem;
125
    mnuSeparator2: TMenuItem;
126
    mnuAccountControl: TMenuItem;
127
    mnuAdministration: TMenuItem;
128
    mnuSeparator1: TMenuItem;
129
    mnuExit: TMenuItem;
130
    mnuDisconnect: TMenuItem;
131
    mnuCentrED: TMenuItem;
132
    oglGameWindow: TOpenGLControl;
133
    pcLeft: TPageControl;
134
    pmGrabTileInfo: TPopupMenu;
135
    pnlBottom: TPanel;
136
    edX: TSpinEdit;
137
    edY: TSpinEdit;
138
    pmTileList: TPopupMenu;
139
    pmTools: TPopupMenu;
140
    pmClients: TPopupMenu;
141
    pnlChat: TPanel;
142
    pnlChatHeader: TPanel;
143
    pmFlatViewSettings: TPopupMenu;
144
    spChat: TSplitter;
145
    spTileList: TSplitter;
146
    tbFilter: TToolButton;
147
    tbFlat: TToolButton;
148
    tbNoDraw: TToolButton;
149
    tbSeparator2: TToolButton;
150
    tbUndo: TToolButton;
151
    ToolButton1: TToolButton;
152
    tsLocations: TTabSheet;
153
    tbSetHue: TToolButton;
154
    tmGrabTileInfo: TTimer;
155
    tmMovement: TTimer;
156
    tbSeparator5: TToolButton;
157
    tbRadarMap: TToolButton;
158
    tbVirtualLayer: TToolButton;
159
    tsClients: TTabSheet;
160
    tbMain: TToolBar;
161
    tbDisconnect: TToolButton;
162
    tbSeparator1: TToolButton;
163
    tbSelect: TToolButton;
164
    tbDrawTile: TToolButton;
165
    tbMoveTile: TToolButton;
166
    tbElevateTile: TToolButton;
167
    tbDeleteTile: TToolButton;
168
    tbSeparator3: TToolButton;
169
    tbBoundaries: TToolButton;
170
    tbSeparator4: TToolButton;
171
    tbTerrain: TToolButton;
172
    tbStatics: TToolButton;
173
    tsTiles: TTabSheet;
174
    vdtTiles: TVirtualDrawTree;
175
    vdtRandom: TVirtualDrawTree;
176
    vstChat: TVirtualStringTree;
177
    vstLocations: TVirtualStringTree;
178
    XMLPropStorage1: TXMLPropStorage;
179
    procedure acBoundariesExecute(Sender: TObject);
180
    procedure acDeleteExecute(Sender: TObject);
181
    procedure acDrawExecute(Sender: TObject);
182
    procedure acElevateExecute(Sender: TObject);
183
    procedure acFilterExecute(Sender: TObject);
184
    procedure acFlatExecute(Sender: TObject);
185
    procedure acHueExecute(Sender: TObject);
186
    procedure acLightlevelExecute(Sender: TObject);
187
    procedure acMoveExecute(Sender: TObject);
188
    procedure acNoDrawExecute(Sender: TObject);
189
    procedure acSelectExecute(Sender: TObject);
190
    procedure acUndoExecute(Sender: TObject);
191
    procedure acVirtualLayerExecute(Sender: TObject);
192
    procedure ApplicationProperties1Idle(Sender: TObject; var Done: Boolean);
193
    procedure ApplicationProperties1ShowHint(var HintStr: string;
194
      var CanShow: Boolean; var HintInfo: THintInfo);
195
    procedure btnAddLocationClick(Sender: TObject);
196
    procedure btnAddRandomClick(Sender: TObject);
197
    procedure btnClearLocationsClick(Sender: TObject);
198
    procedure btnClearRandomClick(Sender: TObject);
199
    procedure btnDeleteLocationClick(Sender: TObject);
200
    procedure btnDeleteRandomClick(Sender: TObject);
201
    procedure btnGoToClick(Sender: TObject);
202
    procedure btnRandomPresetDeleteClick(Sender: TObject);
203
    procedure btnRandomPresetSaveClick(Sender: TObject);
204
    procedure cbRandomPresetChange(Sender: TObject);
205
    procedure cbStaticsChange(Sender: TObject);
206
    procedure cbTerrainChange(Sender: TObject);
207
    procedure edChatKeyPress(Sender: TObject; var Key: char);
208
    procedure edFilterEditingDone(Sender: TObject);
209
    procedure FormActivate(Sender: TObject);
210
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
211
    procedure FormCreate(Sender: TObject);
212
    procedure FormDestroy(Sender: TObject);
213
    procedure edSearchIDExit(Sender: TObject);
214
    procedure edSearchIDKeyPress(Sender: TObject; var Key: char);
215
    procedure lblChatHeaderCaptionClick(Sender: TObject);
216
    procedure lblChatHeaderCaptionMouseEnter(Sender: TObject);
217
    procedure lblChatHeaderCaptionMouseLeave(Sender: TObject);
218
    procedure mnuAboutClick(Sender: TObject);
219
    procedure mnuAccountControlClick(Sender: TObject);
220
    procedure mnuDisconnectClick(Sender: TObject);
221
    procedure mnuExitClick(Sender: TObject);
222
    procedure mnuFlatShowHeightClick(Sender: TObject);
223
    procedure mnuFlushClick(Sender: TObject);
224
    procedure mnuGoToClientClick(Sender: TObject);
225
    procedure mnuGrabHueClick(Sender: TObject);
226
    procedure mnuGrabTileIDClick(Sender: TObject);
227
    procedure mnuLargeScaleCommandsClick(Sender: TObject);
228
    procedure mnuRegionControlClick(Sender: TObject);
229
    procedure mnuShowAnimationsClick(Sender: TObject);
230
    procedure mnuShutdownClick(Sender: TObject);
231
    procedure oglGameWindowDblClick(Sender: TObject);
232
    procedure oglGameWindowKeyDown(Sender: TObject; var Key: Word;
233
      Shift: TShiftState);
234
    procedure oglGameWindowMouseDown(Sender: TObject; Button: TMouseButton;
235
      Shift: TShiftState; X, Y: Integer);
236
    procedure oglGameWindowMouseEnter(Sender: TObject);
237
    procedure oglGameWindowMouseLeave(Sender: TObject);
238
    procedure oglGameWindowMouseMove(Sender: TObject; Shift: TShiftState; X,
239
      Y: Integer);
240
    procedure oglGameWindowMouseUp(Sender: TObject; Button: TMouseButton;
241
      Shift: TShiftState; X, Y: Integer);
242
    procedure oglGameWindowMouseWheel(Sender: TObject; Shift: TShiftState;
243
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
244
    procedure oglGameWindowPaint(Sender: TObject);
245
    procedure oglGameWindowResize(Sender: TObject);
246
    procedure pmGrabTileInfoPopup(Sender: TObject);
247
    procedure tbFilterMouseMove(Sender: TObject; Shift: TShiftState; X,
248
      Y: Integer);
249
    procedure tbRadarMapClick(Sender: TObject);
250
    procedure tbStaticsClick(Sender: TObject);
251
    procedure tbTerrainClick(Sender: TObject);
252
    procedure tmGrabTileInfoTimer(Sender: TObject);
253
    procedure tmMovementTimer(Sender: TObject);
254
    procedure vdtRandomClick(Sender: TObject);
255
    procedure vdtRandomDragDrop(Sender: TBaseVirtualTree; Source: TObject;
256
      DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState;
257
      Pt: TPoint; var Effect: Integer; Mode: TDropMode);
258
    procedure vdtRandomDragOver(Sender: TBaseVirtualTree; Source: TObject;
259
      Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode;
260
      var Effect: Integer; var Accept: Boolean);
261
    procedure vdtRandomLoadNode(Sender: TBaseVirtualTree; Node: PVirtualNode;
262
      Stream: TStream);
263
    procedure vdtRandomSaveNode(Sender: TBaseVirtualTree; Node: PVirtualNode;
264
      Stream: TStream);
265
    procedure vdtRandomUpdating(Sender: TBaseVirtualTree; State: TVTUpdateState);
266
    procedure vdtTilesClick(Sender: TObject);
267
    procedure vdtTilesDrawHint(Sender: TBaseVirtualTree; HintCanvas: TCanvas;
268
      Node: PVirtualNode; const R: TRect; Column: TColumnIndex);
269
    procedure vdtTilesDrawNode(Sender: TBaseVirtualTree;
270
      const PaintInfo: TVTPaintInfo);
271
    procedure vdtTilesEnter(Sender: TObject);
272
    procedure vdtTilesGetHintSize(Sender: TBaseVirtualTree; Node: PVirtualNode;
273
      Column: TColumnIndex; var R: TRect);
274
    procedure vdtTilesKeyPress(Sender: TObject; var Key: char);
275
    procedure vdtTilesScroll(Sender: TBaseVirtualTree; DeltaX, DeltaY: Integer);
276
    procedure vstChatClick(Sender: TObject);
277
    procedure vstChatFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
278
    procedure vstChatGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
279
      Column: TColumnIndex; TextType: TVSTTextType; var CellText: String);
280
    procedure vstChatPaintText(Sender: TBaseVirtualTree;
281
      const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
282
      TextType: TVSTTextType);
283
    procedure vstLocationsDblClick(Sender: TObject);
284
    procedure vstLocationsFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode
285
      );
286
    procedure vstLocationsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
287
      Column: TColumnIndex; TextType: TVSTTextType; var CellText: String);
288
    procedure vstLocationsLoadNode(Sender: TBaseVirtualTree;
289
      Node: PVirtualNode; Stream: TStream);
290
    procedure vstLocationsNewText(Sender: TBaseVirtualTree; Node: PVirtualNode;
291
      Column: TColumnIndex; const NewText: String);
292
    procedure vstLocationsSaveNode(Sender: TBaseVirtualTree;
293
      Node: PVirtualNode; Stream: TStream);
294
    procedure XMLPropStorage1RestoreProperties(Sender: TObject);
295
  protected
296
    { Members }
297
    FAppDir: String;
298
    FConfigDir: String;
299
    FX: Integer;
300
    FY: Integer;
301
    FDrawDistance: Integer;
302
    FLowOffsetX: Integer;
303
    FLowOffsetY: Integer;
304
    FHighOffsetX: Integer;
305
    FHighOffsetY: Integer;
306
    FRangeX: Integer;
307
    FRangeY: Integer;
308
    FLandscape: TLandscape;
309
    FTextureManager: TLandTextureManager;
310
    FScreenBuffer: TScreenBuffer;
311
    FScreenBufferState: TScreenBufferStates;
312
    FCurrentTile: TWorldItem;
313
    FSelectedTile: TWorldItem;
314
    FVirtualTiles: TWorldItemList;
315
    FVLayerImage: TSingleImage;
316
    FVLayerMaterial: TMaterial;
317
    FOverlayUI: TOverlayUI;
318
    FLocationsFile: string;
319
    FRandomPresetsFile: string;
320
    FRandomPresetsDoc: TXMLDocument;
321
    FLastDraw: TDateTime;
322
    FAccessChangedListeners: TAccessChangedListeners;
323
    FRepaintNeeded: Boolean;
324
    FSelection: TRect;
325
    FUndoList: TPacketList;
326
    FGLFont: TGLFont;
327
    FSelectionListeners: TSelectionListeners;
328
    FTileHint: TTileHintInfo;
329
    FLightManager: TLightManager;
330
    { Methods }
331
    procedure BuildTileList;
332
    function  ConfirmAction: Boolean;
333
    function  FindRandomPreset(AName: String): TDOMElement;
334
    procedure ForceUpdateCurrentTile;
335
    procedure GetDrawOffset(AX, AY: Integer; out DrawX, DrawY: Integer); inline;
336
    function  GetInternalTileID(ATile: TWorldItem): Word;
337
    function  GetSelectedRect: TRect;
338
    procedure InitRender;
339
    procedure InitSize;
340
    procedure LoadLocations;
341
    procedure LoadRandomPresets;
342
    procedure MoveBy(AOffsetX, AOffsetY: Integer); inline;
343
    procedure PrepareMapCell(AMapCell: TMapCell);
344
    procedure PrepareScreenBlock(ABlockInfo: PBlockInfo);
345
    procedure ProcessToolState;
346
    procedure ProcessAccessLevel;
347
    procedure RebuildScreenBuffer;
348
    procedure Render;
349
    procedure SaveLocations;
350
    procedure SaveRandomPresets;
351
    procedure SetCurrentTile(const AValue: TWorldItem);
352
    procedure SetDarkLights; inline;
353
    procedure SetNormalLights; inline;
354
    procedure SetSelectedTile(const AValue: TWorldItem);
355
    procedure SetX(const AValue: Integer);
356
    procedure SetY(const AValue: Integer);
357
    procedure UpdateCurrentTile;
358
    procedure UpdateCurrentTile(AX, AY: Integer);
359
    procedure UpdateFilter;
360
    procedure UpdateSelection;
361
    procedure WriteChatMessage(ASender, AMessage: string);
362
    { Events }
363
    procedure OnClientHandlingPacket(ABuffer: TEnhancedMemoryStream);
364
    procedure OnLandscapeChanged;
365
    procedure OnMapChanged(AMapCell: TMapCell);
366
    procedure OnNewBlock(ABlock: TBlock);
367
    procedure OnStaticDeleted(AStaticItem: TStaticItem);
368
    procedure OnStaticElevated(AStaticItem: TStaticItem);
369
    procedure OnStaticHued(AStaticItem: TStaticItem);
370
    procedure OnStaticInserted(AStaticItem: TStaticItem);
371
    procedure OnTileRemoved(ATile: TMulBlock);
372
  public
373
    { Fields }
374
    property X: Integer read FX write SetX;
375
    property Y: Integer read FY write SetY;
376
    property Landscape: TLandscape read FLandscape;
377
    property CurrentTile: TWorldItem read FCurrentTile write SetCurrentTile;
378
    property SelectedTile: TWorldItem read FSelectedTile write SetSelectedTile;
379
    property LightManager: TLightManager read FLightManager;
380
    { Methods }
381
    procedure InvalidateFilter;
382
    procedure InvalidateScreenBuffer;
383
    procedure RegisterAccessChangedListener(AListener: TAccessChangedListener);
384
    procedure RegisterSelectionListener(AListener: TSelectionListener);
385
    procedure SetPos(AX, AY: Word);
386
    procedure SwitchToSelection;
387
    procedure UnregisterAccessChangedListener(AListener: TAccessChangedListener);
388
    procedure UnregisterSelectionListener(AListener: TSelectionListener);
389
  end; 
390
391
var
392
  frmMain: TfrmMain;
393
394
implementation
395
396
uses
397
  UdmNetwork, UArt, UTiledata, UAdminHandling, UPackets,
398
  UfrmAccountControl, UGraphicHelper, ImagingComponents, UfrmDrawSettings,
399
  UfrmBoundaries, UfrmElevateSettings, UfrmConfirmation, UfrmMoveSettings,
400
  UfrmAbout, UPacketHandlers, UfrmHueSettings, UfrmRadar, UfrmLargeScaleCommand,
401
  UfrmLogin, UResourceManager, UfrmVirtualLayer, UfrmFilter, UfrmRegionControl,
402
  Logging, LConvEncoding, LCLType, UfrmLightlevel;
403
404
type
405
  TGLArrayf4 = array[0..3] of GLfloat;
406
  PTileInfo = ^TTileInfo;
407
  TTileInfo = record
408
    ID: Word;
409
  end;
410
  PChatInfo = ^TChatInfo;
411
  TChatInfo = record
412
    Time: TDateTime;
413
    Sender: string;
414
    Msg: string;
415
  end;
416
  PLocationInfo = ^TLocationInfo;
417
  TLocationInfo = record
418
    X: Word;
419
    Y: Word;
420
    Name: string;
421
  end;
422
423
const
424
  CScreenBufferValid = [sbsValid, sbsIndexed, sbsFiltered];
425
426
function IsInRect(const AX, AY: Integer; const ARect: TRect): Boolean; inline;
427
begin
428
  Result := (AX >= ARect.Left) and
429
            (AX <= ARect.Right) and
430
            (AY >= ARect.Top) and
431
            (AY <= ARect.Bottom);
432
end;
433
434
{ TfrmMain }
435
436
procedure TfrmMain.mnuExitClick(Sender: TObject);
437
begin
438
  Close;
439
end;
440
441
procedure TfrmMain.mnuFlatShowHeightClick(Sender: TObject);
442
begin
443
  RebuildScreenBuffer;
444
end;
445
446
procedure TfrmMain.mnuFlushClick(Sender: TObject);
447
begin
448
  dmNetwork.Send(TFlushServerPacket.Create);
449
end;
450
451
procedure TfrmMain.mnuGoToClientClick(Sender: TObject);
452
begin
453
  if lbClients.ItemIndex > -1 then
454
    dmNetwork.Send(TGotoClientPosPacket.Create(lbClients.Items.Strings[lbClients.ItemIndex]));
455
end;
456
457
procedure TfrmMain.mnuGrabHueClick(Sender: TObject);
458
begin
459
  if CurrentTile is TStaticItem then
460
  begin
461
    frmHueSettings.lbHue.ItemIndex := TStaticItem(CurrentTile).Hue;
462
    frmFilter.JumpToHue(TStaticItem(CurrentTile).Hue);
463
  end;
464
end;
465
466
procedure TfrmMain.mnuGrabTileIDClick(Sender: TObject);
467
var
468
  internalTileID: Integer;
469
  node: PVirtualNode;
470
  tileInfo: PTileInfo;
471
begin
472
  if CurrentTile <> nil then
473
  begin
474
    internalTileID := GetInternalTileID(CurrentTile);
475
    node := vdtTiles.GetFirst;
476
    while node <> nil do
477
    begin
478
      tileInfo := vdtTiles.GetNodeData(node);
479
      if tileInfo^.ID = internalTileID then
480
      begin
481
        vdtTiles.ClearSelection;
482
        vdtTiles.Selected[node] := True;
483
        vdtTiles.FocusedNode := node;
484
        Break;
485
      end;
486
      node := vdtTiles.GetNext(node);
487
    end;
488
  end;
489
end;
490
491
procedure TfrmMain.mnuLargeScaleCommandsClick(Sender: TObject);
492
begin
493
  frmLargeScaleCommand.Show;
494
end;
495
496
procedure TfrmMain.mnuRegionControlClick(Sender: TObject);
497
begin
498
  frmRegionControl.Show;
499
end;
500
501
procedure TfrmMain.mnuShowAnimationsClick(Sender: TObject);
502
begin
503
  FTextureManager.UseAnims := mnuShowAnimations.Checked;
504
  RebuildScreenBuffer;
505
end;
506
507
procedure TfrmMain.mnuShutdownClick(Sender: TObject);
508
begin
509
  dmNetwork.Send(TQuitServerPacket.Create(''));
510
end;
511
512
procedure TfrmMain.oglGameWindowDblClick(Sender: TObject);
513
begin
514
  if (acSelect.Checked) and (CurrentTile <> nil) then
515
    btnAddRandomClick(Sender);
516
end;
517
518
procedure TfrmMain.oglGameWindowKeyDown(Sender: TObject; var Key: Word;
519
  Shift: TShiftState);
520
begin
521
  case Key of
522
    VK_W, VK_NUMPAD8, VK_UP:
523
      MoveBy(-8, -8);
524
    VK_S, VK_NUMPAD2, VK_DOWN:
525
      MoveBy(8, 8);
526
    VK_A, VK_NUMPAD4, VK_LEFT:
527
      MoveBy(-8, 8);
528
    VK_D, VK_NUMPAD6, VK_RIGHT:
529
      MoveBy(8, -8);
530
    VK_Q, VK_NUMPAD7:
531
      MoveBy(-8, 0);
532
    VK_E, VK_NUMPAD9:
533
      MoveBy(0, -8);
534
    VK_Y, VK_NUMPAD1:
535
      MoveBy(0, 8);
536
    VK_C, VK_NUMPAD3:
537
      MoveBy(8, 0);
538
  end;
539
end;
540
541
procedure TfrmMain.oglGameWindowMouseDown(Sender: TObject;
542
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
543
begin
544
  Logger.EnterMethod([lcClient, lcDebug], 'MouseDown');
545
  try
546
    if Button = mbRight then
547
      pmTools.PopUp(Mouse.CursorPos.X, Mouse.CursorPos.Y);
548
549
    if Button <> mbLeft then
550
      Exit;
551
552
    UpdateCurrentTile(X, Y);
553
    if FOverlayUI.ActiveArrow > -1 then
554
      tmMovement.Enabled := True;
555
556
    SelectedTile := CurrentTile;
557
    if CurrentTile = nil then Exit;
558
559
    if acSelect.Checked then                      //***** Selection Mode *****//
560
      tmGrabTileInfo.Enabled := True;
561
562
    FRepaintNeeded := True;
563
  finally
564
    Logger.ExitMethod([lcClient, lcDebug], 'MouseDown');
565
  end;
566
end;
567
568
procedure TfrmMain.oglGameWindowMouseEnter(Sender: TObject);
569
begin
570
  if Active then
571
    oglGameWindow.SetFocus;
572
573
  FOverlayUI.Visible := True;
574
575
  if frmFilter.Visible then
576
  begin
577
    frmFilter.Locked := True;
578
    frmFilter.Hide;
579
    frmFilter.Locked := False;
580
  end;
581
582
  FRepaintNeeded := True;
583
end;
584
585
procedure TfrmMain.oglGameWindowMouseLeave(Sender: TObject);
586
begin
587
  if not (frmConfirmation.Visible or
588
          (frmMoveSettings.Visible and (fsModal in frmMoveSettings.FormState))
589
         ) then //during confirmation the mouse would leave ...
590
  begin
591
    CurrentTile := nil;
592
    FOverlayUI.Visible := False;
593
  end;
594
595
  FRepaintNeeded := True;
596
end;
597
598
procedure TfrmMain.oglGameWindowMouseMove(Sender: TObject; Shift: TShiftState;
599
  X, Y: Integer);
600
var
601
  lastTile: TWorldItem;
602
  offsetX, offsetY: Integer;
603
begin
604
  //Logger.EnterMethod([lcClient, lcDebug], 'MouseMove');
605
  lastTile := CurrentTile;
606
  
607
  if ssMiddle in Shift then
608
  begin
609
    UpdateCurrentTile(X, Y);
610
    if (lastTile <> nil) and (CurrentTile <> nil) and (lastTile <> CurrentTile) then
611
    begin
612
      offsetX := lastTile.X - CurrentTile.X;
613
      offsetY := lastTile.Y - CurrentTile.Y;
614
      if InRange(offsetX, -8, 8) and InRange(offsetY, -8, 8) then
615
        SetPos(FX - offsetX, FY - offsetY);
616
    end;
617
  end;
618
619
  UpdateCurrentTile(X, Y);
620
621
  FRepaintNeeded := True;
622
  //Logger.ExitMethod([lcClient, lcDebug], 'MouseMove');
623
end;
624
625
procedure TfrmMain.oglGameWindowMouseUp(Sender: TObject; Button: TMouseButton;
626
  Shift: TShiftState; X, Y: Integer);
627
var
628
  map: TMapCell;
629
  i: Integer;
630
  z: ShortInt;
631
  blockInfo: PBlockInfo;
632
  targetRect: TRect;
633
  offsetX, offsetY: Integer;
634
  tile: TWorldItem;
635
  tileX, tileY, newX, newY: Word;
636
  targetTiles: TWorldItemList;
637
  targetTile: TWorldItem;
638
begin
639
  Logger.EnterMethod([lcClient, lcDebug], 'MouseUp');
640
  if Button <> mbLeft then
641
  begin
642
    Logger.ExitMethod([lcClient, lcDebug], 'MouseUp');
643
    Exit;
644
  end;
645
646
  UpdateCurrentTile(X, Y);
647
  tmMovement.Enabled := False;
648
  if CurrentTile = nil then
649
  begin
650
    SelectedTile := nil;
651
    Logger.ExitMethod([lcClient, lcDebug], 'MouseUp');
652
    Exit;
653
  end;
654
655
  targetTile := CurrentTile;
656
  
657
  if acSelect.Checked then
658
  begin
659
    if tmGrabTileInfo.Enabled then
660
    begin
661
      tmGrabTileInfo.Enabled := False;
662
      mnuGrabTileIDClick(nil);
663
    end;
664
665
    for i := FSelectionListeners.Count - 1 downto 0 do
666
      FSelectionListeners[i](CurrentTile);
667
  end;
668
669
  if (not acSelect.Checked) and (targetTile <> nil) and (SelectedTile <> nil) then
670
  begin
671
    targetRect := GetSelectedRect;
672
    FUndoList.Clear;
673
674
    if (SelectedTile = targetTile) or ConfirmAction then
675
    begin
676
      if acDraw.Checked then                        //***** Drawing Mode *****//
677
      begin
678
        for tileX := FSelection.Left to FSelection.Right do
679
          for tileY := FSelection.Top to FSelection.Bottom do
680
          begin
681
            map := FLandscape.MapCell[tileX, tileY];
682
            if map.IsGhost then
683
            begin
684
              FUndoList.Add(TDrawMapPacket.Create(tileX, tileY, map.RawZ,
685
                map.RawTileID));
686
              dmNetwork.Send(TDrawMapPacket.Create(tileX, tileY, map.Z,
687
                map.TileID));
688
            end;
689
          end;
690
691
        Logger.Send([lcClient, lcDebug], 'Virtual tiles', FVirtualTiles.Count);
692
        for i := 0 to FVirtualTiles.Count - 1 do
693
        begin
694
          tile := FVirtualTiles[i];
695
          if tile is TGhostTile then
696
          begin
697
            dmNetwork.Send(TInsertStaticPacket.Create(tile.X, tile.Y, tile.Z,
698
              tile.TileID, TGhostTile(tile).Hue));
699
            FUndoList.Add(TDeleteStaticPacket.Create(TGhostTile(tile)));
700
          end;
701
        end;
702
      end else if (SelectedTile <> targetTile) or targetTile.CanBeEdited then
703
      begin
704
        if (not acMove.Checked) or (SelectedTile <> targetTile) or
705
           (not frmMoveSettings.cbAsk.Checked) or ConfirmAction then
706
        begin
707
          targetTiles := TWorldItemList.Create(False);
708
          if SelectedTile = targetTile then
709
          begin
710
            targetTiles.Add(targetTile)
711
          end else
712
          begin
713
            blockInfo := nil;
714
            while FScreenBuffer.Iterate(blockInfo) do
715
            begin
716
              if (blockInfo^.State = ssNormal) and
717
                blockInfo^.Item.CanBeEdited and
718
                IsInRect(blockInfo^.Item.X, blockInfo^.Item.Y, targetRect) then
719
              begin
720
                targetTiles.Add(blockInfo^.Item);
721
              end;
722
            end;
723
          end;
724
725
          if acMove.Checked then                       //***** Move tile *****//
726
          begin
727
            offsetX := frmMoveSettings.GetOffsetX;
728
            offsetY := frmMoveSettings.GetOffsetY;
729
            for i := 0 to targetTiles.Count - 1 do
730
            begin
731
              tile := targetTiles.Items[i];
732
733
              if tile is TStaticItem then
734
              begin
735
                newX := EnsureRange(tile.X + offsetX, 0, FLandscape.CellWidth - 1);
736
                newY := EnsureRange(tile.Y + offsetY, 0, FLandscape.CellHeight - 1);
737
                FUndoList.Add(TMoveStaticPacket.Create(newX, newY, tile.Z,
738
                  tile.TileID, TStaticItem(tile).Hue, tile.X, tile.Y));
739
                dmNetwork.Send(TMoveStaticPacket.Create(TStaticItem(tile),
740
                  newX, newY));
741
              end;
742
            end;
743
          end else if acElevate.Checked then        //***** Elevate tile *****//
744
          begin
745
            for i := 0 to targetTiles.Count - 1 do
746
            begin
747
              tile := targetTiles.Items[i];
748
749
              z := frmElevateSettings.seZ.Value;
750
              if frmElevateSettings.rbRaise.Checked then
751
                z := EnsureRange(tile.Z + z, -128, 127)
752
              else if frmElevateSettings.rbLower.Checked then
753
                z := EnsureRange(tile.Z - z, -128, 127);
754
755
              if tile is TMapCell then
756
              begin
757
                if frmElevateSettings.cbRandomHeight.Checked then
758
                  Inc(z, Random(frmElevateSettings.seRandomHeight.Value));
759
                FUndoList.Add(TDrawMapPacket.Create(tile.X, tile.Y, tile.Z,
760
                  tile.TileID));
761
                dmNetwork.Send(TDrawMapPacket.Create(tile.X, tile.Y, z,
762
                  tile.TileID));
763
              end else
764
              begin
765
                FUndoList.Add(TElevateStaticPacket.Create(tile.X, tile.Y,
766
                  z, tile.TileID, TStaticItem(tile).Hue, tile.Z));
767
                dmNetwork.Send(TElevateStaticPacket.Create(TStaticItem(tile), z));
768
              end;
769
            end;
770
          end else if acDelete.Checked then          //***** Delete tile *****//
771
          begin
772
            for i := 0 to targetTiles.Count - 1 do
773
            begin
774
              tile := targetTiles.Items[i];
775
776
              if tile is TStaticItem then
777
              begin
778
                FUndoList.Add(TInsertStaticPacket.Create(tile.X, tile.Y,
779
                  tile.Z, tile.TileID, TStaticItem(tile).Hue));
780
                dmNetwork.Send(TDeleteStaticPacket.Create(TStaticItem(tile)));
781
              end;
782
            end;
783
          end else if acHue.Checked then                //***** Hue tile *****//
784
          begin
785
            for i := 0 to targetTiles.Count - 1 do
786
            begin
787
              tile := targetTiles.Items[i];
788
789
              if (tile is TStaticItem) and
790
                (TStaticItem(tile).Hue <> frmHueSettings.lbHue.ItemIndex) then
791
              begin
792
                FUndoList.Add(THueStaticPacket.Create(tile.X, tile.Y, tile.Z,
793
                  tile.TileID, frmHueSettings.lbHue.ItemIndex,
794
                  TStaticItem(tile).Hue));
795
                dmNetwork.Send(THueStaticPacket.Create(TStaticItem(tile),
796
                  frmHueSettings.lbHue.ItemIndex));
797
              end;
798
            end;
799
          end;
800
801
          targetTiles.Free;
802
        end;
803
      end;
804
    end;
805
  end;
806
  acUndo.Enabled := FUndoList.Count > 0;
807
  SelectedTile := nil;
808
  FRepaintNeeded := True;
809
  Logger.ExitMethod([lcClient, lcDebug], 'MouseUp');
810
end;
811
812
procedure TfrmMain.oglGameWindowMouseWheel(Sender: TObject; Shift: TShiftState;
813
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
814
var
815
  cursorNeedsUpdate: Boolean;
816
  newZ: ShortInt;
817
begin
818
  if CurrentTile = nil then
819
    Exit;
820
821
  //We want single steps ...
822
  WheelDelta := WheelDelta div WHEEL_DELTA;
823
824
  cursorNeedsUpdate := False;
825
  if (CurrentTile is TVirtualTile) or ((ssCtrl in Shift) and
826
     (frmVirtualLayer.cbShowLayer.Checked)) then
827
  begin
828
    frmVirtualLayer.seZ.Value := EnsureRange(frmVirtualLayer.seZ.Value +
829
      WheelDelta, -128, 127);
830
    frmVirtualLayer.seZChange(frmVirtualLayer.seZ);
831
    cursorNeedsUpdate := True;
832
    Handled := True;
833
  end else if not (ssCtrl in Shift) then
834
  begin
835
    FUndoList.Clear;
836
    newZ := EnsureRange(CurrentTile.Z + WheelDelta, -128, 127);
837
    if CurrentTile is TStaticItem then
838
    begin
839
      FUndoList.Add(TElevateStaticPacket.Create(CurrentTile.X, CurrentTile.Y,
840
        newZ, CurrentTile.TileID, TStaticItem(CurrentTile).Hue,
841
        CurrentTile.Z));
842
      dmNetwork.Send(TElevateStaticPacket.Create(TStaticItem(CurrentTile),
843
        newZ));
844
      cursorNeedsUpdate := True;
845
      Handled := True;
846
    end else if CurrentTile is TMapCell then
847
    begin
848
      FUndoList.Add(TDrawMapPacket.Create(CurrentTile.X, CurrentTile.Y,
849
        CurrentTile.Z, CurrentTile.TileID));
850
      dmNetwork.Send(TDrawMapPacket.Create(CurrentTile.X, CurrentTile.Y,
851
        newZ, CurrentTile.TileID));
852
      Handled := True;
853
    end;
854
    acUndo.Enabled := FUndoList.Count > 0;
855
  end;
856
  
857
  if cursorNeedsUpdate then
858
  begin
859
    SetCursorPos(Mouse.CursorPos.X, Mouse.CursorPos.Y - 4 * WheelDelta);
860
    UpdateCurrentTile(MousePos.X, MousePos.Y - 4 * WheelDelta);
861
  end;
862
863
  FRepaintNeeded := True;
864
end;
865
866
procedure TfrmMain.FormCreate(Sender: TObject);
867
begin
868
  FAppDir := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName));
869
  FConfigDir := GetAppConfigDir(False);
870
  ForceDirectories(FConfigDir);
871
872
  XMLPropStorage1.FileName := FConfigDir + 'CentrED.xml';
873
  XMLPropStorage1.Active := True;
874
875
  FLandscape := ResMan.Landscape;
876
  FLandscape.OnChange := @OnLandscapeChanged;
877
  FLandscape.OnMapChanged := @OnMapChanged;
878
  FLandscape.OnNewBlock := @OnNewBlock;
879
  FLandscape.OnStaticDeleted := @OnStaticDeleted;
880
  FLandscape.OnStaticElevated := @OnStaticElevated;
881
  FLandscape.OnStaticHued := @OnStaticHued;
882
  FLandscape.OnStaticInserted := @OnStaticInserted;
883
884
  if FileExists(FAppDir + 'nodraw.txt') then
885
    FLandscape.LoadNoDrawMap(FAppDir + 'nodraw.txt');
886
  if FileExists(FConfigDir + 'nodraw.txt') then
887
    FLandscape.LoadNoDrawMap(FConfigDir + 'nodraw.txt');
888
  if FileExists(ResMan.GetFile('nodraw.txt')) then
889
    FLandscape.LoadNoDrawMap(ResMan.GetFile('nodraw.txt'));
890
891
  FTextureManager := TLandTextureManager.Create;
892
  FScreenBuffer := TScreenBuffer.Create;
893
  FScreenBufferState := [];
894
  X := 0;
895
  Y := 0;
896
  edX.MaxValue := FLandscape.CellWidth;
897
  edY.MaxValue := FLandscape.CellHeight;
898
  FOverlayUI := TOverlayUI.Create;
899
  FLightManager := TLightManager.Create(@GetDrawOffset);
900
  
901
  ProcessAccessLevel;
902
  
903
  vdtTiles.NodeDataSize := SizeOf(TTileInfo);
904
  vdtRandom.NodeDataSize := SizeOf(TTileInfo);
905
  BuildTileList;
906
  Randomize;
907
  
908
  vstChat.NodeDataSize := SizeOf(TChatInfo);
909
  pnlChatHeader.AnchorSide[akBottom].Control := pnlBottom;
910
  
911
  FLocationsFile := FConfigDir + 'Locations.xml';
912
  vstLocations.NodeDataSize := SizeOf(TLocationInfo);
913
  LoadLocations;
914
915
  RegisterPacketHandler($0C, TPacketHandler.Create(0, @OnClientHandlingPacket));
916
917
  FVLayerImage := TSingleImage.CreateFromStream(ResourceManager.GetResource(2));
918
919
  FGLFont := TGLFont.Create;
920
  FGLFont.LoadImage(ResourceManager.GetResource(3));
921
  FGLFont.LoadFontInfo(ResourceManager.GetResource(4));
922
923
  FVirtualTiles := TWorldItemList.Create(True);
924
  FUndoList := TPacketList.Create(True);
925
926
  FRandomPresetsFile := FConfigDir + 'RandomPresets.xml';
927
  LoadRandomPresets;
928
929
  DoubleBuffered := True;
930
  pnlBottom.DoubleBuffered := True;
931
932
  FAccessChangedListeners := TAccessChangedListeners.Create;
933
  FSelectionListeners := TSelectionListeners.Create;
934
  
935
  FLastDraw := Now;
936
end;
937
938
procedure TfrmMain.btnGoToClick(Sender: TObject);
939
begin
940
  SetPos(edX.Value, edY.Value);
941
end;
942
943
procedure TfrmMain.btnRandomPresetDeleteClick(Sender: TObject);
944
var
945
  preset: TDOMElement;
946
begin
947
  if cbRandomPreset.ItemIndex > -1 then
948
  begin
949
    preset := TDOMElement(cbRandomPreset.Items.Objects[cbRandomPreset.ItemIndex]);
950
    FRandomPresetsDoc.DocumentElement.RemoveChild(preset);
951
    cbRandomPreset.Items.Delete(cbRandomPreset.ItemIndex);
952
    cbRandomPreset.ItemIndex := -1;
953
  end;
954
end;
955
956
procedure TfrmMain.btnRandomPresetSaveClick(Sender: TObject);
957
var
958
  presetName: string;
959
  i: Integer;
960
  preset, tile: TDOMElement;
961
  children: TDOMNodeList;
962
  tileNode: PVirtualNode;
963
  tileInfo: PTileInfo;
964
begin
965
  presetName := cbRandomPreset.Text;
966
  if InputQuery('Save Preset', 'Enter the name of the preset:', presetName) then
967
  begin
968
    preset := FindRandomPreset(presetName);
969
    if preset = nil then
970
    begin
971
      preset := FRandomPresetsDoc.CreateElement('Preset');
972
      preset.AttribStrings['Name'] := presetName;
973
      FRandomPresetsDoc.DocumentElement.AppendChild(preset);
974
      cbRandomPreset.Items.AddObject(presetName, preset);
975
    end else
976
    begin
977
      children := preset.ChildNodes;
978
      for i := children.Count - 1 downto 0 do
979
        preset.RemoveChild(children[i]);
980
    end;
981
982
    tileNode := vdtRandom.GetFirst;
983
    while tileNode <> nil do
984
    begin
985
      tileInfo := vdtRandom.GetNodeData(tileNode);
986
      tile := FRandomPresetsDoc.CreateElement('Tile');
987
      tile.AttribStrings['ID'] := IntToStr(tileInfo^.ID);
988
      preset.AppendChild(tile);
989
      tileNode := vdtRandom.GetNext(tileNode);
990
    end;
991
992
    cbRandomPreset.ItemIndex := cbRandomPreset.Items.IndexOfObject(preset);
993
994
    SaveRandomPresets;
995
  end;
996
end;
997
998
procedure TfrmMain.cbRandomPresetChange(Sender: TObject);
999
var
1000
  preset, tile: TDOMElement;
1001
  tiles: TDOMNodeList;
1002
  tileNode: PVirtualNode;
1003
  tileInfo: PTileInfo;
1004
  i, id: Integer;
1005
begin
1006
  if cbRandomPreset.ItemIndex > -1 then
1007
  begin
1008
    vdtRandom.Clear;
1009
    preset := TDOMElement(cbRandomPreset.Items.Objects[cbRandomPreset.ItemIndex]);
1010
    tiles := preset.ChildNodes;
1011
    for i := 0 to tiles.Count - 1 do
1012
    begin
1013
      tile := TDOMElement(tiles[i]);
1014
      if (tile.NodeName = 'Tile') and
1015
         TryStrToInt(tile.AttribStrings['ID'], id) and
1016
         (id < FLandscape.MaxStaticID + $4000) then
1017
      begin
1018
        tileNode := vdtRandom.AddChild(nil);
1019
        tileInfo := vdtRandom.GetNodeData(tileNode);
1020
        tileInfo^.ID := id;
1021
      end;
1022
    end;
1023
  end;
1024
end;
1025
1026
procedure TfrmMain.btnAddRandomClick(Sender: TObject);
1027
var
1028
  selected, node: PVirtualNode;
1029
  sourceTileInfo, targetTileInfo: PTileInfo;
1030
begin
1031
  vdtRandom.BeginUpdate;
1032
  selected := vdtTiles.GetFirstSelected;
1033
  while selected <> nil do
1034
  begin
1035
    sourceTileInfo := vdtTiles.GetNodeData(selected);
1036
    node := vdtRandom.AddChild(nil);
1037
    targetTileInfo := vdtRandom.GetNodeData(node);
1038
    targetTileInfo^.ID := sourceTileInfo^.ID;
1039
    selected := vdtTiles.GetNextSelected(selected);
1040
  end;
1041
  vdtRandom.EndUpdate;
1042
end;
1043
1044
procedure TfrmMain.btnClearLocationsClick(Sender: TObject);
1045
begin
1046
  if MessageDlg('Are you sure you want to delete all saved locations?',
1047
    mtConfirmation, [mbYes, mbNo], 0) = mrYes then
1048
  begin
1049
    vstLocations.Clear;
1050
  end;
1051
end;
1052
1053
procedure TfrmMain.ApplicationProperties1Idle(Sender: TObject; var Done: Boolean);
1054
begin
1055
  if (FScreenBufferState <> CScreenBufferValid) or
1056
     ((FRepaintNeeded or mnuShowAnimations.Checked) and
1057
      (MilliSecondsBetween(Now, FLastDraw) > 50)) then
1058
  begin
1059
    //Logger.Send([lcClient, lcDebug], 'Repainting Game Window');
1060
    oglGameWindow.Repaint;
1061
    FLastDraw := Now;
1062
    FRepaintNeeded := False;
1063
  end;
1064
  Sleep(1);
1065
  Done := False;
1066
end;
1067
1068
procedure TfrmMain.ApplicationProperties1ShowHint(var HintStr: string;
1069
  var CanShow: Boolean; var HintInfo: THintInfo);
1070
begin
1071
  //that check is a bit dirty, but serves its purpose
1072
  //(i.e. to set the timeout for the tile info hints)
1073
  if HintStr = '-' then
1074
    HintInfo.HideTimeout := Application.HintHidePause +
1075
      Application.HintHidePausePerChar * (Length(FTileHint.Name) +
1076
      Length(FTileHint.Flags));
1077
end;
1078
1079
procedure TfrmMain.btnAddLocationClick(Sender: TObject);
1080
var
1081
  locationName: string;
1082
  locationInfo: PLocationInfo;
1083
begin
1084
  locationName := '';
1085
  if InputQuery('New Location', 'Enter the name of the new location:',
1086
    locationName) then
1087
  begin
1088
    locationInfo := vstLocations.GetNodeData(vstLocations.AddChild(nil));
1089
    locationInfo^.X := X;
1090
    locationInfo^.Y := Y;
1091
    locationInfo^.Name := locationName;
1092
  end;
1093
end;
1094
1095
procedure TfrmMain.acSelectExecute(Sender: TObject);
1096
begin
1097
  acSelect.Checked := True;
1098
  tbSelect.Down := True;
1099
  mnuSelect.Checked := True;
1100
  ProcessToolState;
1101
end;
1102
1103
procedure TfrmMain.acUndoExecute(Sender: TObject);
1104
var
1105
  i: Integer;
1106
begin
1107
  for i := FUndoList.Count - 1 downto 0 do
1108
  begin
1109
    dmNetwork.Send(FUndoList[i]);
1110
    FUndoList[i] := nil;
1111
  end;
1112
  FUndoList.Clear;
1113
  acUndo.Enabled := False;
1114
end;
1115
1116
procedure TfrmMain.acVirtualLayerExecute(Sender: TObject);
1117
begin
1118
  frmVirtualLayer.Show;
1119
end;
1120
1121
procedure TfrmMain.acDrawExecute(Sender: TObject);
1122
begin
1123
  acDraw.Checked := True;
1124
  tbDrawTile.Down := True;
1125
  mnuDraw.Checked := True;
1126
  frmDrawSettings.Show;
1127
  ProcessToolState;
1128
end;
1129
1130
procedure TfrmMain.acDeleteExecute(Sender: TObject);
1131
begin
1132
  acDelete.Checked := True;
1133
  tbDeleteTile.Down := True;
1134
  mnuDelete.Checked := True;
1135
  ProcessToolState;
1136
end;
1137
1138
procedure TfrmMain.acBoundariesExecute(Sender: TObject);
1139
begin
1140
  frmBoundaries.Show;
1141
end;
1142
1143
procedure TfrmMain.acElevateExecute(Sender: TObject);
1144
begin
1145
  acElevate.Checked := True;
1146
  tbElevateTile.Down := True;
1147
  mnuElevate.Checked := True;
1148
  ProcessToolState;
1149
  frmElevateSettings.Show;
1150
end;
1151
1152
procedure TfrmMain.acFilterExecute(Sender: TObject);
1153
begin
1154
  if acFilter.Checked then
1155
  begin
1156
    frmFilter.Show;
1157
    frmFilter.Locked := False;
1158
  end else
1159
    frmFilter.Hide;
1160
  InvalidateFilter;
1161
end;
1162
1163
procedure TfrmMain.acFlatExecute(Sender: TObject);
1164
begin
1165
  acFlat.Checked := not acFlat.Checked;
1166
  RebuildScreenBuffer;
1167
end;
1168
1169
procedure TfrmMain.acHueExecute(Sender: TObject);
1170
begin
1171
  acHue.Checked := True;
1172
  tbSetHue.Down := True;
1173
  mnuSetHue.Checked := True;
1174
  ProcessToolState;
1175
  frmHueSettings.Show;
1176
end;
1177
1178
procedure TfrmMain.acLightlevelExecute(Sender: TObject);
1179
begin
1180
  frmLightlevel.Show;
1181
end;
1182
1183
procedure TfrmMain.acMoveExecute(Sender: TObject);
1184
begin
1185
  acMove.Checked := True;
1186
  tbMoveTile.Down := True;
1187
  mnuMove.Checked := True;
1188
  ProcessToolState;
1189
  frmMoveSettings.Show;
1190
end;
1191
1192
procedure TfrmMain.acNoDrawExecute(Sender: TObject);
1193
begin
1194
  acNoDraw.Checked := not acNoDraw.Checked;
1195
  RebuildScreenBuffer;
1196
end;
1197
1198
procedure TfrmMain.btnClearRandomClick(Sender: TObject);
1199
begin
1200
  vdtRandom.BeginUpdate;
1201
  vdtRandom.Clear;
1202
  vdtRandom.EndUpdate;
1203
end;
1204
1205
procedure TfrmMain.btnDeleteLocationClick(Sender: TObject);
1206
begin
1207
  vstLocations.DeleteSelectedNodes;
1208
end;
1209
1210
procedure TfrmMain.btnDeleteRandomClick(Sender: TObject);
1211
begin
1212
  vdtRandom.BeginUpdate;
1213
  vdtRandom.DeleteSelectedNodes;
1214
  vdtRandom.EndUpdate;
1215
end;
1216
1217
procedure TfrmMain.cbStaticsChange(Sender: TObject);
1218
begin
1219
  if (not cbStatics.Checked) and (not cbTerrain.Checked) then
1220
    cbTerrain.Checked := True;
1221
  BuildTileList;
1222
end;
1223
1224
procedure TfrmMain.cbTerrainChange(Sender: TObject);
1225
begin
1226
  if (not cbTerrain.Checked) and (not cbStatics.Checked) then
1227
    cbStatics.Checked := True;
1228
  BuildTileList;
1229
end;
1230
1231
procedure TfrmMain.edChatKeyPress(Sender: TObject; var Key: char);
1232
begin
1233
  if Key = #13 then
1234
  begin
1235
    Key := #0;
1236
    if edChat.Text <> '' then
1237
    begin
1238
      dmNetwork.Send(TChatMessagePacket.Create(edChat.Text));
1239
      edChat.Text := '';
1240
    end;
1241
  end;
1242
end;
1243
1244
procedure TfrmMain.edFilterEditingDone(Sender: TObject);
1245
begin
1246
  BuildTileList;
1247
end;
1248
1249
procedure TfrmMain.FormActivate(Sender: TObject);
1250
begin
1251
  if oglGameWindow.MouseEntered then
1252
    oglGameWindowMouseEnter(Sender);
1253
end;
1254
1255
procedure TfrmMain.FormClose(Sender: TObject; var CloseAction: TCloseAction);
1256
begin
1257
  dmNetwork.CheckClose(Self);
1258
end;
1259
1260
procedure TfrmMain.FormDestroy(Sender: TObject);
1261
begin
1262
  CurrentTile := nil;
1263
  SelectedTile := nil;
1264
1265
  SaveLocations;
1266
  SaveRandomPresets;
1267
1268
  FreeAndNil(FTextureManager);
1269
  FreeAndNil(FScreenBuffer);
1270
  FreeAndNil(FOverlayUI);
1271
  FreeAndNil(FLightManager);
1272
  FreeAndNil(FVLayerImage);
1273
  FreeAndNil(FVLayerMaterial);
1274
  FreeAndNil(FVirtualTiles);
1275
  FreeAndNil(FUndoList);
1276
  FreeAndNil(FGLFont);
1277
  FreeAndNil(FRandomPresetsDoc);
1278
  FreeAndNil(FAccessChangedListeners);
1279
  FreeAndNil(FSelectionListeners);
1280
  
1281
  RegisterPacketHandler($0C, nil);
1282
end;
1283
1284
procedure TfrmMain.edSearchIDExit(Sender: TObject);
1285
begin
1286
  edSearchID.Visible := False;
1287
  edSearchID.Text := '';
1288
end;
1289
1290
procedure TfrmMain.edSearchIDKeyPress(Sender: TObject; var Key: char);
1291
var
1292
  enteredText: String;
1293
  tileID: Integer;
1294
  tileType: Char;
1295
  node: PVirtualNode;
1296
  tileInfo: PTileInfo;
1297
begin
1298
  if Key = #13 then
1299
  begin
1300
    Key := #0;
1301
    enteredText := edSearchID.Text;
1302
    tileType := #0;
1303
    if Length(enteredText) > 1 then
1304
      tileType := enteredText[Length(enteredText)];
1305
1306
    if not (tileType in ['S', 'T']) then
1307
    begin
1308
      if cbTerrain.Checked then
1309
        tileType := 'T'
1310
      else
1311
        tileType := 'S';
1312
    end else
1313
      Delete(enteredText, Length(enteredText), 1);
1314
    
1315
    tileID := 0;
1316
    if not TryStrToInt(enteredText, tileID) then
1317
    begin
1318
      MessageDlg('Error', 'The specified TileID is invalid.', mtError, [mbOK], 0);
1319
      vdtTiles.SetFocus;
1320
      Exit;
1321
    end;
1322
    
1323
    if tileType = 'S' then
1324
      Inc(tileID, $4000);
1325
      
1326
    node := vdtTiles.GetFirst;
1327
    while node <> nil do
1328
    begin
1329
      tileInfo := vdtTiles.GetNodeData(node);
1330
      if tileInfo^.ID = tileID then
1331
      begin
1332
        vdtTiles.ClearSelection;
1333
        vdtTiles.Selected[node] := True;
1334
        vdtTiles.FocusedNode := node;
1335
        Break;
1336
      end;
1337
      node := vdtTiles.GetNext(node);
1338
    end;
1339
    
1340
    if node = nil then
1341
    begin
1342
      MessageDlg('Error', 'The tile with the specified ID could not be found.' +
1343
        LineEnding + 'Check for conflicting filter settings.', mtError, [mbOK], 0);
1344
      vdtTiles.SetFocus;
1345
      Exit;
1346
    end;
1347
    edSearchID.Visible := False;
1348
  end else if Key = #27 then
1349
  begin
1350
    edSearchID.Visible := False;
1351
    Key := #0;
1352
  end else if not (Key in ['$', '0'..'9', 'a'..'f', 'A'..'F', 's', 'S',
1353
    't', 'T', #8]) then
1354
    Key := #0;
1355
end;
1356
1357
procedure TfrmMain.lblChatHeaderCaptionClick(Sender: TObject);
1358
begin
1359
  if pnlChat.Visible then
1360
  begin
1361
    pnlChat.Visible := False;
1362
    spChat.Visible := False;
1363
    pnlChatHeader.AnchorSide[akBottom].Control := pnlBottom;
1364
  end else
1365
  begin
1366
    spChat.Visible := True;
1367
    pnlChat.Visible := True;
1368
    spChat.Top := pnlChat.Top - spChat.Height;
1369
    pnlChatHeader.AnchorSide[akBottom].Control := spChat;
1370
    
1371
    lblChatHeaderCaption.Font.Bold := False;
1372
    lblChatHeaderCaption.Font.Italic := False;
1373
    lblChatHeaderCaption.Font.Color := clWindowText;
1374
    
1375
    edChat.SetFocus;
1376
  end;
1377
end;
1378
1379
procedure TfrmMain.lblChatHeaderCaptionMouseEnter(Sender: TObject);
1380
begin
1381
  lblChatHeaderCaption.Font.Underline := True;
1382
end;
1383
1384
procedure TfrmMain.lblChatHeaderCaptionMouseLeave(Sender: TObject);
1385
begin
1386
  lblChatHeaderCaption.Font.Underline := False;
1387
end;
1388
1389
procedure TfrmMain.mnuAboutClick(Sender: TObject);
1390
begin
1391
  frmAbout.ShowModal;
1392
end;
1393
1394
procedure TfrmMain.mnuAccountControlClick(Sender: TObject);
1395
begin
1396
  frmAccountControl.Show;
1397
end;
1398
1399
procedure TfrmMain.mnuDisconnectClick(Sender: TObject);
1400
begin
1401
  dmNetwork.Disconnect;
1402
end;
1403
1404
procedure TfrmMain.oglGameWindowPaint(Sender: TObject);
1405
begin
1406
  glClearColor(0, 0, 0, 1);
1407
  glClear(GL_COLOR_BUFFER_BIT);
1408
1409
  InitRender;
1410
  InitSize;
1411
1412
  glDisable(GL_DEPTH_TEST);
1413
  Render;
1414
1415
  oglGameWindow.SwapBuffers;
1416
end;
1417
1418
procedure TfrmMain.oglGameWindowResize(Sender: TObject);
1419
begin
1420
  InvalidateScreenBuffer;
1421
end;
1422
1423
procedure TfrmMain.pmGrabTileInfoPopup(Sender: TObject);
1424
begin
1425
  mnuGrabHue.Enabled := CurrentTile is TStaticItem;
1426
end;
1427
1428
procedure TfrmMain.tbFilterMouseMove(Sender: TObject; Shift: TShiftState; X,
1429
  Y: Integer);
1430
begin
1431
  if acFilter.Checked and (not frmFilter.Visible) then
1432
    frmFilter.Show;
1433
end;
1434
1435
procedure TfrmMain.tbRadarMapClick(Sender: TObject);
1436
begin
1437
  frmRadarMap.Show;
1438
  frmRadarMap.BringToFront;
1439
end;
1440
1441
procedure TfrmMain.tbStaticsClick(Sender: TObject);
1442
begin
1443
  RebuildScreenBuffer;
1444
end;
1445
1446
procedure TfrmMain.tbTerrainClick(Sender: TObject);
1447
begin
1448
  RebuildScreenBuffer;
1449
end;
1450
1451
procedure TfrmMain.tmGrabTileInfoTimer(Sender: TObject);
1452
begin
1453
  tmGrabTileInfo.Enabled := False;
1454
  if CurrentTile <> nil then
1455
    pmGrabTileInfo.PopUp(Mouse.CursorPos.X, Mouse.CursorPos.Y);
1456
    
1457
  SelectedTile := nil;
1458
end;
1459
1460
procedure TfrmMain.tmMovementTimer(Sender: TObject);
1461
begin
1462
  case FOverlayUI.ActiveArrow of
1463
    0: MoveBy(-8, 0);
1464
    1: MoveBy(-8, -8);
1465
    2: MoveBy(0, -8);
1466
    3: MoveBy(8, -8);
1467
    4: MoveBy(8, 0);
1468
    5: MoveBy(8, 8);
1469
    6: MoveBy(0, 8);
1470
    7: MoveBy(-8, 8);
1471
  end;
1472
end;
1473
1474
procedure TfrmMain.vdtRandomClick(Sender: TObject);
1475
var
1476
  node: PVirtualNode;
1477
  tileInfo: PTileInfo;
1478
  selectedID: Integer;
1479
begin
1480
  if vdtRandom.SelectedCount = 1 then
1481
  begin
1482
    node := vdtRandom.GetFirstSelected;
1483
    if node <> nil then
1484
    begin
1485
      tileInfo := vdtRandom.GetNodeData(node);
1486
      selectedID := tileInfo^.ID;
1487
1488
      node := vdtTiles.GetFirst;
1489
      while node <> nil do
1490
      begin
1491
        tileInfo := vdtTiles.GetNodeData(node);
1492
        if tileInfo^.ID = selectedID then
1493
        begin
1494
          vdtTiles.ClearSelection;
1495
          vdtTiles.Selected[node] := True;
1496
          vdtTiles.FocusedNode := node;
1497
          node := nil;
1498
        end else
1499
          node := vdtTiles.GetNext(node);
1500
      end;
1501
    end;
1502
  end;
1503
end;
1504
1505
procedure TfrmMain.vdtRandomDragDrop(Sender: TBaseVirtualTree; Source: TObject;
1506
  DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState;
1507
  Pt: TPoint; var Effect: Integer; Mode: TDropMode);
1508
begin
1509
  if Source = vdtTiles then
1510
    btnAddRandomClick(Sender);
1511
end;
1512
1513
procedure TfrmMain.vdtRandomDragOver(Sender: TBaseVirtualTree; Source: TObject;
1514
  Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode;
1515
  var Effect: Integer; var Accept: Boolean);
1516
begin
1517
  if source = vdtTiles then Accept := True;
1518
end;
1519
1520
procedure TfrmMain.vdtRandomLoadNode(Sender: TBaseVirtualTree;
1521
  Node: PVirtualNode; Stream: TStream);
1522
var
1523
  tileInfo: PTileInfo;
1524
begin
1525
  tileInfo := Sender.GetNodeData(Node);
1526
  Stream.Read(tileInfo^.ID, SizeOf(tileInfo^.ID));
1527
end;
1528
1529
procedure TfrmMain.vdtRandomSaveNode(Sender: TBaseVirtualTree;
1530
  Node: PVirtualNode; Stream: TStream);
1531
var
1532
  tileInfo: PTileInfo;
1533
begin
1534
  tileInfo := Sender.GetNodeData(Node);
1535
  Stream.Write(tileInfo^.ID, SizeOf(tileInfo^.ID));
1536
end;
1537
1538
procedure TfrmMain.vdtRandomUpdating(Sender: TBaseVirtualTree;
1539
  State: TVTUpdateState);
1540
begin
1541
  if acDraw.Checked then
1542
    ProcessToolState;
1543
end;
1544
1545
procedure TfrmMain.vdtTilesClick(Sender: TObject);
1546
begin
1547
  if acDraw.Checked then
1548
    ProcessToolState;
1549
end;
1550
1551
procedure TfrmMain.vdtTilesDrawHint(Sender: TBaseVirtualTree;
1552
  HintCanvas: TCanvas; Node: PVirtualNode; const R: TRect; Column: TColumnIndex
1553
  );
1554
begin
1555
  HintCanvas.Font.Assign(Sender.Font);
1556
  HintCanvas.Font.Style := [fsBold];
1557
  DrawText(HintCanvas.Handle, PChar(FTileHint.Name), Length(FTileHint.Name),
1558
    FTileHint.NameRect, 0);
1559
  HintCanvas.Font.Style := [fsItalic];
1560
  DrawText(HintCanvas.Handle, PChar(FTileHint.Flags), Length(FTileHint.Flags),
1561
    FTileHint.FlagsRect, DT_WORDBREAK);
1562
end;
1563
1564
procedure TfrmMain.vdtTilesDrawNode(Sender: TBaseVirtualTree;
1565
  const PaintInfo: TVTPaintInfo);
1566
var
1567
  tileInfo: PTileInfo;
1568
  textStyle: TTextStyle;
1569
  artEntry: TArt;
1570
  tileData: TTileData;
1571
  id: Integer;
1572
begin
1573
  tileInfo := Sender.GetNodeData(PaintInfo.Node);
1574
  textStyle := PaintInfo.Canvas.TextStyle;
1575
  textStyle.Alignment := taCenter;
1576
  textStyle.Layout := tlCenter;
1577
  textStyle.Wordbreak := True;
1578
  case PaintInfo.Column of
1579
    0:
1580
      begin
1581
        id := tileInfo^.ID;
1582
        if id > $3FFF then
1583
          Dec(id, $4000);
1584
        PaintInfo.Canvas.TextRect(PaintInfo.CellRect, 0, 0, Format('$%x', [id]),
1585
          textStyle);
1586
      end;
1587
    1:
1588
      begin
1589
        if ResMan.Art.Exists(tileInfo^.ID) then
1590
        begin
1591
          artEntry := ResMan.Art.GetArt(tileInfo^.ID,
1592
            RGB2ARGB(PaintInfo.Canvas.Pixels[PaintInfo.CellRect.Left,
1593
              PaintInfo.CellRect.Top]), nil, False);
1594
          DisplayImage(PaintInfo.Canvas, PaintInfo.CellRect, artEntry.Graphic);
1595
          artEntry.Free;
1596
        end;
1597
      end;
1598
    2:
1599
      begin
1600
        tileData := TTileData(ResMan.Tiledata.Block[tileInfo^.ID]);
1601
        PaintInfo.Canvas.TextRect(PaintInfo.CellRect, PaintInfo.CellRect.Left,
1602
          PaintInfo.CellRect.Top, ISO_8859_1ToUTF8(Trim(tileData.TileName)),
1603
          textStyle);
1604
        tileData.Free;
1605
      end;
1606
  end;
1607
end;
1608
1609
procedure TfrmMain.vdtTilesEnter(Sender: TObject);
1610
begin
1611
  if acFilter.Checked and (not frmFilter.Visible) and (not frmFilter.Locked) then
1612
  begin
1613
    frmFilter.Locked := True;
1614
    frmFilter.Show;
1615
    frmMain.SetFocus;
1616
    frmFilter.Locked := False;
1617
  end;
1618
end;
1619
1620
procedure TfrmMain.vdtTilesGetHintSize(Sender: TBaseVirtualTree;
1621
  Node: PVirtualNode; Column: TColumnIndex; var R: TRect);
1622
var
1623
  tileInfo: PTileInfo;
1624
  tileData: TTiledata;
1625
  prefix, flags: string;
1626
1627
  procedure UpdateFlags(AFlag: TTileDataFlag; AName: string);
1628
  begin
1629
    if AFlag in tileData.Flags then
1630
    begin
1631
      if flags <> '' then
1632
        flags := flags + ', ' + AName
1633
      else
1634
        flags := AName;
1635
    end;
1636
  end;
1637
1638
begin
1639
  tileInfo := Sender.GetNodeData(Node);
1640
  flags := '';
1641
1642
  tileData := ResMan.Tiledata.TileData[tileInfo^.ID];
1643
  if tileInfo^.ID < $4000 then
1644
  begin
1645
    if TLandTiledata(tileData).TextureID > 0 then
1646
      flags := 'Stretchable';
1647
  end;
1648
1649
  if tdfArticleA in tileData.Flags then
1650
    prefix := 'a '
1651
  else if tdfArticleAn in tileData.Flags then
1652
    prefix := 'an '
1653
  else
1654
    prefix := '';
1655
1656
  FTileHint.Name := AnsiProperCase(Format('%s%s',
1657
    [prefix, tileData.TileName]), [' ']);
1658
  FTileHint.NameRect.Left := 5;
1659
  FTileHint.NameRect.Top := 5;
1660
  Sender.Canvas.Font.Style := [fsBold];
1661
  DrawText(Sender.Canvas.Handle, PChar(FTileHint.Name), Length(FTileHint.Name),
1662
    FTileHint.NameRect, DT_CALCRECT);
1663
1664
  UpdateFlags(tdfBackground, 'Background');
1665
  UpdateFlags(tdfWeapon, 'Weapon');
1666
  UpdateFlags(tdfTransparent, 'Transparent');
1667
  UpdateFlags(tdfTranslucent, 'Translucent');
1668
  UpdateFlags(tdfWall, 'Wall');
1669
  UpdateFlags(tdfDamaging, 'Damaging');
1670
  UpdateFlags(tdfImpassable, 'Impassable');
1671
  UpdateFlags(tdfWet, 'Wet');
1672
  UpdateFlags(tdfSurface, 'Surface');
1673
  UpdateFlags(tdfBridge, 'Bridge');
1674
  UpdateFlags(tdfGeneric, 'Generic');
1675
  UpdateFlags(tdfWindow, 'Window');
1676
  UpdateFlags(tdfNoShoot, 'NoShoot');
1677
  UpdateFlags(tdfInternal, 'Internal');
1678
  UpdateFlags(tdfFoliage, 'Foliage');
1679
  UpdateFlags(tdfPartialHue, 'PartialHue');
1680
  UpdateFlags(tdfMap, 'Map');
1681
  UpdateFlags(tdfContainer, 'Container');
1682
  UpdateFlags(tdfWearable, 'Wearable');
1683
  UpdateFlags(tdfLightSource, 'Lightsource');
1684
  UpdateFlags(tdfAnimation, 'Animation');
1685
  UpdateFlags(tdfNoDiagonal, 'NoDiagonal');
1686
  UpdateFlags(tdfArmor, 'Armor');
1687
  UpdateFlags(tdfRoof, 'Roof');
1688
  UpdateFlags(tdfDoor, 'Door');
1689
  UpdateFlags(tdfStairBack, 'StairBack');
1690
  UpdateFlags(tdfStairRight, 'StairRight');
1691
1692
  FTileHint.Flags := Format('Flags = [%s]', [flags]);
1693
  FTileHint.FlagsRect.Left := 5;
1694
  FTileHint.FlagsRect.Top := FTileHint.NameRect.Bottom + 5;
1695
  FTileHint.FlagsRect.Right := 145;
1696
  Sender.Canvas.Font.Style := [fsItalic];
1697
  DrawText(Sender.Canvas.Handle, PChar(FTileHint.Flags), Length(FTileHint.Flags),
1698
    FTileHint.FlagsRect, DT_CALCRECT or DT_WORDBREAK);
1699
1700
  R := Rect(0, 0, Max(FTileHint.NameRect.Right, FTileHint.FlagsRect.Right) + 5,
1701
    FTileHint.FlagsRect.Bottom + 5);
1702
end;
1703
1704
procedure TfrmMain.vdtTilesKeyPress(Sender: TObject; var Key: char);
1705
begin
1706
  if Key in ['$', '0'..'9'] then
1707
  begin
1708
    edSearchID.Text := Key;
1709
    edSearchID.Visible := True;
1710
    edSearchID.SetFocus;
1711
    edSearchID.SelStart := 1;
1712
    Key := #0;
1713
  end;
1714
end;
1715
1716
procedure TfrmMain.vdtTilesScroll(Sender: TBaseVirtualTree; DeltaX,
1717
  DeltaY: Integer);
1718
begin
1719
  if Sender.CanFocus and Sender.MouseEntered then
1720
    Sender.SetFocus;
1721
end;
1722
1723
procedure TfrmMain.vstChatClick(Sender: TObject);
1724
begin
1725
  edChat.SetFocus;
1726
end;
1727
1728
procedure TfrmMain.vstChatFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
1729
var
1730
  chatInfo: PChatInfo;
1731
begin
1732
  chatInfo := Sender.GetNodeData(Node);
1733
  chatInfo^.Sender := '';
1734
  chatInfo^.Msg := '';
1735
end;
1736
1737
procedure TfrmMain.vstChatGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
1738
  Column: TColumnIndex; TextType: TVSTTextType; var CellText: String);
1739
var
1740
  chatInfo: PChatInfo;
1741
begin
1742
  chatInfo := Sender.GetNodeData(Node);
1743
  case Column of
1744
    0: CellText := TimeToStr(chatInfo^.Time);
1745
    1: CellText := chatInfo^.Sender;
1746
    2: CellText := chatInfo^.Msg;
1747
  end;
1748
end;
1749
1750
procedure TfrmMain.vstChatPaintText(Sender: TBaseVirtualTree;
1751
  const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
1752
  TextType: TVSTTextType);
1753
var
1754
  chatInfo: PChatInfo;
1755
begin
1756
  chatInfo := Sender.GetNodeData(Node);
1757
  if chatInfo^.Sender = 'System' then
1758
  begin
1759
    if Column = 1 then
1760
      TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsItalic, fsBold]
1761
    else
1762
      TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsItalic];
1763
  end;
1764
end;
1765
1766
procedure TfrmMain.vstLocationsDblClick(Sender: TObject);
1767
var
1768
  node: PVirtualNode;
1769
  locationInfo: PLocationInfo;
1770
begin
1771
  node := vstLocations.GetFirstSelected;
1772
  if node <> nil then
1773
  begin
1774
    locationInfo := vstLocations.GetNodeData(node);
1775
    SetPos(locationInfo^.X, locationInfo^.Y);
1776
  end;
1777
end;
1778
1779
procedure TfrmMain.vstLocationsFreeNode(Sender: TBaseVirtualTree;
1780
  Node: PVirtualNode);
1781
var
1782
  locationInfo: PLocationInfo;
1783
begin
1784
  locationInfo := Sender.GetNodeData(Node);
1785
  locationInfo^.Name := EmptyStr;
1786
end;
1787
1788
procedure TfrmMain.vstLocationsGetText(Sender: TBaseVirtualTree;
1789
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
1790
  var CellText: String);
1791
var
1792
  locationInfo: PLocationInfo;
1793
begin
1794
  locationInfo := Sender.GetNodeData(Node);
1795
  case Column of
1796
    0: CellText := Format('%d, %d', [locationInfo^.X, locationInfo^.Y]);
1797
    1: CellText := locationInfo^.Name;
1798
  end;
1799
end;
1800
1801
procedure TfrmMain.vstLocationsLoadNode(Sender: TBaseVirtualTree;
1802
  Node: PVirtualNode; Stream: TStream);
1803
var
1804
  locationInfo: PLocationInfo;
1805
  stringLength: Integer;
1806
  s: string;
1807
begin
1808
  locationInfo := Sender.GetNodeData(Node);
1809
  Stream.Read(locationInfo^.X, SizeOf(Word));
1810
  Stream.Read(locationInfo^.Y, SizeOf(Word));
1811
  stringLength := 0;
1812
  Stream.Read(stringLength, SizeOf(Integer));
1813
  SetLength(s, stringLength);
1814
  Stream.Read(s[1], stringLength);
1815
  locationInfo^.Name := s;
1816
end;
1817
1818
procedure TfrmMain.vstLocationsNewText(Sender: TBaseVirtualTree;
1819
  Node: PVirtualNode; Column: TColumnIndex; const NewText: String);
1820
var
1821
  locationInfo: PLocationInfo;
1822
begin
1823
  if Column = 1 then
1824
  begin
1825
    locationInfo := Sender.GetNodeData(Node);
1826
    locationInfo^.Name := NewText;
1827
  end;
1828
end;
1829
1830
procedure TfrmMain.vstLocationsSaveNode(Sender: TBaseVirtualTree;
1831
  Node: PVirtualNode; Stream: TStream);
1832
var
1833
  locationInfo: PLocationInfo;
1834
  stringLength: Integer;
1835
begin
1836
  locationInfo := Sender.GetNodeData(Node);
1837
  Stream.Write(locationInfo^.X, SizeOf(Word));
1838
  Stream.Write(locationInfo^.Y, SizeOf(Word));
1839
  stringLength := Length(locationInfo^.Name);
1840
  Stream.Write(stringLength, SizeOf(Integer));
1841
  Stream.Write(locationInfo^.Name[1], stringLength);
1842
end;
1843
1844
procedure TfrmMain.XMLPropStorage1RestoreProperties(Sender: TObject);
1845
begin
1846
  FTextureManager.UseAnims := mnuShowAnimations.Checked;
1847
end;
1848
1849
procedure TfrmMain.SetX(const AValue: Integer);
1850
begin
1851
  SetPos(AValue, FY);
1852
end;
1853
1854
procedure TfrmMain.SetY(const AValue: Integer);
1855
begin
1856
  SetPos(FX, AValue);
1857
end;
1858
1859
procedure TfrmMain.SetPos(AX, AY: Word);
1860
begin
1861
  if InRange(AX, 0, FLandscape.CellWidth - 1) and InRange(AY, 0,
1862
    FLandscape.CellHeight - 1) then
1863
  begin
1864
    FX := AX;
1865
    edX.Value := FX;
1866
    FY := AY;
1867
    edY.Value := FY;
1868
    dmNetwork.Send(TUpdateClientPosPacket.Create(AX, AY));
1869
    InvalidateScreenBuffer;
1870
    if frmRadarMap <> nil then frmRadarMap.Repaint;
1871
  end;
1872
end;
1873
1874
procedure TfrmMain.SwitchToSelection;
1875
begin
1876
  acSelect.Checked := True;
1877
  BringToFront;
1878
end;
1879
1880
procedure TfrmMain.RegisterAccessChangedListener(
1881
  AListener: TAccessChangedListener);
1882
begin
1883
  if FAccessChangedListeners.IndexOf(AListener) < 0 then
1884
    FAccessChangedListeners.Add(AListener);
1885
end;
1886
1887
procedure TfrmMain.RegisterSelectionListener(AListener: TSelectionListener);
1888
begin
1889
  if FSelectionListeners.IndexOf(AListener) < 0 then
1890
    FSelectionListeners.Add(AListener);
1891
end;
1892
1893
procedure TfrmMain.UnregisterAccessChangedListener(
1894
  AListener: TAccessChangedListener);
1895
begin
1896
  FAccessChangedListeners.Remove(AListener);
1897
end;
1898
1899
procedure TfrmMain.UnregisterSelectionListener(AListener: TSelectionListener);
1900
begin
1901
  FSelectionListeners.Remove(AListener);
1902
end;
1903
1904
procedure TfrmMain.SetCurrentTile(const AValue: TWorldItem);
1905
begin
1906
  //Logger.EnterMethod([lcClient, lcDebug], 'SetCurrentTile');
1907
  if AValue = FCurrentTile then
1908
  begin
1909
    //Logger.ExitMethod([lcClient, lcDebug], 'SetCurrentTile');
1910
    Exit;
1911
  end;
1912
  //Logger.Send([lcClient, lcDebug], 'Value', AValue);
1913
1914
  if FCurrentTile <> nil then
1915
    FCurrentTile.OnDestroy.UnregisterEvent(@OnTileRemoved);
1916
  FCurrentTile := AValue;
1917
1918
  if FCurrentTile = nil then
1919
  begin
1920
    lblTileInfo.Caption := '';
1921
  end else
1922
  begin
1923
    FCurrentTile.OnDestroy.RegisterEvent(@OnTileRemoved);
1924
    if FCurrentTile is TVirtualTile then
1925
      lblTileInfo.Caption := Format('Virtual Layer: X: %d, Y: %d, Z: %d',
1926
        [FCurrentTile.X, FCurrentTile.Y, FCurrentTile.Z])
1927
    else if FCurrentTile is TMapCell then
1928
      lblTileInfo.Caption := Format('Terrain TileID: $%x, X: %d, Y: %d, Z: %d',
1929
        [FCurrentTile.TileID, FCurrentTile.X, FCurrentTile.Y, FCurrentTile.Z])
1930
    else if FCurrentTile is TStaticItem then
1931
      {lblTileInfo.Caption := Format('Static TileID: $%x, X: %d, Y: %d, Z: %d, Hue: $%x',
1932
        [FCurrentTile.TileID, FCurrentTile.X, FCurrentTile.Y, FCurrentTile.Z,
1933
         TStaticItem(FCurrentTile).Hue]);}
1934
      lblTileInfo.Caption := Format('Static TileID: $%x, X: %d, Y: %d, Z: %d, Hue: $%x, Priority: %d, Bonus: %d, Solver: %d',
1935
        [FCurrentTile.TileID, FCurrentTile.X, FCurrentTile.Y, FCurrentTile.Z,
1936
         TStaticItem(FCurrentTile).Hue, FCurrentTile.Priority, FCurrentTile.PriorityBonus,
1937
         FCurrentTile.PrioritySolver]);
1938
  end;
1939
1940
  UpdateSelection;
1941
  //Logger.ExitMethod([lcClient, lcDebug], 'SetCurrentTile');
1942
end;
1943
1944
procedure TfrmMain.SetSelectedTile(const AValue: TWorldItem);
1945
begin
1946
  //Logger.EnterMethod([lcClient, lcDebug], 'SetSelectedTile');
1947
  if AValue = FSelectedTile then
1948
  begin
1949
    //Logger.ExitMethod([lcClient, lcDebug], 'SetSelectedTile');
1950
    Exit;
1951
  end;
1952
  //Logger.Send([lcClient, lcDebug], 'Value', AValue);
1953
1954
  if FSelectedTile <> nil then
1955
    FSelectedTile.OnDestroy.UnregisterEvent(@OnTileRemoved);
1956
  FSelectedTile := AValue;
1957
  if FSelectedTile <> nil then
1958
    FSelectedTile.OnDestroy.RegisterEvent(@OnTileRemoved);
1959
1960
  UpdateSelection;
1961
  //Logger.ExitMethod([lcClient, lcDebug], 'SetSelectedTile');
1962
end;
1963
1964
procedure TfrmMain.SetNormalLights;
1965
const
1966
  specular: TGLArrayf4 = (2, 2, 2, 1);
1967
  ambient: TGLArrayf4 = (1, 1, 1, 1);
1968
begin
1969
  glLightfv(GL_LIGHT0, GL_AMBIENT, @specular);
1970
  glLightModelfv(GL_LIGHT_MODEL_AMBIENT, @ambient);
1971
end;
1972
1973
procedure TfrmMain.SetDarkLights;
1974
const
1975
  specularDark: TGLArrayf4 = (0.5, 0.5, 0.5, 1);
1976
  ambientDark: TGLArrayf4 = (0.25, 0.25, 0.25, 1);
1977
begin
1978
  glLightfv(GL_LIGHT0, GL_AMBIENT, @specularDark);
1979
  glLightModelfv(GL_LIGHT_MODEL_AMBIENT, @ambientDark);
1980
end;
1981
1982
procedure TfrmMain.InitRender;
1983
const
1984
  lightPosition: TGLArrayf4 = (-1, -1, 0.5, 0);
1985
begin
1986
  glEnable(GL_ALPHA_TEST);
1987
  glAlphaFunc(GL_GREATER, 0.1);
1988
  glEnable(GL_TEXTURE_2D);
1989
  glDisable(GL_DITHER);
1990
  glEnable(GL_BLEND); // Enable alpha blending of textures
1991
  glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
1992
  glShadeModel(GL_SMOOTH);
1993
  glEnable(GL_NORMALIZE);
1994
1995
  glEnable(GL_LIGHT0);
1996
  glLightfv(GL_LIGHT0, GL_POSITION, @lightPosition);
1997
  glLightModeli(GL_LIGHT_MODEL_TWO_SIDE, GL_FALSE);
1998
end;
1999
2000
procedure TfrmMain.InitSize;
2001
begin
2002
  glViewport(0, 0, oglGameWindow.Width, oglGameWindow.Height);
2003
  glMatrixMode(GL_PROJECTION);
2004
  glLoadIdentity;
2005
  gluOrtho2D(0, oglGameWindow.Width, oglGameWindow.Height, 0);
2006
  glMatrixMode(GL_MODELVIEW);
2007
  glLoadIdentity;
2008
end;
2009
2010
procedure TfrmMain.LoadLocations;
2011
var
2012
  xmlDoc: TXMLDocument;
2013
  location: TDOMElement;
2014
  locationNode: PVirtualNode;
2015
  locationInfo: PLocationInfo;
2016
  locations: TDOMNodeList;
2017
  i, j: Integer;
2018
begin
2019
  vstLocations.Clear;
2020
2021
  if FileExists(FLocationsFile) then
2022
  begin
2023
    ReadXMLFile(xmlDoc, FLocationsFile);
2024
    if xmlDoc.DocumentElement.NodeName = 'Locations' then
2025
    begin
2026
      locations := xmlDoc.DocumentElement.ChildNodes;
2027
      for i := 0 to locations.Count - 1 do
2028
      begin
2029
        location := TDOMElement(locations[i]);
2030
        if location.NodeName = 'Location' then
2031
        begin
2032
          locationNode := vstLocations.AddChild(nil);
2033
          locationInfo := vstLocations.GetNodeData(locationNode);
2034
          locationInfo^.Name := location.AttribStrings['Name'];
2035
2036
          if TryStrToInt(location.AttribStrings['X'], j) then
2037
            locationInfo^.X := j
2038
          else
2039
            locationInfo^.X := 0;
2040
2041
          if TryStrToInt(location.AttribStrings['Y'], j) then
2042
            locationInfo^.Y := j
2043
          else
2044
            locationInfo^.Y := 0;
2045
        end;
2046
      end;
2047
    end;
2048
2049
    xmlDoc.Free;
2050
  end;
2051
end;
2052
2053
procedure TfrmMain.LoadRandomPresets;
2054
var
2055
  presets: TDOMNodeList;
2056
  i: Integer;
2057
begin
2058
  cbRandomPreset.Clear;
2059
2060
  FreeAndNil(FRandomPresetsDoc);
2061
  if FileExists(FRandomPresetsFile) then
2062
  begin
2063
    ReadXMLFile(FRandomPresetsDoc, FRandomPresetsFile);
2064
    presets := FRandomPresetsDoc.DocumentElement.ChildNodes;
2065
    for i := 0 to presets.Count - 1 do
2066
    begin
2067
      if presets[i].NodeName = 'Preset' then
2068
      begin
2069
        cbRandomPreset.Items.AddObject(TDOMElement(presets[i]).AttribStrings['Name'],
2070
          presets[i]);
2071
      end;
2072
    end;
2073
  end else
2074
  begin
2075
    FRandomPresetsDoc := TXMLDocument.Create;
2076
    FRandomPresetsDoc.AppendChild(FRandomPresetsDoc.CreateElement('RandomPresets'));
2077
  end;
2078
end;
2079
2080
procedure TfrmMain.MoveBy(AOffsetX, AOffsetY: Integer); inline;
2081
begin
2082
  SetPos(EnsureRange(FX + AOffsetX, 0, FLandscape.CellWidth - 1),
2083
         EnsureRange(FY + AOffsetY, 0, FLandscape.CellHeight - 1));
2084
  UpdateCurrentTile;
2085
end;
2086
2087
procedure TfrmMain.PrepareMapCell(AMapCell: TMapCell);
2088
var
2089
  current, north, east, west: PBlockInfo;
2090
  cell: TMapCell;
2091
begin
2092
  current := FScreenBuffer.UpdateSortOrder(AMapCell);
2093
  if current = nil then
2094
    Exit; //off-screen update
2095
2096
  PrepareScreenBlock(current);
2097
  Exclude(FScreenBufferState, sbsIndexed);
2098
2099
  //Find surrounding cells
2100
  current := nil;
2101
  north := nil;
2102
  east := nil;
2103
  west := nil;
2104
  while ((north = nil) or (east = nil) or (west = nil)) and
2105
    FScreenBuffer.Iterate(current) do
2106
  begin
2107
    if current^.Item is TMapCell then
2108
    begin
2109
      cell := TMapCell(current^.Item);
2110
      if (cell.X = AMapCell.X - 1) and (cell.Y = AMapCell.Y - 1) then
2111
        north := current
2112
      else if (cell.X = AMapCell.X) and (cell.Y = AMapCell.Y - 1) then
2113
        east := current
2114
      else if (cell.X = AMapCell.X - 1) and (cell.Y = AMapCell.Y) then
2115
        west := current;
2116
    end;
2117
  end;
2118
2119
  if north <> nil then PrepareScreenBlock(north);
2120
  if east <> nil then PrepareScreenBlock(east);
2121
  if west <> nil then PrepareScreenBlock(west);
2122
end;
2123
2124
procedure TfrmMain.InvalidateFilter;
2125
begin
2126
  Exclude(FScreenBufferState, sbsFiltered);
2127
end;
2128
2129
procedure TfrmMain.InvalidateScreenBuffer;
2130
begin
2131
  Exclude(FScreenBufferState, sbsValid);
2132
end;
2133
2134
procedure TfrmMain.PrepareScreenBlock(ABlockInfo: PBlockInfo);
2135
2136
  procedure GetLandAlt(const AX, AY: Integer; const ADefaultZ,
2137
    ADefaultRaw: SmallInt; out Z, RawZ: SmallInt);
2138
  var
2139
    cell: TMapCell;
2140
  begin
2141
    cell := FLandscape.MapCell[AX, AY];
2142
    if cell <> nil then
2143
    begin
2144
      Z := cell.Z;
2145
      RawZ := cell.RawZ;
2146
    end else
2147
    begin
2148
      Z := ADefaultZ;
2149
      RawZ := ADefaultRaw;
2150
    end;
2151
  end;
2152
2153
var
2154
  item: TWorldItem;
2155
  drawX, drawY: Integer;
2156
  z, west, south, east: SmallInt;
2157
  rawZ, rawWest, rawSouth, rawEast: SmallInt;
2158
  staticItem: TStaticItem;
2159
begin
2160
  //add normals to map tiles and materials where possible
2161
2162
  item := ABlockInfo^.Item;
2163
2164
  GetDrawOffset(item.X , item.Y, drawX, drawY);
2165
2166
  if acFlat.Checked then
2167
  begin
2168
    z := 0;
2169
    rawZ := 0;
2170
  end else
2171
  begin
2172
    z := item.Z;
2173
    rawZ := item.RawZ;
2174
  end;
2175
2176
  if ABlockInfo^.HighRes <> nil then ABlockInfo^.HighRes.DelRef;
2177
  if ABlockInfo^.LowRes <> nil then ABlockInfo^.LowRes.DelRef;
2178
2179
  ABlockInfo^.HighRes := nil;
2180
  ABlockInfo^.CheckRealQuad := False;
2181
  ABlockInfo^.Text.Free;
2182
2183
  if item is TMapCell then
2184
  begin
2185
    if not acFlat.Checked then
2186
    begin
2187
      GetLandAlt(item.X, item.Y + 1, z, rawZ, west, rawWest);
2188
      GetLandAlt(item.X + 1, item.Y + 1, z, rawZ, south, rawSouth);
2189
      GetLandAlt(item.X + 1, item.Y, z, rawZ, east, rawEast);
2190
2191
      if  (west <> z) or (south <> z) or (east <> z) then
2192
        ABlockInfo^.HighRes := FTextureManager.GetTexMaterial(item.TileID);
2193
2194
      if (rawWest <> rawZ) or (rawSouth <> rawZ) or (rawEast <> rawZ) then
2195
      begin
2196
        ABlockInfo^.RealQuad[0][0] := drawX;
2197
        ABlockInfo^.RealQuad[0][1] := drawY - rawZ * 4;
2198
        ABlockInfo^.RealQuad[1][0] := drawX + 22;
2199
        ABlockInfo^.RealQuad[1][1] := drawY + 22 - rawEast * 4;
2200
        ABlockInfo^.RealQuad[2][0] := drawX;
2201
        ABlockInfo^.RealQuad[2][1] := drawY + 44 - rawSouth * 4;
2202
        ABlockInfo^.RealQuad[3][0] := drawX - 22;
2203
        ABlockInfo^.RealQuad[3][1] := drawY + 22 - rawWest * 4;
2204
2205
        with ABlockInfo^ do
2206
        begin
2207
          with ScreenRect do
2208
          begin
2209
            Left := drawX - 22;
2210
            Right := drawX + 22;
2211
            Top := RealQuad[0][1];
2212
            Bottom := RealQuad[0][1];
2213
2214
            if RealQuad[1][1] < Top then Top := RealQuad[1][1];
2215
            if RealQuad[1][1] > Bottom then Bottom := RealQuad[1][1];
2216
2217
            if RealQuad[2][1] < Top then Top := RealQuad[2][1];
2218
            if RealQuad[2][1] > Bottom then Bottom := RealQuad[2][1];
2219
2220
            if RealQuad[3][1] < Top then Top := RealQuad[3][1];
2221
            if RealQuad[3][1] > Bottom then Bottom := RealQuad[3][1];
2222
          end;
2223
          CheckRealQuad := True;
2224
        end;
2225
      end;
2226
    end else
2227
    begin
2228
      if mnuFlatShowHeight.Checked then
2229
        ABlockInfo^.Text := TGLText.Create(FGLFont, IntToStr(item.Z));
2230
    end;
2231
2232
    if not ABlockInfo^.CheckRealQuad then
2233
      ABlockInfo^.ScreenRect := Bounds(Trunc(drawX - 22),
2234
        Trunc(drawY - rawZ * 4), 44, 44);
2235
2236
    ABlockInfo^.LowRes := FTextureManager.GetArtMaterial(item.TileID);
2237
2238
    if ABlockInfo^.HighRes <> nil then
2239
    begin
2240
      if ABlockInfo^.Normals = nil then
2241
        New(ABlockInfo^.Normals);
2242
      FLandscape.GetNormals(item.X, item.Y, ABlockInfo^.Normals^);
2243
      ABlockInfo^.DrawQuad[0][0] := drawX;
2244
      ABlockInfo^.DrawQuad[0][1] := drawY - z * 4;
2245
      ABlockInfo^.DrawQuad[1][0] := drawX + 22;
2246
      ABlockInfo^.DrawQuad[1][1] := drawY + 22 - east * 4;
2247
      ABlockInfo^.DrawQuad[2][0] := drawX;
2248
      ABlockInfo^.DrawQuad[2][1] := drawY + 44 - south * 4;
2249
      ABlockInfo^.DrawQuad[3][0] := drawX - 22;
2250
      ABlockInfo^.DrawQuad[3][1] := drawY + 22 - west * 4;
2251
    end else
2252
    begin
2253
      ABlockInfo^.DrawQuad[0][0] := drawX - 22;
2254
      ABlockInfo^.DrawQuad[0][1] := drawY - z * 4;
2255
      ABlockInfo^.DrawQuad[1][0] := drawX - 22 + ABlockInfo^.LowRes.Width;
2256
      ABlockInfo^.DrawQuad[1][1] := drawY - z * 4;
2257
      ABlockInfo^.DrawQuad[2][0] := drawX - 22 + ABlockInfo^.LowRes.Width;
2258
      ABlockInfo^.DrawQuad[2][1] := drawY + ABlockInfo^.LowRes.Height - z * 4;
2259
      ABlockInfo^.DrawQuad[3][0] := drawX - 22;
2260
      ABlockInfo^.DrawQuad[3][1] := drawY + ABlockInfo^.LowRes.Height - z * 4;
2261
    end;
2262
  end else
2263
  if item is TVirtualTile then
2264
  begin
2265
    ABlockInfo^.LowRes := FVLayerMaterial;
2266
    ABlockInfo^.LowRes.AddRef;
2267
    ABlockInfo^.ScreenRect := Bounds(Trunc(drawX - 22), Trunc(drawY - z * 4),
2268
      44, 44);
2269
    ABlockInfo^.DrawQuad[0][0] := drawX - 22;
2270
    ABlockInfo^.DrawQuad[0][1] := drawY - z * 4;
2271
    ABlockInfo^.DrawQuad[1][0] := drawX - 22 + ABlockInfo^.LowRes.Width;
2272
    ABlockInfo^.DrawQuad[1][1] := drawY - z * 4;
2273
    ABlockInfo^.DrawQuad[2][0] := drawX - 22 + ABlockInfo^.LowRes.Width;
2274
    ABlockInfo^.DrawQuad[2][1] := drawY + ABlockInfo^.LowRes.Height - z * 4;
2275
    ABlockInfo^.DrawQuad[3][0] := drawX - 22;
2276
    ABlockInfo^.DrawQuad[3][1] := drawY + ABlockInfo^.LowRes.Height - z * 4;
2277
  end else
2278
  begin
2279
    staticItem := TStaticItem(item);
2280
2281
    ABlockInfo^.LowRes := FTextureManager.GetStaticMaterial(staticItem);
2282
    ABlockInfo^.HueOverride := False;
2283
    ABlockInfo^.ScreenRect := Bounds(Trunc(drawX - ABlockInfo^.LowRes.RealWidth / 2),
2284
      Trunc(drawY + 44 - ABlockInfo^.LowRes.RealHeight - z * 4),
2285
      ABlockInfo^.LowRes.RealWidth,
2286
      ABlockInfo^.LowRes.RealHeight);
2287
2288
    ABlockInfo^.Translucent := tdfTranslucent in
2289
      ResMan.Tiledata.StaticTiles[staticItem.TileID].Flags;
2290
2291
    south := ABlockInfo^.LowRes.RealHeight;
2292
    east := ABlockInfo^.LowRes.RealWidth div 2;
2293
2294
    ABlockInfo^.DrawQuad[0][0] := drawX - east;
2295
    ABlockInfo^.DrawQuad[0][1] := drawY + 44 - south - z * 4;
2296
    ABlockInfo^.DrawQuad[1][0] := drawX - east + ABlockInfo^.LowRes.Width;
2297
    ABlockInfo^.DrawQuad[1][1] := drawY + 44 - south - z * 4;
2298
    ABlockInfo^.DrawQuad[2][0] := drawX - east + ABlockInfo^.LowRes.Width;
2299
    ABlockInfo^.DrawQuad[2][1] := drawY + 44 - south + ABlockInfo^.LowRes.Height - z * 4;
2300
    ABlockInfo^.DrawQuad[3][0] := drawX - east;
2301
    ABlockInfo^.DrawQuad[3][1] := drawY + 44 - south + ABlockInfo^.LowRes.Height - z * 4;
2302
  end;
2303
end;
2304
2305
procedure TfrmMain.Render;
2306
var
2307
  highlight: Boolean;
2308
  intensity: GLfloat;
2309
  blockInfo: PBlockInfo;
2310
  item: TWorldItem;
2311
begin
2312
  if not (sbsValid in FScreenBufferState) then
2313
    RebuildScreenBuffer;
2314
2315
  if not (sbsIndexed in FScreenBufferState) then
2316
  begin
2317
    FScreenBuffer.UpdateShortcuts;
2318
    Include(FScreenBufferState, sbsIndexed);
2319
  end;
2320
2321
  if not (sbsFiltered in FScreenBufferState) then
2322
    UpdateFilter;
2323
2324
  blockInfo := nil;
2325
  while FScreenBuffer.Iterate(blockInfo) do
2326
  begin
2327
    if blockInfo^.State = ssFiltered then
2328
      Continue;
2329
2330
    item := blockInfo^.Item;
2331
2332
    if acSelect.Checked or item.CanBeEdited or (item is TVirtualTile) then
2333
    begin
2334
      intensity := 1.0;
2335
      SetNormalLights;
2336
    end else
2337
    begin
2338
      intensity := 0.5;
2339
      SetDarkLights;
2340
    end;
2341
2342
    if blockInfo^.Translucent then
2343
      glColor4f(intensity, intensity, intensity, 0.8)
2344
    else
2345
      glColor4f(intensity, intensity, intensity, 1.0);
2346
2347
    highlight := blockInfo^.Highlighted and item.CanBeEdited;
2348
2349
    if highlight then
2350
    begin
2351
      glEnable(GL_COLOR_LOGIC_OP);
2352
      glLogicOp(GL_COPY_INVERTED);
2353
    end;
2354
2355
    if blockInfo^.HighRes <> nil then
2356
    begin
2357
      glBindTexture(GL_TEXTURE_2D, blockInfo^.HighRes.Texture);
2358
2359
      if not highlight then
2360
        glEnable(GL_LIGHTING);
2361
2362
      glBegin(GL_QUADS);
2363
        glNormal3fv(@blockInfo^.Normals^[0]);
2364
        glTexCoord2i(0, 0); glVertex2iv(@blockInfo^.DrawQuad[0]);
2365
        glNormal3fv(@blockInfo^.Normals^[3]);
2366
        glTexCoord2i(0, 1); glVertex2iv(@blockInfo^.DrawQuad[3]);
2367
        glNormal3fv(@blockInfo^.Normals^[2]);
2368
        glTexCoord2i(1, 1); glVertex2iv(@blockInfo^.DrawQuad[2]);
2369
        glNormal3fv(@blockInfo^.Normals^[1]);
2370
        glTexCoord2i(1, 0); glVertex2iv(@blockInfo^.DrawQuad[1]);
2371
      glEnd;
2372
2373
      if not highlight then
2374
        glDisable(GL_LIGHTING);
2375
    end else
2376
    begin
2377
      glBindTexture(GL_TEXTURE_2D, blockInfo^.LowRes.Texture);
2378
      glBegin(GL_QUADS);
2379
        glTexCoord2i(0, 0); glVertex2iv(@blockInfo^.DrawQuad[0]);
2380
        glTexCoord2i(1, 0); glVertex2iv(@blockInfo^.DrawQuad[1]);
2381
        glTexCoord2i(1, 1); glVertex2iv(@blockInfo^.DrawQuad[2]);
2382
        glTexCoord2i(0, 1); glVertex2iv(@blockInfo^.DrawQuad[3]);
2383
      glEnd;
2384
    end;
2385
2386
    if highlight then
2387
      glDisable(GL_COLOR_LOGIC_OP);
2388
2389
    if (blockInfo^.Text <> nil) then
2390
      blockInfo^.Text.Render(blockInfo^.ScreenRect);
2391
  end;
2392
2393
  if (FLightManager.LightLevel > 0) and not acFlat.Checked then
2394
    FLightManager.Draw(oglGameWindow.ClientRect);
2395
  FOverlayUI.Draw(oglGameWindow);
2396
end;
2397
2398
procedure TfrmMain.SaveLocations;
2399
var
2400
  xmlDoc: TXMLDocument;
2401
  location: TDOMElement;
2402
  locationNode: PVirtualNode;
2403
  locationInfo: PLocationInfo;
2404
begin
2405
  xmlDoc := TXMLDocument.Create;
2406
  xmlDoc.AppendChild(xmlDoc.CreateElement('Locations'));
2407
2408
  locationNode := vstLocations.GetFirst;
2409
  while locationNode <> nil do
2410
  begin
2411
    locationInfo := vstLocations.GetNodeData(locationNode);
2412
    location := xmlDoc.CreateElement('Location');
2413
    location.AttribStrings['Name'] := locationInfo^.Name;
2414
    location.AttribStrings['X'] := IntToStr(locationInfo^.X);
2415
    location.AttribStrings['Y'] := IntToStr(locationInfo^.Y);
2416
    xmlDoc.DocumentElement.AppendChild(location);
2417
2418
    locationNode := vstLocations.GetNext(locationNode);
2419
  end;
2420
2421
  WriteXMLFile(xmlDoc, FLocationsFile);
2422
  xmlDoc.Free;
2423
end;
2424
2425
procedure TfrmMain.SaveRandomPresets;
2426
begin
2427
  WriteXMLFile(FRandomPresetsDoc, FRandomPresetsFile);
2428
end;
2429
2430
procedure TfrmMain.OnLandscapeChanged;
2431
begin
2432
  InvalidateScreenBuffer;
2433
  oglGameWindow.Repaint;
2434
  UpdateCurrentTile;
2435
end;
2436
2437
procedure TfrmMain.OnMapChanged(AMapCell: TMapCell);
2438
begin
2439
  PrepareMapCell(AMapCell);
2440
  ForceUpdateCurrentTile;
2441
  InvalidateFilter
2442
end;
2443
2444
procedure TfrmMain.OnNewBlock(ABlock: TBlock);
2445
begin
2446
  InvalidateScreenBuffer;
2447
end;
2448
2449
procedure TfrmMain.OnStaticDeleted(AStaticItem: TStaticItem);
2450
begin
2451
  FScreenBuffer.Delete(AStaticItem);
2452
  FRepaintNeeded := True;
2453
  ForceUpdateCurrentTile;
2454
  InvalidateFilter
2455
end;
2456
2457
procedure TfrmMain.OnStaticElevated(AStaticItem: TStaticItem);
2458
var
2459
  blockInfo: PBlockInfo;
2460
begin
2461
  AStaticItem.PrioritySolver := FScreenBuffer.GetSerial;
2462
  blockInfo := FScreenBuffer.UpdateSortOrder(AStaticItem);
2463
  if blockInfo <> nil then
2464
  begin
2465
    PrepareScreenBlock(blockInfo);
2466
    Exclude(FScreenBufferState, sbsIndexed);
2467
    ForceUpdateCurrentTile;
2468
    InvalidateFilter
2469
  end;
2470
end;
2471
2472
procedure TfrmMain.OnStaticHued(AStaticItem: TStaticItem);
2473
var
2474
  blockInfo: PBlockInfo;
2475
begin
2476
  blockInfo := nil;
2477
  while FScreenBuffer.Iterate(blockInfo) do
2478
  begin
2479
    if blockInfo^.Item = AStaticItem then
2480
    begin
2481
      PrepareScreenBlock(blockInfo);
2482
      FRepaintNeeded := True;
2483
      ForceUpdateCurrentTile;
2484
      Break;
2485
    end;
2486
  end;
2487
end;
2488
2489
procedure TfrmMain.OnStaticInserted(AStaticItem: TStaticItem);
2490
begin
2491
  if (AStaticItem.X >= FX + FLowOffsetX) and
2492
     (AStaticItem.X <= FX + FHighOffsetX) and
2493
     (AStaticItem.Y >= FY + FLowOffsetY) and
2494
     (AStaticItem.Y <= FY + FHighOffsetY) then
2495
  begin
2496
    AStaticItem.PrioritySolver := FScreenBuffer.GetSerial;
2497
    PrepareScreenBlock(FScreenBuffer.Insert(AStaticItem));
2498
    FRepaintNeeded := True;
2499
    ForceUpdateCurrentTile;
2500
    InvalidateFilter
2501
  end;
2502
end;
2503
2504
procedure TfrmMain.BuildTileList;
2505
var
2506
  minID, maxID, i, lastID: Integer;
2507
  node: PVirtualNode;
2508
  tileInfo: PTileInfo;
2509
  filter: string;
2510
begin
2511
  maxID := $3FFF;
2512
  if cbTerrain.Checked then minID := $0 else minID := $4000;
2513
  if cbStatics.Checked then maxID := maxID + FLandscape.MaxStaticID;
2514
  filter := AnsiLowerCase(UTF8ToISO_8859_1(edFilter.Text));
2515
  
2516
  node := vdtTiles.GetFirstSelected;
2517
  if node <> nil then
2518
  begin
2519
    tileInfo := vdtTiles.GetNodeData(node);
2520
    lastID := tileInfo^.ID;
2521
  end else
2522
    lastID := -1;
2523
  
2524
  vdtTiles.BeginUpdate;
2525
  vdtTiles.Clear;
2526
  
2527
  for i := minID to maxID do
2528
  begin
2529
    if ResMan.Art.Exists(i) then
2530
    begin
2531
      if (filter <> '') and (Pos(filter, AnsiLowerCase(
2532
        ResMan.Tiledata.TileData[i].TileName)) = 0) then Continue;
2533
      node := vdtTiles.AddChild(nil);
2534
      tileInfo := vdtTiles.GetNodeData(node);
2535
      tileInfo^.ID := i;
2536
      if i = lastID then
2537
        vdtTiles.Selected[node] := True;
2538
    end;
2539
  end;
2540
  
2541
  if vdtTiles.GetFirstSelected = nil then
2542
  begin
2543
    node := vdtTiles.GetFirst;
2544
    if node <> nil then
2545
      vdtTiles.Selected[node] := True;
2546
  end;
2547
  
2548
  vdtTiles.EndUpdate;
2549
  
2550
  node := vdtTiles.GetFirstSelected;
2551
  if node <> nil then
2552
    vdtTiles.FocusedNode := node;
2553
end;
2554
2555
procedure TfrmMain.ProcessToolState;
2556
var
2557
  blockInfo: PBlockInfo;
2558
begin
2559
  if acSelect.Checked then
2560
  begin
2561
    //lblTip.Caption := 'Right click shows a menu with all the tools.';
2562
    lblTip.Caption := 'Press and hold the left mouse button to show a list with'
2563
      + ' actions (eg. grab hue).';
2564
    oglGameWindow.Cursor := crDefault;
2565
2566
    //no highlighted tiles in "selection" mode
2567
    Logger.Send([lcClient, lcDebug], 'Disable highlighting');
2568
    blockInfo := nil;
2569
    while FScreenBuffer.Iterate(blockInfo) do
2570
      if blockInfo^.State = ssNormal then
2571
        blockInfo^.Highlighted := False;
2572
  end else
2573
  begin
2574
    lblTip.Caption := 'Press and hold the left mouse button to target an area.';
2575
    oglGameWindow.Cursor := crHandPoint;
2576
  end;
2577
2578
  FRepaintNeeded := True;
2579
end;
2580
2581
procedure TfrmMain.ProcessAccessLevel;
2582
begin
2583
  mnuAdministration.Visible := (dmNetwork.AccessLevel >= alAdministrator);
2584
  acDraw.Enabled := (dmNetwork.AccessLevel >= alNormal);
2585
  acMove.Enabled := (dmNetwork.AccessLevel >= alNormal);
2586
  acElevate.Enabled := (dmNetwork.AccessLevel >= alNormal);
2587
  acDelete.Enabled := (dmNetwork.AccessLevel >= alNormal);
2588
  acHue.Enabled := (dmNetwork.AccessLevel >= alNormal);
2589
  Caption := Format('UO CentrED - [%s (%s)]', [dmNetwork.Username,
2590
    GetAccessLevelString(dmNetwork.AccessLevel)]);
2591
end;
2592
2593
procedure TfrmMain.RebuildScreenBuffer;
2594
var
2595
  blockInfo: PBlockInfo;
2596
  i, tileX, tileY: Integer;
2597
  virtualTile: TVirtualTile;
2598
begin
2599
  //Logger.EnterMethod([lcClient], 'RebuildScreenBuffer');
2600
2601
  FDrawDistance := Trunc(Sqrt(oglGameWindow.Width * oglGameWindow.Width +
2602
    oglGamewindow.Height * oglGamewindow.Height) / 44);
2603
  //Logger.Send([lcClient], 'DrawDistance', FDrawDistance);
2604
2605
  {$HINTS off}{$WARNINGS off}
2606
  if FX - FDrawDistance < 0 then FLowOffsetX := -FX else FLowOffsetX := -FDrawDistance;
2607
  if FY - FDrawDistance < 0 then FLowOffsetY := -FY else FLowOffsetY := -FDrawDistance;
2608
  if FX + FDrawDistance >= FLandscape.Width * 8 then FHighOffsetX := FLandscape.Width * 8 - FX - 1 else FHighOffsetX := FDrawDistance;
2609
  if FY + FDrawDistance >= FLandscape.Height * 8 then FHighOffsetY := FLandscape.Height * 8 - FY - 1 else FHighOffsetY := FDrawDistance;
2610
  {$HINTS on}{$WARNINGS on}
2611
2612
  FRangeX := FHighOffsetX - FLowOffsetX;
2613
  FRangeY := FHighOffsetY - FLowOffsetY;
2614
2615
  FLandscape.PrepareBlocks((FX + FLowOffsetX) div 8, (FY + FLowOffsetY) div 8,
2616
    (FX + FHighOffsetX) div 8 + 1, (FY + FHighOffsetY) div 8 + 1);
2617
2618
  if frmVirtualLayer.cbShowLayer.Checked then
2619
  begin
2620
    //Logger.Send([lcClient, lcDebug], 'Preparing Virtual Layer');
2621
2622
    if FVLayerMaterial = nil then
2623
      FVLayerMaterial := TSimpleMaterial.Create(FVLayerImage);
2624
2625
    i := 0;
2626
    for tileX := FX + FLowOffsetX to FX + FHighOffsetX do
2627
    begin
2628
      for tileY := FY + FLowOffsetY to FY + FHighOffsetY do
2629
      begin
2630
        while (i < FVirtualTiles.Count) and (not (FVirtualTiles[i] is TVirtualTile)) do
2631
          Inc(i);
2632
2633
        if i < FVirtualTiles.Count then
2634
        begin
2635
          virtualTile := TVirtualTile(FVirtualTiles[i]);
2636
        end else
2637
        begin
2638
          virtualTile := TVirtualTile.Create(nil);
2639
          FVirtualTiles.Add(virtualTile);
2640
        end;
2641
2642
        virtualTile.X := tileX;
2643
        virtualTile.Y := tileY;
2644
        virtualTile.Z := frmVirtualLayer.seZ.Value;
2645
        virtualTile.Priority := virtualTile.Z;
2646
        virtualTile.PriorityBonus := High(ShortInt);
2647
2648
        Inc(i);
2649
      end;
2650
    end;
2651
    while i < FVirtualTiles.Count do
2652
    begin
2653
      if FVirtualTiles[i] is TVirtualTile then
2654
        FVirtualTiles.Delete(i)
2655
      else
2656
        Inc(i);
2657
    end;
2658
  end else
2659
  begin
2660
    for i := FVirtualTiles.Count - 1 downto 0 do
2661
      if FVirtualTiles[i] is TVirtualTile then
2662
        FVirtualTiles.Delete(i);
2663
  end;
2664
2665
  //Logger.Send([lcClient, lcDebug], 'VirtualTiles', FVirtualTiles.Count);
2666
2667
  FLandscape.FillDrawList(FScreenBuffer, FX + FLowOffsetX, FY + FLowOffsetY,
2668
    FRangeX, FRangeY, tbTerrain.Down, tbStatics.Down, acNoDraw.Checked,
2669
    FVirtualTiles);
2670
2671
  //Pre-process the buffer
2672
  blockInfo := nil;
2673
  while FScreenBuffer.Iterate(blockInfo) do
2674
    PrepareScreenBlock(blockInfo);
2675
2676
  FScreenBuffer.UpdateShortcuts;
2677
  FScreenBufferState := [sbsValid, sbsIndexed];
2678
2679
  //Logger.ExitMethod([lcClient], 'RebuildScreenBuffer');
2680
end;
2681
2682
procedure TfrmMain.UpdateCurrentTile;
2683
var
2684
  localPos: TPoint;
2685
begin
2686
  if oglGameWindow.MouseEntered then
2687
  begin
2688
    localPos := oglGameWindow.ScreenToClient(Mouse.CursorPos);
2689
    UpdateCurrentTile(localPos.X, localPos.Y);
2690
  end;
2691
end;
2692
2693
procedure TfrmMain.UpdateCurrentTile(AX, AY: Integer);
2694
var
2695
  blockInfo: PBlockInfo;
2696
begin
2697
  //Logger.EnterMethod([lcClient, lcDebug], 'UpdateCurrentTile');
2698
  FOverlayUI.ActiveArrow := FOverlayUI.HitTest(AX, AY);
2699
  if FOverlayUI.ActiveArrow > -1 then
2700
  begin
2701
    //Logger.Send([lcClient, lcDebug], 'Overlay active');
2702
    CurrentTile := nil;
2703
    //Logger.ExitMethod([lcClient, lcDebug], 'UpdateCurrentTile');
2704
    Exit;
2705
  end;
2706
2707
  blockInfo := FScreenBuffer.Find(Point(AX, AY));
2708
  if blockInfo <> nil then
2709
    CurrentTile := blockInfo^.Item
2710
  else
2711
    CurrentTile := nil;
2712
2713
  //Logger.ExitMethod([lcClient, lcDebug], 'UpdateCurrentTile');
2714
end;
2715
2716
procedure TfrmMain.UpdateFilter;
2717
var
2718
  blockInfo: PBlockInfo;
2719
begin
2720
  blockInfo := nil;
2721
  while FScreenBuffer.Iterate(blockInfo) do
2722
  begin
2723
    if blockInfo^.State in [ssNormal, ssFiltered] then
2724
    begin
2725
      blockInfo^.State := ssNormal;
2726
      if (blockInfo^.Item.Z < frmBoundaries.tbMinZ.Position) or
2727
        (blockInfo^.Item.Z > frmBoundaries.tbMaxZ.Position) then
2728
      begin
2729
        blockInfo^.State := ssFiltered;
2730
      end else
2731
      if tbFilter.Down and (blockInfo^.Item is TStaticItem) and
2732
        (not frmFilter.Filter(TStaticItem(blockInfo^.Item))) then
2733
      begin
2734
        blockInfo^.State := ssFiltered;
2735
      end;
2736
    end;
2737
  end;
2738
  Include(FScreenBufferState, sbsFiltered);
2739
2740
  if (FLightManager.LightLevel > 0) and not acFlat.Checked then
2741
    FLightManager.UpdateLightMap(FX + FLowOffsetX, FRangeX + 1, FY + FLowOffsetY,
2742
      FRangeY + 1, FScreenBuffer);
2743
end;
2744
2745
procedure TfrmMain.UpdateSelection;
2746
2747
  procedure SetHighlight(ABlockInfo: PBlockInfo; AHighlighted: Boolean);
2748
  begin
2749
    if (ABlockInfo^.Item is TStaticItem) and acHue.Checked then
2750
    begin
2751
      if ABlockInfo^.HueOverride <> AHighlighted then
2752
      begin
2753
        ABlockInfo^.HueOverride := AHighlighted;
2754
        if AHighlighted then
2755
          ABlockInfo^.LowRes := FTextureManager.GetStaticMaterial(
2756
            TStaticItem(ABlockInfo^.Item), frmHueSettings.lbHue.ItemIndex)
2757
        else
2758
          ABlockInfo^.LowRes := FTextureManager.GetStaticMaterial(
2759
            TStaticItem(ABlockInfo^.Item));
2760
      end;
2761
    end else
2762
    begin
2763
      ABlockInfo^.Highlighted := AHighlighted;
2764
    end;
2765
  end;
2766
2767
  procedure AddGhostTile(AX, AY: Word; ABaseTile: TWorldItem);
2768
  var
2769
    blockInfo: PBlockInfo;
2770
    tileInfo: PTileInfo;
2771
    node: PVirtualNode;
2772
    cell: TMapCell;
2773
    ghostTile: TGhostTile;
2774
    i: Integer;
2775
  begin
2776
    tileInfo := nil;
2777
    if frmDrawSettings.rbTileList.Checked then
2778
    begin
2779
      node := vdtTiles.GetFirstSelected;
2780
      if node <> nil then
2781
        tileInfo := vdtTiles.GetNodeData(node);
2782
    end else if frmDrawSettings.rbRandom.Checked then
2783
    begin
2784
      node := vdtRandom.GetFirst;
2785
      for i := 1 to Random(vdtRandom.RootNodeCount) do
2786
        node := vdtRandom.GetNext(node);
2787
2788
      if node <> nil then
2789
        tileInfo := vdtRandom.GetNodeData(node);
2790
    end;
2791
2792
    if tileInfo <> nil then
2793
    begin
2794
      if tileInfo^.ID < $4000 then
2795
      begin
2796
        cell := FLandscape.MapCell[AX, AY];
2797
        if cell <> nil then
2798
        begin
2799
          cell.IsGhost := True;
2800
          cell.GhostID := tileInfo^.ID;
2801
          if frmDrawSettings.cbForceAltitude.Checked then
2802
            cell.GhostZ := frmDrawSettings.seForceAltitude.Value
2803
          else
2804
            cell.GhostZ := cell.RawZ;
2805
          if frmDrawSettings.cbRandomHeight.Checked then
2806
            cell.GhostZ := cell.GhostZ + Random(frmDrawSettings.seRandomHeight.Value);
2807
2808
          PrepareMapCell(cell);
2809
        end;
2810
      end else
2811
      begin
2812
        ghostTile := TGhostTile.Create(nil, nil, 0, 0);
2813
        ghostTile.TileID := tileInfo^.ID - $4000;
2814
        ghostTile.Hue := frmHueSettings.lbHue.ItemIndex;
2815
        ghostTile.X := AX;
2816
        ghostTile.Y := AY;
2817
        if not frmDrawSettings.cbForceAltitude.Checked then
2818
        begin
2819
          ghostTile.Z := ABaseTile.Z;
2820
          if ABaseTile is TStaticItem then
2821
            ghostTile.Z := ghostTile.Z +
2822
              ResMan.Tiledata.StaticTiles[ABaseTile.TileID].Height;
2823
        end else
2824
          ghostTile.Z := frmDrawSettings.seForceAltitude.Value;
2825
        if frmDrawSettings.cbRandomHeight.Checked then
2826
          ghostTile.Z := ghostTile.Z +
2827
            Random(frmDrawSettings.seRandomHeight.Value);
2828
2829
        ghostTile.UpdatePriorities(ResMan.Tiledata.StaticTiles[ghostTile.TileID],
2830
          MaxInt);
2831
        ghostTile.CanBeEdited := True;
2832
2833
        FVirtualTiles.Add(ghostTile);
2834
        blockInfo := FScreenBuffer.Insert(ghostTile);
2835
        blockInfo^.State := ssGhost;
2836
        PrepareScreenBlock(blockInfo);
2837
      end;
2838
2839
    end;
2840
  end;
2841
2842
var
2843
  selectedRect: TRect;
2844
  blockInfo: PBlockInfo;
2845
  item: TWorldItem;
2846
  cell: TMapCell;
2847
  i, tileX, tileY: Integer;
2848
begin
2849
  //Logger.EnterMethod([lcClient, lcDebug], 'UpdateSelection');
2850
2851
  //If the current tile is nil, but we still have a selected tile, the
2852
  //procedure is pointless - the selection should stay intact.
2853
  if (CurrentTile <> nil) or (SelectedTile = nil) then
2854
  begin
2855
    if CurrentTile = nil then
2856
      selectedRect := Rect(-1, -1, -1, -1)
2857
    else
2858
      selectedRect := GetSelectedRect;
2859
2860
    //clean up old ghost tiles
2861
    //Logger.Send([lcClient, lcDebug], 'Cleaning ghost tiles');
2862
    for i := FVirtualTiles.Count - 1 downto 0 do
2863
    begin
2864
      item := FVirtualTiles[i];
2865
      if (item is TGhostTile) and not IsInRect(item.X, item.Y, selectedRect) then
2866
      begin
2867
        FScreenBuffer.Delete(item);
2868
        FVirtualTiles.Delete(i);
2869
      end;
2870
    end;
2871
    //Logger.Send([lcClient, lcDebug], 'FSelection', FSelection);
2872
    for tileX := FSelection.Left to FSelection.Right do
2873
      for tileY := FSelection.Top to FSelection.Bottom do
2874
        if not IsInRect(tileX, tileY, selectedRect) then
2875
        begin
2876
          cell := FLandscape.MapCell[tileX, tileY];
2877
          if (cell <> nil) and cell.IsGhost then
2878
          begin
2879
            cell.IsGhost := False;
2880
            PrepareMapCell(cell);
2881
          end;
2882
        end;
2883
2884
    if (CurrentTile <> nil) and (not acSelect.Checked) then
2885
    begin
2886
      blockInfo := nil;
2887
      if (SelectedTile <> nil) and (CurrentTile <> SelectedTile) then
2888
      begin
2889
        {Logger.Send([lcClient, lcDebug], 'Multiple Targets');
2890
        Logger.Send([lcClient, lcDebug], 'SelectedRect', selectedRect);}
2891
        //set new ghost tiles
2892
        if acDraw.Checked then
2893
          for tileX := selectedRect.Left to selectedRect.Right do
2894
            for tileY := selectedRect.Top to selectedRect.Bottom do
2895
              if not IsInRect(tileX, tileY, FSelection) then
2896
                AddGhostTile(tileX, tileY, SelectedTile);
2897
        while FScreenBuffer.Iterate(blockInfo) do
2898
          if (blockInfo^.State = ssNormal) then
2899
            SetHighlight(blockInfo, IsInRect(blockInfo^.Item.X, blockInfo^.Item.Y,
2900
              selectedRect) and not acDraw.Checked);
2901
      end else
2902
      begin
2903
        //Logger.Send([lcClient, lcDebug], 'Single Target');
2904
        if acDraw.Checked and not IsInRect(CurrentTile.X, CurrentTile.Y,
2905
          FSelection) then
2906
          AddGhostTile(CurrentTile.X, CurrentTile.Y, CurrentTile);
2907
        while FScreenBuffer.Iterate(blockInfo) do
2908
          if blockInfo^.State = ssNormal then
2909
            SetHighlight(blockInfo, (blockInfo^.Item = CurrentTile) and
2910
              not acDraw.Checked);
2911
      end;
2912
    end;
2913
    FSelection := selectedRect;
2914
  end;
2915
  {Logger.Send([lcClient, lcDebug], 'Virtual Tiles', FVirtualTiles.Count);
2916
  Logger.ExitMethod([lcClient, lcDebug], 'UpdateSelection');}
2917
end;
2918
2919
procedure TfrmMain.OnTileRemoved(ATile: TMulBlock);
2920
begin
2921
  if ATile = FCurrentTile then
2922
    FCurrentTile := nil
2923
  else if ATile = FSelectedTile then
2924
    FSelectedTile := nil;
2925
end;
2926
2927
procedure TfrmMain.WriteChatMessage(ASender, AMessage: string);
2928
var
2929
  node: PVirtualNode;
2930
  chatInfo: PChatInfo;
2931
begin
2932
  node := vstChat.AddChild(nil);
2933
  chatInfo := vstChat.GetNodeData(node);
2934
  chatInfo^.Time := Now;
2935
  chatInfo^.Sender := ASender;
2936
  chatInfo^.Msg := AMessage;
2937
  if vstChat.RootNodeCount > 30 then
2938
    vstChat.DeleteNode(vstChat.GetFirst);
2939
  vstChat.ScrollIntoView(node, False);
2940
  
2941
  if not pnlChat.Visible then
2942
  begin
2943
    lblChatHeaderCaption.Font.Bold := True;
2944
    lblChatHeaderCaption.Font.Italic := True;
2945
    lblChatHeaderCaption.Font.Color := clRed;
2946
  end;
2947
end;
2948
2949
procedure TfrmMain.OnClientHandlingPacket(ABuffer: TEnhancedMemoryStream);
2950
var
2951
  sender, msg: string;
2952
  i: Integer;
2953
  accessLevel: TAccessLevel;
2954
begin
2955
  case ABuffer.ReadByte of
2956
    $01: //client connected
2957
      begin
2958
        sender := ABuffer.ReadStringNull;
2959
        lbClients.Items.Add(sender);
2960
        if sender <> dmNetwork.Username then
2961
          WriteChatMessage('System', Format('User "%s" has connected.', [sender]));
2962
      end;
2963
    $02:
2964
      begin
2965
        sender := ABuffer.ReadStringNull;
2966
        lbClients.Items.Delete(lbClients.Items.IndexOf(sender));
2967
        if sender <> dmNetwork.Username then
2968
          WriteChatMessage('System', Format('User "%s" has disconnected.', [sender]));
2969
      end;
2970
    $03: //Client list
2971
      begin
2972
        lbClients.Clear;
2973
        while ABuffer.Position < ABuffer.Size do
2974
          lbClients.Items.Add(ABuffer.ReadStringNull);
2975
      end;
2976
    $04: //Set pos
2977
      begin
2978
        FX := ABuffer.ReadWord;
2979
        FY := ABuffer.ReadWord;
2980
        SetPos(FX, FY);
2981
      end;
2982
    $05: //chat
2983
      begin
2984
        sender := ABuffer.ReadStringNull;
2985
        msg := ABuffer.ReadStringNull;
2986
        WriteChatMessage(sender, msg);
2987
      end;
2988
    $07: //access changed
2989
      begin
2990
        accessLevel := TAccessLevel(ABuffer.ReadByte);
2991
        FLandscape.UpdateWriteMap(ABuffer);
2992
        FRepaintNeeded := True;
2993
2994
        if accessLevel <> dmNetwork.AccessLevel then
2995
        begin
2996
          dmNetwork.AccessLevel := accessLevel;
2997
          if accessLevel = alNone then
2998
          begin
2999
            MessageDlg('AccessLevel change', 'Your account has been locked.', mtWarning, [mbOK], 0);
3000
            mnuDisconnectClick(nil);
3001
          end else
3002
          begin
3003
            ProcessAccessLevel;
3004
            MessageDlg('AccessLevel change', Format('Your accesslevel has been changed to %s.', [GetAccessLevelString(accessLevel)]), mtWarning, [mbOK], 0);
3005
          end;
3006
        end;
3007
3008
        for i := FAccessChangedListeners.Count - 1 downto 0 do
3009
          FAccessChangedListeners[i](accessLevel);
3010
      end;
3011
  end;
3012
end;
3013
3014
function TfrmMain.GetInternalTileID(ATile: TWorldItem): Word;
3015
begin
3016
  Result := ATile.TileID;
3017
  if ATile is TStaticItem then
3018
    Inc(Result, $4000);
3019
end;
3020
3021
function TfrmMain.GetSelectedRect: TRect;
3022
begin
3023
  if CurrentTile <> nil then
3024
  begin
3025
    if SelectedTile <> nil then
3026
    begin
3027
      Result.Left := Min(CurrentTile.X, SelectedTile.X);
3028
      Result.Top := Min(CurrentTile.Y, SelectedTile.Y);
3029
      Result.Right := Max(CurrentTile.X, SelectedTile.X);
3030
      Result.Bottom := Max(CurrentTile.Y, SelectedTile.Y);
3031
    end else
3032
    begin
3033
      Result.Left := CurrentTile.X;
3034
      Result.Top := CurrentTile.Y;
3035
      Result.Right := CurrentTile.X;
3036
      Result.Bottom := CurrentTile.Y;
3037
    end;
3038
  end;
3039
end;
3040
3041
function TfrmMain.ConfirmAction: Boolean;
3042
begin
3043
  if acMove.Checked and frmMoveSettings.cbAsk.Checked then
3044
  begin
3045
    Result := frmMoveSettings.ShowModal = mrYes;
3046
  end else
3047
  if not mnuSecurityQuestion.Checked then
3048
  begin
3049
    Result := True;
3050
  end else
3051
  begin
3052
    frmConfirmation.Left := Mouse.CursorPos.x - frmConfirmation.btnYes.Left - frmConfirmation.btnYes.Width div 2;
3053
    frmConfirmation.Top := Mouse.CursorPos.y - frmConfirmation.btnYes.Top - frmConfirmation.btnYes.Height div 2;
3054
    Result := frmConfirmation.ShowModal = mrYes;
3055
  end;
3056
3057
  if not oglGameWindow.MouseEntered then
3058
    oglGameWindowMouseLeave(nil);
3059
end;
3060
3061
function TfrmMain.FindRandomPreset(AName: String): TDOMElement;
3062
var
3063
  preset: TDOMElement;
3064
  presets: TDOMNodeList;
3065
  i: Integer;
3066
begin
3067
  presets := FRandomPresetsDoc.DocumentElement.ChildNodes;
3068
  Result := nil;
3069
  i := 0;
3070
  while (i < presets.Count) and (Result = nil) do
3071
  begin
3072
    preset := TDOMElement(presets[i]);
3073
    if SameText(preset.AttribStrings['Name'], AName) then
3074
      Result := preset
3075
    else
3076
      Inc(i);
3077
  end;
3078
end;
3079
3080
procedure TfrmMain.ForceUpdateCurrentTile;
3081
begin
3082
  CurrentTile := nil;
3083
  UpdateCurrentTile;
3084
end;
3085
3086
procedure TfrmMain.GetDrawOffset(AX, AY: Integer; out DrawX, DrawY: Integer); inline;
3087
begin
3088
  Dec(AX, FX);
3089
  Dec(AY, FY);
3090
  DrawX := (oglGameWindow.Width div 2) + (AX - AY) * 22;
3091
  DrawY := (oglGamewindow.Height div 2) + (AX + AY) * 22;
3092
end;
3093
3094
initialization
3095
  {$I UfrmMain.lrs}
3096
3097
end.
3098