1#!/usr/bin/perl -w 2use strict; 3use Gtk2::TestHelper tests => 57; 4 5# $Id$ 6 7my $description = Gtk2::Pango::FontDescription -> new(); 8isa_ok($description, "Gtk2::Pango::FontDescription"); 9 10like($description -> hash(), qr/^\d+$/); 11is($description -> equal($description), 1); 12 13$description -> set_family("Sans"); 14$description -> set_family_static("Sans"); 15is($description -> get_family(), "Sans"); 16 17$description -> set_style("normal"); 18is($description -> get_style(), "normal"); 19 20$description -> set_variant("normal"); 21is($description -> get_variant(), "normal"); 22 23$description -> set_weight("bold"); 24is($description -> get_weight(), "bold"); 25 26$description -> set_stretch("condensed"); 27is($description -> get_stretch(), "condensed"); 28 29$description -> set_size(23); 30is($description -> get_size(), 23); 31 32isa_ok($description -> get_set_fields(), "Gtk2::Pango::FontMask"); 33$description -> unset_fields([qw(size stretch)]); 34 35$description -> merge($description, 1); 36$description -> merge_static($description, 1); 37 38ok(!$description -> better_match($description, $description)); 39ok($description -> better_match(undef, $description)); 40 41$description = Gtk2::Pango::FontDescription -> from_string("Sans 12"); 42isa_ok($description, "Gtk2::Pango::FontDescription"); 43 44is($description -> to_string(), "Sans 12"); 45ok(defined($description -> to_filename())); 46 47SKIP: { 48 skip("new 1.8 stuff", 1) 49 unless (Gtk2::Pango -> CHECK_VERSION(1, 8, 0)); 50 51 $description -> set_absolute_size(23.42); 52 is($description -> get_size_is_absolute(), TRUE); 53} 54 55SKIP: { 56 skip("new 1.16 stuff", 1) 57 unless (Gtk2::Pango -> CHECK_VERSION(1, 16, 0)); 58 59 $description -> set_gravity("south"); 60 is($description -> get_gravity(), "south"); 61} 62 63############################################################################### 64 65my $label = Gtk2::Label -> new("Bla"); 66my $context = $label -> create_pango_context(); 67my $font = $context -> load_font($description); 68my $language = Gtk2 -> get_default_language(); 69 70my $number = qr/^-?\d+$/; 71 72isa_ok($font -> describe(), "Gtk2::Pango::FontDescription"); 73 74SKIP: { 75 skip "new 1.14 stuff", 1 76 unless Gtk2::Pango -> CHECK_VERSION(1, 14, 0); 77 78 isa_ok($font -> describe_with_absolute_size(), "Gtk2::Pango::FontDescription"); 79} 80 81foreach my $rectangle ($font -> get_glyph_extents(23)) { 82 foreach my $key (qw(x y width height)) { 83 like($rectangle -> { $key }, $number); 84 } 85} 86 87my $metrics = $font -> get_metrics($language); 88isa_ok($metrics, "Gtk2::Pango::FontMetrics"); 89 90like($metrics -> get_ascent(), $number); 91like($metrics -> get_descent(), $number); 92like($metrics -> get_approximate_char_width(), $number); 93like($metrics -> get_approximate_digit_width(), $number); 94 95SKIP: { 96 skip("new 1.6 stuff", 4) 97 unless (Gtk2::Pango -> CHECK_VERSION(1, 6, 0)); 98 99 like($metrics -> get_underline_position(), $number); 100 like($metrics -> get_underline_thickness(), $number); 101 like($metrics -> get_strikethrough_position(), $number); 102 like($metrics -> get_strikethrough_thickness(), $number); 103} 104 105SKIP: { 106 skip("new 1.10 stuff", 1) 107 unless (Gtk2::Pango -> CHECK_VERSION(1, 10, 0)); 108 109 isa_ok($font -> get_font_map(), "Gtk2::Pango::FontMap"); 110} 111 112############################################################################### 113 114like(int(Gtk2::Pango -> scale()), $number); 115like(int(Gtk2::Pango -> scale_xx_small()), $number); 116like(int(Gtk2::Pango -> scale_x_small()), $number); 117like(int(Gtk2::Pango -> scale_small()), $number); 118like(int(Gtk2::Pango -> scale_medium()), $number); 119like(int(Gtk2::Pango -> scale_large()), $number); 120like(int(Gtk2::Pango -> scale_x_large()), $number); 121like(int(Gtk2::Pango -> scale_xx_large()), $number); 122like(int(Gtk2::Pango -> PANGO_PIXELS(23)), $number); 123like(int(Gtk2::Pango -> pixels(23)), $number); 124 125############################################################################### 126 127my @families = $context->list_families; 128ok (@families > 0, 'got a list of families'); 129isa_ok ($families[0], 'Gtk2::Pango::FontFamily'); 130ok ($families[0]->get_name, 'get_name works'); 131SKIP: { 132 skip "is_monospace is new in 1.4.0", 1 133 unless Gtk2::Pango->CHECK_VERSION (1, 4, 0); 134 # we don't really have a way of knowing if this font should actually 135 # be monospaced, so just check that the function doesn't die. 136 $families[0]->is_monospace; 137 ok (1, 'is_monospace works'); 138} 139 140my @faces = $families[0]->list_faces; 141#print "faces @faces\n"; 142ok (@faces > 0, 'got a list of faces'); 143isa_ok ($faces[0], 'Gtk2::Pango::FontFace'); 144my $desc = $faces[0]->describe; 145isa_ok ($desc, 'Gtk2::Pango::FontDescription'); 146ok ($faces[0]->get_face_name); 147SKIP: { 148 skip "list_sizes is new in 1.4.0", 1 149 unless Gtk2::Pango->CHECK_VERSION (1, 4, 0); 150 # again, whether we'll get sizes depends on whether this first font and 151 # face is a bitmapped font. we can't know that, so just test that the 152 # call does not result in a crash. 153 my @sizes = $faces[0]->list_sizes; 154 #print "sizes @sizes\n"; 155 ok (1, 'list_sizes did not crash'); 156} 157 158SKIP: { 159 skip("new 1.18 stuff", 1) 160 unless (Gtk2::Pango -> CHECK_VERSION(1, 18, 0)); 161 162 ok(defined $faces[0]->is_synthesized); 163} 164 165__END__ 166 167Copyright (C) 2003-2005 by the gtk2-perl team (see the file AUTHORS for the 168full list). See LICENSE for more information. 169