Statistics
| Branch: | Tag: | Revision:

root / Client / UfrmMain.pas @ 156:c3e84c102edd

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