Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

Re: Unable to capture mouse events in Win32::Console

by fireblood (Scribe)
on Apr 28, 2022 at 13:10 UTC ( #11143390=note: print w/replies, xml ) Need Help??


in reply to Unable to capture mouse events in Win32::Console

Hi all, the following is what I put together based on all of the feedback that you've provided:

# This program displays details about console events that occur in +the window in # wnich this program is running. This program creates a file calle +d "event_log.txt" # in the current directory. # # References: # # https://docs.microsoft.com/en-us/windows/console/reading-i +nput-buffer-events # # Definitions and values of constants such as ENABLE_* are avail +able at the # following URL: # # https://docs.microsoft.com/en-us/windows/console/setconsol +emode # BEGIN { select STDERR; $|++; # do not buffer STDERR select STDOUT; $|++; # do not buffer STDOUT system ("cls"); print "\n\n\tInitializing the environment ...\n\n\t"; }; use strict; use warnings; # The following package provides access to basic information about t +he runtime environment # such as the release of Windows under which this program is running use Win32; # The following package provides access to console events such as ke +y presses and mouse clicks use Win32::Console; my $console; my @console_event; my @info; my $log_file = "event_log.txt"; my $fh_log_file; unless (open ($fh_log_file, ">", $log_file)) { print STDERR "\nCould not open $log_file: $!\n\n"; die; } unless ($console = Win32::Console -> new (STD_INPUT_HANDLE)) { print STDERR "\nSomething has gone wrong with the Win32::Conso +le constructor: $!\n\n"; die; } $console -> Flush (); my $starting_console_mode_setting = $console -> Mode; END {$console -> Mode ($starting_console_mode_setting)}; # The following instruction is based on expertise provided by vr # at https://www.perlmonks.org/?node_id=11143316 $console -> Mode ((($starting_console_mode_setting | 0x0010 ) & ~0x004 +0 ) & ~ENABLE_PROCESSED_INPUT); print "Perl version $^V running on ", join (" ", Win32::GetOSName), ". +\n\n"; print $fh_log_file "Perl version $^V running on ", join (" ", Win32::G +etOSName), ".\n\n"; # The following is to demonstrate that the $console environment has +been set up print "Your mouse has ", $console->MouseButtons(), " buttons.\n\n"; print $fh_log_file "Your mouse has ", $console->MouseButtons(), " butt +ons.\n\n"; print "Enter keyboard activity or mouse events ...\n\n"; print $fh_log_file "Enter keyboard activity or mouse events ...\n\n"; my $start_time = time (); my $when_to_stop_listening = $start_time + 15; while (time () < $when_to_stop_listening) { if ($console -> GetEvents ()) # This may be unnecessary, c +an simply invoke Input () # and check if it has return +ed anything { @console_event = $console -> Input (); print "A console event has been detected. Its attribu +tes are the following:\n\n"; print $fh_log_file "A console event has been detected. + Its attributes are the following:\n\n"; print "Time of event: ", time (), "\n"; print $fh_log_file "Time of event: ", time (), "\ +n"; print "Type of event: "; print $fh_log_file "Type of event: "; if (defined ($console_event [0])) { if ($console_event [0] == 1) { print "Keyboard event.\n"; print $fh_log_file "Keyboard event.\n" +; print "Key down: ", $console +_event[1], "\n"; print $fh_log_file "Key down: + ", $console_event[1], "\n"; print "Repeat count: ", $console +_event[2], "\n"; print $fh_log_file "Repeat count: + ", $console_event[2], "\n"; print "Virtual key code: ", $console +_event[3], "\n"; print $fh_log_file "Virtual key code: + ", $console_event[3], "\n"; print "Virtual scan code: ", $console +_event[4], "\n"; print $fh_log_file "Virtual scan code: + ", $console_event[4], "\n"; print "ASCII code: ", $console +_event[5], "\n"; print $fh_log_file "ASCII code: + ", $console_event[5], "\n"; print "ASCII code letter: ", chr $co +nsole_event[5], "\n"; print $fh_log_file "ASCII code letter: + ", chr $console_event[5], "\n"; print "Control key state: ", $console +_event[6], "\n"; print $fh_log_file "Control key state: + ", $console_event[6], "\n"; } elsif ($console_event [0] == 2) { print "Mouse event.\n"; print $fh_log_file "Mouse event.\n"; print "Mouse X coord: ", $console +_event[1], "\n"; print $fh_log_file "Mouse X coord: + ", $console_event[1], "\n"; print "Mouse Y coord: ", $console +_event[2], "\n"; print $fh_log_file "Mouse Y coord: + ", $console_event[2], "\n"; print "Mouse button state: ", $console +_event[3], "\n"; print $fh_log_file "Mouse button state +: ", $console_event[3], "\n"; print "Control key state: ", $console +_event[4], "\n"; print $fh_log_file "Control key state: + ", $console_event[4], "\n"; print "Event flags: ", $console +_event[5], "\n"; print $fh_log_file "Event flags: + ", $console_event[5], "\n"; } else { print "Unknown type \"$console_event[0 +]\".\n"; print $fh_log_file "Unknown type \"$co +nsole_event[0]\".\n"; } print "\nAdditional information:\n"; print $fh_log_file "A\ndditional information:\ +n"; @info = $console -> Info (); # @info is supposed to contain the following + elements: # # $info[0]: columns (X size) of the consol +e buffer. # $info[1]: rows (Y size) of the console b +uffer. # $info[2]: current column (X position) of + the cursor. # $info[3]: current row (Y position) of th +e cursor. # $info[4]: current attribute used for Wri +te. # $info[5]: left column (X of the starting + point) of the current console window. # $info[6]: top row (Y of the starting poi +nt) of the current console window. # $info[7]: right column (X of the final p +oint) of the current console window. # $info[8]: bottom row (Y of the final poi +nt) of the current console window. # $info[9]: maximum number of columns for +the console window, given the current buffer size, font and the scree +n size. # $info[10]: maximum number of rows for the + console window, given the current buffer size, font and the screen s +ize. # # but look at what is actually happening: print "The size of \@info is ", scalar @info, +".\n"; print $fh_log_file "The size of \@info is ", s +calar @info, ".\n"; print "The value of \$info[0] is \"", $info[0] +, "\".\n"; print $fh_log_file "The value of \$info[0] is +\"", $info[0], "\".\n"; print "\n"; print $fh_log_file "\n"; } else { print "undefined event type.\n"; print $fh_log_file "undefined event type.\n"; } print "\n"; print $fh_log_file "\n"; } } print "The time to stop listening has been reached. Program is ending +.\n\n"; print $fh_log_file "The time to stop listening has been reached. Prog +ram is ending.\n\n";

When I run this in my environment, I find that $console -> Info () returns only a one-element array the single member of which is an empty string. Because some of the Info () elements are critical to my real application, I looked again at Win32::GUI and found that it can be used with non-owned windows, i.e., windows that it did not create. A quick test program revealed that it provided all of the functionality that I need for my real project. Given that Win32::Console was written to be used with what Microsoft is now calling legacy consoles, whereas Win32::GUI was written in 2017 and seems to work exactly as its documentation describes, it seems that Win32::GUI is the better way to go, at least for now. One comment that was provided was that using the TCL module is actually the best way to go in the long run.

Thanks again for all of the very constructive feedback.

Replies are listed 'Best First'.
Re^2: Unable to capture mouse events in Win32::Console
by Anonymous Monk on Apr 28, 2022 at 18:26 UTC

    Your while loop loops ~700k times in 15s for me, and somewhat fully loads 2 cores even without me touching anything. It's NOT the result supposed to arise from advice given.

    + Not an expert on these, Info seems to produce valid list if STD_OUTPUT_HANDLE was used to create an object.

    + Win32::GUI was not "written in 2017", is built on same-time as Win32::Console i.e. dated and legacy some-middle-90s MS API.

      somewhat fully loads 2 cores even without me touching anything

      If I do a loop (similar to what fireblood used), then it does seem to hog at least one CPU if it can:

      use strict; use warnings; use Win32::Console; use Time::HiRes qw(sleep); my $OUT = new Win32::Console(STD_OUTPUT_HANDLE); my $IN = new Win32::Console(STD_INPUT_HANDLE); my $save = $IN-> Mode; END { $IN-> Mode( $save )}; $IN-> Mode(( $save | 0x0010 ) & ~0x0040 ); # +MOUSE, -QUICK_EDIT $OUT->Write("Perl version $^V \n"); $OUT->Write("more text could go here\n\n"); my $n_buttons = $IN->MouseButtons(); $OUT->Write("Your mouse has $n_buttons buttons\n"); $IN->Mode(ENABLE_MOUSE_INPUT); my @info = $IN->Info(); $OUT->Write(sprintf "IN info:(%s)\n", "@info"); @info = $OUT->Info(); $OUT->Write(sprintf "OUT info:(%s)\n", "@info"); my $counter = 0; my %MouseFlags = ( FIRST_CLICK => 0, MOUSE_MOVED => 1, DOUBLE_CLICK => 2, MOUSE_WHEELED => 4, MOUSE_HWHEELED => 8, ); @MouseFlags{values %MouseFlags} = keys %MouseFlags; # reverse mapping while(1) { if($IN->GetEvents) { @console_events = $IN->Input(); local $" = ","; if( 2 == ($console_events[0]//0) ) { $OUT->Write(sprintf "Mouse (@console_events): (%d,%d) Btn= +%d Flag=%d:%s\r", @console_events[1..3], $console_events[5], $MouseFl +ags{$console_events[5]}); # I switched to \r so that the mouse events + wouldn't flood the screen, which was causing the mouse y coordinate +reported to be confusing, since it was scrolling the window, and it's + mouse-coordinate relative to the TOP of the console history } elsif ( 1 == ($console_events[0]//0) ) { $OUT->Write("Keyboard (@console_events)\n", ); exit if 27 == ($console_events[3]//0); # ESC = 27 } else { $OUT->Write("Unknown (@console_events)\n"); } } }

      However, if I add a 10ms sleep in the else condition, then the CPU usage drops to virtually nothing, at least for me:

      ... # the code before the while loop is identical to the program listi +ng above use Time::HiRes qw/sleep/ while(1) { if($IN->GetEvents) { @console_events = $IN->Input(); ... } else { sleep 0.01; } }

      Alternately, getting rid of the GetEvents also seems to not peg the CPU, at least for me:

      ... while(1) { @console_events = $IN->Input(); ... }

      Info seems to produce valid list if STD_OUTPUT_HANDLE was used

      I agree with the Anonymous Monk's assessment that STD_OUTPUT_HANDLE will give valid ->Info().

      use strict; use warnings; use Win32::Console; my $OUT = new Win32::Console(STD_OUTPUT_HANDLE); my $IN = new Win32::Console(STD_INPUT_HANDLE); my @info = $IN->Info(); $OUT->Write(sprintf "IN info:(%s)\n", "@info"); @info = $OUT->Info(); $OUT->Write(sprintf "OUT info:(%s)\n", "@info"); __END__ IN info:() OUT info:(150 9001 0 15 7 0 0 149 29 150 71)

      is built on same-time as Win32::Console i.e. dated and legacy some-middle-90s MS API.

      I partially agree. Win32::GUI is built on the Win32 API, which has its roots in the 90s MS API -- but so are any Win32 API application. But MS specifically documents the Console+Mouse related calls as not recommended (see, for example, Mouse Event Record Structure, which is where the ->Input() results come from for Mouse events), whereas MS doesn't mark most of the Win32 API (like the Win32 controls, which is where Win32::GUI gets all of its pushbuttons, windows, etc) with similar verbiage

      And regarding 2013 vs 2017: both are still too long since they were maintained and had reported bugs fixed: Win32::Console hasn't been updated since 2013; Win32::GUI hasn't been updated since 2017; both could stand some improvements, even in their handling of the underlying Win32 API, and especially in their documentation.

      Yes, you are correct, I should have said that the last update to Win32::GUI was in 2017, not that it was written in 2017.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://11143390]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (3)
As of 2022-12-03 08:46 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?