+ added a keyboard dump test tool

git-svn-id: branches/unicodekvm@40154 -

.gitattributes

@@ -7422,6 +7422,9 @@ packages/rtl-console/src/win16/keyboard.pp svneol=native#text/plain
 packages/rtl-console/src/win16/mouse.pp svneol=native#text/plain
 packages/rtl-console/src/win16/video.pp svneol=native#text/plain
 packages/rtl-console/tests/kbd1.pp svneol=native#text/plain
+packages/rtl-console/tests/kbddump.pp svneol=native#text/plain
+packages/rtl-console/tests/kbdutil.pp svneol=native#text/plain
+packages/rtl-console/tests/us101.txt svneol=native#text/plain
 packages/rtl-extra/Makefile svneol=native#text/plain
 packages/rtl-extra/Makefile.fpc svneol=native#text/plain
 packages/rtl-extra/Makefile.fpc.fpcmake svneol=native#text/plain

packages/rtl-console/tests/kbddump.pp

@@ -0,0 +1,109 @@
+program kbddump;
+
+{$MODE objfpc}{$H+}
+
+uses
+  Video, Keyboard, Mouse, kbdutil;
+
+procedure TextOut(X, Y: Integer; const S: string; TextAttr: Byte);
+var
+  W, P, I, M: Integer;
+begin
+  P := ((X-1)+(Y-1)*ScreenWidth);
+  M := Length(S);
+  if (P+M) > ScreenWidth*ScreenHeight then
+    M := ScreenWidth*ScreenHeight-P;
+  for I := 1 to M do
+    VideoBuf^[P+I-1] := Ord(S[I]) + (TextAttr shl 8);
+end;
+
+procedure DrawKey(const Key: TKey; TextAttr: Byte);
+var
+  Y: Integer;
+begin
+  for Y := Key.YTop to Key.YBottom do
+  begin
+    if Y = Key.Y then
+      TextOut(Key.X + 1, Y + 1, Key.KeyLabel, TextAttr)
+    else
+      TextOut(Key.X + 1, Y + 1, StringOfChar(' ', Length(Key.KeyLabel)), TextAttr);
+  end;
+end;
+
+procedure DrawKeyboard(const Kbd: TKeyboard);
+var
+  I: Integer;
+begin
+  for I := Low(kbd.Keys) to High(kbd.Keys) do
+    DrawKey(kbd.Keys[I], $70);
+end;
+
+procedure SampleAllKeys(const Kbd: TKeyboard; const OutFileName: string);
+var
+  I: Integer;
+  K: TKeyEvent;
+  M: TMouseEvent;
+  OutF: TextFile;
+begin
+  AssignFile(OutF, OutFileName);
+  Rewrite(OutF);
+  for I := Low(kbd.Keys) to High(kbd.Keys) do
+  begin
+    DrawKey(kbd.Keys[I], $17);
+    UpdateScreen(False);
+
+    repeat
+      K := PollKeyEvent;
+      if PollMouseEvent(M) then
+        GetMouseEvent(M);
+    until (K <> 0) or ((GetMouseButtons and MouseRightButton) <> 0);
+    if K <> 0 then
+    begin
+      K := GetKeyEvent;
+      Write(OutF, K, ' ');
+      K:=TranslateKeyEvent(K);
+      Writeln(OutF, K);
+    end
+    else
+    begin
+      Writeln(OutF, '-1 -1');
+      while (GetMouseButtons and MouseRightButton) <> 0 do
+      begin
+        if PollMouseEvent(M) then
+          GetMouseEvent(M);
+      end;
+    end;
+
+    DrawKey(kbd.Keys[I], $70);
+    UpdateScreen(False);
+  end;
+  CloseFile(OutF);
+end;
+
+var
+  kbd: TKeyboard;
+begin
+  if ParamCount <> 2 then
+  begin
+    Writeln('Usage: ', ParamStr(0), ' <kbd_file> <output_file>');
+    Halt(1);
+  end;
+
+
+  InitVideo;
+  InitKeyboard;
+  InitMouse;
+
+  kbd := ReadKeyboardFromFile(ParamStr(1));
+  DrawKeyboard(kbd);
+  UpdateScreen(False);
+
+  TextOut(1, 20, 'Press the highlighted key. Use the right mouse button to skip if the key', $07);
+  TextOut(1, 21, 'cannot be detected.', $07);
+  UpdateScreen(False);
+  SampleAllKeys(kbd, ParamStr(2));
+
+  DoneMouse;
+  DoneKeyboard;
+  DoneVideo;
+end.

packages/rtl-console/tests/kbdutil.pp

@@ -0,0 +1,73 @@
+unit kbdutil;
+
+{$MODE objfpc}{$H+}
+
+interface
+
+type
+  TKey = record
+    X, Y: Integer;
+    YTop, YBottom: Integer;
+    KeyLabel: string;
+  end;
+  TKeys = array of TKey;
+  TKeyboard = record
+    Keys: TKeys;
+  end;
+
+function ReadKeyboardFromFile(const FileName: string): TKeyboard;
+
+implementation
+
+function ReadKeyboardFromFile(const FileName: string): TKeyboard;
+var
+  SaveCtrlZMarksEOF: Boolean;
+  InF: TextFile;
+  KeyX, KeyY, KeyY1, KeyY2: Integer;
+  KeyStr: string;
+begin
+  SaveCtrlZMarksEOF := CtrlZMarksEOF;
+  try
+    CtrlZMarksEOF := False;
+    FillChar(Result, SizeOf(Result), 0);
+    AssignFile(InF, FileName);
+    Reset(InF);
+    while not EoF(InF) do
+    begin
+      Read(InF, KeyX);
+      if KeyX <> -1 then
+      begin
+        Readln(InF, KeyY, KeyStr);
+        Delete(KeyStr, 1, 1);
+        SetLength(Result.Keys, Length(Result.Keys) + 1);
+        with Result.Keys[High(Result.Keys)] do
+        begin
+          X := KeyX;
+          Y := KeyY;
+          YTop := KeyY;
+          YBottom := KeyY;
+          KeyLabel := KeyStr;
+        end;
+      end
+      else
+      begin
+        Readln(InF, KeyX, KeyY1, KeyY2, KeyY, KeyStr);
+        Delete(KeyStr, 1, 1);
+        SetLength(Result.Keys, Length(Result.Keys) + 1);
+        with Result.Keys[High(Result.Keys)] do
+        begin
+          X := KeyX;
+          Y := KeyY;
+          YTop := KeyY1;
+          YBottom := KeyY2;
+          KeyLabel := KeyStr;
+        end;
+      end;
+    end;
+    CloseFile(InF);
+  finally
+    CtrlZMarksEOF := SaveCtrlZMarksEOF;
+  end;
+end;
+
+end.

packages/rtl-console/tests/us101.txt

@@ -0,0 +1,101 @@
+3 0 Esc
+9 0 F1
+12 0 F2
+15 0 F3
+18 0 F4
+22 0 F5
+25 0 F6
+28 0 F7
+31 0 F8
+35 0 F9
+38 0 10
+41 0 11
+44 0 12
+48 0 PSc
+52 0 SLk
+56 0 Pau
+3 3  `
+6 3  1
+9 3  2
+12 3  3
+15 3  4
+18 3  5
+21 3  6
+24 3  7
+27 3  8
+30 3  9
+33 3  0
+36 3  -
+39 3  =
+42 3 -BS
+3 5 Tab
+7 5  Q
+10 5  W
+13 5  E
+16 5  R
+19 5  T
+22 5  Y
+25 5  U
+28 5  I
+31 5  O
+34 5  P
+37 5  [
+40 5  ]
+43 5  \ 
+3 7 Caps
+8 7  A
+11 7  S
+14 7  D
+17 7  F
+20 7  G
+23 7  H
+26 7  J
+29 7  K
+32 7  L
+35 7  ;
+38 7  '
+41 7 Enter
+3 9 Shift
+9 9  Z
+12 9  X
+15 9  C
+18 9  V
+21 9  B
+24 9  N
+27 9  M
+30 9  ,
+33 9  .
+36 9  /
+39 9  Shift 
+3 11 Ctrl
+10 11  Alt
+15 11      Space Bar     
+35 11  Alt
+42 11 Ctrl
+48 3 Ins
+52 3 Hom
+56 3 PgU
+48 5 Del
+52 5 End
+56 5 PgD
+52 9   
+48 11   
+52 11   
+56 11   
+61 3 NL
+64 3  /
+67 3  *
+70 3  -
+61 5  7
+64 5  8
+67 5  9
+61 7  4
+64 7  5
+67 7  6
+61 9  1
+64 9  2
+67 9  3
+61 11  0   
+67 11  .
+-1 70 5 7 6  +
+-1 70 9 11 10 Ù