CentrED/Client/UfrmRegionControl.pas

(*
 * 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 2008 Andreas Schneider
 *)
unit UfrmRegionControl;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, CheckLst,
  VirtualTrees, ExtCtrls, ImagingComponents, StdCtrls, Buttons, Spin, LCLIntf,
  math, UPlatformTypes, UEnhancedMemoryStream, Menus,contnrs, UInterfaces,
  URectList;

type
  TAreaMoveType = (amLeft, amTop, amRight, amBottom);
  TAreaMove = set of TAreaMoveType;

  { TfrmRegionControl }

  TfrmRegionControl = class(TForm)
    btnAddArea: TSpeedButton;
    btnClearArea: TSpeedButton;
    btnDeleteArea: TSpeedButton;
    btnExit: TButton;
    btnSave: TButton;
    Label1: TLabel;
    lblX: TLabel;
    lblY: TLabel;
    mnuAddGroup: TMenuItem;
    mnuRemoveGroup: TMenuItem;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    pbArea: TPaintBox;
    pnlAreaControls: TPanel;
    pmGroup: TPopupMenu;
    sbArea: TScrollBox;
    seX1: TSpinEdit;
    seX2: TSpinEdit;
    seY1: TSpinEdit;
    seY2: TSpinEdit;
    vstGroups: TVirtualStringTree;
    vstArea: TVirtualStringTree;
    procedure acAddGroup(Sender: TObject);
    procedure accRemoveGroup(Sender: TObject);
    procedure btnAddAreaClick(Sender: TObject);
    procedure btnClearAreaClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure btnDeleteAreaClick(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure pbAreaMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure pbAreaMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer
      );
    procedure pbAreaPaint(Sender: TObject);
    procedure seX1Change(Sender: TObject);
    procedure vstAreaChange(Sender: TBaseVirtualTree; Node: PVirtualNode);
    procedure vstAreaGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
    procedure vstGroupsChange(Sender: TBaseVirtualTree; Node: PVirtualNode);
    procedure vstGroupsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
    procedure vstGroupsNewText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; const NewText: WideString);
    procedure vstGroupsOnEditing(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; var Allowed: Boolean);
  protected
    FLastX: Integer;
    FLastY: Integer;
    FAreaMove: TAreaMove;
    procedure OnListRegionsPacket(ABuffer: TEnhancedMemoryStream);
  private
    { private declarations }
  public
    { public declarations }
  end; 
  
var
  frmRegionControl: TfrmRegionControl;

implementation

uses
  UGameResources, UfrmRadar, UfrmMain, UdmNetwork, UPacket, UPackets,
  UGUIPlatformUtils, UAdminHandling, UPacketHandlers;

type

  { TRequestRegionListPacket }

  TRequestRegionListPacket = class(TPacket)
    constructor Create;
  end;
  
  PRegionInfo = ^TRegionInfo;
  TRegionInfo = record
    Name: string;
    Areas: TRectList;
  end;

{ TRequestRegionListPacket }

constructor TRequestRegionListPacket.Create;
begin
  inherited Create($03, 0);
  FStream.WriteByte($0A);
end;

{ TfrmRegionControl }

procedure TfrmRegionControl.OnListRegionsPacket(ABuffer: TEnhancedMemoryStream);
var
  regionCount, areaCount: Byte;
  i, j, x1, x2, y1, y2: Integer;
  node: PVirtualNode;
  regionInfo: PRegionInfo;
begin
  vstGroups.BeginUpdate;
  vstGroups.Clear;
  regionCount := ABuffer.ReadByte;
  for i := 0 to regionCount - 1 do
  begin
   node := vstGroups.AddChild(nil);
   regionInfo := vstGroups.GetNodeData(node);
   regionInfo^.Name := ABuffer.ReadStringNull;
   regionInfo^.Areas := TRectList.Create;
   areaCount := ABuffer.ReadByte;
   for j := 0 to areaCount - 1 do
   begin
     x1 := ABuffer.ReadWord;
     y1 := ABuffer.ReadWord;
     x2 := ABuffer.ReadWord;
     y2 := ABuffer.ReadWord;
     regionInfo^.Areas.Add(x1, y1, x2, y2);
   end;
  end;
  vstGroups.EndUpdate;
end;


procedure TfrmRegionControl.FormCreate(Sender: TObject);
begin
  pbArea.Width := frmRadarMap.Radar.Width;
  pbArea.Height := frmRadarMap.Radar.Height;
  seX1.MaxValue := ResMan.Landscape.CellWidth;
  seX2.MaxValue := ResMan.Landscape.CellWidth;
  seY1.MaxValue := ResMan.Landscape.CellHeight;
  seY2.MaxValue := ResMan.Landscape.CellHeight;
  
  vstArea.NodeDataSize := SizeOf(TRect);
  vstGroups.NodeDataSize := SizeOf(TRegionInfo);
  
  frmRadarMap.Dependencies.Add(pbArea);

  AdminPacketHandlers[$09] := TPacketHandler.Create(0, @OnListRegionsPacket);
end;

procedure TfrmRegionControl.btnDeleteAreaClick(Sender: TObject);
var
  infoGroup: PRegionInfo;
  i: Integer;
begin
  if vstGroups.GetFirstSelected <> nil then
  begin
   infoGroup := vstGroups.GetNodeData(vstGroups.GetFirstSelected);
   infoGroup^.Areas.Delete(vstArea.AbsoluteIndex(vstArea.GetFirstSelected));
   vstGroupsChange(vstGroups, vstGroups.GetFirstSelected);
  end;
end;

procedure TfrmRegionControl.btnSaveClick(Sender: TObject);
var
  packet: TPacket;
  stream: TEnhancedMemoryStream;
  groupCount,areaCount: Byte;
  i, j: Integer;
  node: PVirtualNode;
  groupInfo: PRegionInfo;
begin
  packet := TPacket.Create($03, 0);
  stream := packet.Stream;
  stream.Position := stream.Size;
  stream.WriteByte($09);

  groupCount := Min(vstGroups.RootNodeCount, 255);
  stream.WriteByte(groupCount);
  if groupCount = 0 then Exit;

  i := 0;
  node := vstGroups.GetFirst;
  while (node <> nil) and (i < groupCount) do
  begin
    groupInfo := vstGroups.GetNodeData(node);
    stream.WriteStringNull(groupInfo^.Name);
    areaCount:=Min(groupInfo^.Areas.Count,255);
    stream.WriteByte(areaCount);
    for j := 0 to areaCount-1 do
      with groupInfo^.Areas.Rects[j] do
      begin
        stream.WriteWord(Min(Left, Right));
        stream.WriteWord(Min(Top,  Bottom));
        stream.WriteWord(Max(Left, Right));
        stream.WriteWord(Max(Top,  Bottom));
      end;
    node := vstGroups.GetNext(node);
    Inc(i);
  end;
  dmNetwork.Send(TCompressedPacket.Create(packet));
  Close;
end;

procedure TfrmRegionControl.acAddGroup(Sender: TObject);
var
  node : PVirtualNode;
  infoGroup : PRegionInfo;
begin
  node := vstGroups.AddChild(nil);
  infoGroup := vstGroups.GetNodeData(node);
  infoGroup^.Name := 'Unnamed';
  infoGroup^.Areas := TRectList.Create;
end;

procedure TfrmRegionControl.accRemoveGroup(Sender: TObject);
begin
  vstGroups.DeleteSelectedNodes;
  vstGroupsChange(vstGroups, nil);
end;

procedure TfrmRegionControl.btnAddAreaClick(Sender: TObject);
var
  node: PVirtualNode;
  nodeInfo: ^TRect;
  infoGroup : PRegionInfo;
begin
   infoGroup:=vstGroups.GetNodeData(vstGroups.GetFirstSelected);
   node := vstArea.AddChild(nil);
   nodeInfo := vstArea.GetNodeData(node);
   nodeInfo^.Left := 0;
   nodeInfo^.Top := 0;
   nodeInfo^.Right := 0;
   nodeInfo^.Bottom := 0;
   infoGroup^.Areas.Add(0, 0, 0, 0);
   vstArea.ClearSelection;
   vstArea.Selected[node] := True;
   vstArea.FocusedNode := node;
end;

procedure TfrmRegionControl.btnClearAreaClick(Sender: TObject);
var
  infoGroup: PRegionInfo;
  infoArea : TRect;
  i: Integer;
begin
  if vstGroups.GetFirstSelected <> nil then
  begin
    infoGroup := vstGroups.GetNodeData(vstGroups.GetFirstSelected);
    infoGroup^.Areas.Clear;
    vstGroupsChange(vstGroups, vstGroups.GetFirstSelected);
  end;
end;

procedure TfrmRegionControl.btnCloseClick(Sender: TObject);
begin
  Close;
end;

procedure TfrmRegionControl.FormDestroy(Sender: TObject);
begin
  frmRadarMap.Dependencies.Remove(pbArea);
  if AdminPacketHandlers[$09] <> nil then FreeAndNil(AdminPacketHandlers[$09]);
end;

procedure TfrmRegionControl.FormShow(Sender: TObject);
begin
  SetWindowParent(Handle, frmMain.Handle);
  dmNetwork.Send(TRequestRegionListPacket.Create);
end;

procedure TfrmRegionControl.pbAreaMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  node, match: PVirtualNode;
  nodeInfo: ^TRect;
  p: TPoint;
  i: Integer;
  infoArea: TRect;
  infoGroup: PRegionInfo;
begin
  FAreaMove := [];
  p := Point(X * 8, Y * 8);
  match := nil;
  node := vstArea.GetFirst;
  while node <> nil do
  begin
    nodeInfo := vstArea.GetNodeData(node);
    if PtInRect(nodeInfo^, p) then
      match := node;
    node := vstArea.GetNext(node);
  end;
  if match <> nil then
  begin
    nodeInfo := vstArea.GetNodeData(match);
    if p.x - nodeInfo^.Left <= 64 then Include(FAreaMove, amLeft);
    if p.y - nodeInfo^.Top <= 64 then Include(FAreaMove, amTop);
    if nodeInfo^.Right - p.x <= 64 then Include(FAreaMove, amRight);
    if nodeInfo^.Bottom - p.y <= 64 then Include(FAreaMove, amBottom);
    if FAreaMove = [] then
      FAreaMove := [amLeft, amTop, amRight, amBottom];
  end else
  begin
   if vstGroups.GetFirstSelected <> nil then
   begin
     infoGroup:=vstGroups.GetNodeData(vstGroups.GetFirstSelected);
     match := vstArea.AddChild(nil);
     nodeInfo:=vstArea.GetNodeData(match);
     nodeInfo^.Left := p.x;
     nodeInfo^.Top := p.y;
     nodeInfo^.Right := p.x;
     nodeInfo^.Bottom := p.y;
     infoGroup^.Areas.Add(p.x, p.y, p.x, p.y);

     pbArea.Repaint;

     FAreaMove := [amRight, amBottom];
   end;
  end;
  vstArea.ClearSelection;
  vstArea.Selected[match] := True;
  FLastX := X;
  FLastY := Y;
end;

procedure TfrmRegionControl.pbAreaMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var
  offsetX, offsetY: Integer;
begin
  if (ssLeft in Shift) and (vstArea.GetFirstSelected <> nil) then
  begin
    offsetX := (X - FLastX) * 8;
    offsetY := (Y - FLastY) * 8;
    if amLeft in FAreaMove then seX1.Value := seX1.Value + offsetX;
    if amRight in FAreaMove then seX2.Value := seX2.Value + offsetX;
    if amTop in FAreaMove then seY1.Value := seY1.Value + offsetY;
    if amBottom in FAreaMove then seY2.Value := seY2.Value + offsetY;
    FLastX := X;
    FLastY := Y;
    seX1Change(nil);
  end;
end;

procedure TfrmRegionControl.pbAreaPaint(Sender: TObject);
var
  i: Integer;
  node: PVirtualNode;
  nodeInfo: ^TRect;
begin
  DisplayImage(pbArea.Canvas, 0, 0, frmRadarMap.Radar);
  pbArea.Canvas.Pen.Color := clRed;
  pbArea.Canvas.Brush.Color := clMaroon;
  pbArea.Canvas.Brush.Style := bsFDiagonal;
  node := vstArea.GetFirst;
  while node <> nil do
  begin
    if vstArea.Selected[node] then
    begin
      pbArea.Canvas.Pen.Width := 2;
      pbArea.Canvas.Pen.Style := psSolid;
    end else
    begin
      pbArea.Canvas.Pen.Width := 1;
      pbArea.Canvas.Pen.Style := psDot;
    end;
    nodeInfo := vstArea.GetNodeData(node);
    pbArea.Canvas.Rectangle(nodeInfo^.Left div 8, nodeInfo^.Top div 8,
      nodeInfo^.Right div 8 + 1, nodeInfo^.Bottom div 8 + 1);
    node := vstArea.GetNext(node);
  end;
end;

procedure TfrmRegionControl.seX1Change(Sender: TObject);
var
  node: PVirtualNode;
  nodeInfo: ^TRect;
  infoGroup: PRegionInfo;
begin
  node := vstArea.GetFirstSelected;
  if node <> nil then
  begin
    nodeInfo := vstArea.GetNodeData(node);
    nodeInfo^.Left := seX1.Value;
    nodeInfo^.Right := seX2.Value;
    nodeInfo^.Top := seY1.Value;
    nodeInfo^.Bottom := seY2.Value;
    infoGroup:= vstGroups.GetNodeData(vstGroups.GetFirstSelected);
    infoGroup^.Areas.Rects[vstArea.AbsoluteIndex(node)] := nodeinfo^;
    vstArea.InvalidateNode(node);
    pbArea.Repaint;
  end;
end;

procedure TfrmRegionControl.vstAreaChange(Sender: TBaseVirtualTree;
  Node: PVirtualNode);
var
  nodeInfo: ^TRect;
  selected: Boolean;
begin
  selected := (Node <> nil) and Sender.Selected[Node];
  btnDeleteArea.Enabled := selected;
  lblX.Enabled := selected;
  lblY.Enabled := selected;
  seX1.Enabled := selected;
  seX2.Enabled := selected;
  seY1.Enabled := selected;
  seY2.Enabled := selected;
  if selected then
  begin
    nodeInfo := Sender.GetNodeData(Node);
    seX1.Value := nodeInfo^.Left;
    seX2.Value := nodeInfo^.Right;
    seY1.Value := nodeInfo^.Top;
    seY2.Value := nodeInfo^.Bottom;
  end;
end;

procedure TfrmRegionControl.vstAreaGetText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: WideString);
var
  nodeInfo: ^TRect;
begin
  nodeInfo := Sender.GetNodeData(Node);
  CellText := Format('(%d, %d), (%d, %d)', [nodeInfo^.Left, nodeInfo^.Top,
    nodeInfo^.Right, nodeInfo^.Bottom]);
end;

procedure TfrmRegionControl.vstGroupsChange(Sender: TBaseVirtualTree;
  Node: PVirtualNode);
var
  i: Integer;
  nodeArea: PVirtualNode;
  infoGroup: PRegionInfo;
  infoArea: ^TRect;
  Area: ^TRect;
begin
  vstArea.BeginUpdate;
  vstArea.Clear;
  if Node <> nil then
  begin {TODO : code style!!!!}
    infoGroup:=Sender.GetNodeData(Node);
    for i:=0 to infoGroup^.Areas.Count-1 do
    begin
      nodeArea := vstArea.AddChild(nil);
      infoArea := vstArea.GetNodeData(nodeArea);
      Area := infoGroup^.Areas[i];
      infoArea^.Left := Area^.Left;
      infoArea^.Top := Area^.Top;
      infoArea^.Right := Area^.Right;
      infoArea^.Bottom := Area^.Bottom;
    end;
  end;
  vstArea.EndUpdate;
  pbArea.Repaint;
end;

procedure TfrmRegionControl.vstGroupsGetText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: WideString);
var
  nodeInfo: PRegionInfo;
begin
  nodeInfo := Sender.GetNodeData(Node);
  CellText := nodeInfo^.Name;
end;

procedure TfrmRegionControl.vstGroupsNewText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; const NewText: WideString);
var
  nodeInfo: PRegionInfo;
begin
  if (Node <> nil) then begin
    nodeInfo := Sender.GetNodeData(Node);
    nodeInfo^.Name := NewText;
  end;
end;

procedure TfrmRegionControl.vstGroupsOnEditing(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
begin
  Allowed := True;
end;


initialization
  {$I UfrmRegionControl.lrs}

end.