CentrED/Client/UfrmMain.pas

2772 lines
81 KiB
Plaintext
Raw Normal View History

(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit UfrmMain;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Menus,
ComCtrls, OpenGLContext, GL, GLu, UGameResources, ULandscape, ExtCtrls,
StdCtrls, Spin, UEnums, VirtualTrees, Buttons, UMulBlock, UWorldItem, math,
2009-12-04 20:24:36 +01:00
LCLIntf, UOverlayUI, UStatics, UEnhancedMemoryStream, ActnList, fgl,
ImagingClasses, dateutils, UPlatformTypes, UMap, UPacket, UGLFont;
type
TAccessChangedListener = procedure(AAccessLevel: TAccessLevel) of object;
TScreenBufferState = (sbsValid, sbsIndexed, sbsFiltered);
TScreenBufferStates = set of TScreenBufferState;
TGhostTile = class(TStaticItem);
2009-12-04 20:24:36 +01:00
TPacketList = specialize TFPGObjectList<TPacket>;
{ TfrmMain }
TfrmMain = class(TForm)
acSelect: TAction;
acDraw: TAction;
acMove: TAction;
acElevate: TAction;
acDelete: TAction;
acHue: TAction;
acBoundaries: TAction;
acFilter: TAction;
acFlat: TAction;
acNoDraw: TAction;
2009-12-04 20:24:36 +01:00
acUndo: TAction;
acVirtualLayer: TAction;
ActionList1: TActionList;
ApplicationProperties1: TApplicationProperties;
btnAddLocation: TSpeedButton;
btnAddRandom: TSpeedButton;
btnClearLocations: TSpeedButton;
btnClearRandom: TSpeedButton;
btnDeleteLocation: TSpeedButton;
btnDeleteRandom: TSpeedButton;
btnGoTo: TButton;
btnRandomPresetDelete: TSpeedButton;
btnRandomPresetSave: TSpeedButton;
cbRandomPreset: TComboBox;
cbStatics: TCheckBox;
cbTerrain: TCheckBox;
edChat: TEdit;
edFilter: TEdit;
edSearchID: TEdit;
gbRandom: TGroupBox;
ImageList1: TImageList;
lblChatHeaderCaption: TLabel;
lblFilter: TLabel;
lblTipC: TLabel;
lblTip: TLabel;
lblTileInfo: TLabel;
lblX: TLabel;
lblY: TLabel;
lbClients: TListBox;
MainMenu1: TMainMenu;
mnuFlatShowHeight: TMenuItem;
mnuGrabHue: TMenuItem;
mnuGrabTileID: TMenuItem;
mnuRegionControl: TMenuItem;
mnuVirtualLayer: TMenuItem;
mnuLargeScaleCommands: TMenuItem;
mnuSetHue: TMenuItem;
mnuGoToClient: TMenuItem;
mnuAbout: TMenuItem;
mnuHelp: TMenuItem;
mnuSeparator3: TMenuItem;
mnuBoundaries: TMenuItem;
mnuSelect: TMenuItem;
mnuDraw: TMenuItem;
mnuMove: TMenuItem;
mnuElevate: TMenuItem;
mnuDelete: TMenuItem;
mnuAddToRandom: TMenuItem;
mnuFlush: TMenuItem;
mnuShutdown: TMenuItem;
mnuSeparator2: TMenuItem;
mnuAccountControl: TMenuItem;
mnuAdministration: TMenuItem;
mnuSeparator1: TMenuItem;
mnuExit: TMenuItem;
mnuDisconnect: TMenuItem;
mnuCentrED: TMenuItem;
oglGameWindow: TOpenGLControl;
pcLeft: TPageControl;
pmGrabTileInfo: TPopupMenu;
pnlBottom: TPanel;
edX: TSpinEdit;
edY: TSpinEdit;
pmTileList: TPopupMenu;
pmTools: TPopupMenu;
pmClients: TPopupMenu;
pnlChat: TPanel;
pnlChatHeader: TPanel;
pmFlatViewSettings: TPopupMenu;
spChat: TSplitter;
spTileList: TSplitter;
tbFilter: TToolButton;
tbFlat: TToolButton;
tbNoDraw: TToolButton;
tmTileHint: TTimer;
2009-12-04 20:24:36 +01:00
tbSeparator2: TToolButton;
tbUndo: TToolButton;
tsLocations: TTabSheet;
tbSetHue: TToolButton;
tmGrabTileInfo: TTimer;
tmMovement: TTimer;
2009-12-04 20:24:36 +01:00
tbSeparator5: TToolButton;
tbRadarMap: TToolButton;
tbVirtualLayer: TToolButton;
tsClients: TTabSheet;
tbMain: TToolBar;
tbDisconnect: TToolButton;
tbSeparator1: TToolButton;
tbSelect: TToolButton;
tbDrawTile: TToolButton;
tbMoveTile: TToolButton;
tbElevateTile: TToolButton;
tbDeleteTile: TToolButton;
tbSeparator3: TToolButton;
2009-12-04 20:24:36 +01:00
tbBoundaries: TToolButton;
tbSeparator4: TToolButton;
tbTerrain: TToolButton;
tbStatics: TToolButton;
tsTiles: TTabSheet;
vdtTiles: TVirtualDrawTree;
vdtRandom: TVirtualDrawTree;
vstChat: TVirtualStringTree;
vstLocations: TVirtualStringTree;
procedure acBoundariesExecute(Sender: TObject);
procedure acDeleteExecute(Sender: TObject);
procedure acDrawExecute(Sender: TObject);
procedure acElevateExecute(Sender: TObject);
procedure acFilterExecute(Sender: TObject);
procedure acFlatExecute(Sender: TObject);
procedure acHueExecute(Sender: TObject);
procedure acMoveExecute(Sender: TObject);
procedure acNoDrawExecute(Sender: TObject);
procedure acSelectExecute(Sender: TObject);
2009-12-04 20:24:36 +01:00
procedure acUndoExecute(Sender: TObject);
procedure acVirtualLayerExecute(Sender: TObject);
procedure ApplicationProperties1Idle(Sender: TObject; var Done: Boolean);
procedure btnAddLocationClick(Sender: TObject);
procedure btnAddRandomClick(Sender: TObject);
procedure btnClearLocationsClick(Sender: TObject);
procedure btnClearRandomClick(Sender: TObject);
procedure btnDeleteLocationClick(Sender: TObject);
procedure btnDeleteRandomClick(Sender: TObject);
procedure btnGoToClick(Sender: TObject);
procedure btnRandomPresetDeleteClick(Sender: TObject);
procedure btnRandomPresetSaveClick(Sender: TObject);
procedure cbRandomPresetChange(Sender: TObject);
procedure cbStaticsChange(Sender: TObject);
procedure cbTerrainChange(Sender: TObject);
procedure edChatKeyPress(Sender: TObject; var Key: char);
procedure edFilterEditingDone(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure edSearchIDExit(Sender: TObject);
procedure edSearchIDKeyPress(Sender: TObject; var Key: char);
procedure lblChatHeaderCaptionClick(Sender: TObject);
procedure lblChatHeaderCaptionMouseEnter(Sender: TObject);
procedure lblChatHeaderCaptionMouseLeave(Sender: TObject);
procedure mnuAboutClick(Sender: TObject);
procedure mnuAccountControlClick(Sender: TObject);
procedure mnuDisconnectClick(Sender: TObject);
procedure mnuExitClick(Sender: TObject);
procedure mnuFlatShowHeightClick(Sender: TObject);
procedure mnuFlushClick(Sender: TObject);
procedure mnuGoToClientClick(Sender: TObject);
procedure mnuGrabHueClick(Sender: TObject);
procedure mnuGrabTileIDClick(Sender: TObject);
procedure mnuLargeScaleCommandsClick(Sender: TObject);
procedure mnuRegionControlClick(Sender: TObject);
procedure mnuShutdownClick(Sender: TObject);
procedure oglGameWindowDblClick(Sender: TObject);
procedure oglGameWindowMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure oglGameWindowMouseEnter(Sender: TObject);
procedure oglGameWindowMouseLeave(Sender: TObject);
procedure oglGameWindowMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure oglGameWindowMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure oglGameWindowMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
procedure oglGameWindowPaint(Sender: TObject);
procedure oglGameWindowResize(Sender: TObject);
procedure pmGrabTileInfoPopup(Sender: TObject);
procedure tbFilterMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure tbRadarMapClick(Sender: TObject);
procedure tbStaticsClick(Sender: TObject);
procedure tbTerrainClick(Sender: TObject);
procedure tmGrabTileInfoTimer(Sender: TObject);
procedure tmMovementTimer(Sender: TObject);
procedure tmTileHintTimer(Sender: TObject);
procedure vdtRandomDragDrop(Sender: TBaseVirtualTree; Source: TObject;
DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState;
Pt: TPoint; var Effect: Integer; Mode: TDropMode);
procedure vdtRandomDragOver(Sender: TBaseVirtualTree; Source: TObject;
Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode;
var Effect: Integer; var Accept: Boolean);
procedure vdtRandomLoadNode(Sender: TBaseVirtualTree; Node: PVirtualNode;
Stream: TStream);
procedure vdtRandomSaveNode(Sender: TBaseVirtualTree; Node: PVirtualNode;
Stream: TStream);
procedure vdtRandomUpdating(Sender: TBaseVirtualTree; State: TVTUpdateState);
procedure vdtTilesClick(Sender: TObject);
procedure vdtTilesDrawNode(Sender: TBaseVirtualTree;
const PaintInfo: TVTPaintInfo);
procedure vdtTilesEnter(Sender: TObject);
procedure vdtTilesExit(Sender: TObject);
procedure vdtTilesHotChange(Sender: TBaseVirtualTree; OldNode,
NewNode: PVirtualNode);
procedure vdtTilesKeyPress(Sender: TObject; var Key: char);
procedure vdtTilesMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure vdtTilesScroll(Sender: TBaseVirtualTree; DeltaX, DeltaY: Integer);
procedure vstChatClick(Sender: TObject);
procedure vstChatFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure vstChatGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: String);
procedure vstChatPaintText(Sender: TBaseVirtualTree;
const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType);
procedure vstLocationsDblClick(Sender: TObject);
procedure vstLocationsFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode
);
procedure vstLocationsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: String);
procedure vstLocationsLoadNode(Sender: TBaseVirtualTree;
Node: PVirtualNode; Stream: TStream);
procedure vstLocationsNewText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; const NewText: String);
procedure vstLocationsSaveNode(Sender: TBaseVirtualTree;
Node: PVirtualNode; Stream: TStream);
protected
{ Members }
FAppDir: String;
FX: Integer;
FY: Integer;
FDrawDistance: Integer;
FLowOffsetX: Integer;
FLowOffsetY: Integer;
FHighOffsetX: Integer;
FHighOffsetY: Integer;
FRangeX: Integer;
FRangeY: Integer;
FLandscape: TLandscape;
FTextureManager: TLandTextureManager;
FScreenBuffer: TScreenBuffer;
FScreenBufferState: TScreenBufferStates;
FCurrentTile: TWorldItem;
FSelectedTile: TWorldItem;
FVirtualTiles: TWorldItemList;
FVLayerMaterial: TMaterial;
FOverlayUI: TOverlayUI;
FLocationsFile: string;
FRandomPresetLocation: string;
FLastDraw: TDateTime;
FAccessChangedListeners: array of TAccessChangedListener;
FRepaintNeeded: Boolean;
FSelection: TRect;
2009-12-04 20:24:36 +01:00
FUndoList: TPacketList;
FGLFont: TGLFont;
{ Methods }
procedure BuildTileList;
function ConfirmAction: Boolean;
procedure ForceUpdateCurrentTile;
procedure GetDrawOffset(ARelativeX, ARelativeY: Integer; out DrawX,
DrawY: Integer); inline;
function GetInternalTileID(ATile: TWorldItem): Word;
function GetSelectedRect: TRect;
procedure InitRender;
procedure InitSize;
procedure PrepareMapCell(AMapCell: TMapCell);
procedure PrepareScreenBlock(ABlockInfo: PBlockInfo);
procedure ProcessToolState;
procedure ProcessAccessLevel;
procedure RebuildScreenBuffer;
procedure Render;
procedure SetCurrentTile(const AValue: TWorldItem);
procedure SetDarkLights; inline;
procedure SetNormalLights; inline;
procedure SetSelectedTile(const AValue: TWorldItem);
procedure SetX(const AValue: Integer);
procedure SetY(const AValue: Integer);
procedure UpdateCurrentTile;
procedure UpdateCurrentTile(AX, AY: Integer);
procedure UpdateFilter;
procedure UpdateSelection;
procedure WriteChatMessage(ASender, AMessage: string);
{ Events }
procedure OnClientHandlingPacket(ABuffer: TEnhancedMemoryStream);
procedure OnLandscapeChanged;
procedure OnMapChanged(AMapCell: TMapCell);
procedure OnNewBlock(ABlock: TBlock);
procedure OnStaticDeleted(AStaticItem: TStaticItem);
procedure OnStaticElevated(AStaticItem: TStaticItem);
procedure OnStaticHued(AStaticItem: TStaticItem);
procedure OnStaticInserted(AStaticItem: TStaticItem);
procedure OnTileRemoved(ATile: TMulBlock);
public
{ Fields }
property X: Integer read FX write SetX;
property Y: Integer read FY write SetY;
property Landscape: TLandscape read FLandscape;
property CurrentTile: TWorldItem read FCurrentTile write SetCurrentTile;
property SelectedTile: TWorldItem read FSelectedTile write SetSelectedTile;
{ Methods }
procedure InvalidateFilter;
2009-09-29 02:25:19 +02:00
procedure InvalidateScreenBuffer;
procedure RegisterAccessChangedListener(AListener: TAccessChangedListener);
procedure SetPos(AX, AY: Word);
procedure UnregisterAccessChangedListener(AListener: TAccessChangedListener);
end;
var
frmMain: TfrmMain;
implementation
uses
UdmNetwork, UArt, UTiledata, UAdminHandling, UPackets,
UfrmAccountControl, UGraphicHelper, ImagingComponents, UfrmDrawSettings,
UfrmBoundaries, UfrmElevateSettings, UfrmConfirmation, UfrmMoveSettings,
UfrmAbout, UPacketHandlers, UfrmHueSettings, UfrmRadar, UfrmLargeScaleCommand,
UfrmLogin, UResourceManager, UfrmVirtualLayer, UfrmFilter, UfrmTileInfo,
UfrmRegionControl, Logging, LConvEncoding;
type
TGLArrayf4 = array[0..3] of GLfloat;
PTileInfo = ^TTileInfo;
TTileInfo = record
ID: Word;
end;
PChatInfo = ^TChatInfo;
TChatInfo = record
Time: TDateTime;
Sender: string;
Msg: string;
end;
PLocationInfo = ^TLocationInfo;
TLocationInfo = record
X: Word;
Y: Word;
Name: string;
end;
const
CScreenBufferValid = [sbsValid, sbsIndexed, sbsFiltered];
function IsInRect(const AX, AY: Integer; const ARect: TRect): Boolean; inline;
begin
Result := (AX >= ARect.Left) and
(AX <= ARect.Right) and
(AY >= ARect.Top) and
(AY <= ARect.Bottom);
end;
{ TfrmMain }
procedure TfrmMain.mnuExitClick(Sender: TObject);
begin
Close;
end;
procedure TfrmMain.mnuFlatShowHeightClick(Sender: TObject);
begin
RebuildScreenBuffer;
end;
procedure TfrmMain.mnuFlushClick(Sender: TObject);
begin
dmNetwork.Send(TFlushServerPacket.Create);
end;
procedure TfrmMain.mnuGoToClientClick(Sender: TObject);
begin
if lbClients.ItemIndex > -1 then
dmNetwork.Send(TGotoClientPosPacket.Create(lbClients.Items.Strings[lbClients.ItemIndex]));
end;
procedure TfrmMain.mnuGrabHueClick(Sender: TObject);
begin
if CurrentTile is TStaticItem then
begin
frmHueSettings.lbHue.ItemIndex := TStaticItem(CurrentTile).Hue;
frmFilter.JumpToHue(TStaticItem(CurrentTile).Hue);
end;
end;
procedure TfrmMain.mnuGrabTileIDClick(Sender: TObject);
var
internalTileID: Integer;
node: PVirtualNode;
tileInfo: PTileInfo;
begin
if CurrentTile <> nil then
begin
internalTileID := GetInternalTileID(CurrentTile);
node := vdtTiles.GetFirst;
while node <> nil do
begin
tileInfo := vdtTiles.GetNodeData(node);
if tileInfo^.ID = internalTileID then
begin
vdtTiles.ClearSelection;
vdtTiles.Selected[node] := True;
vdtTiles.FocusedNode := node;
Break;
end;
node := vdtTiles.GetNext(node);
end;
end;
end;
procedure TfrmMain.mnuLargeScaleCommandsClick(Sender: TObject);
begin
frmLargeScaleCommand.Show;
end;
procedure TfrmMain.mnuRegionControlClick(Sender: TObject);
begin
frmRegionControl.Show;
end;
procedure TfrmMain.mnuShutdownClick(Sender: TObject);
begin
dmNetwork.Send(TQuitServerPacket.Create(''));
end;
procedure TfrmMain.oglGameWindowDblClick(Sender: TObject);
begin
if (acSelect.Checked) and (CurrentTile <> nil) then
btnAddRandomClick(Sender);
end;
procedure TfrmMain.oglGameWindowMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
Logger.EnterMethod([lcClient, lcDebug], 'MouseDown');
try
if Button = mbRight then
pmTools.PopUp(Mouse.CursorPos.X, Mouse.CursorPos.Y);
if Button <> mbLeft then
Exit;
UpdateCurrentTile(X, Y);
if FOverlayUI.ActiveArrow > -1 then
tmMovement.Enabled := True;
SelectedTile := CurrentTile;
if CurrentTile = nil then Exit;
if acSelect.Checked then //***** Selection Mode *****//
tmGrabTileInfo.Enabled := True;
FRepaintNeeded := True;
finally
Logger.ExitMethod([lcClient, lcDebug], 'MouseDown');
end;
end;
procedure TfrmMain.oglGameWindowMouseEnter(Sender: TObject);
begin
if Active then
oglGameWindow.SetFocus;
FOverlayUI.Visible := True;
if frmFilter.Visible then
begin
frmFilter.Locked := True;
frmFilter.Hide;
frmFilter.Locked := False;
end;
FRepaintNeeded := True;
end;
procedure TfrmMain.oglGameWindowMouseLeave(Sender: TObject);
begin
if not (frmConfirmation.Visible or
(frmMoveSettings.Visible and (fsModal in frmMoveSettings.FormState))
) then //during confirmation the mouse would leave ...
begin
CurrentTile := nil;
FOverlayUI.Visible := False;
end;
FRepaintNeeded := True;
end;
procedure TfrmMain.oglGameWindowMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
var
lastTile: TWorldItem;
offsetX, offsetY: Integer;
begin
Logger.EnterMethod([lcClient, lcDebug], 'MouseMove');
lastTile := CurrentTile;
if ssMiddle in Shift then
begin
UpdateCurrentTile(X, Y);
if (lastTile <> nil) and (CurrentTile <> nil) and (lastTile <> CurrentTile) then
begin
offsetX := lastTile.X - CurrentTile.X;
offsetY := lastTile.Y - CurrentTile.Y;
if InRange(offsetX, -8, 8) and InRange(offsetY, -8, 8) then
SetPos(FX - offsetX, FY - offsetY);
end;
end;
UpdateCurrentTile(X, Y);
FRepaintNeeded := True;
Logger.ExitMethod([lcClient, lcDebug], 'MouseMove');
end;
procedure TfrmMain.oglGameWindowMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
node: PVirtualNode;
tileInfo: PTileInfo;
map: TMapCell;
i: Integer;
z: ShortInt;
blockInfo: PBlockInfo;
targetRect: TRect;
offsetX, offsetY: Integer;
tile: TWorldItem;
2009-12-04 20:24:36 +01:00
tileX, tileY, newX, newY: Word;
targetTiles: TWorldItemList;
targetTile: TWorldItem;
begin
Logger.EnterMethod([lcClient, lcDebug], 'MouseUp');
if Button <> mbLeft then
begin
Logger.ExitMethod([lcClient, lcDebug], 'MouseUp');
Exit;
end;
UpdateCurrentTile(X, Y);
tmMovement.Enabled := False;
if CurrentTile = nil then
begin
SelectedTile := nil;
Logger.ExitMethod([lcClient, lcDebug], 'MouseUp');
Exit;
end;
targetTile := CurrentTile;
if acSelect.Checked and tmGrabTileInfo.Enabled then
begin
tmGrabTileInfo.Enabled := False;
mnuGrabTileIDClick(nil);
end;
if (not acSelect.Checked) and (targetTile <> nil) and (SelectedTile <> nil) then
begin
targetRect := GetSelectedRect;
2009-12-04 20:24:36 +01:00
FUndoList.Clear;
if (SelectedTile = targetTile) or ConfirmAction then
begin
if acDraw.Checked then //***** Drawing Mode *****//
begin
for tileX := FSelection.Left to FSelection.Right do
for tileY := FSelection.Top to FSelection.Bottom do
begin
map := FLandscape.MapCell[tileX, tileY];
if map.IsGhost then
2009-12-04 20:24:36 +01:00
begin
FUndoList.Add(TDrawMapPacket.Create(tileX, tileY, map.RawZ,
map.RawTileID));
dmNetwork.Send(TDrawMapPacket.Create(tileX, tileY, map.Z,
map.TileID));
2009-12-04 20:24:36 +01:00
end;
end;
Logger.Send([lcClient, lcDebug], 'Virtual tiles', FVirtualTiles.Count);
for i := 0 to FVirtualTiles.Count - 1 do
begin
tile := FVirtualTiles[i];
if tile is TGhostTile then
2009-12-04 20:24:36 +01:00
begin
dmNetwork.Send(TInsertStaticPacket.Create(tile.X, tile.Y, tile.Z,
tile.TileID, TGhostTile(tile).Hue));
2009-12-04 20:24:36 +01:00
FUndoList.Add(TDeleteStaticPacket.Create(TGhostTile(tile)));
end;
end;
end else if (SelectedTile <> targetTile) or targetTile.CanBeEdited then
begin
if (not acMove.Checked) or (SelectedTile <> targetTile) or
(not frmMoveSettings.cbAsk.Checked) or ConfirmAction then
begin
targetTiles := TWorldItemList.Create(False);
if SelectedTile = targetTile then
begin
targetTiles.Add(targetTile)
end else
begin
blockInfo := nil;
while FScreenBuffer.Iterate(blockInfo) do
begin
if (blockInfo^.State = ssNormal) and
blockInfo^.Item.CanBeEdited and
IsInRect(blockInfo^.Item.X, blockInfo^.Item.Y, targetRect) then
begin
targetTiles.Add(blockInfo^.Item);
end;
end;
end;
if acMove.Checked then //***** Move tile *****//
begin
offsetX := frmMoveSettings.GetOffsetX;
offsetY := frmMoveSettings.GetOffsetY;
for i := 0 to targetTiles.Count - 1 do
begin
tile := targetTiles.Items[i];
if tile is TStaticItem then
begin
2009-12-04 20:24:36 +01:00
newX := EnsureRange(tile.X + offsetX, 0, FLandscape.CellWidth - 1);
newY := EnsureRange(tile.Y + offsetY, 0, FLandscape.CellHeight - 1);
FUndoList.Add(TMoveStaticPacket.Create(newX, newY, tile.Z,
tile.TileID, TStaticItem(tile).Hue, tile.X, tile.Y));
dmNetwork.Send(TMoveStaticPacket.Create(TStaticItem(tile),
2009-12-04 20:24:36 +01:00
newX, newY));
end;
end;
end else if acElevate.Checked then //***** Elevate tile *****//
begin
for i := 0 to targetTiles.Count - 1 do
begin
tile := targetTiles.Items[i];
z := frmElevateSettings.seZ.Value;
if frmElevateSettings.rbRaise.Checked then
z := EnsureRange(tile.Z + z, -128, 127)
else if frmElevateSettings.rbLower.Checked then
z := EnsureRange(tile.Z - z, -128, 127);
if tile is TMapCell then
begin
if frmElevateSettings.cbRandomHeight.Checked then
Inc(z, Random(frmElevateSettings.seRandomHeight.Value));
2009-12-04 20:24:36 +01:00
FUndoList.Add(TDrawMapPacket.Create(tile.X, tile.Y, tile.Z,
tile.TileID));
dmNetwork.Send(TDrawMapPacket.Create(tile.X, tile.Y, z,
tile.TileID));
end else
begin
2009-12-04 20:24:36 +01:00
FUndoList.Add(TElevateStaticPacket.Create(tile.X, tile.Y,
z, tile.TileID, TStaticItem(tile).Hue, tile.Z));
dmNetwork.Send(TElevateStaticPacket.Create(TStaticItem(tile), z));
end;
end;
end else if acDelete.Checked then //***** Delete tile *****//
begin
for i := 0 to targetTiles.Count - 1 do
begin
tile := targetTiles.Items[i];
if tile is TStaticItem then
2009-12-04 20:24:36 +01:00
begin
FUndoList.Add(TInsertStaticPacket.Create(tile.X, tile.Y,
tile.Z, tile.TileID, TStaticItem(tile).Hue));
dmNetwork.Send(TDeleteStaticPacket.Create(TStaticItem(tile)));
2009-12-04 20:24:36 +01:00
end;
end;
end else if acHue.Checked then //***** Hue tile *****//
begin
for i := 0 to targetTiles.Count - 1 do
begin
tile := targetTiles.Items[i];
if (tile is TStaticItem) and
(TStaticItem(tile).Hue <> frmHueSettings.lbHue.ItemIndex) then
begin
2009-12-04 20:24:36 +01:00
FUndoList.Add(THueStaticPacket.Create(tile.X, tile.Y, tile.Z,
tile.TileID, frmHueSettings.lbHue.ItemIndex,
TStaticItem(tile).Hue));
dmNetwork.Send(THueStaticPacket.Create(TStaticItem(tile),
frmHueSettings.lbHue.ItemIndex));
end;
end;
end;
targetTiles.Free;
end;
end;
end;
end;
2009-12-04 20:24:36 +01:00
acUndo.Enabled := FUndoList.Count > 0;
SelectedTile := nil;
FRepaintNeeded := True;
Logger.ExitMethod([lcClient, lcDebug], 'MouseUp');
end;
procedure TfrmMain.oglGameWindowMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
cursorNeedsUpdate: Boolean;
newZ: ShortInt;
begin
//We want single steps ...
WheelDelta := WheelDelta div WHEEL_DELTA;
cursorNeedsUpdate := False;
if (CurrentTile is TVirtualTile) or ((ssCtrl in Shift) and
(frmVirtualLayer.cbShowLayer.Checked)) then
begin
frmVirtualLayer.seZ.Value := EnsureRange(frmVirtualLayer.seZ.Value +
WheelDelta, -128, 127);
cursorNeedsUpdate := True;
Handled := True;
end else if not (ssCtrl in Shift) then
begin
FUndoList.Clear;
newZ := EnsureRange(CurrentTile.Z + WheelDelta, -128, 127);
if CurrentTile is TStaticItem then
begin
FUndoList.Add(TElevateStaticPacket.Create(CurrentTile.X, CurrentTile.Y,
newZ, CurrentTile.TileID, TStaticItem(CurrentTile).Hue,
CurrentTile.Z));
dmNetwork.Send(TElevateStaticPacket.Create(TStaticItem(CurrentTile),
newZ));
cursorNeedsUpdate := True;
Handled := True;
end else if CurrentTile is TMapCell then
begin
FUndoList.Add(TDrawMapPacket.Create(CurrentTile.X, CurrentTile.Y,
CurrentTile.Z, CurrentTile.TileID));
dmNetwork.Send(TDrawMapPacket.Create(CurrentTile.X, CurrentTile.Y,
newZ, CurrentTile.TileID));
Handled := True;
end;
acUndo.Enabled := FUndoList.Count > 0;
end;
if cursorNeedsUpdate then
begin
SetCursorPos(Mouse.CursorPos.X, Mouse.CursorPos.Y - 4 * WheelDelta);
UpdateCurrentTile(MousePos.X, MousePos.Y - 4 * WheelDelta);
end;
FRepaintNeeded := True;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
var
virtualLayerGraphic: TSingleImage;
searchRec: TSearchRec;
begin
FAppDir := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName));
FLandscape := ResMan.Landscape;
FLandscape.OnChange := @OnLandscapeChanged;
FLandscape.OnMapChanged := @OnMapChanged;
FLandscape.OnNewBlock := @OnNewBlock;
FLandscape.OnStaticDeleted := @OnStaticDeleted;
FLandscape.OnStaticElevated := @OnStaticElevated;
FLandscape.OnStaticHued := @OnStaticHued;
FLandscape.OnStaticInserted := @OnStaticInserted;
FTextureManager := TLandTextureManager.Create;
FScreenBuffer := TScreenBuffer.Create;
FScreenBufferState := [];
X := 0;
Y := 0;
edX.MaxValue := FLandscape.CellWidth;
edY.MaxValue := FLandscape.CellHeight;
FOverlayUI := TOverlayUI.Create;
ProcessAccessLevel;
vdtTiles.NodeDataSize := SizeOf(TTileInfo);
vdtRandom.NodeDataSize := SizeOf(TTileInfo);
BuildTileList;
Randomize;
vstChat.NodeDataSize := SizeOf(TChatInfo);
pnlChatHeader.AnchorSide[akBottom].Control := pnlBottom;
FLocationsFile := FAppDir + 'Locations.dat';
vstLocations.NodeDataSize := SizeOf(TLocationInfo);
try
if FileExists(FLocationsFile) then
vstLocations.LoadFromFile(FLocationsFile);
except
on E: EVirtualTreeError do
begin
MessageDlg('Warning', 'The Locations could not be loaded. Most likely it is an' + LineEnding +
'outdated version or the file is damaged.' + LineEnding + LineEnding +
'A backup will be made as "Locations.bak".', mtWarning, [mbOK], 0);
RenameFile(FLocationsFile, FAppDir + 'Locations.bak');
end;
end;
RegisterPacketHandler($0C, TPacketHandler.Create(0, @OnClientHandlingPacket));
virtualLayerGraphic := TSingleImage.CreateFromStream(ResourceManager.GetResource(2));
FVLayerMaterial := TMaterial.Create(virtualLayerGraphic.Width,
virtualLayerGraphic.Height, virtualLayerGraphic);
virtualLayerGraphic.Free;
2009-09-29 02:25:19 +02:00
FGLFont := TGLFont.Create;
FGLFont.LoadImage(ResourceManager.GetResource(3));
FGLFont.LoadFontInfo(ResourceManager.GetResource(4));
FVirtualTiles := TWorldItemList.Create(True);
2009-12-04 20:24:36 +01:00
FUndoList := TPacketList.Create(True);
FRandomPresetLocation := FAppDir + 'RandomPresets' + PathDelim;
if not DirectoryExists(FRandomPresetLocation) then
CreateDir(FRandomPresetLocation);
if FindFirst(FRandomPresetLocation + '*.dat', faAnyFile, searchRec) = 0 then
begin
repeat
cbRandomPreset.Items.Add(ChangeFileExt(searchRec.Name, ''));
until FindNext(searchRec) <> 0;
end;
FindClose(searchRec);
DoubleBuffered := True;
pnlBottom.DoubleBuffered := True;
FLastDraw := Now;
end;
procedure TfrmMain.btnGoToClick(Sender: TObject);
begin
SetPos(edX.Value, edY.Value);
end;
procedure TfrmMain.btnRandomPresetDeleteClick(Sender: TObject);
begin
if cbRandomPreset.ItemIndex > -1 then
begin
DeleteFile(FRandomPresetLocation + cbRandomPreset.Text + '.dat');
cbRandomPreset.Items.Delete(cbRandomPreset.ItemIndex);
cbRandomPreset.ItemIndex := -1;
end;
end;
procedure TfrmMain.btnRandomPresetSaveClick(Sender: TObject);
var
fileName: string;
index: Integer;
begin
fileName := cbRandomPreset.Text;
if InputQuery('Save Preset', 'Enter the name of the preset:', fileName) then
begin
vdtRandom.SaveToFile(FRandomPresetLocation + fileName + '.dat');;
index := cbRandomPreset.Items.IndexOf(fileName);
if index = -1 then
begin
cbRandomPreset.Items.Add(fileName);
index := cbRandomPreset.Items.Count - 1;
end;
cbRandomPreset.ItemIndex := index;
end;
end;
procedure TfrmMain.cbRandomPresetChange(Sender: TObject);
begin
if cbRandomPreset.ItemIndex > -1 then
begin
try
vdtRandom.LoadFromFile(FRandomPresetLocation + cbRandomPreset.Text + '.dat');
except
on EVirtualTreeError do
begin
if MessageDlg('Error', 'The profile could not be loaded. Most likely it is an' + LineEnding +
'outdated version or the file is damaged.' + LineEnding + LineEnding +
'Should this profile be deleted now?', mtError, [mbYes, mbNo], 0) = mrYes then
begin
DeleteFile(FRandomPresetLocation + cbRandomPreset.Text + '.dat');
cbRandomPreset.Items.Delete(cbRandomPreset.ItemIndex);
end;
end;
end;
end;
end;
procedure TfrmMain.btnAddRandomClick(Sender: TObject);
var
selected, node: PVirtualNode;
sourceTileInfo, targetTileInfo: PTileInfo;
begin
vdtRandom.BeginUpdate;
selected := vdtTiles.GetFirstSelected;
while selected <> nil do
begin
sourceTileInfo := vdtTiles.GetNodeData(selected);
node := vdtRandom.AddChild(nil);
targetTileInfo := vdtRandom.GetNodeData(node);
targetTileInfo^.ID := sourceTileInfo^.ID;
selected := vdtTiles.GetNextSelected(selected);
end;
vdtRandom.EndUpdate;
end;
procedure TfrmMain.btnClearLocationsClick(Sender: TObject);
begin
if MessageDlg('Are you sure you want to delete all saved locations?',
mtConfirmation, [mbYes, mbNo], 0) = mrYes then
begin
vstLocations.Clear;
end;
end;
procedure TfrmMain.ApplicationProperties1Idle(Sender: TObject; var Done: Boolean);
begin
if (FScreenBufferState <> CScreenBufferValid) or
(FRepaintNeeded and (MilliSecondsBetween(Now, FLastDraw) > 50)) then
begin
Logger.Send([lcClient, lcDebug], 'Repainting Game Window');
oglGameWindow.Repaint;
FLastDraw := Now;
FRepaintNeeded := False;
end;
Sleep(1);
Done := False;
end;
procedure TfrmMain.btnAddLocationClick(Sender: TObject);
var
locationName: string;
locationInfo: PLocationInfo;
begin
locationName := '';
if InputQuery('New Location', 'Enter the name of the new location:',
locationName) then
begin
locationInfo := vstLocations.GetNodeData(vstLocations.AddChild(nil));
locationInfo^.X := X;
locationInfo^.Y := Y;
locationInfo^.Name := locationName;
end;
end;
procedure TfrmMain.acSelectExecute(Sender: TObject);
begin
acSelect.Checked := True;
tbSelect.Down := True;
mnuSelect.Checked := True;
ProcessToolState;
end;
2009-12-04 20:24:36 +01:00
procedure TfrmMain.acUndoExecute(Sender: TObject);
var
i: Integer;
begin
for i := FUndoList.Count - 1 downto 0 do
begin
dmNetwork.Send(FUndoList[i]);
FUndoList[i] := nil;
end;
FUndoList.Clear;
acUndo.Enabled := False;
end;
procedure TfrmMain.acVirtualLayerExecute(Sender: TObject);
begin
frmVirtualLayer.Show;
end;
procedure TfrmMain.acDrawExecute(Sender: TObject);
begin
acDraw.Checked := True;
tbDrawTile.Down := True;
mnuDraw.Checked := True;
frmDrawSettings.ShowModal;
ProcessToolState;
end;
procedure TfrmMain.acDeleteExecute(Sender: TObject);
begin
acDelete.Checked := True;
tbDeleteTile.Down := True;
mnuDelete.Checked := True;
ProcessToolState;
end;
procedure TfrmMain.acBoundariesExecute(Sender: TObject);
begin
frmBoundaries.Show;
end;
procedure TfrmMain.acElevateExecute(Sender: TObject);
begin
acElevate.Checked := True;
tbElevateTile.Down := True;
mnuElevate.Checked := True;
ProcessToolState;
frmElevateSettings.Show;
end;
procedure TfrmMain.acFilterExecute(Sender: TObject);
begin
if acFilter.Checked then
begin
frmFilter.Show;
frmFilter.Locked := False;
end else
frmFilter.Hide;
InvalidateFilter;
end;
procedure TfrmMain.acFlatExecute(Sender: TObject);
begin
acFlat.Checked := not acFlat.Checked;
RebuildScreenBuffer;
end;
procedure TfrmMain.acHueExecute(Sender: TObject);
begin
acHue.Checked := True;
tbSetHue.Down := True;
mnuSetHue.Checked := True;
ProcessToolState;
frmHueSettings.Show;
end;
procedure TfrmMain.acMoveExecute(Sender: TObject);
begin
acMove.Checked := True;
tbMoveTile.Down := True;
mnuMove.Checked := True;
ProcessToolState;
frmMoveSettings.Show;
end;
procedure TfrmMain.acNoDrawExecute(Sender: TObject);
begin
acNoDraw.Checked := not acNoDraw.Checked;
RebuildScreenBuffer;
end;
procedure TfrmMain.btnClearRandomClick(Sender: TObject);
begin
vdtRandom.BeginUpdate;
vdtRandom.Clear;
vdtRandom.EndUpdate;
end;
procedure TfrmMain.btnDeleteLocationClick(Sender: TObject);
begin
vstLocations.DeleteSelectedNodes;
end;
procedure TfrmMain.btnDeleteRandomClick(Sender: TObject);
begin
vdtRandom.BeginUpdate;
vdtRandom.DeleteSelectedNodes;
vdtRandom.EndUpdate;
end;
procedure TfrmMain.cbStaticsChange(Sender: TObject);
begin
if (not cbStatics.Checked) and (not cbTerrain.Checked) then
cbTerrain.Checked := True;
BuildTileList;
end;
procedure TfrmMain.cbTerrainChange(Sender: TObject);
begin
if (not cbTerrain.Checked) and (not cbStatics.Checked) then
cbStatics.Checked := True;
BuildTileList;
end;
procedure TfrmMain.edChatKeyPress(Sender: TObject; var Key: char);
begin
if Key = #13 then
begin
Key := #0;
if edChat.Text <> '' then
begin
dmNetwork.Send(TChatMessagePacket.Create(edChat.Text));
edChat.Text := '';
end;
end;
end;
procedure TfrmMain.edFilterEditingDone(Sender: TObject);
begin
BuildTileList;
end;
procedure TfrmMain.FormActivate(Sender: TObject);
begin
if oglGameWindow.MouseEntered then
oglGameWindowMouseEnter(Sender);
end;
procedure TfrmMain.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
dmNetwork.CheckClose(Self);
end;
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
CurrentTile := nil;
SelectedTile := nil;
vstLocations.SaveToFile(FLocationsFile);
2009-09-29 02:25:19 +02:00
FreeAndNil(FTextureManager);
FreeAndNil(FScreenBuffer);
FreeAndNil(FOverlayUI);
FreeAndNil(FVLayerMaterial);
FreeAndNil(FVirtualTiles);
2009-12-04 20:24:36 +01:00
FreeAndNil(FUndoList);
FreeAndNil(FGLFont);
RegisterPacketHandler($0C, nil);
end;
procedure TfrmMain.edSearchIDExit(Sender: TObject);
begin
edSearchID.Visible := False;
edSearchID.Text := '';
//edSearchID.Font.Color := clWindowText;
end;
procedure TfrmMain.edSearchIDKeyPress(Sender: TObject; var Key: char);
var
enteredText: String;
tileID: Integer;
tileType: Char;
node: PVirtualNode;
tileInfo: PTileInfo;
begin
if Key = #13 then
begin
Key := #0;
enteredText := edSearchID.Text;
tileType := #0;
if Length(enteredText) > 1 then
tileType := enteredText[Length(enteredText)];
if not (tileType in ['S', 'T']) then
begin
if cbTerrain.Checked then
tileType := 'T'
else
tileType := 'S';
end else
Delete(enteredText, Length(enteredText), 1);
tileID := 0;
if not TryStrToInt(enteredText, tileID) then
begin
//edSearchID.Font.Color := clRed;
MessageDlg('Error', 'The specified TileID is invalid.', mtError, [mbOK], 0);
vdtTiles.SetFocus;
Exit;
end;
if tileType = 'S' then
Inc(tileID, $4000);
node := vdtTiles.GetFirst;
while node <> nil do
begin
tileInfo := vdtTiles.GetNodeData(node);
if tileInfo^.ID = tileID then
begin
vdtTiles.ClearSelection;
vdtTiles.Selected[node] := True;
vdtTiles.FocusedNode := node;
Break;
end;
node := vdtTiles.GetNext(node);
end;
if node = nil then
begin
//edSearchID.Font.Color := clRed;
MessageDlg('Error', 'The tile with the specified ID could not be found.' +
LineEnding + 'Check for conflicting filter settings.', mtError, [mbOK], 0);
vdtTiles.SetFocus;
Exit;
end;
//edSearchID.Font.Color := clWindowText;
edSearchID.Visible := False;
end else if Key = #27 then
begin
edSearchID.Visible := False;
//edSearchID.Font.Color := clWindowText;
Key := #0;
end else if not (Key in ['$', '0'..'9', 'a'..'f', 'A'..'F', 's', 'S',
't', 'T', #8]) then
Key := #0;
end;
procedure TfrmMain.lblChatHeaderCaptionClick(Sender: TObject);
begin
if pnlChat.Visible then
begin
pnlChat.Visible := False;
spChat.Visible := False;
pnlChatHeader.AnchorSide[akBottom].Control := pnlBottom;
end else
begin
spChat.Visible := True;
pnlChat.Visible := True;
spChat.Top := pnlChat.Top - spChat.Height;
pnlChatHeader.AnchorSide[akBottom].Control := spChat;
lblChatHeaderCaption.Font.Bold := False;
lblChatHeaderCaption.Font.Italic := False;
lblChatHeaderCaption.Font.Color := clWindowText;
edChat.SetFocus;
end;
end;
procedure TfrmMain.lblChatHeaderCaptionMouseEnter(Sender: TObject);
begin
lblChatHeaderCaption.Font.Underline := True;
end;
procedure TfrmMain.lblChatHeaderCaptionMouseLeave(Sender: TObject);
begin
lblChatHeaderCaption.Font.Underline := False;
end;
procedure TfrmMain.mnuAboutClick(Sender: TObject);
begin
frmAbout.ShowModal;
end;
procedure TfrmMain.mnuAccountControlClick(Sender: TObject);
begin
frmAccountControl.Show;
end;
procedure TfrmMain.mnuDisconnectClick(Sender: TObject);
begin
dmNetwork.Disconnect;
end;
procedure TfrmMain.oglGameWindowPaint(Sender: TObject);
begin
glClear(GL_COLOR_BUFFER_BIT);
InitRender;
InitSize;
if FVLayerMaterial.Texture = 0 then
FVLayerMaterial.UpdateTexture;
glDisable(GL_DEPTH_TEST);
Render;
oglGameWindow.SwapBuffers;
end;
procedure TfrmMain.oglGameWindowResize(Sender: TObject);
begin
InvalidateScreenBuffer;
end;
procedure TfrmMain.pmGrabTileInfoPopup(Sender: TObject);
begin
mnuGrabHue.Enabled := CurrentTile is TStaticItem;
end;
procedure TfrmMain.tbFilterMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if acFilter.Checked and (not frmFilter.Visible) then
frmFilter.Show;
end;
procedure TfrmMain.tbRadarMapClick(Sender: TObject);
begin
frmRadarMap.Show;
frmRadarMap.BringToFront;
end;
procedure TfrmMain.tbStaticsClick(Sender: TObject);
begin
RebuildScreenBuffer;
end;
procedure TfrmMain.tbTerrainClick(Sender: TObject);
begin
RebuildScreenBuffer;
end;
procedure TfrmMain.tmGrabTileInfoTimer(Sender: TObject);
begin
tmGrabTileInfo.Enabled := False;
if CurrentTile <> nil then
pmGrabTileInfo.PopUp(Mouse.CursorPos.X, Mouse.CursorPos.Y);
SelectedTile := nil;
end;
procedure TfrmMain.tmMovementTimer(Sender: TObject);
procedure MoveBy(AOffsetX, AOffsetY: Integer);
begin
SetPos(EnsureRange(FX + AOffsetX, 0, FLandscape.CellWidth - 1),
EnsureRange(FY + AOffsetY, 0, FLandscape.CellHeight - 1));
end;
begin
case FOverlayUI.ActiveArrow of
0: MoveBy(-8, 0);
1: MoveBy(-8, -8);
2: MoveBy(0, -8);
3: MoveBy(8, -8);
4: MoveBy(8, 0);
5: MoveBy(8, 8);
6: MoveBy(0, 8);
7: MoveBy(-8, 8);
end;
end;
procedure TfrmMain.tmTileHintTimer(Sender: TObject);
begin
frmTileInfo.Show;
tmTileHint.Enabled := False;
end;
procedure TfrmMain.vdtRandomDragDrop(Sender: TBaseVirtualTree; Source: TObject;
DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState;
Pt: TPoint; var Effect: Integer; Mode: TDropMode);
begin
if Source = vdtTiles then
btnAddRandomClick(Sender);
end;
procedure TfrmMain.vdtRandomDragOver(Sender: TBaseVirtualTree; Source: TObject;
Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode;
var Effect: Integer; var Accept: Boolean);
begin
if source = vdtTiles then Accept := True;
end;
procedure TfrmMain.vdtRandomLoadNode(Sender: TBaseVirtualTree;
Node: PVirtualNode; Stream: TStream);
var
tileInfo: PTileInfo;
begin
tileInfo := Sender.GetNodeData(Node);
Stream.Read(tileInfo^.ID, SizeOf(tileInfo^.ID));
end;
procedure TfrmMain.vdtRandomSaveNode(Sender: TBaseVirtualTree;
Node: PVirtualNode; Stream: TStream);
var
tileInfo: PTileInfo;
begin
tileInfo := Sender.GetNodeData(Node);
Stream.Write(tileInfo^.ID, SizeOf(tileInfo^.ID));
end;
procedure TfrmMain.vdtRandomUpdating(Sender: TBaseVirtualTree;
State: TVTUpdateState);
begin
if acDraw.Checked then
ProcessToolState;
end;
procedure TfrmMain.vdtTilesClick(Sender: TObject);
begin
{if vdtTiles.GetFirstSelected <> nil then
begin
if not tbDrawTile.Down then
begin
frmDrawSettings.rbTileList.Checked := True;
tbDrawTileClick(Sender);
end else
ProcessToolState;
end;}
if acDraw.Checked then
ProcessToolState;
end;
procedure TfrmMain.vdtTilesDrawNode(Sender: TBaseVirtualTree;
const PaintInfo: TVTPaintInfo);
var
tileInfo: PTileInfo;
textStyle: TTextStyle;
artEntry: TArt;
tileData: TTileData;
id: Integer;
begin
tileInfo := Sender.GetNodeData(PaintInfo.Node);
textStyle := PaintInfo.Canvas.TextStyle;
textStyle.Alignment := taCenter;
textStyle.Layout := tlCenter;
textStyle.Wordbreak := True;
case PaintInfo.Column of
0:
begin
id := tileInfo^.ID;
if id > $3FFF then
Dec(id, $4000);
PaintInfo.Canvas.TextRect(PaintInfo.CellRect, 0, 0, Format('$%x', [id]),
textStyle);
end;
1:
begin
if ResMan.Art.Exists(tileInfo^.ID) then
begin
artEntry := ResMan.Art.GetArt(tileInfo^.ID,
RGB2ARGB(PaintInfo.Canvas.Pixels[PaintInfo.CellRect.Left,
PaintInfo.CellRect.Top]), nil, False);
DisplayImage(PaintInfo.Canvas, PaintInfo.CellRect, artEntry.Graphic);
artEntry.Free;
end;
end;
2:
begin
tileData := TTileData(ResMan.Tiledata.Block[tileInfo^.ID]);
PaintInfo.Canvas.TextRect(PaintInfo.CellRect, PaintInfo.CellRect.Left,
PaintInfo.CellRect.Top, ISO_8859_1ToUTF8(Trim(tileData.TileName)),
textStyle);
tileData.Free;
end;
end;
end;
procedure TfrmMain.vdtTilesEnter(Sender: TObject);
begin
if acFilter.Checked and (not frmFilter.Visible) and (not frmFilter.Locked) then
begin
frmFilter.Locked := True;
frmFilter.Show;
frmMain.SetFocus;
frmFilter.Locked := False;
end;
end;
procedure TfrmMain.vdtTilesExit(Sender: TObject);
begin
{TODO : Fix mouse over on !Windows platforms}
{$IFDEF Windows}
tmTileHint.Enabled := False;
{$ENDIF Windows}
end;
procedure TfrmMain.vdtTilesHotChange(Sender: TBaseVirtualTree; OldNode,
NewNode: PVirtualNode);
{$IFDEF Windows}
var
tileInfo: PTileInfo;
{$ENDIF Windows}
begin
{TODO : Fix mouse over on !Windows platforms}
{$IFDEF Windows}
if NewNode <> nil then
begin
tileInfo := vdtTiles.GetNodeData(NewNode);
frmTileInfo.Update(tileInfo^.ID);
tmTileHint.Enabled := True;
end else
begin
frmTileInfo.Hide;
tmTileHint.Enabled := False;
end;
{$ENDIF Windows}
end;
procedure TfrmMain.vdtTilesKeyPress(Sender: TObject; var Key: char);
begin
if Key in ['$', '0'..'9'] then
begin
edSearchID.Text := Key;
edSearchID.Visible := True;
edSearchID.SetFocus;
edSearchID.SelStart := 1;
Key := #0;
end;
end;
procedure TfrmMain.vdtTilesMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if tmTileHint.Enabled then
begin
tmTileHint.Enabled := False;
tmTileHint.Enabled := True; //Restart timer
end;
if frmTileInfo.Visible then
begin
frmTileInfo.Hide;
tmTileHint.Enabled := True;
end;
end;
procedure TfrmMain.vdtTilesScroll(Sender: TBaseVirtualTree; DeltaX,
DeltaY: Integer);
begin
if Sender.CanFocus and Sender.MouseEntered then
Sender.SetFocus;
end;
procedure TfrmMain.vstChatClick(Sender: TObject);
begin
edChat.SetFocus;
end;
procedure TfrmMain.vstChatFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
var
chatInfo: PChatInfo;
begin
chatInfo := Sender.GetNodeData(Node);
chatInfo^.Sender := '';
chatInfo^.Msg := '';
end;
procedure TfrmMain.vstChatGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: String);
var
chatInfo: PChatInfo;
begin
chatInfo := Sender.GetNodeData(Node);
case Column of
0: CellText := TimeToStr(chatInfo^.Time);
1: CellText := chatInfo^.Sender;
2: CellText := chatInfo^.Msg;
end;
end;
procedure TfrmMain.vstChatPaintText(Sender: TBaseVirtualTree;
const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType);
var
chatInfo: PChatInfo;
begin
chatInfo := Sender.GetNodeData(Node);
if chatInfo^.Sender = 'System' then
begin
if Column = 1 then
TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsItalic, fsBold]
else
TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsItalic];
end;
end;
procedure TfrmMain.vstLocationsDblClick(Sender: TObject);
var
node: PVirtualNode;
locationInfo: PLocationInfo;
begin
node := vstLocations.GetFirstSelected;
if node <> nil then
begin
locationInfo := vstLocations.GetNodeData(node);
SetPos(locationInfo^.X, locationInfo^.Y);
end;
end;
procedure TfrmMain.vstLocationsFreeNode(Sender: TBaseVirtualTree;
Node: PVirtualNode);
var
locationInfo: PLocationInfo;
begin
locationInfo := Sender.GetNodeData(Node);
locationInfo^.Name := '';
end;
procedure TfrmMain.vstLocationsGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: String);
var
locationInfo: PLocationInfo;
begin
locationInfo := Sender.GetNodeData(Node);
case Column of
0: CellText := Format('%d, %d', [locationInfo^.X, locationInfo^.Y]);
1: CellText := locationInfo^.Name;
end;
end;
procedure TfrmMain.vstLocationsLoadNode(Sender: TBaseVirtualTree;
Node: PVirtualNode; Stream: TStream);
var
locationInfo: PLocationInfo;
stringLength: Integer;
s: string;
begin
locationInfo := Sender.GetNodeData(Node);
Stream.Read(locationInfo^.X, SizeOf(Word));
Stream.Read(locationInfo^.Y, SizeOf(Word));
stringLength := 0;
Stream.Read(stringLength, SizeOf(Integer));
SetLength(s, stringLength);
Stream.Read(s[1], stringLength);
locationInfo^.Name := s;
end;
procedure TfrmMain.vstLocationsNewText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; const NewText: String);
var
locationInfo: PLocationInfo;
begin
if Column = 1 then
begin
locationInfo := Sender.GetNodeData(Node);
locationInfo^.Name := NewText;
end;
end;
procedure TfrmMain.vstLocationsSaveNode(Sender: TBaseVirtualTree;
Node: PVirtualNode; Stream: TStream);
var
locationInfo: PLocationInfo;
stringLength: Integer;
begin
locationInfo := Sender.GetNodeData(Node);
Stream.Write(locationInfo^.X, SizeOf(Word));
Stream.Write(locationInfo^.Y, SizeOf(Word));
stringLength := Length(locationInfo^.Name);
Stream.Write(stringLength, SizeOf(Integer));
Stream.Write(locationInfo^.Name[1], stringLength);
end;
procedure TfrmMain.SetX(const AValue: Integer);
begin
SetPos(AValue, FY);
end;
procedure TfrmMain.SetY(const AValue: Integer);
begin
SetPos(FX, AValue);
end;
procedure TfrmMain.SetPos(AX, AY: Word);
begin
if InRange(AX, 0, FLandscape.CellWidth - 1) and InRange(AY, 0,
FLandscape.CellHeight - 1) then
begin
FX := AX;
edX.Value := FX;
FY := AY;
edY.Value := FY;
dmNetwork.Send(TUpdateClientPosPacket.Create(AX, AY));
InvalidateScreenBuffer;
if frmRadarMap <> nil then frmRadarMap.Repaint;
end;
end;
procedure TfrmMain.RegisterAccessChangedListener(
AListener: TAccessChangedListener);
var
i: Integer;
begin
for i := Low(FAccessChangedListeners) to High(FAccessChangedListeners) do
if FAccessChangedListeners[i] = AListener then
Exit; //Prevent duplicates
SetLength(FAccessChangedListeners, Length(FAccessChangedListeners) + 1);
FAccessChangedListeners[High(FAccessChangedListeners)] := AListener;
end;
procedure TfrmMain.UnregisterAccessChangedListener(
AListener: TAccessChangedListener);
var
i: Integer;
found: Boolean;
begin
i := Low(FAccessChangedListeners);
found := False;
while (i <= High(FAccessChangedListeners)) and (not found) do
begin
if FAccessChangedListeners[i] = AListener then
begin
if i < High(FAccessChangedListeners) then
Move(FAccessChangedListeners[i+1], FAccessChangedListeners[i],
(High(FAccessChangedListeners) - Low(FAccessChangedListeners) - i) *
SizeOf(TAccessChangedListener)); //move subsequent entries
SetLength(FAccessChangedListeners, Length(FAccessChangedListeners) - 1);
found := True;
end else
Inc(i);
end;
end;
procedure TfrmMain.SetCurrentTile(const AValue: TWorldItem);
begin
Logger.EnterMethod([lcClient, lcDebug], 'SetCurrentTile');
if AValue = FCurrentTile then
begin
Logger.ExitMethod([lcClient, lcDebug], 'SetCurrentTile');
Exit;
end;
Logger.Send([lcClient, lcDebug], 'Value', AValue);
if FCurrentTile <> nil then
FCurrentTile.OnDestroy.UnregisterEvent(@OnTileRemoved);
FCurrentTile := AValue;
if FCurrentTile = nil then
begin
lblTileInfo.Caption := '';
end else
begin
FCurrentTile.OnDestroy.RegisterEvent(@OnTileRemoved);
if FCurrentTile is TVirtualTile then
lblTileInfo.Caption := Format('Virtual Layer: X: %d, Y: %d, Z: %d',
[FCurrentTile.X, FCurrentTile.Y, FCurrentTile.Z])
else if FCurrentTile is TMapCell then
lblTileInfo.Caption := Format('Terrain TileID: $%x, X: %d, Y: %d, Z: %d',
[FCurrentTile.TileID, FCurrentTile.X, FCurrentTile.Y, FCurrentTile.Z])
else if FCurrentTile is TStaticItem then
lblTileInfo.Caption := Format('Static TileID: $%x, X: %d, Y: %d, Z: %d, Hue: $%x',
[FCurrentTile.TileID, FCurrentTile.X, FCurrentTile.Y, FCurrentTile.Z,
TStaticItem(FCurrentTile).Hue]);
end;
UpdateSelection;
Logger.ExitMethod([lcClient, lcDebug], 'SetCurrentTile');
end;
procedure TfrmMain.SetSelectedTile(const AValue: TWorldItem);
begin
Logger.EnterMethod([lcClient, lcDebug], 'SetSelectedTile');
if AValue = FSelectedTile then
begin
Logger.ExitMethod([lcClient, lcDebug], 'SetSelectedTile');
Exit;
end;
Logger.Send([lcClient, lcDebug], 'Value', AValue);
if FSelectedTile <> nil then
FSelectedTile.OnDestroy.UnregisterEvent(@OnTileRemoved);
FSelectedTile := AValue;
if FSelectedTile <> nil then
FSelectedTile.OnDestroy.RegisterEvent(@OnTileRemoved);
UpdateSelection;
Logger.ExitMethod([lcClient, lcDebug], 'SetSelectedTile');
end;
procedure TfrmMain.SetNormalLights;
const
specular: TGLArrayf4 = (2, 2, 2, 1);
ambient: TGLArrayf4 = (1, 1, 1, 1);
begin
glLightfv(GL_LIGHT0, GL_AMBIENT, @specular);
glLightModelfv(GL_LIGHT_MODEL_AMBIENT, @ambient);
end;
procedure TfrmMain.SetDarkLights;
const
specularDark: TGLArrayf4 = (0.5, 0.5, 0.5, 1);
ambientDark: TGLArrayf4 = (0.25, 0.25, 0.25, 1);
begin
glLightfv(GL_LIGHT0, GL_AMBIENT, @specularDark);
glLightModelfv(GL_LIGHT_MODEL_AMBIENT, @ambientDark);
end;
procedure TfrmMain.InitRender;
const
lightPosition: TGLArrayf4 = (-1, -1, 0.5, 0);
begin
glEnable(GL_ALPHA_TEST);
glAlphaFunc(GL_GREATER, 0.1);
glEnable(GL_TEXTURE_2D);
glDisable(GL_DITHER);
glEnable(GL_BLEND); // Enable alpha blending of textures
glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
glShadeModel(GL_SMOOTH);
glEnable(GL_NORMALIZE);
glEnable(GL_LIGHT0);
glLightfv(GL_LIGHT0, GL_POSITION, @lightPosition);
glLightModeli(GL_LIGHT_MODEL_TWO_SIDE, GL_FALSE);
end;
procedure TfrmMain.InitSize;
begin
glViewport(0, 0, oglGameWindow.Width, oglGameWindow.Height);
glMatrixMode(GL_PROJECTION);
glPushMatrix;
glLoadIdentity;
gluOrtho2D(0, oglGameWindow.Width, oglGameWindow.Height, 0);
glMatrixMode(GL_MODELVIEW);
glPushMatrix;
glLoadIdentity;
end;
procedure TfrmMain.PrepareMapCell(AMapCell: TMapCell);
var
current, north, east, west: PBlockInfo;
cell: TMapCell;
begin
current := FScreenBuffer.UpdateSortOrder(AMapCell);
if current = nil then
Exit; //off-screen update
PrepareScreenBlock(current);
Exclude(FScreenBufferState, sbsIndexed);
//Find surrounding cells
current := nil;
north := nil;
east := nil;
west := nil;
while ((north = nil) or (east = nil) or (west = nil)) and
FScreenBuffer.Iterate(current) do
begin
if current^.Item is TMapCell then
begin
cell := TMapCell(current^.Item);
if (cell.X = AMapCell.X - 1) and (cell.Y = AMapCell.Y - 1) then
north := current
else if (cell.X = AMapCell.X) and (cell.Y = AMapCell.Y - 1) then
east := current
else if (cell.X = AMapCell.X - 1) and (cell.Y = AMapCell.Y) then
west := current;
end;
end;
if north <> nil then PrepareScreenBlock(north);
if east <> nil then PrepareScreenBlock(east);
if west <> nil then PrepareScreenBlock(west);
end;
procedure TfrmMain.InvalidateFilter;
begin
Exclude(FScreenBufferState, sbsFiltered);
end;
procedure TfrmMain.InvalidateScreenBuffer;
begin
Exclude(FScreenBufferState, sbsValid);
end;
procedure TfrmMain.PrepareScreenBlock(ABlockInfo: PBlockInfo);
procedure GetLandAlt(const AX, AY: Integer; const ADefaultZ,
ADefaultRaw: SmallInt; var Z, RawZ: SmallInt);
var
cell: TMapCell;
begin
cell := FLandscape.MapCell[AX, AY];
if cell <> nil then
begin
Z := cell.Z;
RawZ := cell.RawZ;
end else
begin
Z := ADefaultZ;
RawZ := ADefaultRaw;
end;
end;
var
item: TWorldItem;
drawX, drawY: Integer;
z, west, south, east: SmallInt;
rawZ, rawWest, rawSouth, rawEast: SmallInt;
staticItem: TStaticItem;
begin
//add normals to map tiles and materials where possible
item := ABlockInfo^.Item;
GetDrawOffset(item.X - FX, item.Y - FY, drawX, drawY);
if acFlat.Checked then
begin
z := 0;
rawZ := 0;
end else
begin
z := item.Z;
rawZ := item.RawZ;
end;
ABlockInfo^.HighRes := nil;
ABlockInfo^.CheckRealQuad := False;
ABlockInfo^.Text.Free;
if item is TMapCell then
begin
if not acFlat.Checked then
begin
GetLandAlt(item.X, item.Y + 1, z, rawZ, west, rawWest);
GetLandAlt(item.X + 1, item.Y + 1, z, rawZ, south, rawSouth);
GetLandAlt(item.X + 1, item.Y, z, rawZ, east, rawEast);
if (west <> z) or (south <> z) or (east <> z) then
ABlockInfo^.HighRes := FTextureManager.GetTexMaterial(item.TileID);
if (rawWest <> rawZ) or (rawSouth <> rawZ) or (rawEast <> rawZ) then
begin
ABlockInfo^.RealQuad[0][0] := drawX;
ABlockInfo^.RealQuad[0][1] := drawY - rawZ * 4;
ABlockInfo^.RealQuad[1][0] := drawX + 22;
ABlockInfo^.RealQuad[1][1] := drawY + 22 - rawEast * 4;
ABlockInfo^.RealQuad[2][0] := drawX;
ABlockInfo^.RealQuad[2][1] := drawY + 44 - rawSouth * 4;
ABlockInfo^.RealQuad[3][0] := drawX - 22;
ABlockInfo^.RealQuad[3][1] := drawY + 22 - rawWest * 4;
with ABlockInfo^ do
begin
with ScreenRect do
begin
Left := drawX - 22;
Right := drawX + 22;
Top := RealQuad[0][1];
Bottom := RealQuad[0][1];
if RealQuad[1][1] < Top then Top := RealQuad[1][1];
if RealQuad[1][1] > Bottom then Bottom := RealQuad[1][1];
if RealQuad[2][1] < Top then Top := RealQuad[2][1];
if RealQuad[2][1] > Bottom then Bottom := RealQuad[2][1];
if RealQuad[3][1] < Top then Top := RealQuad[3][1];
if RealQuad[3][1] > Bottom then Bottom := RealQuad[3][1];
end;
CheckRealQuad := True;
end;
end;
end else
begin
if mnuFlatShowHeight.Checked then
ABlockInfo^.Text := TGLText.Create(FGLFont, IntToStr(item.Z));
end;
if not ABlockInfo^.CheckRealQuad then
ABlockInfo^.ScreenRect := Bounds(Trunc(drawX - 22),
Trunc(drawY - rawZ * 4), 44, 44);
ABlockInfo^.LowRes := FTextureManager.GetArtMaterial(item.TileID);
if ABlockInfo^.HighRes <> nil then
begin
2009-12-03 01:38:42 +01:00
if ABlockInfo^.Normals = nil then
New(ABlockInfo^.Normals);
FLandscape.GetNormals(item.X, item.Y, ABlockInfo^.Normals^);
ABlockInfo^.DrawQuad[0][0] := drawX;
ABlockInfo^.DrawQuad[0][1] := drawY - z * 4;
ABlockInfo^.DrawQuad[1][0] := drawX + 22;
ABlockInfo^.DrawQuad[1][1] := drawY + 22 - east * 4;
ABlockInfo^.DrawQuad[2][0] := drawX;
ABlockInfo^.DrawQuad[2][1] := drawY + 44 - south * 4;
ABlockInfo^.DrawQuad[3][0] := drawX - 22;
ABlockInfo^.DrawQuad[3][1] := drawY + 22 - west * 4;
end else
begin
ABlockInfo^.DrawQuad[0][0] := drawX - 22;
ABlockInfo^.DrawQuad[0][1] := drawY - z * 4;
ABlockInfo^.DrawQuad[1][0] := drawX - 22 + ABlockInfo^.LowRes.Width;
ABlockInfo^.DrawQuad[1][1] := drawY - z * 4;
ABlockInfo^.DrawQuad[2][0] := drawX - 22 + ABlockInfo^.LowRes.Width;
ABlockInfo^.DrawQuad[2][1] := drawY + ABlockInfo^.LowRes.Height - z * 4;
ABlockInfo^.DrawQuad[3][0] := drawX - 22;
ABlockInfo^.DrawQuad[3][1] := drawY + ABlockInfo^.LowRes.Height - z * 4;
end;
end else
2009-09-29 02:25:19 +02:00
if item is TVirtualTile then
begin
ABlockInfo^.LowRes := FVLayerMaterial;
ABlockInfo^.ScreenRect := Bounds(Trunc(drawX - 22), Trunc(drawY - z * 4),
44, 44);
2009-09-29 02:25:19 +02:00
ABlockInfo^.DrawQuad[0][0] := drawX - 22;
ABlockInfo^.DrawQuad[0][1] := drawY - z * 4;
ABlockInfo^.DrawQuad[1][0] := drawX - 22 + ABlockInfo^.LowRes.Width;
ABlockInfo^.DrawQuad[1][1] := drawY - z * 4;
ABlockInfo^.DrawQuad[2][0] := drawX - 22 + ABlockInfo^.LowRes.Width;
ABlockInfo^.DrawQuad[2][1] := drawY + ABlockInfo^.LowRes.Height - z * 4;
ABlockInfo^.DrawQuad[3][0] := drawX - 22;
ABlockInfo^.DrawQuad[3][1] := drawY + ABlockInfo^.LowRes.Height - z * 4;
end else
begin
staticItem := TStaticItem(item);
ABlockInfo^.LowRes := FTextureManager.GetStaticMaterial(staticItem);
ABlockInfo^.HueOverride := False;
ABlockInfo^.ScreenRect := Bounds(Trunc(drawX - ABlockInfo^.LowRes.RealWidth / 2),
Trunc(drawY + 44 - ABlockInfo^.LowRes.RealHeight - z * 4),
ABlockInfo^.LowRes.RealWidth,
ABlockInfo^.LowRes.RealHeight);
ABlockInfo^.Translucent := tdfTranslucent in
ResMan.Tiledata.StaticTiles[staticItem.TileID].Flags;
south := ABlockInfo^.LowRes.RealHeight;
east := ABlockInfo^.LowRes.RealWidth div 2;
ABlockInfo^.DrawQuad[0][0] := drawX - east;
ABlockInfo^.DrawQuad[0][1] := drawY + 44 - south - z * 4;
ABlockInfo^.DrawQuad[1][0] := drawX - east + ABlockInfo^.LowRes.Width;
ABlockInfo^.DrawQuad[1][1] := drawY + 44 - south - z * 4;
ABlockInfo^.DrawQuad[2][0] := drawX - east + ABlockInfo^.LowRes.Width;
ABlockInfo^.DrawQuad[2][1] := drawY + 44 - south + ABlockInfo^.LowRes.Height - z * 4;
ABlockInfo^.DrawQuad[3][0] := drawX - east;
ABlockInfo^.DrawQuad[3][1] := drawY + 44 - south + ABlockInfo^.LowRes.Height - z * 4;
end;
end;
procedure TfrmMain.Render;
var
highlight: Boolean;
intensity: GLfloat;
blockInfo: PBlockInfo;
item: TWorldItem;
begin
if not (sbsValid in FScreenBufferState) then
RebuildScreenBuffer;
if not (sbsIndexed in FScreenBufferState) then
begin
FScreenBuffer.UpdateShortcuts;
Include(FScreenBufferState, sbsIndexed);
end;
if not (sbsFiltered in FScreenBufferState) then
UpdateFilter;
blockInfo := nil;
while FScreenBuffer.Iterate(blockInfo) do
begin
if blockInfo^.State = ssFiltered then
Continue;
item := blockInfo^.Item;
2009-09-29 02:25:19 +02:00
if acSelect.Checked or item.CanBeEdited or (item is TVirtualTile) then
begin
intensity := 1.0;
SetNormalLights;
end else
begin
intensity := 0.5;
SetDarkLights;
end;
if blockInfo^.Translucent then
glColor4f(intensity, intensity, intensity, 0.5)
else
glColor4f(intensity, intensity, intensity, 1.0);
highlight := blockInfo^.Highlighted and item.CanBeEdited;
if highlight then
begin
glEnable(GL_COLOR_LOGIC_OP);
glLogicOp(GL_COPY_INVERTED);
end;
if blockInfo^.HighRes <> nil then
begin
glBindTexture(GL_TEXTURE_2D, blockInfo^.HighRes.Texture);
if not highlight then
glEnable(GL_LIGHTING);
glLoadName(PtrInt(item));
glBegin(GL_QUADS);
glNormal3fv(@blockInfo^.Normals^[0]);
glTexCoord2i(0, 0); glVertex2iv(@blockInfo^.DrawQuad[0]);
glNormal3fv(@blockInfo^.Normals^[3]);
glTexCoord2i(0, 1); glVertex2iv(@blockInfo^.DrawQuad[3]);
glNormal3fv(@blockInfo^.Normals^[2]);
glTexCoord2i(1, 1); glVertex2iv(@blockInfo^.DrawQuad[2]);
glNormal3fv(@blockInfo^.Normals^[1]);
glTexCoord2i(1, 0); glVertex2iv(@blockInfo^.DrawQuad[1]);
glEnd;
if not highlight then
glDisable(GL_LIGHTING);
end else
begin
glBindTexture(GL_TEXTURE_2D, blockInfo^.LowRes.Texture);
glLoadName(PtrInt(item));
glBegin(GL_QUADS);
glTexCoord2i(0, 0); glVertex2iv(@blockInfo^.DrawQuad[0]);
glTexCoord2i(1, 0); glVertex2iv(@blockInfo^.DrawQuad[1]);
glTexCoord2i(1, 1); glVertex2iv(@blockInfo^.DrawQuad[2]);
glTexCoord2i(0, 1); glVertex2iv(@blockInfo^.DrawQuad[3]);
glEnd;
end;
if highlight then
glDisable(GL_COLOR_LOGIC_OP);
if (blockInfo^.Text <> nil) then
blockInfo^.Text.Render(blockInfo^.ScreenRect);
end;
FOverlayUI.Draw(oglGameWindow);
end;
procedure TfrmMain.OnLandscapeChanged;
begin
InvalidateScreenBuffer;
oglGameWindow.Repaint;
UpdateCurrentTile;
end;
procedure TfrmMain.OnMapChanged(AMapCell: TMapCell);
begin
PrepareMapCell(AMapCell);
ForceUpdateCurrentTile;
end;
procedure TfrmMain.OnNewBlock(ABlock: TBlock);
begin
InvalidateScreenBuffer;
end;
procedure TfrmMain.OnStaticDeleted(AStaticItem: TStaticItem);
begin
FScreenBuffer.Delete(AStaticItem);
UpdateCurrentTile;
FRepaintNeeded := True;
ForceUpdateCurrentTile;
end;
procedure TfrmMain.OnStaticElevated(AStaticItem: TStaticItem);
var
blockInfo: PBlockInfo;
begin
AStaticItem.PrioritySolver := FScreenBuffer.GetSerial;
blockInfo := FScreenBuffer.UpdateSortOrder(AStaticItem);
if blockInfo <> nil then
begin
PrepareScreenBlock(blockInfo);
Exclude(FScreenBufferState, sbsIndexed);
ForceUpdateCurrentTile;
end;
end;
procedure TfrmMain.OnStaticHued(AStaticItem: TStaticItem);
var
blockInfo: PBlockInfo;
begin
blockInfo := nil;
while FScreenBuffer.Iterate(blockInfo) do
begin
if blockInfo^.Item = AStaticItem then
begin
PrepareScreenBlock(blockInfo);
FRepaintNeeded := True;
Break;
end;
end;
end;
procedure TfrmMain.OnStaticInserted(AStaticItem: TStaticItem);
begin
if (AStaticItem.X >= FX + FLowOffsetX) and
(AStaticItem.X <= FX + FHighOffsetX) and
(AStaticItem.Y >= FY + FLowOffsetY) and
(AStaticItem.Y <= FY + FHighOffsetY) then
begin
AStaticItem.PrioritySolver := FScreenBuffer.GetSerial;
PrepareScreenBlock(FScreenBuffer.Insert(AStaticItem));
FRepaintNeeded := True;
ForceUpdateCurrentTile;
end;
end;
procedure TfrmMain.BuildTileList;
var
minID, maxID, i, lastID: Integer;
node: PVirtualNode;
tileInfo: PTileInfo;
filter: string;
begin
if cbTerrain.Checked then minID := $0 else minID := $4000;
if cbStatics.Checked then maxID := $7FFF else maxID := $3FFF;
filter := AnsiLowerCase(edFilter.Text);
node := vdtTiles.GetFirstSelected;
if node <> nil then
begin
tileInfo := vdtTiles.GetNodeData(node);
lastID := tileInfo^.ID;
end else
lastID := -1;
vdtTiles.BeginUpdate;
vdtTiles.Clear;
for i := minID to maxID do
begin
if ResMan.Art.Exists(i) then
begin
if (filter <> '') and (Pos(filter, AnsiLowerCase(TTileData(
ResMan.Tiledata.Block[i]).TileName)) = 0) then Continue;
node := vdtTiles.AddChild(nil);
tileInfo := vdtTiles.GetNodeData(node);
tileInfo^.ID := i;
if i = lastID then
vdtTiles.Selected[node] := True;
end;
end;
if vdtTiles.GetFirstSelected = nil then
begin
node := vdtTiles.GetFirst;
if node <> nil then
vdtTiles.Selected[node] := True;
end;
vdtTiles.EndUpdate;
node := vdtTiles.GetFirstSelected;
if node <> nil then
vdtTiles.FocusedNode := node;
end;
procedure TfrmMain.ProcessToolState;
var
blockInfo: PBlockInfo;
begin
if acSelect.Checked then
begin
//lblTip.Caption := 'Right click shows a menu with all the tools.';
lblTip.Caption := 'Press and hold the left mouse button to show a list with'
+ ' actions (eg. grab hue).';
oglGameWindow.Cursor := crDefault;
//no highlighted tiles in "selection" mode
Logger.Send([lcClient, lcDebug], 'Disable highlighting');
blockInfo := nil;
while FScreenBuffer.Iterate(blockInfo) do
if blockInfo^.State = ssNormal then
blockInfo^.Highlighted := False;
end else
begin
lblTip.Caption := 'Press and hold the left mouse button to target an area.';
oglGameWindow.Cursor := crHandPoint;
end;
FRepaintNeeded := True;
end;
procedure TfrmMain.ProcessAccessLevel;
begin
mnuAdministration.Visible := (dmNetwork.AccessLevel >= alAdministrator);
acDraw.Enabled := (dmNetwork.AccessLevel >= alNormal);
acMove.Enabled := (dmNetwork.AccessLevel >= alNormal);
acElevate.Enabled := (dmNetwork.AccessLevel >= alNormal);
acDelete.Enabled := (dmNetwork.AccessLevel >= alNormal);
acHue.Enabled := (dmNetwork.AccessLevel >= alNormal);
Caption := Format('UO CentrED - [%s (%s)]', [dmNetwork.Username, GetAccessLevelString(dmNetwork.AccessLevel)]);
end;
procedure TfrmMain.RebuildScreenBuffer;
var
blockInfo: PBlockInfo;
2009-09-29 02:25:19 +02:00
i, tileX, tileY: Integer;
virtualTile: TVirtualTile;
begin
2009-09-29 02:25:19 +02:00
Logger.EnterMethod([lcClient], 'RebuildScreenBuffer');
FDrawDistance := Trunc(Sqrt(oglGameWindow.Width * oglGameWindow.Width + oglGamewindow.Height * oglGamewindow.Height) / 44);
2009-09-29 02:25:19 +02:00
Logger.Send([lcClient], 'DrawDistance', FDrawDistance);
{$HINTS off}{$WARNINGS off}
if FX - FDrawDistance < 0 then FLowOffsetX := -FX else FLowOffsetX := -FDrawDistance;
if FY - FDrawDistance < 0 then FLowOffsetY := -FY else FLowOffsetY := -FDrawDistance;
if FX + FDrawDistance >= FLandscape.Width * 8 then FHighOffsetX := FLandscape.Width * 8 - FX - 1 else FHighOffsetX := FDrawDistance;
if FY + FDrawDistance >= FLandscape.Height * 8 then FHighOffsetY := FLandscape.Height * 8 - FY - 1 else FHighOffsetY := FDrawDistance;
{$HINTS on}{$WARNINGS on}
FRangeX := FHighOffsetX - FLowOffsetX;
FRangeY := FHighOffsetY - FLowOffsetY;
FLandscape.PrepareBlocks((FX + FLowOffsetX) div 8, (FY + FLowOffsetY) div 8, (FX + FHighOffsetX) div 8 + 1, (FY + FHighOffsetY) div 8 + 1);
2009-09-29 02:25:19 +02:00
if frmVirtualLayer.cbShowLayer.Checked then
begin
Logger.Send([lcClient, lcDebug], 'Preparing Virtual Layer');
i := 0;
for tileX := FX + FLowOffsetX to FX + FHighOffsetX do
begin
for tileY := FY + FLowOffsetY to FY + FHighOffsetY do
begin
while (i < FVirtualTiles.Count) and (not (FVirtualTiles[i] is TVirtualTile)) do
Inc(i);
if i < FVirtualTiles.Count then
begin
virtualTile := TVirtualTile(FVirtualTiles[i]);
end else
begin
virtualTile := TVirtualTile.Create(nil);
2009-09-29 02:25:19 +02:00
FVirtualTiles.Add(virtualTile);
end;
virtualTile.X := tileX;
virtualTile.Y := tileY;
virtualTile.Z := frmVirtualLayer.seZ.Value;
virtualTile.Priority := virtualTile.Z;
virtualTile.PriorityBonus := MaxInt;
2009-09-29 02:25:19 +02:00
Inc(i);
end;
end;
while i < FVirtualTiles.Count do
begin
if FVirtualTiles[i] is TVirtualTile then
FVirtualTiles.Delete(i)
else
Inc(i);
end;
end else
begin
for i := FVirtualTiles.Count - 1 downto 0 do
if FVirtualTiles[i] is TVirtualTile then
FVirtualTiles.Delete(i);
end;
Logger.Send([lcClient, lcDebug], 'VirtualTiles', FVirtualTiles.Count);
FLandscape.FillDrawList(FScreenBuffer, FX + FLowOffsetX, FY + FLowOffsetY,
FRangeX, FRangeY, tbTerrain.Down, tbStatics.Down, acNoDraw.Checked,
FVirtualTiles);
//Pre-process the buffer
blockInfo := nil;
while FScreenBuffer.Iterate(blockInfo) do
PrepareScreenBlock(blockInfo);
FScreenBuffer.UpdateShortcuts;
FScreenBufferState := [sbsValid, sbsIndexed];
2009-09-29 02:25:19 +02:00
Logger.ExitMethod([lcClient], 'RebuildScreenBuffer');
end;
procedure TfrmMain.UpdateCurrentTile;
var
localPos: TPoint;
begin
if oglGameWindow.MouseEntered then
begin
localPos := oglGameWindow.ScreenToClient(Mouse.CursorPos);
UpdateCurrentTile(localPos.X, localPos.Y);
end;
end;
procedure TfrmMain.UpdateCurrentTile(AX, AY: Integer);
var
blockInfo: PBlockInfo;
begin
Logger.EnterMethod([lcClient, lcDebug], 'UpdateCurrentTile');
FOverlayUI.ActiveArrow := FOverlayUI.HitTest(AX, AY);
if FOverlayUI.ActiveArrow > -1 then
begin
Logger.Send([lcClient, lcDebug], 'Overlay active');
CurrentTile := nil;
Logger.ExitMethod([lcClient, lcDebug], 'UpdateCurrentTile');
Exit;
end;
blockInfo := FScreenBuffer.Find(Point(AX, AY));
if blockInfo <> nil then
CurrentTile := blockInfo^.Item
else
CurrentTile := nil;
Logger.ExitMethod([lcClient, lcDebug], 'UpdateCurrentTile');
end;
procedure TfrmMain.UpdateFilter;
var
blockInfo: PBlockInfo;
begin
blockInfo := nil;
while FScreenBuffer.Iterate(blockInfo) do
begin
if blockInfo^.State in [ssNormal, ssFiltered] then
begin
blockInfo^.State := ssNormal;
if (blockInfo^.Item.Z < frmBoundaries.tbMinZ.Position) or
(blockInfo^.Item.Z > frmBoundaries.tbMaxZ.Position) then
begin
blockInfo^.State := ssFiltered;
end else
if tbFilter.Down and (blockInfo^.Item is TStaticItem) and
(not frmFilter.Filter(TStaticItem(blockInfo^.Item))) then
begin
blockInfo^.State := ssFiltered;
end;
end;
end;
Include(FScreenBufferState, sbsFiltered);
end;
procedure TfrmMain.UpdateSelection;
procedure SetHighlight(ABlockInfo: PBlockInfo; AHighlighted: Boolean);
begin
if (ABlockInfo^.Item is TStaticItem) and acHue.Checked then
begin
if ABlockInfo^.HueOverride <> AHighlighted then
begin
ABlockInfo^.HueOverride := AHighlighted;
if AHighlighted then
ABlockInfo^.LowRes := FTextureManager.GetStaticMaterial(
TStaticItem(ABlockInfo^.Item), frmHueSettings.lbHue.ItemIndex)
else
ABlockInfo^.LowRes := FTextureManager.GetStaticMaterial(
TStaticItem(ABlockInfo^.Item));
end;
end else
begin
ABlockInfo^.Highlighted := AHighlighted;
end;
end;
procedure AddGhostTile(AX, AY: Word; ABaseTile: TWorldItem);
var
blockInfo: PBlockInfo;
tileInfo: PTileInfo;
node: PVirtualNode;
cell: TMapCell;
2009-12-04 01:27:06 +01:00
ghostTile: TGhostTile;
i: Integer;
begin
tileInfo := nil;
if frmDrawSettings.rbTileList.Checked then
begin
node := vdtTiles.GetFirstSelected;
if node <> nil then
tileInfo := vdtTiles.GetNodeData(node);
end else if frmDrawSettings.rbRandom.Checked then
begin
node := vdtRandom.GetFirst;
for i := 1 to Random(vdtRandom.RootNodeCount) do
node := vdtRandom.GetNext(node);
if node <> nil then
tileInfo := vdtRandom.GetNodeData(node);
end;
if tileInfo <> nil then
begin
if tileInfo^.ID < $4000 then
begin
cell := FLandscape.MapCell[AX, AY];
if cell <> nil then
begin
cell.IsGhost := True;
cell.GhostID := tileInfo^.ID;
if frmDrawSettings.cbForceAltitude.Checked then
cell.GhostZ := frmDrawSettings.seForceAltitude.Value
else
cell.GhostZ := cell.RawZ;
if frmDrawSettings.cbRandomHeight.Checked then
cell.GhostZ := cell.GhostZ + Random(frmDrawSettings.seRandomHeight.Value);
PrepareMapCell(cell);
end;
end else
begin
2009-12-04 01:27:06 +01:00
ghostTile := TGhostTile.Create(nil, nil, 0, 0);
ghostTile.TileID := tileInfo^.ID - $4000;
ghostTile.Hue := frmHueSettings.lbHue.ItemIndex;
ghostTile.X := AX;
ghostTile.Y := AY;
if not frmDrawSettings.cbForceAltitude.Checked then
begin
ghostTile.Z := ABaseTile.Z;
if ABaseTile is TStaticItem then
2009-12-04 01:27:06 +01:00
ghostTile.Z := ghostTile.Z +
ResMan.Tiledata.StaticTiles[ABaseTile.TileID].Height;
2009-12-04 01:27:06 +01:00
end else
ghostTile.Z := frmDrawSettings.seForceAltitude.Value;
if frmDrawSettings.cbRandomHeight.Checked then
ghostTile.Z := ghostTile.Z +
Random(frmDrawSettings.seRandomHeight.Value);
ghostTile.UpdatePriorities(ResMan.Tiledata.StaticTiles[ghostTile.TileID],
MaxInt);
ghostTile.CanBeEdited := True;
2009-12-04 01:27:06 +01:00
FVirtualTiles.Add(ghostTile);
blockInfo := FScreenBuffer.Insert(ghostTile);
blockInfo^.State := ssGhost;
PrepareScreenBlock(blockInfo);
end;
end;
end;
var
selectedRect: TRect;
blockInfo: PBlockInfo;
item: TWorldItem;
cell: TMapCell;
i, tileX, tileY: Integer;
begin
Logger.EnterMethod([lcClient, lcDebug], 'UpdateSelection');
//If the current tile is nil, but we still have a selected tile, the
//procedure is pointless - the selection should stay intact.
if (CurrentTile <> nil) or (SelectedTile = nil) then
begin
if CurrentTile = nil then
selectedRect := Rect(-1, -1, -1, -1)
else
selectedRect := GetSelectedRect;
//clean up old ghost tiles
Logger.Send([lcClient, lcDebug], 'Cleaning ghost tiles');
for i := FVirtualTiles.Count - 1 downto 0 do
begin
item := FVirtualTiles[i];
if (item is TGhostTile) and not IsInRect(item.X, item.Y, selectedRect) then
begin
FScreenBuffer.Delete(item);
FVirtualTiles.Delete(i);
end;
end;
Logger.Send([lcClient, lcDebug], 'FSelection', FSelection);
for tileX := FSelection.Left to FSelection.Right do
for tileY := FSelection.Top to FSelection.Bottom do
if not IsInRect(tileX, tileY, selectedRect) then
begin
cell := FLandscape.MapCell[tileX, tileY];
if (cell <> nil) and cell.IsGhost then
begin
cell.IsGhost := False;
PrepareMapCell(cell);
end;
end;
if (CurrentTile <> nil) and (not acSelect.Checked) then
begin
blockInfo := nil;
if (SelectedTile <> nil) and (CurrentTile <> SelectedTile) then
begin
Logger.Send([lcClient, lcDebug], 'Multiple Targets');
Logger.Send([lcClient, lcDebug], 'SelectedRect', selectedRect);
//set new ghost tiles
if acDraw.Checked then
for tileX := selectedRect.Left to selectedRect.Right do
for tileY := selectedRect.Top to selectedRect.Bottom do
if not IsInRect(tileX, tileY, FSelection) then
AddGhostTile(tileX, tileY, SelectedTile);
while FScreenBuffer.Iterate(blockInfo) do
if (blockInfo^.State = ssNormal) then
SetHighlight(blockInfo, IsInRect(blockInfo^.Item.X, blockInfo^.Item.Y,
selectedRect) and not acDraw.Checked);
end else
begin
Logger.Send([lcClient, lcDebug], 'Single Target');
if acDraw.Checked and not IsInRect(CurrentTile.X, CurrentTile.Y,
FSelection) then
AddGhostTile(CurrentTile.X, CurrentTile.Y, CurrentTile);
while FScreenBuffer.Iterate(blockInfo) do
if blockInfo^.State = ssNormal then
SetHighlight(blockInfo, (blockInfo^.Item = CurrentTile) and
not acDraw.Checked);
end;
end;
FSelection := selectedRect;
end;
Logger.Send([lcClient, lcDebug], 'Virtual Tiles', FVirtualTiles.Count);
Logger.ExitMethod([lcClient, lcDebug], 'UpdateSelection');
end;
procedure TfrmMain.OnTileRemoved(ATile: TMulBlock);
begin
if ATile = FCurrentTile then
FCurrentTile := nil
else if ATile = FSelectedTile then
FSelectedTile := nil;
end;
procedure TfrmMain.WriteChatMessage(ASender, AMessage: string);
var
node: PVirtualNode;
chatInfo: PChatInfo;
begin
node := vstChat.AddChild(nil);
chatInfo := vstChat.GetNodeData(node);
chatInfo^.Time := Now;
chatInfo^.Sender := ASender;
chatInfo^.Msg := AMessage;
if vstChat.RootNodeCount > 30 then
vstChat.DeleteNode(vstChat.GetFirst);
vstChat.ScrollIntoView(node, False);
if not pnlChat.Visible then
begin
lblChatHeaderCaption.Font.Bold := True;
lblChatHeaderCaption.Font.Italic := True;
lblChatHeaderCaption.Font.Color := clRed;
end;
end;
procedure TfrmMain.OnClientHandlingPacket(ABuffer: TEnhancedMemoryStream);
var
sender, msg: string;
i: Integer;
accessLevel: TAccessLevel;
begin
case ABuffer.ReadByte of
$01: //client connected
begin
sender := ABuffer.ReadStringNull;
lbClients.Items.Add(sender);
if sender <> dmNetwork.Username then
WriteChatMessage('System', Format('User "%s" has connected.', [sender]));
end;
$02:
begin
sender := ABuffer.ReadStringNull;
lbClients.Items.Delete(lbClients.Items.IndexOf(sender));
if sender <> dmNetwork.Username then
WriteChatMessage('System', Format('User "%s" has disconnected.', [sender]));
end;
$03: //Client list
begin
lbClients.Clear;
while ABuffer.Position < ABuffer.Size do
lbClients.Items.Add(ABuffer.ReadStringNull);
end;
$04: //Set pos
begin
FX := ABuffer.ReadWord;
FY := ABuffer.ReadWord;
SetPos(FX, FY);
end;
$05: //chat
begin
sender := ABuffer.ReadStringNull;
msg := ABuffer.ReadStringNull;
WriteChatMessage(sender, msg);
end;
$07: //access changed
begin
accessLevel := TAccessLevel(ABuffer.ReadByte);
FLandscape.UpdateWriteMap(ABuffer);
FRepaintNeeded := True;
if accessLevel <> dmNetwork.AccessLevel then
begin
dmNetwork.AccessLevel := accessLevel;
if accessLevel = alNone then
begin
MessageDlg('AccessLevel change', 'Your account has been locked.', mtWarning, [mbOK], 0);
mnuDisconnectClick(nil);
end else
begin
ProcessAccessLevel;
MessageDlg('AccessLevel change', Format('Your accesslevel has been changed to %s.', [GetAccessLevelString(accessLevel)]), mtWarning, [mbOK], 0);
end;
end;
for i := Low(FAccessChangedListeners) to High(FAccessChangedListeners) do
FAccessChangedListeners[i](accessLevel);
end;
end;
end;
function TfrmMain.GetInternalTileID(ATile: TWorldItem): Word;
begin
Result := ATile.TileID;
if ATile is TStaticItem then
Inc(Result, $4000);
end;
function TfrmMain.GetSelectedRect: TRect;
begin
if CurrentTile <> nil then
begin
if SelectedTile <> nil then
begin
Result.Left := Min(CurrentTile.X, SelectedTile.X);
Result.Top := Min(CurrentTile.Y, SelectedTile.Y);
Result.Right := Max(CurrentTile.X, SelectedTile.X);
Result.Bottom := Max(CurrentTile.Y, SelectedTile.Y);
end else
begin
Result.Left := CurrentTile.X;
Result.Top := CurrentTile.Y;
Result.Right := CurrentTile.X;
Result.Bottom := CurrentTile.Y;
end;
end;
end;
function TfrmMain.ConfirmAction: Boolean;
begin
if acMove.Checked and frmMoveSettings.cbAsk.Checked then
begin
Result := frmMoveSettings.ShowModal = mrYes;
end else
begin
frmConfirmation.Left := Mouse.CursorPos.x - frmConfirmation.btnYes.Left - frmConfirmation.btnYes.Width div 2;
frmConfirmation.Top := Mouse.CursorPos.y - frmConfirmation.btnYes.Top - frmConfirmation.btnYes.Height div 2;
Result := frmConfirmation.ShowModal = mrYes;
end;
if not oglGameWindow.MouseEntered then
oglGameWindowMouseLeave(nil);
end;
procedure TfrmMain.ForceUpdateCurrentTile;
begin
CurrentTile := nil;
UpdateCurrentTile;
end;
procedure TfrmMain.GetDrawOffset(ARelativeX, ARelativeY: Integer; out DrawX,
DrawY: Integer); inline;
begin
DrawX := (oglGameWindow.Width div 2) + (ARelativeX - ARelativeY) * 22;
DrawY := (oglGamewindow.Height div 2) + (ARelativeX + ARelativeY) * 22;
end;
initialization
{$I UfrmMain.lrs}
end.