1use strict; 2use warnings; 3 4use Test::More; 5use Prima::sys::Test; 6 7reset_flag; 8my $window = create_window; 9 10$::application->begin_paint; 11plan skip_all => "rdesktop" if $^O =~ /win32/i && $::application->pixel(0,0) == cl::Invalid; 12$::application->end_paint; 13 14$Prima::sys::Test::timeout = 5000; 15 16plan tests => 11; 17 18$window-> bring_to_front; 19my @rcrect; 20my $ww = $window-> insert( Widget => origin => [ 0, 0] => size => [ 8, 8], 21 syncPaint => 0, 22 buffered => 0, 23 cursorSize => [ 30, 30], 24 cursorVisible => 1, 25 onPaint => sub { 26 $_[0]-> on_paint( $_[1]); 27 set_flag; 28 @rcrect = $_[0]-> clipRect; 29 }); 30ok( wait_flag, "onPaint message" ); 31reset_flag; 32 33$ww-> repaint; 34$ww-> update_view; 35ok( get_flag, "update_view" ); 36 37reset_flag; 38SKIP: { 39 my $p = $ww-> scroll( 2, 2); 40 skip "Window is still not top-level, obscured by something?", 8 if $p != scr::Expose; 41 42 $ww-> update_view; 43 ok( get_flag, "scroll" ); 44 45 $ww-> invalidate_rect( 0, 0, 2, 2); 46 my @cr = $ww-> get_invalid_rect; 47 is_deeply( \@cr, [0,0,2,2], "query invalid area" ); 48 $ww-> update_view; 49 is_deeply( \@rcrect, [0,0,1,1], "invalid area consistency" ); 50 51 $ww-> buffered(1); 52 $ww-> set( onPaint => sub { 53 my $x = $_[1]; 54 $_[0]-> on_paint( $x); 55 $x-> pixel( 0,0,cl::White); 56 my $white = $x-> pixel(0,0); 57 $x-> pixel( 0,0,cl::Black); 58 is( $x-> pixel(0,0), 0, "pixel" ); 59 $x-> color( cl::White); 60 $x-> bar( 0, 0, 7, 7); 61 $x-> color( cl::Black); 62 $x-> clipRect( 2, 2, 3, 3); 63 $x-> bar( 1, 1, 2, 2); 64 $x-> clipRect( 0, 0, $x-> size); 65 is( $x-> pixel( 2,2), 0, "clipRect" ); 66 is( $x-> pixel( 1,1), $white, "clipRect" ); 67 68 $x-> color( cl::White); 69 $x-> bar( 0, 0, 7, 7); 70 $x-> color( cl::Black); 71 $x-> translate( -1, 1); 72 $x-> bar( 2, 2, 3, 3); 73 $x-> translate( 0, 0); 74 is( $x-> pixel( 1,4), 0, "translate" ); 75 is( $x-> pixel( 3,2), $white, "translate" ); 76 }); 77 $ww-> repaint; 78 $ww-> update_view; 79} 80 81$ww-> destroy; 82 83$ww = $window->insert( Widget => onPaint => sub { die "moo" }); 84eval { $ww->repaint; $ww->update_view; }; 85ok( $@ =~ /moo/, 'exception in cmPaint'); 86$ww-> destroy; 87