Вертикальный текст на Gnome2::Canvas (Perl/Gtk2)

Question

Рисуя на Gnome2::Canvas, я хочу нарисовать оси X и Y с горизонтальной меткой и вертикальной меткой.

Gnome2:: Canvas:: Текстовые объекты допускают разметку Pango. Такой тег Pango должен работать, но не работает.

<span gravity="west">...</span>

Есть ли способ преодолеть нежелание Gtk рисовать повернутый текст?

#!/usr/bin/perl
package vertical;

use strict;
use diagnostics;
use warnings;

use Gtk2 '-init';
use Gnome2::Canvas;

my $window = Gtk2::Window->new('toplevel');
$window->set_title('Hello world');
$window->set_position('center');
$window->set_default_size(500, 500);
$window->signal_connect('delete-event' => sub {

    Gtk2->main_quit();
    exit;
});

my $canvasFrame = Gtk2::Frame->new(undef);
$window->add($canvasFrame);
$canvasFrame->set_border_width(3);

my $canvasScroller = Gtk2::ScrolledWindow->new();
$canvasFrame->add($canvasScroller);
$canvasScroller->set_border_width(3);
$canvasScroller->set_policy('always','always');

my $canvas = Gnome2::Canvas->new();
$canvasScroller->add($canvas);
$canvas->set_scroll_region(0, 0, 400, 400);
$canvas->set_center_scroll_region(1);

# White background
my $canvasObj = Gnome2::Canvas::Item->new (
    $canvas->root(),
    'Gnome2::Canvas::Rect',
    x1 => 0,
    y1 => 0,
    x2 => 400,
    y2 => 400,
    fill_color => '#FFFFFF',
    outline_color => '#FFFFFF',
);
$canvasObj->lower_to_bottom();

# Black text
my $canvasObj2 = Gnome2::Canvas::Item->new(
    $canvas->root(),
    'Gnome2::Canvas::Text',
    x => 100,
    y => 300,
    fill_color => '#000000',
    font => 'Sans',
    size => 20000,
    anchor => 'GTK_ANCHOR_W',
    markup => "this is <span gravity=\"east\">not vertical</span>",
);
$canvasObj2->raise_to_top();

$window->show_all();

Gtk2->main();

Answer 1

Я думаю, что использование gravity Атрибут в разметке Pango не поддерживается, по крайней мере, я не смог заставить его работать.

Однако вместо использования Gnome2::Canvas, вы можете попробовать использовать rotate() функция в Cairo::Context, Вот пример использования Gtk3:

use strict;
use warnings;
use Gtk3 '-init';
use Glib qw/TRUE FALSE/;
use Cairo;
use Pango;

use constant PI     => 3.1415927;

my $window = Gtk3::Window->new('toplevel');
$window->set_title("Cairo Basics");
$window->set_position("mouse");
$window->set_default_size(600, 400);
$window->set_border_width(5);
$window->signal_connect (delete_event => sub { Gtk3->main_quit });

my $frame = Gtk3::Frame->new("Cairo Drawings");
$window->add($frame);
my $drawable = Gtk3::DrawingArea->new;
$drawable->signal_connect( draw => sub { cairo_draw($drawable, @_ ) });
$frame->add($drawable);
$window->show_all;
Gtk3->main;

sub cairo_draw {
    my ( $drawable, $widget, $context, $ref_status ) = @_;

    my $pango_layout = $drawable->create_pango_layout("");
    $pango_layout->set_markup(
        "<span foreground = '#FF4444'"
        ." size = '20000' face='sans' style='normal' weight='bold'>"
        . "This is vertical</span>"
    );
    my $pango_context = $pango_layout->get_context();
    $context->move_to(200, 100);
    $context->rotate(PI*(90/180));
    Pango::Cairo::show_layout( $context, $pango_layout );    
    return FALSE;
}

Кроме того, вы можете вообще пропустить разметку Pango и использовать только Cairo:

sub cairo_draw {
    my ( $drawable, $widget, $context, $ref_status ) = @_;

    $context->set_source_rgba(1, 0.4, 0.4, 1);
    $context->select_font_face( "Sans", "normal", "bold" );
    $context->set_font_size( 35 );
    $context->move_to(220, 50);
    $context->rotate(PI*(90/180));
    $context->show_text( "This is vertical");
    return FALSE;
}