Statistics
| Branch: | Tag: | Revision:

root / Client / UfrmMain.pas @ 157:0b95089e72d4

History | View | Annotate | Download (93.1 kB)

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