ChivalryServerLauncher/source/view/Forms.Main.pas

unit Forms.Main;

interface
uses
  System.Bindings.Expression,
  System.Classes,
  System.Generics.Collections,
  Vcl.ActnList,
  Vcl.ComCtrls,
  Vcl.Controls,
  Vcl.ExtCtrls,
  Vcl.Forms,
  Vcl.Imaging.pngimage,
  Vcl.ImgList,
  Vcl.Mask,
  Vcl.Menus,
  Vcl.StdCtrls,
  Vcl.ToolWin,

  JvExControls,
  JvExMask,
  JvGradient,
  JvGroupHeader,
  JvSpin,
  VirtualTrees,
  X2CLGraphicList,
  X2CLMenuBar,
  X2CLmusikCubeMenuBarPainter,

  Game.Base,
  Game.Intf;


type
  TMainForm = class(TForm)
    actGameAdd: TAction;
    actGameRemove: TAction;
    actMapAdd: TAction;
    actMapDown: TAction;
    actMapRemove: TAction;
    actMapUp: TAction;
    alMain: TActionList;
    btnClose: TButton;
    btnLaunch: TButton;
    btnSave: TButton;
    bvlButtons: TBevel;
    edtMessageOfTheDay: TEdit;
    edtServerName: TEdit;
    gbPorts: TGroupBox;
    gbServerName: TGroupBox;
    gcMenu: TX2GraphicContainer;
    gcMenuAbout: TX2GraphicContainerItem;
    gcMenuGames: TX2GraphicContainerItem;
    gcMenuMaplist: TX2GraphicContainerItem;
    gcMenuNetwork: TX2GraphicContainerItem;
    gcMenuSettings: TX2GraphicContainerItem;
    gcToolbar: TX2GraphicContainer;
    gcToolbaradd: TX2GraphicContainerItem;
    gcToolbardown: TX2GraphicContainerItem;
    gcToolbarremove: TX2GraphicContainerItem;
    gcToolbarup: TX2GraphicContainerItem;
    glMenu: TX2GraphicList;
    glToolbar: TX2GraphicList;
    grdMenu: TJvGradient;
    imgGamesWarning: TImage;
    imgLogo: TImage;
    lblChivalry: TLabel;
    lblGamesWarning: TLabel;
    lblGentleface: TLabel;
    lblJCL: TLabel;
    lblMessageOfTheDay: TLabel;
    lblPeerPort: TLabel;
    lblPixelophilia: TLabel;
    lblQueryPort: TLabel;
    lblServerName: TLabel;
    lblServerPort: TLabel;
    lblSuperObject: TLabel;
    lblVirtualTreeview: TLabel;
    llChivalry: TLinkLabel;
    llGentleface: TLinkLabel;
    llGentlefaceCC: TLinkLabel;
    llJCL: TLinkLabel;
    llPixelophilia: TLinkLabel;
    llPixelophiliaCC: TLinkLabel;
    llSuperObject: TLinkLabel;
    llVirtualTreeview: TLinkLabel;
    mbMenu: TX2MenuBar;
    mbpMenuPainter: TX2MenuBarmusikCubePainter;
    pcMain: TPageControl;
    pmnLaunch: TPopupMenu;
    pmnLaunchCopyCmdLine: TMenuItem;
    pnlButtons: TPanel;
    pnlGamesWarning: TPanel;
    pnlLogo: TPanel;
    sePeerPort: TJvSpinEdit;
    seQueryPort: TJvSpinEdit;
    seServerPort: TJvSpinEdit;
    shpLogo: TShape;
    shpMenu: TShape;
    tbGameAdd: TToolButton;
    tbGameRemove: TToolButton;
    tbGames: TToolBar;
    tbMapAdd: TToolButton;
    tbMapDown: TToolButton;
    tbMapRemove: TToolButton;
    tbMapSep1: TToolButton;
    tbMapUp: TToolButton;
    ToolBar1: TToolBar;
    tsAbout: TTabSheet;
    tsConfiguration: TTabSheet;
    tsGames: TTabSheet;
    tsMapList: TTabSheet;
    tsNetwork: TTabSheet;
    vstGames: TVirtualStringTree;
    vstMapList: TVirtualStringTree;
    actLaunch: TAction;
    actCopyCmdLine: TAction;
    actSave: TAction;
    actClose: TAction;

    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure mbMenuCollapsing(Sender: TObject; Group: TX2MenuBarGroup; var Allowed: Boolean);
    procedure mbMenuSelectedChanged(Sender: TObject; Item: TX2CustomMenuBarItem);
    procedure llLinkClick(Sender: TObject; const Link: string; LinkType: TSysLinkType);
    procedure SpinEditChange(Sender: TObject);
    procedure EditChange(Sender: TObject);
    procedure actGameAddExecute(Sender: TObject);
    procedure actGameRemoveExecute(Sender: TObject);
    procedure vstGamesGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
    procedure vstGamesFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex);
    procedure vstMapListGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
    procedure actMapAddExecute(Sender: TObject);
    procedure actCloseExecute(Sender: TObject);
  private type
    TBindingExpressionList = TList<TBindingExpression>;
    TPageMenuMap = TDictionary<TTabSheet, TX2MenuBarItem>;
  private
    FActiveGame: TCustomGame;
    FPageMenuMap: TPageMenuMap;
    FUIBindings: TBindingExpressionList;

    procedure SetActiveGame(const Value: TCustomGame);
  protected
    procedure ActiveGameChanged;

    procedure ClearUIBindings;
    procedure Bind(const APropertyName: string; ADestObject: TObject; const ADestPropertyName: string);
    procedure BindGameNetwork;
    procedure BindGameName;

    procedure UpdateMenu;
    procedure UpdateGameList;
    procedure UpdateMapList;

    property ActiveGame: TCustomGame read FActiveGame write SetActiveGame;
    property PageMenuMap: TPageMenuMap read FPageMenuMap;
    property UIBindings: TBindingExpressionList read FUIBindings;
  end;


implementation
uses
  System.Bindings.Helper,
  System.Math,
  System.StrUtils,
  System.SysUtils,
  System.Types,
  Vcl.Graphics,
  Vcl.GraphUtil,
  Vcl.Themes,
  Winapi.ShellAPI,
  Winapi.Windows,

  X2UtGraphics,

  Forms.Game,
  Forms.Map,
  Game.Chivalry.MedievalWarfare,
  Game.List,
  Persist.GameList,
  Resources;


type
  TINIHintWindow = class(THintWindow)
  protected
    function IsINIHint(const AHint: string): Boolean;
    function GetINIHint(const AHint: string; out ASection, AKey: string): Boolean;

    procedure Paint; override;
  public
    function CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect; override;
  end;


const
  INIHintPrefix = 'INI:';
  INIHintSeparator = '>';


  GameColumnName = 0;
  GameColumnLocation = 1;

  MapColumnName = 0;
  MapColumnCategory = 1;


{$R *.dfm}


{ TMainForm }
procedure TMainForm.FormCreate(Sender: TObject);
var
  lightBtnFace: TColor;
  pageIndex: Integer;
  menuGroup: TX2MenuBarGroup;
  menuItem: TX2MenuBarItem;
  userGamesFileName: string;

begin
  FUIBindings := TBindingExpressionList.Create;
  FPageMenuMap := TPageMenuMap.Create(pcMain.PageCount);


  vstGames.NodeDataSize := SizeOf(TCustomGame);
  vstMapList.NodeDataSize := SizeOf(TCustomGame);


  { Configure pages }
  for pageIndex := 0 to Pred(pcMain.PageCount) do
    pcMain.Pages[pageIndex].TabVisible := False;

  pageIndex := 0;

  for menuGroup in mbMenu.Groups do
    for menuItem in menuGroup.Items do
    begin
      Assert(pageIndex < pcMain.PageCount);

      FPageMenuMap.Add(pcMain.Pages[pageIndex], menuItem);
      menuItem.Tag := pageIndex;
      Inc(pageIndex);
    end;


  { Eye-candy }
  lightBtnFace := BlendColors(clBtnFace, clWindow, 196);
  pnlGamesWarning.Color := lightBtnFace;


  { Load games }
  userGamesFileName := Resources.GetUserDataPath(Resources.UserGamesFileName);
  if FileExists(userGamesFileName) then
    TGameListPersist.Load(userGamesFileName, TGameList.Instance)
  else
    TGameList.Instance.AutoDetect;

  UpdateGameList;

  // #ToDo1 -oMvR: 30-6-2014: load last active game
  if TGameList.Instance.Count > 0 then
    ActiveGame := TGameList.Instance.First;

  { Initialize menu }
  mbpMenuPainter.GroupColors.Hot.Assign(mbpMenuPainter.GroupColors.Normal);

  mbMenu.SelectFirst;
end;


procedure TMainForm.FormDestroy(Sender: TObject);
begin
  ClearUIBindings;

  FreeAndNil(FPageMenuMap);
  FreeAndNil(FUIBindings);
end;


procedure TMainForm.ActiveGameChanged;
begin
  ClearUIBindings;
  vstMapList.Clear;

  if Assigned(ActiveGame) and (not ActiveGame.Loaded) then
    ActiveGame.Load;

  // #ToDo1 -oMvR: 30-6-2014: attach observer to monitor changes

  if Supports(ActiveGame, IGameNetwork) then
    BindGameNetwork;

  if Supports(ActiveGame, IGameName) then
    BindGameName;

  if Supports(ActiveGame, IGameMapList) then
    UpdateMapList;

  UpdateMenu;
end;


procedure TMainForm.ClearUIBindings;
var
  binding: TBindingExpression;

begin
  for binding in UIBindings do
    TBindings.RemoveBinding(binding);

  UIBindings.Clear;
end;


procedure TMainForm.Bind(const APropertyName: string; ADestObject: TObject; const ADestPropertyName: string);
begin
  { Source -> Destination }
  UIBindings.Add(TBindings.CreateManagedBinding(
      [TBindings.CreateAssociationScope([Associate(ActiveGame, 'src')])],
      'src.' + APropertyName,

      [TBindings.CreateAssociationScope([Associate(ADestObject, 'dst')])],
      'dst.' + ADestPropertyName,

      nil, nil, [coNotifyOutput, coEvaluate]));

  { Destination -> Source }
  UIBindings.Add(TBindings.CreateManagedBinding(
      [TBindings.CreateAssociationScope([Associate(ADestObject, 'src')])],
      'src.' + ADestPropertyName,

      [TBindings.CreateAssociationScope([Associate(ActiveGame, 'dst')])],
      'dst.' + APropertyName,

      nil, nil, [coNotifyOutput]));
end;


procedure TMainForm.BindGameNetwork;
begin
  Bind('ServerPort', seServerPort, 'Value');
  Bind('PeerPort', sePeerPort, 'Value');
  Bind('QueryPort', seQueryPort, 'Value');
end;


procedure TMainForm.BindGameName;
begin
  Bind('ServerName', edtServerName, 'Text');
  Bind('MessageOfTheDay', edtMessageOfTheDay, 'Text');
end;


procedure TMainForm.UpdateMenu;

  procedure EnablePageByInterface(APage: TTabSheet; AInterface: TGUID);
  begin
    PageMenuMap[APage].Enabled := Supports(ActiveGame, AInterface);
  end;

begin
  EnablePageByInterface(tsNetwork, IGameNetwork);
  EnablePageByInterface(tsConfiguration, IGameName);
  EnablePageByInterface(tsMapList, IGameMapList);

  if Assigned(mbMenu.SelectedItem) and (not mbMenu.SelectedItem.Enabled) then
    mbMenu.SelectFirst;
end;


procedure TMainForm.UpdateGameList;
begin
  vstGames.RootNodeCount := TGameList.Instance.Count;
  pnlGamesWarning.Visible := (TGameList.Instance.Count = 0);
end;


procedure TMainForm.UpdateMapList;
begin
  if Assigned(ActiveGame) then
    vstMapList.RootNodeCount := (ActiveGame as IGameMapList).GetMapList.Count
  else
    vstMapList.Clear;
end;


procedure TMainForm.SetActiveGame(const Value: TCustomGame);
begin
  if Value <> FActiveGame then
  begin
    FActiveGame := Value;
    ActiveGameChanged;
  end;
end;


procedure TMainForm.mbMenuCollapsing(Sender: TObject; Group: TX2MenuBarGroup; var Allowed: Boolean);
begin
  Allowed := False;
end;


procedure TMainForm.mbMenuSelectedChanged(Sender: TObject; Item: TX2CustomMenuBarItem);
begin
  pcMain.ActivePageIndex := Item.Tag;
end;


procedure TMainForm.llLinkClick(Sender: TObject; const Link: string; LinkType: TSysLinkType);
begin
  ShellExecute(0, 'open', PChar(Link), nil, nil, SW_SHOWNORMAL);
end;


procedure TMainForm.SpinEditChange(Sender: TObject);
begin
  TBindings.Notify(Sender, 'Value');
end;


procedure TMainForm.EditChange(Sender: TObject);
begin
  TBindings.Notify(Sender, 'Text');
end;


procedure TMainForm.actGameAddExecute(Sender: TObject);
var
  game: TCustomGame;

begin
  if TGameForm.Insert(Self, game) then
  begin
    TGameList.Instance.Add(game);

    // #ToDo1 -oMvR: 30-6-2014: move to shared spot
    TGameListPersist.Save(Resources.GetUserDataPath(Resources.UserGamesFileName), TGameList.Instance);
    UpdateGameList;

    ActiveGame := game;
  end;
end;


procedure TMainForm.actGameRemoveExecute(Sender: TObject);
var
  gameIndex: Integer;
  game: TCustomGame;

begin
  if not Assigned(vstGames.FocusedNode) then
    exit;

  gameIndex := vstGames.FocusedNode^.Index;

  if MessageBox(Self.Handle, 'Do you want to remove the selected game?', 'Remove', MB_YESNO or MB_ICONQUESTION) = ID_YES then
  begin
    vstGames.BeginUpdate;
    try
      game := TGameList.Instance[gameIndex];
      TGameList.Instance.Delete(gameIndex);

      if game = ActiveGame then
      begin
        if TGameList.Instance.Count > 0 then
          ActiveGame := TGameList.Instance.First
        else
          ActiveGame := nil;
      end;

      // #ToDo1 -oMvR: 30-6-2014: move to shared spot
      TGameListPersist.Save(Resources.GetUserDataPath(Resources.UserGamesFileName), TGameList.Instance);

      UpdateGameList;
    finally
      vstGames.EndUpdate;
    end;
  end;
end;


procedure TMainForm.vstGamesGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
var
  game: TCustomGame;

begin
  game := TGameList.Instance[Node^.Index];

  case Column of
    GameColumnName:
      CellText := game.GameName;

    GameColumnLocation:
      CellText := game.Location;
  end;
end;


procedure TMainForm.vstGamesFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex);
begin
  actGameRemove.Enabled := Assigned(Sender.FocusedNode);
end;


procedure TMainForm.vstMapListGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
var
  map: TGameMap;

begin
  if not Assigned(ActiveGame) then
    exit;

  map := (ActiveGame as IGameMapList).GetMapList[Node^.Index];

  case Column of
    MapColumnName:
      CellText := map.DisplayName;

    MapColumnCategory:
      CellText := map.Category;
  end;
end;


procedure TMainForm.actMapAddExecute(Sender: TObject);
var
  mapList: IGameMapList;
  map: TGameMap;

begin
  mapList := ActiveGame as IGameMapList;

  if TMapForm.Insert(Self, mapList, map) then
  begin
    mapList.GetMapList.Add(map);
    UpdateMapList;
  end;
end;


procedure TMainForm.actCloseExecute(Sender: TObject);
begin
  Close;
end;



{ TINIHintWindow }
function TINIHintWindow.CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect;
var
  section: string;
  key: string;
  sectionRect: TRect;

begin
  if GetINIHint(AHint, section, key) then
  begin
    Canvas.Font.Style := [fsBold];
    try
      sectionRect := inherited CalcHintRect(MaxWidth, section, AData);
    finally
      Canvas.Font.Style := [];
    end;

    Result := inherited CalcHintRect(MaxWidth, key, AData);

    Result.Right := Max(Result.Right, sectionRect.Right);
    Inc(Result.Bottom, RectHeight(sectionRect));
  end else
    Result := inherited CalcHintRect(MaxWidth, AHint, AData);
end;


procedure TINIHintWindow.Paint;
var
  section: string;
  key: string;
  textRect: TRect;
  clipRect: TRect;
  elementColor: TColor;
  elementDetails: TThemedElementDetails;
  gradientStart: TColor;
  gradientEnd: TColor;
  textColor: TColor;

begin
  if GetINIHint(Caption, section, key) then
  begin
    textRect := ClientRect;
    textColor := Screen.HintFont.Color;

    if StyleServices.Enabled then
    begin
      clipRect := textRect;
      InflateRect(textRect, 4, 4);
      if TOSVersion.Check(6) and StyleServices.IsSystemStyle then
      begin
        // Paint Windows gradient background
        StyleServices.DrawElement(Canvas.Handle, StyleServices.GetElementDetails(tttStandardNormal), textRect, clipRect);
      end else
      begin
        elementDetails := StyleServices.GetElementDetails(thHintNormal);
        if StyleServices.GetElementColor(elementDetails, ecGradientColor1, elementColor) and (elementColor <> clNone) then
          gradientStart := elementColor
        else
          gradientStart := clInfoBk;
        if StyleServices.GetElementColor(elementDetails, ecGradientColor2, elementColor) and (elementColor <> clNone) then
          gradientEnd := elementColor
        else
          gradientEnd := clInfoBk;
        if StyleServices.GetElementColor(elementDetails, ecTextColor, elementColor) and (elementColor <> clNone) then
          textColor := elementColor
        else
          textColor := Screen.HintFont.Color;
        GradientFillCanvas(Canvas, gradientStart, gradientEnd, textRect, gdVertical);
      end;

      textRect := clipRect;
    end;

    Inc(textRect.Left, 2);
    Inc(textRect.Top, 2);

    Canvas.Font.Color := textColor;
    Canvas.Font.Style := [fsBold];
    try
      DrawText(Canvas.Handle, section, -1, textRect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK or DrawTextBiDiModeFlagsReadingOnly);
      Inc(textRect.Top, Canvas.TextHeight(section) + 2);
    finally
      Canvas.Font.Style := [];
    end;

    DrawText(Canvas.Handle, key, -1, textRect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK or DrawTextBiDiModeFlagsReadingOnly);
  end else
    inherited Paint;
end;


function TINIHintWindow.IsINIHint(const AHint: string): Boolean;
begin
  Result := AnsiStartsText(INIHintPrefix, AHint);
end;


function TINIHintWindow.GetINIHint(const AHint: string; out ASection, AKey: string): Boolean;
var
  hint: string;
  separatorPos: Integer;

begin
  Result := IsINIHint(AHint);
  if Result then
  begin
    hint := Copy(AHint, Succ(Length(INIHintPrefix)), MaxInt);
    ASection := '';
    AKey := hint;

    separatorPos := Pos(INIHintSeparator, hint);
    if separatorPos > 0 then
    begin
      ASection := hint;
      SetLength(ASection, Pred(separatorPos));
      Delete(AKey, 1, Pred(separatorPos) + Length(INIHintSeparator));
    end;
  end;
end;


initialization
  HintWindowClass := TINIHintWindow;

end.