(* * 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 2011 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, LCLIntf, UOverlayUI, UStatics, UEnhancedMemoryStream, ActnList, XMLPropStorage, ImagingClasses, dateutils, UPlatformTypes, UMap, UPacket, UGLFont, DOM, XMLRead, XMLWrite, strutils, ULightManager, heContnrs, UContnrExt; type TAccessChangedListener = procedure(AAccessLevel: TAccessLevel) of object; TSelectionListener = procedure(AWorldItem: TWorldItem) of object; TScreenBufferState = (sbsValid, sbsIndexed, sbsFiltered); TScreenBufferStates = set of TScreenBufferState; TBlockInfoList = specialize TheVector; TGhostTile = class(TStaticItem); TPacketList = specialize TheObjectVector; TAccessChangedListeners = specialize TPointerVectorSet; TSelectionListeners = specialize TPointerVectorSet; TTileHintInfo = record Name: String; Flags: String; NameRect: TRect; FlagsRect: TRect; end; { TfrmMain } TfrmMain = class(TForm) acSelect: TAction; acDraw: TAction; acMove: TAction; acElevate: TAction; acDelete: TAction; acHue: TAction; acBoundaries: TAction; acFilter: TAction; acFlat: TAction; acNoDraw: TAction; acLightlevel: TAction; acWalkable: TAction; 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; mnuChangePassword: TMenuItem; mnuWhiteBackground: TMenuItem; mnuSecurityQuestion: TMenuItem; mnuShowAnimations: TMenuItem; mnuSettings: TMenuItem; 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; tbSeparator2: TToolButton; tbUndo: TToolButton; tbLightlevel: TToolButton; tbWalkable: TToolButton; tsLocations: TTabSheet; tbSetHue: TToolButton; tmGrabTileInfo: TTimer; tmMovement: TTimer; 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; tbBoundaries: TToolButton; tbSeparator4: TToolButton; tbTerrain: TToolButton; tbStatics: TToolButton; tsTiles: TTabSheet; vdtTiles: TVirtualDrawTree; vdtRandom: TVirtualDrawTree; vstChat: TVirtualStringTree; vstLocations: TVirtualStringTree; XMLPropStorage1: TXMLPropStorage; 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 acLightlevelExecute(Sender: TObject); procedure acMoveExecute(Sender: TObject); procedure acNoDrawExecute(Sender: TObject); procedure acSelectExecute(Sender: TObject); procedure acUndoExecute(Sender: TObject); procedure acVirtualLayerExecute(Sender: TObject); procedure acWalkableExecute(Sender: TObject); procedure ApplicationProperties1Idle(Sender: TObject; var Done: Boolean); procedure ApplicationProperties1ShowHint(var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo); 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 mnuChangePasswordClick(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 mnuShowAnimationsClick(Sender: TObject); procedure mnuShutdownClick(Sender: TObject); procedure mnuWhiteBackgroundClick(Sender: TObject); procedure oglGameWindowDblClick(Sender: TObject); procedure oglGameWindowKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 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 vdtRandomClick(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 vdtTilesDrawHint(Sender: TBaseVirtualTree; HintCanvas: TCanvas; Node: PVirtualNode; const R: TRect; Column: TColumnIndex); procedure vdtTilesDrawNode(Sender: TBaseVirtualTree; const PaintInfo: TVTPaintInfo); procedure vdtTilesEnter(Sender: TObject); procedure vdtTilesGetHintSize(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var R: TRect); procedure vdtTilesKeyPress(Sender: TObject; var Key: char); 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); procedure XMLPropStorage1RestoreProperties(Sender: TObject); protected { Members } FAppDir: String; FConfigDir: 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; FVLayerImage: TSingleImage; FVLayerMaterial: TMaterial; FOverlayUI: TOverlayUI; FLocationsFile: string; FRandomPresetsFile: string; FRandomPresetsDoc: TXMLDocument; FLastDraw: TDateTime; FAccessChangedListeners: TAccessChangedListeners; FRepaintNeeded: Boolean; FSelection: TRect; FUndoList: TPacketList; FGLFont: TGLFont; FSelectionListeners: TSelectionListeners; FTileHint: TTileHintInfo; FLightManager: TLightManager; { Methods } procedure BuildTileList; function ConfirmAction: Boolean; function FindRandomPreset(AName: String): TDOMElement; procedure ForceUpdateCurrentTile; procedure GetDrawOffset(AX, AY: Integer; out DrawX, DrawY: Integer); inline; function GetInternalTileID(ATile: TWorldItem): Word; function GetSelectedRect: TRect; procedure InitRender; procedure InitSize; procedure LoadLocations; procedure LoadRandomPresets; procedure MoveBy(AOffsetX, AOffsetY: Integer); inline; procedure PrepareMapCell(AMapCell: TMapCell); procedure PrepareScreenBlock(ABlockInfo: PBlockInfo); procedure ProcessToolState; procedure ProcessAccessLevel; procedure RebuildScreenBuffer; procedure Render; procedure SaveLocations; procedure SaveRandomPresets; 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; property LightManager: TLightManager read FLightManager; { Methods } procedure InvalidateFilter; procedure InvalidateScreenBuffer; procedure RegisterAccessChangedListener(AListener: TAccessChangedListener); procedure RegisterSelectionListener(AListener: TSelectionListener); procedure SetPos(AX, AY: Word); procedure SwitchToSelection; procedure UnregisterAccessChangedListener(AListener: TAccessChangedListener); procedure UnregisterSelectionListener(AListener: TSelectionListener); 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, UfrmRegionControl, Logging, LConvEncoding, LCLType, UfrmLightlevel, UfrmChangePassword; 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.mnuShowAnimationsClick(Sender: TObject); begin FTextureManager.UseAnims := mnuShowAnimations.Checked; RebuildScreenBuffer; end; procedure TfrmMain.mnuShutdownClick(Sender: TObject); begin dmNetwork.Send(TQuitServerPacket.Create('')); end; procedure TfrmMain.mnuWhiteBackgroundClick(Sender: TObject); begin FRepaintNeeded := True; end; procedure TfrmMain.oglGameWindowDblClick(Sender: TObject); begin if (acSelect.Checked) and (CurrentTile <> nil) then btnAddRandomClick(Sender); end; procedure TfrmMain.oglGameWindowKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Shift <> [] then Exit; case Key of VK_W, VK_NUMPAD8, VK_UP: MoveBy(-8, -8); VK_S, VK_NUMPAD2, VK_DOWN: MoveBy(8, 8); VK_A, VK_NUMPAD4, VK_LEFT: MoveBy(-8, 8); VK_D, VK_NUMPAD6, VK_RIGHT: MoveBy(8, -8); VK_Q, VK_NUMPAD7: MoveBy(-8, 0); VK_E, VK_NUMPAD9: MoveBy(0, -8); VK_Y, VK_NUMPAD1: MoveBy(0, 8); VK_C, VK_NUMPAD3: MoveBy(8, 0); end; 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 map: TMapCell; i: Integer; z: ShortInt; blockInfo: PBlockInfo; targetRect: TRect; offsetX, offsetY: Integer; item: TWorldItem; tileX, tileY, newX, newY: Word; targetBlocks: TBlockInfoList; targetTile: TWorldItem; selectionListener: TSelectionListener; 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 then begin if tmGrabTileInfo.Enabled then begin tmGrabTileInfo.Enabled := False; mnuGrabTileIDClick(nil); end; for selectionListener in FSelectionListeners.Reversed do selectionListener(CurrentTile); end; if (not acSelect.Checked) and (targetTile <> nil) and (SelectedTile <> nil) then begin targetRect := GetSelectedRect; 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 begin FUndoList.Add(TDrawMapPacket.Create(tileX, tileY, map.RawZ, map.RawTileID)); dmNetwork.Send(TDrawMapPacket.Create(tileX, tileY, map.Z, map.TileID)); end; end; Logger.Send([lcClient, lcDebug], 'Virtual tiles', FVirtualTiles.Count); for item in FVirtualTiles do begin if item is TGhostTile then begin dmNetwork.Send(TInsertStaticPacket.Create(item.X, item.Y, item.Z, item.TileID, TGhostTile(item).Hue)); FUndoList.Add(TDeleteStaticPacket.Create(TGhostTile(item))); 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 targetBlocks := TBlockInfoList.Create; if SelectedTile = targetTile then begin blockInfo := nil; while FScreenBuffer.Iterate(blockInfo) do begin if blockInfo^.Item = targetTile then begin targetBlocks.Add(blockInfo); Break; end; end; 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 targetBlocks.Add(blockInfo); end; end; end; if acMove.Checked then //***** Move item *****// begin offsetX := frmMoveSettings.GetOffsetX; offsetY := frmMoveSettings.GetOffsetY; for blockInfo in targetBlocks do begin item := blockInfo^.Item; if item is TStaticItem then begin newX := EnsureRange(item.X + offsetX, 0, FLandscape.CellWidth - 1); newY := EnsureRange(item.Y + offsetY, 0, FLandscape.CellHeight - 1); FUndoList.Add(TMoveStaticPacket.Create(newX, newY, item.Z, item.TileID, TStaticItem(item).Hue, item.X, item.Y)); dmNetwork.Send(TMoveStaticPacket.Create(TStaticItem(item), newX, newY)); end; end; end else if acElevate.Checked then //***** Elevate item *****// begin for blockInfo in targetBlocks do begin item := blockInfo^.Item; z := frmElevateSettings.seZ.Value; if frmElevateSettings.rbRaise.Checked then z := EnsureRange(item.Z + z, -128, 127) else if frmElevateSettings.rbLower.Checked then z := EnsureRange(item.Z - z, -128, 127); if item is TMapCell then begin if frmElevateSettings.cbRandomHeight.Checked then Inc(z, Random(frmElevateSettings.seRandomHeight.Value)); FUndoList.Add(TDrawMapPacket.Create(item.X, item.Y, item.Z, item.TileID)); dmNetwork.Send(TDrawMapPacket.Create(item.X, item.Y, z, item.TileID)); end else begin FUndoList.Add(TElevateStaticPacket.Create(item.X, item.Y, z, item.TileID, TStaticItem(item).Hue, item.Z)); dmNetwork.Send(TElevateStaticPacket.Create(TStaticItem(item), z)); end; end; end else if acDelete.Checked then //***** Delete item *****// begin for blockInfo in targetBlocks do begin item := blockInfo^.Item; if item is TStaticItem then begin FUndoList.Add(TInsertStaticPacket.Create(item.X, item.Y, item.Z, item.TileID, TStaticItem(item).Hue)); dmNetwork.Send(TDeleteStaticPacket.Create(TStaticItem(item))); end; end; end else if acHue.Checked then //***** Hue item *****// begin for blockInfo in targetBlocks do begin item := blockInfo^.Item; if blockInfo^.HueOverride and (item is TStaticItem) then begin if TStaticItem(item).Hue <> blockInfo^.Hue then begin FUndoList.Add(THueStaticPacket.Create(item.X, item.Y, item.Z, item.TileID, blockInfo^.Hue, TStaticItem(item).Hue)); dmNetwork.Send(THueStaticPacket.Create(TStaticItem(item), blockInfo^.Hue)); end; end; end; end; targetBlocks.Free; end; end; end; end; 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 if CurrentTile = nil then Exit; //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); frmVirtualLayer.seZChange(frmVirtualLayer.seZ); 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); begin FAppDir := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName)); FConfigDir := GetAppConfigDir(False); ForceDirectories(FConfigDir); XMLPropStorage1.FileName := FConfigDir + 'CentrED.xml'; XMLPropStorage1.Active := True; FLandscape := ResMan.Landscape; FLandscape.OnChange := @OnLandscapeChanged; FLandscape.OnMapChanged := @OnMapChanged; FLandscape.OnNewBlock := @OnNewBlock; FLandscape.OnStaticDeleted := @OnStaticDeleted; FLandscape.OnStaticElevated := @OnStaticElevated; FLandscape.OnStaticHued := @OnStaticHued; FLandscape.OnStaticInserted := @OnStaticInserted; if FileExists(FAppDir + 'nodraw.txt') then FLandscape.LoadNoDrawMap(FAppDir + 'nodraw.txt'); if FileExists(FConfigDir + 'nodraw.txt') then FLandscape.LoadNoDrawMap(FConfigDir + 'nodraw.txt'); if FileExists(ResMan.GetFile('nodraw.txt')) then FLandscape.LoadNoDrawMap(ResMan.GetFile('nodraw.txt')); FTextureManager := TLandTextureManager.Create; FScreenBuffer := TScreenBuffer.Create; FScreenBufferState := []; X := 0; Y := 0; edX.MaxValue := FLandscape.CellWidth; edY.MaxValue := FLandscape.CellHeight; FOverlayUI := TOverlayUI.Create; FLightManager := TLightManager.Create(@GetDrawOffset); ProcessAccessLevel; vdtTiles.NodeDataSize := SizeOf(TTileInfo); vdtRandom.NodeDataSize := SizeOf(TTileInfo); BuildTileList; Randomize; vstChat.NodeDataSize := SizeOf(TChatInfo); pnlChatHeader.AnchorSide[akBottom].Control := pnlBottom; FLocationsFile := FConfigDir + 'Locations.xml'; vstLocations.NodeDataSize := SizeOf(TLocationInfo); LoadLocations; RegisterPacketHandler($0C, TPacketHandler.Create(0, @OnClientHandlingPacket)); FVLayerImage := TSingleImage.CreateFromStream(ResourceManager.GetResource(2)); FGLFont := TGLFont.Create; FGLFont.LoadImage(ResourceManager.GetResource(3)); FGLFont.LoadFontInfo(ResourceManager.GetResource(4)); FVirtualTiles := TWorldItemList.Create(True); FUndoList := TPacketList.Create(True); FRandomPresetsFile := FConfigDir + 'RandomPresets.xml'; LoadRandomPresets; DoubleBuffered := True; pnlBottom.DoubleBuffered := True; FAccessChangedListeners := TAccessChangedListeners.Create; FSelectionListeners := TSelectionListeners.Create; FLastDraw := Now; end; procedure TfrmMain.btnGoToClick(Sender: TObject); begin SetPos(edX.Value, edY.Value); end; procedure TfrmMain.btnRandomPresetDeleteClick(Sender: TObject); var preset: TDOMElement; begin if cbRandomPreset.ItemIndex > -1 then begin preset := TDOMElement(cbRandomPreset.Items.Objects[cbRandomPreset.ItemIndex]); FRandomPresetsDoc.DocumentElement.RemoveChild(preset); cbRandomPreset.Items.Delete(cbRandomPreset.ItemIndex); cbRandomPreset.ItemIndex := -1; end; end; procedure TfrmMain.btnRandomPresetSaveClick(Sender: TObject); var presetName: string; i: Integer; presetElement, tileElement: TDOMElement; children: TDOMNodeList; tileNode: PVirtualNode; tileInfo: PTileInfo; begin presetName := cbRandomPreset.Text; if InputQuery('Save Preset', 'Enter the name of the preset:', presetName) then begin presetElement := FindRandomPreset(presetName); if presetElement = nil then begin presetElement := FRandomPresetsDoc.CreateElement('Preset'); presetElement.AttribStrings['Name'] := presetName; FRandomPresetsDoc.DocumentElement.AppendChild(presetElement); cbRandomPreset.Items.AddObject(presetName, presetElement); end else begin children := presetElement.ChildNodes; for i := children.Count - 1 downto 0 do presetElement.RemoveChild(children[i]); end; tileNode := vdtRandom.GetFirst; while tileNode <> nil do begin tileInfo := vdtRandom.GetNodeData(tileNode); tileElement := FRandomPresetsDoc.CreateElement('Tile'); tileElement.AttribStrings['ID'] := IntToStr(tileInfo^.ID); presetElement.AppendChild(tileElement); tileNode := vdtRandom.GetNext(tileNode); end; cbRandomPreset.ItemIndex := cbRandomPreset.Items.IndexOfObject(presetElement); SaveRandomPresets; end; end; procedure TfrmMain.cbRandomPresetChange(Sender: TObject); var presetElement, tileElement: TDOMElement; tiles: TDOMNodeList; tileNode: PVirtualNode; tileInfo: PTileInfo; i, id: Integer; begin if cbRandomPreset.ItemIndex > -1 then begin vdtRandom.Clear; presetElement := TDOMElement(cbRandomPreset.Items.Objects[cbRandomPreset.ItemIndex]); tiles := presetElement.ChildNodes; for i := 0 to tiles.Count - 1 do begin tileElement := TDOMElement(tiles[i]); if (tileElement.NodeName = 'Tile') and TryStrToInt(tileElement.AttribStrings['ID'], id) and (id < FLandscape.MaxStaticID + $4000) then begin tileNode := vdtRandom.AddChild(nil); tileInfo := vdtRandom.GetNodeData(tileNode); tileInfo^.ID := id; 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 or mnuShowAnimations.Checked) 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.ApplicationProperties1ShowHint(var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo); begin //that check is a bit dirty, but serves its purpose //(i.e. to set the timeout for the tile info hints) if HintStr = '-' then HintInfo.HideTimeout := Application.HintHidePause + Application.HintHidePausePerChar * (Length(FTileHint.Name) + Length(FTileHint.Flags)); 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; procedure TfrmMain.acUndoExecute(Sender: TObject); var packet: TPacket; begin //Send each reversed action in reverse order. for packet in FUndoList.Reversed do dmNetwork.Send(packet); //Cleanup without freeing the objects (this was already done by dmNetwork.Send) FUndoList.Wipe; //No Undo packets, nothing to undo. acUndo.Enabled := False; end; procedure TfrmMain.acVirtualLayerExecute(Sender: TObject); begin frmVirtualLayer.Show; end; procedure TfrmMain.acWalkableExecute(Sender: TObject); begin InvalidateFilter; FRepaintNeeded := True; end; procedure TfrmMain.acDrawExecute(Sender: TObject); begin acDraw.Checked := True; tbDrawTile.Down := True; mnuDraw.Checked := True; frmDrawSettings.Show; 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.acLightlevelExecute(Sender: TObject); begin frmLightlevel.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; SaveLocations; SaveRandomPresets; FreeAndNil(FTextureManager); FreeAndNil(FScreenBuffer); FreeAndNil(FOverlayUI); FreeAndNil(FLightManager); FreeAndNil(FVLayerImage); FreeAndNil(FVLayerMaterial); FreeAndNil(FVirtualTiles); FreeAndNil(FUndoList); FreeAndNil(FGLFont); FreeAndNil(FRandomPresetsDoc); FreeAndNil(FAccessChangedListeners); FreeAndNil(FSelectionListeners); RegisterPacketHandler($0C, nil); end; procedure TfrmMain.edSearchIDExit(Sender: TObject); begin edSearchID.Visible := False; edSearchID.Text := ''; 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 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 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.Visible := False; end else if Key = #27 then begin edSearchID.Visible := False; 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.mnuChangePasswordClick(Sender: TObject); begin frmChangePassword.ShowModal; 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 if mnuWhiteBackground.Checked then glClearColor(1, 1, 1, 1) else glClearColor(0, 0, 0, 1); glClear(GL_COLOR_BUFFER_BIT); InitRender; InitSize; 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); 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.vdtRandomClick(Sender: TObject); var node: PVirtualNode; tileInfo: PTileInfo; selectedID: Integer; begin if vdtRandom.SelectedCount = 1 then begin node := vdtRandom.GetFirstSelected; if node <> nil then begin tileInfo := vdtRandom.GetNodeData(node); selectedID := tileInfo^.ID; node := vdtTiles.GetFirst; while node <> nil do begin tileInfo := vdtTiles.GetNodeData(node); if tileInfo^.ID = selectedID then begin vdtTiles.ClearSelection; vdtTiles.Selected[node] := True; vdtTiles.FocusedNode := node; node := nil; end else node := vdtTiles.GetNext(node); end; end; end; 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 acDraw.Checked then ProcessToolState; end; procedure TfrmMain.vdtTilesDrawHint(Sender: TBaseVirtualTree; HintCanvas: TCanvas; Node: PVirtualNode; const R: TRect; Column: TColumnIndex ); begin HintCanvas.Font.Assign(Sender.Font); HintCanvas.Font.Style := [fsBold]; DrawText(HintCanvas.Handle, PChar(FTileHint.Name), Length(FTileHint.Name), FTileHint.NameRect, 0); HintCanvas.Font.Style := [fsItalic]; DrawText(HintCanvas.Handle, PChar(FTileHint.Flags), Length(FTileHint.Flags), FTileHint.FlagsRect, DT_WORDBREAK); 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.vdtTilesGetHintSize(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var R: TRect); var tileInfo: PTileInfo; tileData: TTiledata; prefix, flags: string; procedure UpdateFlags(AFlag: TTileDataFlag; AName: string); begin if AFlag in tileData.Flags then begin if flags <> '' then flags := flags + ', ' + AName else flags := AName; end; end; begin tileInfo := Sender.GetNodeData(Node); flags := ''; tileData := ResMan.Tiledata.TileData[tileInfo^.ID]; if tileInfo^.ID < $4000 then begin if TLandTiledata(tileData).TextureID > 0 then flags := 'Stretchable'; end; if tdfArticleA in tileData.Flags then prefix := 'a ' else if tdfArticleAn in tileData.Flags then prefix := 'an ' else prefix := ''; FTileHint.Name := AnsiProperCase(Format('%s%s', [prefix, tileData.TileName]), [' ']); FTileHint.NameRect.Left := 5; FTileHint.NameRect.Top := 5; Sender.Canvas.Font.Style := [fsBold]; DrawText(Sender.Canvas.Handle, PChar(FTileHint.Name), Length(FTileHint.Name), FTileHint.NameRect, DT_CALCRECT); UpdateFlags(tdfBackground, 'Background'); UpdateFlags(tdfWeapon, 'Weapon'); UpdateFlags(tdfTransparent, 'Transparent'); UpdateFlags(tdfTranslucent, 'Translucent'); UpdateFlags(tdfWall, 'Wall'); UpdateFlags(tdfDamaging, 'Damaging'); UpdateFlags(tdfImpassable, 'Impassable'); UpdateFlags(tdfWet, 'Wet'); UpdateFlags(tdfSurface, 'Surface'); UpdateFlags(tdfBridge, 'Bridge'); UpdateFlags(tdfGeneric, 'Generic'); UpdateFlags(tdfWindow, 'Window'); UpdateFlags(tdfNoShoot, 'NoShoot'); UpdateFlags(tdfInternal, 'Internal'); UpdateFlags(tdfFoliage, 'Foliage'); UpdateFlags(tdfPartialHue, 'PartialHue'); UpdateFlags(tdfMap, 'Map'); UpdateFlags(tdfContainer, 'Container'); UpdateFlags(tdfWearable, 'Wearable'); UpdateFlags(tdfLightSource, 'Lightsource'); UpdateFlags(tdfAnimation, 'Animation'); UpdateFlags(tdfNoDiagonal, 'NoDiagonal'); UpdateFlags(tdfArmor, 'Armor'); UpdateFlags(tdfRoof, 'Roof'); UpdateFlags(tdfDoor, 'Door'); UpdateFlags(tdfStairBack, 'StairBack'); UpdateFlags(tdfStairRight, 'StairRight'); FTileHint.Flags := Format('Flags = [%s]', [flags]); FTileHint.FlagsRect.Left := 5; FTileHint.FlagsRect.Top := FTileHint.NameRect.Bottom + 5; FTileHint.FlagsRect.Right := 145; Sender.Canvas.Font.Style := [fsItalic]; DrawText(Sender.Canvas.Handle, PChar(FTileHint.Flags), Length(FTileHint.Flags), FTileHint.FlagsRect, DT_CALCRECT or DT_WORDBREAK); R := Rect(0, 0, Max(FTileHint.NameRect.Right, FTileHint.FlagsRect.Right) + 5, FTileHint.FlagsRect.Bottom + 5); 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.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 := EmptyStr; 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.XMLPropStorage1RestoreProperties(Sender: TObject); begin FTextureManager.UseAnims := mnuShowAnimations.Checked; if spTileList.Top > spTileList.Parent.Height then spTileList.Top := spTileList.Parent.Height - 200; 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.SwitchToSelection; begin acSelect.Checked := True; BringToFront; end; procedure TfrmMain.RegisterAccessChangedListener( AListener: TAccessChangedListener); begin FAccessChangedListeners.Include(AListener); end; procedure TfrmMain.RegisterSelectionListener(AListener: TSelectionListener); begin FSelectionListeners.Include(AListener); end; procedure TfrmMain.UnregisterAccessChangedListener( AListener: TAccessChangedListener); begin FAccessChangedListeners.Exclude(AListener); end; procedure TfrmMain.UnregisterSelectionListener(AListener: TSelectionListener); begin FSelectionListeners.Exclude(AListener); 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); glLoadIdentity; gluOrtho2D(0, oglGameWindow.Width, oglGameWindow.Height, 0); glMatrixMode(GL_MODELVIEW); glLoadIdentity; end; procedure TfrmMain.LoadLocations; var xmlDoc: TXMLDocument; location: TDOMElement; locationNode: PVirtualNode; locationInfo: PLocationInfo; locations: TDOMNodeList; i, j: Integer; begin vstLocations.Clear; if FileExists(FLocationsFile) then begin ReadXMLFile(xmlDoc, FLocationsFile); if xmlDoc.DocumentElement.NodeName = 'Locations' then begin locations := xmlDoc.DocumentElement.ChildNodes; for i := 0 to locations.Count - 1 do begin location := TDOMElement(locations[i]); if location.NodeName = 'Location' then begin locationNode := vstLocations.AddChild(nil); locationInfo := vstLocations.GetNodeData(locationNode); locationInfo^.Name := location.AttribStrings['Name']; if TryStrToInt(location.AttribStrings['X'], j) then locationInfo^.X := j else locationInfo^.X := 0; if TryStrToInt(location.AttribStrings['Y'], j) then locationInfo^.Y := j else locationInfo^.Y := 0; end; end; end; xmlDoc.Free; end; end; procedure TfrmMain.LoadRandomPresets; var presets: TDOMNodeList; i: Integer; begin cbRandomPreset.Clear; FreeAndNil(FRandomPresetsDoc); if FileExists(FRandomPresetsFile) then begin ReadXMLFile(FRandomPresetsDoc, FRandomPresetsFile); presets := FRandomPresetsDoc.DocumentElement.ChildNodes; for i := 0 to presets.Count - 1 do begin if presets[i].NodeName = 'Preset' then begin cbRandomPreset.Items.AddObject(TDOMElement(presets[i]).AttribStrings['Name'], presets[i]); end; end; end else begin FRandomPresetsDoc := TXMLDocument.Create; FRandomPresetsDoc.AppendChild(FRandomPresetsDoc.CreateElement('RandomPresets')); end; end; procedure TfrmMain.MoveBy(AOffsetX, AOffsetY: Integer); inline; begin SetPos(EnsureRange(FX + AOffsetX, 0, FLandscape.CellWidth - 1), EnsureRange(FY + AOffsetY, 0, FLandscape.CellHeight - 1)); UpdateCurrentTile; 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; out 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 , item.Y, drawX, drawY); if acFlat.Checked then begin z := 0; rawZ := 0; end else begin z := item.Z; rawZ := item.RawZ; end; if ABlockInfo^.HighRes <> nil then ABlockInfo^.HighRes.DelRef; if ABlockInfo^.LowRes <> nil then ABlockInfo^.LowRes.DelRef; 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 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 if item is TVirtualTile then begin ABlockInfo^.LowRes := FVLayerMaterial; ABlockInfo^.LowRes.AddRef; ABlockInfo^.ScreenRect := Bounds(Trunc(drawX - 22), Trunc(drawY - z * 4), 44, 44); 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, red, green, blue: 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; if acSelect.Checked or item.CanBeEdited or (item is TVirtualTile) then begin intensity := 1.0; SetNormalLights; end else begin intensity := 0.5; SetDarkLights; end; case blockInfo^.WalkRestriction of wrNone: begin red := 1; green := 1; blue := 1; end; wrCanWalk: begin red := 0.5; green := 1; blue := 0.5; end; wrCannotWalk: begin red := 1; green := 0.5; blue := 0.5; end; end; if blockInfo^.Translucent then glColor4f(intensity * red, intensity * green, intensity * blue, 0.8) else glColor4f(intensity * red, intensity * green, intensity * blue, 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 and (blockInfo^.WalkRestriction = wrNone) then glEnable(GL_LIGHTING); 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 and (blockInfo^.WalkRestriction = wrNone) then glDisable(GL_LIGHTING); end else begin glBindTexture(GL_TEXTURE_2D, blockInfo^.LowRes.Texture); 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; if (FLightManager.LightLevel > 0) and not acFlat.Checked then FLightManager.Draw(oglGameWindow.ClientRect); FOverlayUI.Draw(oglGameWindow); end; procedure TfrmMain.SaveLocations; var xmlDoc: TXMLDocument; location: TDOMElement; locationNode: PVirtualNode; locationInfo: PLocationInfo; begin xmlDoc := TXMLDocument.Create; xmlDoc.AppendChild(xmlDoc.CreateElement('Locations')); locationNode := vstLocations.GetFirst; while locationNode <> nil do begin locationInfo := vstLocations.GetNodeData(locationNode); location := xmlDoc.CreateElement('Location'); location.AttribStrings['Name'] := locationInfo^.Name; location.AttribStrings['X'] := IntToStr(locationInfo^.X); location.AttribStrings['Y'] := IntToStr(locationInfo^.Y); xmlDoc.DocumentElement.AppendChild(location); locationNode := vstLocations.GetNext(locationNode); end; WriteXMLFile(xmlDoc, FLocationsFile); xmlDoc.Free; end; procedure TfrmMain.SaveRandomPresets; begin WriteXMLFile(FRandomPresetsDoc, FRandomPresetsFile); end; procedure TfrmMain.OnLandscapeChanged; begin InvalidateScreenBuffer; oglGameWindow.Repaint; UpdateCurrentTile; end; procedure TfrmMain.OnMapChanged(AMapCell: TMapCell); begin PrepareMapCell(AMapCell); ForceUpdateCurrentTile; InvalidateFilter end; procedure TfrmMain.OnNewBlock(ABlock: TBlock); begin InvalidateScreenBuffer; end; procedure TfrmMain.OnStaticDeleted(AStaticItem: TStaticItem); begin FScreenBuffer.Delete(AStaticItem); FRepaintNeeded := True; ForceUpdateCurrentTile; InvalidateFilter 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; InvalidateFilter 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; ForceUpdateCurrentTile; 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; InvalidateFilter end; end; procedure TfrmMain.BuildTileList; var minID, maxID, i, lastID: Integer; node: PVirtualNode; tileInfo: PTileInfo; filter: string; begin maxID := $3FFF; if cbTerrain.Checked then minID := $0 else minID := $4000; if cbStatics.Checked then maxID := maxID + FLandscape.MaxStaticID; filter := AnsiLowerCase(UTF8ToISO_8859_1(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( ResMan.Tiledata.TileData[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; i, tileX, tileY: Integer; virtualTile: TVirtualTile; begin //Logger.EnterMethod([lcClient], 'RebuildScreenBuffer'); FDrawDistance := Trunc(Sqrt(oglGameWindow.Width * oglGameWindow.Width + oglGamewindow.Height * oglGamewindow.Height) / 44); //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); if frmVirtualLayer.cbShowLayer.Checked then begin //Logger.Send([lcClient, lcDebug], 'Preparing Virtual Layer'); if FVLayerMaterial = nil then FVLayerMaterial := TSimpleMaterial.Create(FVLayerImage); 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); FVirtualTiles.Add(virtualTile); end; virtualTile.X := tileX; virtualTile.Y := tileY; virtualTile.Z := frmVirtualLayer.seZ.Value; virtualTile.Priority := virtualTile.Z; virtualTile.PriorityBonus := High(ShortInt); 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]; //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; tileData: TTiledata; staticTileData: TStaticTileData; lastSurface: PBlockInfo; surfaceTop: Integer; begin blockInfo := nil; lastSurface := 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; blockInfo^.WalkRestriction := wrNone; if acWalkable.Checked then begin if blockInfo^.Item is TMapCell then begin tileData := ResMan.Tiledata.LandTiles[blockInfo^.Item.TileID]; if tdfImpassable in tileData.Flags then begin blockInfo^.WalkRestriction := wrCannotWalk; lastSurface := nil; end else begin blockInfo^.WalkRestriction := wrCanWalk; lastSurface := blockInfo; surfaceTop := blockInfo^.Item.Z; end; end else begin staticTileData := ResMan.Tiledata.StaticTiles[blockInfo^.Item.TileID]; if (lastSurface <> nil) and (lastSurface^.WalkRestriction = wrCanWalk) and (lastSurface^.Item.X = blockInfo^.Item.X) and (lastSurface^.Item.Y = blockInfo^.Item.Y) and ([tdfSurface, tdfImpassable] * staticTileData.Flags <> []) then begin if (blockInfo^.Item.Z < surfaceTop + 16) and ((blockInfo^.Item.Z > lastSurface^.Item.Z + 2) or not (tdfSurface in staticTileData.Flags)) then lastSurface^.WalkRestriction := wrCannotWalk; end; if tdfSurface in staticTileData.Flags then begin if tdfImpassable in staticTileData.Flags then begin blockInfo^.WalkRestriction := wrCannotWalk; lastSurface := nil; end else begin blockInfo^.WalkRestriction := wrCanWalk; lastSurface := blockInfo; surfaceTop := blockInfo^.Item.Z + staticTileData.Height; end; end; end; end; //acWalkable.Checked end; end; Include(FScreenBufferState, sbsFiltered); if (FLightManager.LightLevel > 0) and not acFlat.Checked then FLightManager.UpdateLightMap(FX + FLowOffsetX, FRangeX + 1, FY + FLowOffsetY, FRangeY + 1, FScreenBuffer); 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 begin ABlockInfo^.Hue := frmHueSettings.GetHue; ABlockInfo^.LowRes := FTextureManager.GetStaticMaterial( TStaticItem(ABlockInfo^.Item), ABlockInfo^.Hue); end else begin ABlockInfo^.LowRes := FTextureManager.GetStaticMaterial( TStaticItem(ABlockInfo^.Item)); end; 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; 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 ghostTile := TGhostTile.Create(nil, nil, 0, 0); ghostTile.TileID := tileInfo^.ID - $4000; ghostTile.Hue := frmHueSettings.GetHue; ghostTile.X := AX; ghostTile.Y := AY; if not frmDrawSettings.cbForceAltitude.Checked then begin ghostTile.Z := ABaseTile.Z; if ABaseTile is TStaticItem then ghostTile.Z := ghostTile.Z + ResMan.Tiledata.StaticTiles[ABaseTile.TileID].Height; 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; 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; accessChangedListener: TAccessChangedListener; pwdChangeStatus: TPasswordChangeStatus; 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 accessChangedListener in FAccessChangedListeners.Reversed do accessChangedListener(accessLevel); end; $08: //password change status begin pwdChangeStatus := TPasswordChangeStatus(ABuffer.ReadByte); case pwdChangeStatus of pcSuccess: Messagedlg('Password Change', 'Your password has been changed', mtInformation, [mbOK], 0); pcOldPwInvalid: Messagedlg('Password Change', 'The old password is wrong.' + sLineBreak + 'Your password has NOT been changed.', mtWarning, [mbOK], 0); pcNewPwInvalid: Messagedlg('Password Change', 'The new password is not allowed.' + sLineBreak + 'Your password has NOT been changed.', mtWarning, [mbOK], 0); pcIdentical: Messagedlg('Password Change', 'The new password matched the old password.' + sLineBreak + 'Your password has NOT been changed.', mtWarning, [mbOK], 0); end; 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 if not mnuSecurityQuestion.Checked then begin Result := True; 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; function TfrmMain.FindRandomPreset(AName: String): TDOMElement; var preset: TDOMElement; presets: TDOMNodeList; i: Integer; begin presets := FRandomPresetsDoc.DocumentElement.ChildNodes; Result := nil; i := 0; while (i < presets.Count) and (Result = nil) do begin preset := TDOMElement(presets[i]); if SameText(preset.AttribStrings['Name'], AName) then Result := preset else Inc(i); end; end; procedure TfrmMain.ForceUpdateCurrentTile; begin CurrentTile := nil; UpdateCurrentTile; end; procedure TfrmMain.GetDrawOffset(AX, AY: Integer; out DrawX, DrawY: Integer); inline; begin Dec(AX, FX); Dec(AY, FY); DrawX := (oglGameWindow.Width div 2) + (AX - AY) * 22; DrawY := (oglGamewindow.Height div 2) + (AX + AY) * 22; end; initialization {$I UfrmMain.lrs} end.