1#!/usr/bin/perl 2use strict; 3use warnings; 4use lib qw(t/inc); 5use PangoTestHelper; 6 7if (UNIVERSAL::can("Pango::Cairo::FontMap", "new") && 8 Pango -> CHECK_VERSION(1, 10, 0)) { 9 plan tests => 22; 10} else { 11 plan skip_all => "PangoCairo stuff: need Cairo and pango >= 1.10.0"; 12} 13 14my $fontmap = Pango::Cairo::FontMap -> new(); 15isa_ok($fontmap, "Pango::Cairo::FontMap"); 16isa_ok($fontmap, "Pango::FontMap"); 17 18SKIP: { 19 skip 'new 1.18 stuff', 3 20 unless Pango -> CHECK_VERSION(1, 18, 0); 21 22 $fontmap = Pango::Cairo::FontMap -> new_for_font_type('ft'); 23 24 skip 'new_for_font_type returned undef', 3 25 unless defined $fontmap; 26 27 isa_ok($fontmap, "Pango::Cairo::FontMap"); 28 isa_ok($fontmap, "Pango::FontMap"); 29 is($fontmap -> get_font_type(), 'ft'); 30} 31 32$fontmap = Pango::Cairo::FontMap -> get_default(); 33isa_ok($fontmap, "Pango::Cairo::FontMap"); 34isa_ok($fontmap, "Pango::FontMap"); 35 36$fontmap -> set_resolution(72); 37is($fontmap -> get_resolution(), 72); 38 39my $context = $fontmap -> create_context(); 40isa_ok($context, "Pango::Context"); 41 42# Just to make sure this is a valid Pango::FontMap 43isa_ok(($fontmap -> list_families())[0], "Pango::FontFamily"); 44 45my $target = Cairo::ImageSurface -> create("argb32", 100, 100); 46my $cr = Cairo::Context -> create($target); 47 48Pango::Cairo::update_context($cr, $context); 49 50my $options = Cairo::FontOptions -> create(); 51 52# Function interface 53{ 54 Pango::Cairo::Context::set_font_options($context, $options); 55 isa_ok(Pango::Cairo::Context::get_font_options($context), 56 "Cairo::FontOptions"); 57 58 Pango::Cairo::Context::set_resolution($context, 72); 59 is(Pango::Cairo::Context::get_resolution($context), 72); 60} 61 62# Method interface 63{ 64 isa_ok($context, "Pango::Cairo::Context"); 65 66 $context -> set_font_options($options); 67 isa_ok($context -> get_font_options(), "Cairo::FontOptions"); 68 69 $context -> set_resolution(72); 70 is($context -> get_resolution(), 72); 71} 72 73my $layout = Pango::Cairo::create_layout($cr); 74isa_ok($layout, "Pango::Layout"); 75 76my $line = $layout -> get_line(0); 77 78Pango::Cairo::show_layout_line($cr, $line); 79Pango::Cairo::show_layout($cr, $layout); 80Pango::Cairo::layout_line_path($cr, $line); 81Pango::Cairo::layout_path($cr, $layout); 82 83Pango::Cairo::update_layout($cr, $layout); 84 85# FIXME: pango_cairo_show_glyph_string, pango_cairo_glyph_string_path. 86 87SKIP: { 88 skip "error line stuff", 0 89 unless Pango -> CHECK_VERSION(1, 14, 0); 90 91 Pango::Cairo::show_error_underline($cr, 23, 42, 5, 5); 92 Pango::Cairo::error_underline_path($cr, 23, 42, 5, 5); 93} 94 95SKIP: { 96 skip 'new 1.18 stuff', 6 97 unless Pango -> CHECK_VERSION(1, 18, 0); 98 99 $context -> set_shape_renderer(undef, undef); 100 101 my $target = Cairo::ImageSurface -> create('argb32', 100, 100); 102 my $cr = Cairo::Context -> create($target); 103 104 my $layout = Pango::Cairo::create_layout($cr); 105 Pango::Cairo::Context::set_shape_renderer( 106 $layout -> get_context(), 107 sub { 108 my ($cr, $shape, $do_path, $data) = @_; 109 110 isa_ok($cr, 'Cairo::Context'); 111 isa_ok($shape, 'Pango::AttrShape'); 112 ok(defined $do_path); 113 is($data, 'bla'); 114 }, 115 'bla'); 116 $layout -> set_text('Bla'); 117 118 my $ink = { x => 23, y => 42, width => 10, height => 15 }; 119 my $logical = { x => 42, y => 23, width => 15, height => 10 }; 120 my $attr = Pango::AttrShape -> new($ink, $logical, 0, 1); 121 my $list = Pango::AttrList -> new(); 122 $list -> insert($attr); 123 $layout -> set_attributes($list); 124 125 Pango::Cairo::show_layout($cr, $layout); 126 127 my $desc = Pango::FontDescription -> from_string('Sans 10'); 128 my $font = $fontmap -> load_font($context, $desc); 129 skip 'could not load font', 2 130 unless defined $font; 131 isa_ok($font, 'Pango::Cairo::Font'); 132 isa_ok($font -> get_scaled_font(), 'Cairo::ScaledFont'); 133} 134 135__END__ 136 137Copyright (C) 2005 by the gtk2-perl team (see the file AUTHORS for the 138full list). See LICENSE for more information. 139