In response to Tomas Hajny:
I'd certainly be willing to give it a try. Granted, I only have Windows XP, but if I'm careful it should be a smooth transition. No promises on a timeline :)
Another problem with Windows (not sure about other OSs) is in bug 2084. (Use the second example in the description.) I was able to narrow down what the problem is, and it's pretty daunting. Essentially, initmouse will call SetMouseEventHandler() in winevent.pp. This spawns a thread that runs EventHandleThread in a fairly tight loop, which captures all console input.
The problem comes when ReadKey then calls KeyPressed, which also attempts to read console input. No matter what, EventHandleThread will capture the input (since it places a call to WaitForSingleObject, waking up the instant something is in the queue), leaving KeyPressed with nothing to process.
My initial attempt to get around this is to tie KeyPressed to EventHandleThread as well. (If you can't beat 'em, join 'em, right?) I've attached the work I've done so far, but it's not quite right. With two ReadKey calls in a row, the first will read the key, the second will exit without even reading the queue. I think this is because the first ReadKey hasn't had a chance to clear the ScanCode variable before the second ReadKey call to KeyPressed (which exits when ScanCode <> #0). This results in the DOS window outputting a garbage character when the program finishes because there's still something in the queue.
It's possible to fix it by wrapping the contents of ReadKey in a critical section, but that, to me, is just more overhead. I think there's a more elegant solution waiting to be discovered :-)
Thanks,
Sterling
Your message below:
------------------
Unfortunately, the problem is wider - there are several other issues with the current OS/2 implementation (if you just quickly compare it with e.g. the GO32v2 implementation, you'd find some other problems too - e.g. handling of #8 is surely incorrect etc.).
The main problem is that there's a lot platform independent functionality in Crt unit which is re-implemented for every platform again and again. The best solution would be to throw all the individual implementations away completely and implement cross-platform Crt unit based on capabilities provided by units Keyboard and Video (possibly missing functionalities within these units necessary for Crt could be either handled by platform specific include file, or by extending current Keyboard and/or Video). This issue has been discussed several times in the core team already, but nobody found the time for doing it yet due to higher priority tasks. Would you be willing to give it a try by any chance?
Post your free ad now! Yahoo! Canada Personals
===================================================================
RCS file: /FPC/CVS/fpc/rtl/win32/crt.pp,v
retrieving revision 1.24
diff -w -b -i -u -p -1 -0 -r1.24 crt.pp
--- crt.pp 14 Feb 2005 17:13:32 -0000 1.24
+++ crt.pp 31 Mar 2005 06:08:59 -0000
@@ -20,21 +20,22 @@ interface
{$i crth.inc}
procedure Window32(X1,Y1,X2,Y2: DWord);
procedure GotoXY32(X,Y: DWord);
function WhereX32: DWord;
function WhereY32: DWord;
implementation
uses
- windows;
+ windows,
+ winevent;
var
SaveCursorSize: Longint;
{
definition of textrec is in textrec.inc
}
{$i textrec.inc}
@@ -347,130 +348,138 @@ begin
end
else
case Scancode of
// Function keys
$57..$58: inc(Scancode, $2E); // F11 and F12
end;
RemapScanCode := ScanCode;
end;
+var
+ KeyEvt: THandle; // signal that a key is ready for processing
+ KeyPrcEvt: THandle; // signal that the key has been processed
+ KeyBuf: PInputRecord; // pointer to incoming INPUT_RECORD
+ KeyCS: TCriticalSection; // restricts KeyPressed access to single thread
+
+
+procedure OnKeyEvent(var ir: INPUT_RECORD);
+begin
+ KeyBuf := @ir;
+ Windows.SetEvent(KeyEvt);
+ WaitForSingleObject(KeyPrcEvt, INFINITE);
+ Windows.ResetEvent(KeyEvt);
+end;
+
+
function KeyPressed : boolean;
var
nevents,nread : dword;
- buf : TINPUTRECORD;
AltKey: Boolean;
c : longint;
begin
KeyPressed := FALSE;
+ { Leave KeyPrcEvt "set" at the end of the proc; this avoids deadlocks in }
+ { OnKeyEvent while waiting for the event to signal. }
+ Windows.ResetEvent(KeyPrcEvt);
+
if ScanCode <> #0 then
KeyPressed := TRUE
else
begin
- GetNumberOfConsoleInputEvents(TextRec(input).Handle,nevents);
- while nevents>0 do
- begin
- ReadConsoleInputA(TextRec(input).Handle,buf,1,nread);
- if buf.EventType = KEY_EVENT then
- if buf.Event.KeyEvent.bKeyDown then
+ WaitForSingleObject(KeyEvt, INFINITE);
+
+ if KeyBuf^.Event.KeyEvent.bKeyDown then
begin
{ Alt key is VK_MENU }
{ Capslock key is VK_CAPITAL }
- AltKey := ((Buf.Event.KeyEvent.dwControlKeyState AND
+ AltKey := ((KeyBuf^.Event.KeyEvent.dwControlKeyState AND
(RIGHT_ALT_PRESSED OR LEFT_ALT_PRESSED)) > 0);
- if not(Buf.Event.KeyEvent.wVirtualKeyCode in [VK_SHIFT,
VK_MENU, VK_CONTROL,
+ if not(KeyBuf^.Event.KeyEvent.wVirtualKeyCode in [VK_SHIFT, VK_MENU,
VK_CONTROL,
VK_CAPITAL, VK_NUMLOCK,
VK_SCROLL]) then
begin
keypressed:=true;
- if (ord(buf.Event.KeyEvent.AsciiChar) = 0) or
- (buf.Event.KeyEvent.dwControlKeyState and
(LEFT_ALT_PRESSED or ENHANCED_KEY) > 0) then
+ if (Ord(KeyBuf^.Event.KeyEvent.AsciiChar) = 0) or
+ (KeyBuf^.Event.KeyEvent.dwControlKeyState and
(LEFT_ALT_PRESSED or ENHANCED_KEY) > 0) then
begin
SpecialKey := TRUE;
- ScanCode :=
Chr(RemapScanCode(Buf.Event.KeyEvent.wVirtualScanCode,
Buf.Event.KeyEvent.dwControlKeyState,
-
Buf.Event.KeyEvent.wVirtualKeyCode));
+ ScanCode :=
Chr(RemapScanCode(KeyBuf^.Event.KeyEvent.wVirtualScanCode,
KeyBuf^.Event.KeyEvent.dwControlKeyState,
+ KeyBuf^.Event.KeyEvent.wVirtualKeyCode));
end
else
begin
{ Map shift-tab }
- if (buf.Event.KeyEvent.AsciiChar=#9) and
- (buf.Event.KeyEvent.dwControlKeyState and
SHIFT_PRESSED > 0) then
+ if (KeyBuf^.Event.KeyEvent.AsciiChar=#9) and
+ (KeyBuf^.Event.KeyEvent.dwControlKeyState and
SHIFT_PRESSED > 0) then
begin
SpecialKey := TRUE;
ScanCode := #15;
end
else
begin
SpecialKey := FALSE;
- ScanCode :=
Chr(Ord(buf.Event.KeyEvent.AsciiChar));
+ ScanCode := Chr(Ord(KeyBuf^.Event.KeyEvent.AsciiChar));
end;
end;
- if AltKey then
+ if AltKey and (KeyBuf^.Event.KeyEvent.wVirtualScanCode in
[71,72,73,75,76,77,79,80,81,82]) then
begin
- case Buf.Event.KeyEvent.wVirtualScanCode of
+ case KeyBuf^.Event.KeyEvent.wVirtualScanCode of
71 : c:=7;
72 : c:=8;
73 : c:=9;
75 : c:=4;
76 : c:=5;
77 : c:=6;
79 : c:=1;
80 : c:=2;
81 : c:=3;
82 : c:=0;
- else
- break;
end;
DoingNumChars := true;
DoingNumCode := Byte((DoingNumCode * 10) + c);
Keypressed := false;
Specialkey := false;
ScanCode := #0;
end
- else
- break;
end;
end
- else
- begin
- if (Buf.Event.KeyEvent.wVirtualKeyCode in [VK_MENU]) then
- if DoingNumChars then
- if DoingNumCode > 0 then
+ else if (KeyBuf^.Event.KeyEvent.wVirtualKeyCode in [VK_MENU]) and
+ (DoingNumChars) and (DoingNumCode > 0) then
begin
ScanCode := Chr(DoingNumCode);
Keypressed := true;
DoingNumChars := false;
DoingNumCode := 0;
- break
end; { if }
- end;
- { if we got a key then we can exit }
- if keypressed then
- exit;
- GetNumberOfConsoleInputEvents(TextRec(input).Handle,nevents);
- end;
+
+ Windows.SetEvent(KeyPrcEvt);
end;
end;
function ReadKey: char;
begin
while (not KeyPressed) do
Sleep(1);
- if SpecialKey then begin
+
+ if SpecialKey then
+ begin
ReadKey := #0;
SpecialKey := FALSE;
- end else begin
+ end
+ else
+ begin
ReadKey := ScanCode;
ScanCode := #0;
end;
end;
{*************************************************************************
Delay
*************************************************************************}
@@ -788,20 +797,26 @@ end;
var
CursorInfo : TConsoleCursorInfo;
ConsoleInfo : TConsoleScreenBufferinfo;
// ts
begin
{ Initialize the output handles }
LastMode := 3;
+ { Init keyboard event management }
+ InitializeCriticalSection(KeyCS);
+ KeyEvt := CreateEvent(nil, true, false, nil);
+ KeyPrcEvt := CreateEvent(nil, true, false, nil);
+ SetKeyboardEventHandler(@OnKeyEvent);
+
SetActiveWindow(0);
{--------------------- Get the cursor size and such -----------------------}
FillChar(CursorInfo, SizeOf(CursorInfo), 00);
GetConsoleCursorInfo(GetStdHandle(STD_OUTPUT_HANDLE), CursorInfo);
SaveCursorSize := CursorInfo.dwSize;
{------------------ Get the current cursor position and attr --------------}
FillChar(ConsoleInfo, SizeOf(ConsoleInfo), 0);
GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE), ConsoleInfo);
_______________________________________________ fpc-devel maillist - fpc-devel@lists.freepascal.org http://lists.freepascal.org/mailman/listinfo/fpc-devel
