1use strict; 2use warnings; 3 4use Test::More; 5use Prima::sys::Test; 6 7reset_flag; 8my @keydata = (); 9my $window = create_window(); 10my $c = $window-> insert( Widget => 11 onCreate => \&set_flag, 12 onDestroy => \&set_flag, 13 onMouseDown => sub { set_flag; push( @keydata, [@_]); }, 14 onMouseUp => sub { set_flag; }, 15 onMouseMove => sub { set_flag; }, 16 onMouseClick => sub { set_flag; push( @keydata, [@_]);}, 17); 18 19plan skip_all => "can't capture" unless $c->capture(1); 20$c->capture(0); 21 22# XP does some random bad magic with mouse movements 23# if there's a top-level window on top, or start menu, 24# or shutdown prompt ... anyway, we're not testing for robustness here, 25# but for proper implementation under normal circumstances 26if ( $^O =~ /win32/i) { 27 my $info = $::application->get_system_info; 28 plan skip_all => "XP does random bad things to me" if $info->{release} < 6; 29} 30 31plan tests => 10; 32 33$c-> mouse_event( cm::MouseDown, mb::Left, 0, 1, 2, 0, 0); 34@keydata = grep { $$_[1] == mb::Left && $$_[2] == 0 && $$_[3] == 1 && $$_[4] == 2} @keydata; 35ok( get_flag && scalar @keydata, "send"); 36@keydata = (); 37 38my $w; 39$c-> mouse_event( cm::MouseDown, mb::Left, 0, 1, 2, 0, 1); 40reset_flag; 41$w = wait_flag; 42@keydata = grep { scalar @$_ == 5 && $$_[1] == mb::Left && $$_[2] == 0 && $$_[3] == 1 && $$_[4] == 2} @keydata; 43ok($w && scalar @keydata, "post" ); 44 45reset_flag(); 46$c-> mouse_event( cm::MouseUp, mb::Left, 0, 1, 2, 0, 0); 47ok( get_flag, "mouse up" ); 48 49reset_flag; 50$c-> mouse_event( cm::MouseMove, mb::Left, 0, 1, 2, 0, 0); 51ok( get_flag, "mouse move" ); 52 53reset_flag; 54@keydata = (); 55$c-> mouse_event( cm::MouseClick, mb::Left, 0, 1, 2, 0, 0); 56@keydata = grep { scalar @$_ == 6 && $$_[1] == mb::Left && $$_[2] == 0 && $$_[3] == 1 && $$_[4] == 2 && $$_[5] == 0 } @keydata; 57ok( get_flag && scalar @keydata, "click" ); 58 59reset_flag; 60@keydata = (); 61$c-> mouse_event( cm::MouseClick, mb::Left, 0, 1, 2, 1, 0); 62@keydata = grep { scalar @$_ == 6 && $$_[1] == mb::Left && $$_[2] == 0 && $$_[3] == 1 && $$_[4] == 2 && $$_[5] == 1 } @keydata; 63ok( get_flag && scalar @keydata, "doubleclick" ); 64 65my @ppx = $c-> pointerPos; 66 67SKIP: { 68 $c-> capture(1) or skip "Can't capture", 1; 69 $c-> focus; 70 ok( $c-> capture, "capture" ); 71} 72 73SKIP: { 74 $::application->begin_paint; 75 skip "rdesktop", 3 if $^O =~ /win32/i && $::application->pixel(0,0) == cl::Invalid; 76 $::application->end_paint; 77 78 reset_flag; 79 $c-> pointerPos( 10, 10); 80 my @pp = $c-> pointerPos; 81 is( $pp[0], 10, "positioning" ); 82 is( $pp[1], 10, "positioning" ); 83 $c-> pointerPos( 11, 11); 84 ok( wait_flag, "simulated movement" ); 85 86 $c-> pointerPos( @ppx); 87 $c-> capture(0); 88} 89$c-> destroy; 90