/
pango.t
106 lines (89 loc) · 3.19 KB
/
pango.t
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
#!/usr/bin/perl -w
use strict;
use SDL;
use SDL::Config;
use SDL::Color;
use SDL::Surface;
use SDL::Overlay;
use SDL::Rect;
use SDL::Video;
use SDL::PixelFormat;
BEGIN {
use Test::More;
use lib 't/lib';
use SDL::TestTool;
if ( !SDL::Config->has('SDL_Pango') ) {
plan( skip_all => 'SDL_Pango support not compiled' );
}
}
use SDL::Pango;
use SDL::Pango::Context;
use SDL::Version;
my $videodriver = $ENV{SDL_VIDEODRIVER};
$ENV{SDL_VIDEODRIVER} = 'dummy' unless $ENV{SDL_RELEASE_TESTING};
is( SDL::Pango::was_init(), 0, "[was_init] returns false" );
is( SDL::Pango::init(), 0, "[init] succeeded" );
isnt( SDL::Pango::was_init(), 0, "[was_init] returns true" );
my $context = SDL::Pango::Context->new;
isa_ok( $context, 'SDL::Pango::Context', "[new SDL::Pango::Context]" );
my $text = 'Hi <b><span foreground="red"><i>k</i></span>thakore</b> its me, <u>Pango</u>!!';
SDL::Pango::set_default_color( $context, 0xA7C344FF, 0 );
pass "[set_default_color] ran";
SDL::Pango::set_default_color(
$context, 0xA7, 0xC3, 0x44, 0xFF, 0, 0, 0,
0x00
);
pass "[set_default_color] ran";
SDL::Pango::set_minimum_size( $context, 640, 0 );
pass "[set_minimum_size] ran";
SDL::Pango::set_text( $context, $text, 20 );
pass "[set_text] ran";
SDL::Pango::set_markup( $context, $text, -1 );
pass "[set_markup] ran";
my $w = SDL::Pango::get_layout_width($context);
ok( $w >= 0, "[get_layout_width] width is $w" );
my $h = SDL::Pango::get_layout_height($context);
ok( $h >= 0, "[get_layout_height] height is $h" );
is( SDLPANGO_DIRECTION_LTR, 0, "constant: SDLPANGO_DIRECTION_LTR" );
is( SDLPANGO_DIRECTION_RTL, 1, "constant: SDLPANGO_DIRECTION_RTL" );
is( SDLPANGO_DIRECTION_WEAK_LTR, 2, "constant: SDLPANGO_DIRECTION_WEAK_LTR" );
is( SDLPANGO_DIRECTION_WEAK_RTL, 3, "constant: SDLPANGO_DIRECTION_WEAK_RTL" );
is( SDLPANGO_DIRECTION_NEUTRAL, 4, "constant: SDLPANGO_DIRECTION_NEUTRAL" );
SDL::Pango::set_base_direction( $context, SDLPANGO_DIRECTION_LTR );
pass "[set_base_direction] to SDLPANGO_DIRECTION_LTR";
SDL::Pango::set_dpi( $context, 48, 48 );
pass "[set_dpi] to x=48 and y=48";
SDL::Pango::set_language( $context, "en" );
pass "[set_language] to 'en'";
SKIP:
{
skip( 'We need video support for this', 2 )
unless SDL::TestTool->init(SDL_INIT_VIDEO);
my $display = SDL::Video::set_video_mode( 640, 480, 32, SDL_SWSURFACE );
SDL::Pango::draw( $context, $display, ( 640 - $w ) / 2, ( 480 - $h ) / 2 );
pass "[draw] ran";
my $bg = SDL::Video::map_RGB( $display->format, 0x12, 0x22, 0x45 );
SDL::Video::fill_rect( $display, SDL::Rect->new( 0, 0, 640, 480 ), $bg );
SDL::Pango::set_surface_create_args(
$context, SDL_SWSURFACE, 32, 255 << 24,
255 << 16, 255 << 8, 255
);
pass "[set_surface_create_args] ran";
my $surface = SDL::Pango::create_surface_draw($context);
isa_ok( $surface, 'SDL::Surface', "[create_surface_draw]" );
SDL::Video::blit_surface(
$surface, SDL::Rect->new( 0, 0, 640, 480 ),
$display,
SDL::Rect->new( ( 640 - $w ) / 2, ( 480 - $h ) / 2, $w, $h )
);
SDL::Video::update_rect( $display, 0, 0, 0, 0 );
SDL::delay(2000);
}
if ($videodriver) {
$ENV{SDL_VIDEODRIVER} = $videodriver;
} else {
delete $ENV{SDL_VIDEODRIVER};
}
pass 'Are we still alive? Checking for segfaults';
done_testing;
sleep(1);