1use strict; 2use warnings; 3 4use Test::More; 5use Prima::sys::Test; 6use Prima::Application; 7 8plan tests => 14; 9 10my $a = $::application; 11 12my @sz = $a->size; 13 14# Test screen grabbing 15SKIP: { 16 if ($^O eq 'darwin') { 17 skip "not compiled with cocoa", 3 unless $a->get_system_info->{guiDescription} =~ /Cocoa/; 18 } elsif ( ($ENV{XDG_SESSION_TYPE} // 'x11') ne 'x11') { 19 skip "not compiled with gtk", 3 unless $a->get_system_info->{gui} == gui::GTK; 20 } elsif ( $^O =~ /win32/i && $::application->pixel(0,0) == cl::Invalid) { 21 skip "rdesktop", 3; 22 } 23 24 reset_flag; 25 my $w = $a->insert( 26 (($^O =~ /win32/i) ? ( 27 Window => 28 borderStyle => bs::None, 29 borderIcons => 0, 30 onTop => 1, 31 ) : ('Widget')), 32 rect => [0,0,5,5], 33 color => cl::White, 34 backColor => cl::Black, 35 onPaint => sub { 36 my $w = shift; 37 $w->fillPattern(fp::SimpleDots); 38 $w->bar(0,0,$w->size); 39 set_flag; 40 }, 41 ); 42 $w->show; 43 $w->bring_to_front; 44 wait_flag; 45 select(undef,undef,undef,0.1); 46 47 my $i = $a->get_image(1,1,2,1); 48 ok( $i && $i->width == 2 && $i->height == 1, "some bitmap grabbing succeeded"); 49 skip "no bitmap", 1 unless $i; 50 $i->type(im::BW); 51 my ( $a, $b ) = ( $i->pixel(0,0), $i->pixel(1,0) ); 52 ($a,$b) = ($b,$a) if $b < $a; 53 is($a, 0, "one pixel is black"); 54 is($b, 255, "another is white"); 55 $w->destroy; 56} 57 58 59 60SKIP: { 61 skip "system doesn't allow direct access to screen", 3 unless $a-> begin_paint; 62 ok( $a-> get_paint_state, "get_paint_state"); 63 my $pix = $a-> pixel( 10, 10); 64 skip "rdesktop", 2 if $^O =~ /win32/i && $pix == cl::Invalid; 65 66 $a-> pixel( 10, 10, 0); 67 my $bl = $a-> pixel( 10, 10); 68 $a-> pixel( 10, 10, 0xFFFFFF); 69 my $wh = $a-> pixel( 10, 10); 70 $a-> pixel( 10, 10, $pix); 71 my ( $xr, $xg, $xb) = (( $wh & 0xFF0000) >> 16, ( $wh & 0xFF00) >> 8, $wh & 0xFF); 72 $wh = ( $xr + $xg + $xb ) / 3; 73 is( $bl, 0, "black pixel"); 74 cmp_ok( $wh, '>', 200, "white pixel"); 75 $a-> end_paint; 76} 77 78 79$a-> visible(0); 80ok( $a-> visible && $a-> width == $sz[0] && $a-> height == $sz[1], "width and height"); 81 82my $msz = $a->get_monitor_rects; 83ok( $msz && ref($msz) eq 'ARRAY' && @$msz > 0, "monitor configuration" ); 84 85# test yield 86alarm(10); 87$::application->yield(0); # clear up accumulated events 88my $t = Prima::Timer->new( timeout => 50, onTick => \&set_flag ); 89$t->start; 90my $e = 1; 91$e &= $::application->yield(1) while !get_flag; 92ok( $e && get_flag, "timer triggers yield return"); 93$t->stop; 94 95reset_flag; 96alarm(10); 97my $p = 0; 98$::application->onIdle( sub { $p|=1 } ); 99$::application->onIdle( sub { $p|=2 } ); 100$::application->insert( Timer => 101 timeout => 1000, 102 onTick => sub { 103 set_flag; 104 shift->stop 105 } 106)->start; 107my $time = time + 2; 108while ( 1) { 109 $::application->yield(1); 110 last if $time < time or get_flag; 111} 112ok( get_flag, "yield without events sleeps, but still is alive"); 113ok( $p == 3, "idle event"); 114 115alarm(10); 116$::application->insert( Timer => 117 timeout => 100, 118 onTick => sub { $::application->stop; shift->stop }, 119)->start; 120$::application->go; 121ok( $::application->alive, "stop #1 works" ); 122$::application->insert( Timer => 123 timeout => 100, 124 onTick => sub { $::application->stop; shift->stop }, 125)->start; 126$::application->go; 127ok( $::application->alive, "stop #2 works" ); 128 129$SIG{ALRM} = 'DEFAULT'; 130alarm(10); 131$::application->close; 132$e = $::application->yield(1); 133ok(!$e, "yield returns 0 on application.close"); 134 135