From c0b5051b00d6e2de5a46cfacbda9b18774312be4 Mon Sep 17 00:00:00 2001
From: Andreas Schneider <aksdb@gmx.de>
Date: Mon, 7 Dec 2009 16:26:47 +0100
Subject: [PATCH] - Added Keyboard movement to oglGameWindow (fixes #5)

---
 Client/CentrED.lpi  |  3 ++-
 Client/UfrmMain.lfm | 15 ++++++++-------
 Client/UfrmMain.pas | 42 ++++++++++++++++++++++++++++++++++--------
 3 files changed, 44 insertions(+), 16 deletions(-)

diff --git a/Client/CentrED.lpi b/Client/CentrED.lpi
index a847023..624f15e 100644
--- a/Client/CentrED.lpi
+++ b/Client/CentrED.lpi
@@ -319,7 +319,8 @@
       <CompilerMessages>
         <IgnoredMessages idx5024="True"/>
       </CompilerMessages>
-      <CustomOptions Value="-FE../bin/
"/>
+      <CustomOptions Value="-FE../bin/
+"/>
       <CompilerPath Value="$(CompPath)"/>
     </Other>
   </CompilerOptions>
diff --git a/Client/UfrmMain.lfm b/Client/UfrmMain.lfm
index 650fb9f..775ffca 100644
--- a/Client/UfrmMain.lfm
+++ b/Client/UfrmMain.lfm
@@ -614,11 +614,11 @@ object frmMain: TfrmMain
     end
     object tsClients: TTabSheet
       Caption = 'Clients'
-      ClientHeight = 495
+      ClientHeight = 492
       ClientWidth = 218
       object lbClients: TListBox
         Left = 0
-        Height = 495
+        Height = 492
         Top = 0
         Width = 218
         Align = alClient
@@ -632,7 +632,7 @@ object frmMain: TfrmMain
     end
     object tsLocations: TTabSheet
       Caption = 'Locations'
-      ClientHeight = 495
+      ClientHeight = 492
       ClientWidth = 218
       object btnClearLocations: TSpeedButton
         AnchorSideLeft.Control = btnDeleteLocation
@@ -641,7 +641,7 @@ object frmMain: TfrmMain
         Left = 128
         Height = 22
         Hint = 'Clear'
-        Top = 453
+        Top = 450
         Width = 23
         BorderSpacing.Left = 4
         Color = clBtnFace
@@ -694,7 +694,7 @@ object frmMain: TfrmMain
         Left = 101
         Height = 22
         Hint = 'Delete'
-        Top = 453
+        Top = 450
         Width = 23
         Anchors = [akLeft, akBottom]
         BorderSpacing.Bottom = 4
@@ -746,7 +746,7 @@ object frmMain: TfrmMain
         Left = 74
         Height = 22
         Hint = 'Add'
-        Top = 453
+        Top = 450
         Width = 23
         Anchors = [akTop, akRight]
         BorderSpacing.Right = 4
@@ -800,7 +800,7 @@ object frmMain: TfrmMain
         AnchorSideBottom.Control = btnDeleteLocation
         Cursor = 63
         Left = 4
-        Height = 431
+        Height = 428
         Top = 18
         Width = 210
         Anchors = [akTop, akLeft, akRight, akBottom]
@@ -1146,6 +1146,7 @@ object frmMain: TfrmMain
     Width = 542
     Anchors = [akTop, akLeft, akRight, akBottom]
     OnDblClick = oglGameWindowDblClick
+    OnKeyDown = oglGameWindowKeyDown
     OnMouseDown = oglGameWindowMouseDown
     OnMouseEnter = oglGameWindowMouseEnter
     OnMouseLeave = oglGameWindowMouseLeave
diff --git a/Client/UfrmMain.pas b/Client/UfrmMain.pas
index 132b1e4..5f2fc4a 100644
--- a/Client/UfrmMain.pas
+++ b/Client/UfrmMain.pas
@@ -209,6 +209,8 @@ type
     procedure mnuRegionControlClick(Sender: TObject);
     procedure mnuShutdownClick(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);
@@ -309,6 +311,7 @@ type
     function  GetSelectedRect: TRect;
     procedure InitRender;
     procedure InitSize;
+    procedure MoveBy(AOffsetX, AOffsetY: Integer); inline;
     procedure PrepareMapCell(AMapCell: TMapCell);
     procedure PrepareScreenBlock(ABlockInfo: PBlockInfo);
     procedure ProcessToolState;
@@ -362,7 +365,7 @@ uses
   UfrmBoundaries, UfrmElevateSettings, UfrmConfirmation, UfrmMoveSettings,
   UfrmAbout, UPacketHandlers, UfrmHueSettings, UfrmRadar, UfrmLargeScaleCommand,
   UfrmLogin, UResourceManager, UfrmVirtualLayer, UfrmFilter, UfrmTileInfo,
-  UfrmRegionControl, Logging, LConvEncoding;
+  UfrmRegionControl, Logging, LConvEncoding, LCLType;
 
 type
   TGLArrayf4 = array[0..3] of GLfloat;
@@ -472,6 +475,29 @@ begin
     btnAddRandomClick(Sender);
 end;
 
+procedure TfrmMain.oglGameWindowKeyDown(Sender: TObject; var Key: Word;
+  Shift: TShiftState);
+begin
+  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
@@ -1345,13 +1371,6 @@ begin
 end;
 
 procedure TfrmMain.tmMovementTimer(Sender: TObject);
-
-  procedure MoveBy(AOffsetX, AOffsetY: Integer);
-  begin
-    SetPos(EnsureRange(FX + AOffsetX, 0, FLandscape.CellWidth - 1),
-           EnsureRange(FY + AOffsetY, 0, FLandscape.CellHeight - 1));
-  end;
-
 begin
   case FOverlayUI.ActiveArrow of
     0: MoveBy(-8, 0);
@@ -1832,6 +1851,13 @@ begin
   glLoadIdentity;
 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;