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