perl - 在运行的 Gtk3 Perl 应用程序中更改 TextView 小部件的字体大小

Question

我正在尝试在运行的 Perl 应用程序中修改 TextView 小部件中的字体大小，但我遇到了困难。这是我的一个尝试(相关代码在函数 setFontSize 中)。

#! /usr/bin/env perl

use feature qw(state);
use local::lib;

use warnings;
use strict;
use utf8;

use constant MAX_FONT_SIZE => 200;
use constant MIN_FONT_SIZE => 12;
use constant FONT_UNIT => 4;

use Glib qw(TRUE FALSE);
use Gtk3 qw(init);
use Pango;

sub killKey {
    my ($object, $event) = @_;
    my $c = lc chr ($event->keyval);
    Gtk3->main_quit if $c eq 'q';
    FALSE;
}

sub setFontSize {
    my ($tView, $font_size) = @_;
    my $pCont = $tView->get_pango_context();
    my $fDescr = $pCont->get_font_description();
    $fDescr->set_absolute_size($font_size * Pango::SCALE);
    my $buf = $tView->get_buffer();
    my $end = $buf->get_end_iter();
    my $start = $buf->get_start_iter();
    my $str = $buf->get_text($start, $end, TRUE);
    my $newBuf = Gtk3::TextBuffer->new();
    $newBuf->set_text($str);
    #$buf->set_text($buf->get_text($start, $end, TRUE), -1);
    $tView->set_buffer($newBuf);
    STDOUT->print("called: ", $fDescr->to_string(),"\n");
#   {
#       no strict "refs";
#       
#       for my $elem (sort keys %{ref($fDescr)."::"}) {
#           STDOUT->print("${elem}\n");
#       }
#   }
}

sub catchScroll {
    my ($object, $event, $tView) = @_;

    state $font_size = 40;

    my $dir = $event->direction;
    my ($ctrl, $mod) = @{$event->state};
    if ($ctrl eq q<control-mask> && $mod eq q<mod2-mask>) {
        if ($dir eq q<up>) {
            $font_size += FONT_UNIT if $font_size < MAX_FONT_SIZE;
            setFontSize($tView, $font_size);
            return FALSE;
        }elsif ($dir eq q<down>) {
            $font_size -= FONT_UNIT if $font_size > MIN_FONT_SIZE;
            setFontSize($tView, $font_size);
            return FALSE;
        }
    }
    FALSE;
}

my $window = Gtk3::Window->new(q<toplevel>);
my $scrWin = Gtk3::ScrolledWindow->new();
my $tView = Gtk3::TextView->new();
my $provider = Gtk3::CssProvider->new();

$provider->load_from_path("the.css");
my $style = $tView->get_style_context();
$style->add_provider($provider, 600);

my $str = qx(perldoc -T -t -f split 2>&1);

my $buf = $tView->get_buffer();
$buf->set_text($str);
my $sIter = $buf->get_start_iter();
$buf->place_cursor($sIter);
#$tView->set_editable(FALSE);

$window->add_events(q<GDK_KEY_PRESS_MASK>);
$window->add_events(q<GDK_SCROLL_MASK>);

$window->signal_connect(delete_event => sub{Gtk3->main_quit; FALSE});
$window->signal_connect(key_press_event => \&killKey);
$window->signal_connect(scroll_event => \&catchScroll, $tView);

$window->set_border_width(0);
$window->fullscreen();
$window->set_decorated(FALSE);

$scrWin->add($tView);
$window->add($scrWin);

$window->show_all;

Gtk3->main;

我可以破解提供者的字体值，而且它工作得很好......有点让你想知道为什么 Gtk3 的人没有这种功能来解决这些类型的问题。

.css

text {
    background-color: rgb(0,0,0); 
    color: rgb(0, 255, 0);
}

textview {
    font-size: 40px;
}

最终版本:我添加了 CSS::Tiny 来处理 provider 中的 css，并添加了在使用 Ctrl+鼠标滚轮修改字体大小时卡住垂直滚动条的功能。

#! /usr/bin/env perl

use feature qw(state);
use warnings;
use strict;
use utf8;

use constant MAX_FONT_SIZE => 200;
use constant MIN_FONT_SIZE => 20;
use constant FONT_UNIT => 4;
use constant FONT_START_SIZE => 40;

use CSS::Tiny;

use Glib qw(TRUE FALSE);
use Gtk3 qw(init);

sub killKey {
    my ($object, $event) = @_;
    my $c = lc chr ($event->keyval);
    Gtk3->main_quit if $c eq 'q';
}

sub changeFontSize {
    my ($style, $provider, $font_size) = @_;
    my $cssStr = $provider->to_string();
    my $css = CSS::Tiny->new();
    $css = CSS::Tiny->read_string($cssStr);
    $css->{textview}->{q<font-size>} = "${font_size}px";

    $style->remove_provider($provider);
    $provider = Gtk3::CssProvider->new();
    $provider->load_from_data($css->write_string());
    $style->add_provider($provider, 600);
}

sub catchScroll {
    my ($object, $event, $data) = @_;
    my ($style, $provider, $vadj) = @{$data};
    my ($ctrl, $mod) = @{$event->state};
    my $dir = $event->direction;

    my $retval = Gtk3::get_current_event();

    state $font_size = FONT_START_SIZE;

    if ($ctrl eq q<control-mask> && $mod eq q<mod2-mask>) {
        if ($dir eq q<up>) {
            $font_size += FONT_UNIT if $font_size < MAX_FONT_SIZE;
            changeFontSize($style, $provider, $font_size);
        }elsif ($dir eq q<down>) {
            $font_size -= FONT_UNIT if $font_size > MIN_FONT_SIZE;
            changeFontSize($style, $provider, $font_size);
        }else {
        }
        $vadj->set_value(0.0);
    }
    FALSE;
}

my $window = Gtk3::Window->new(q<toplevel>);
my $scrWin = Gtk3::ScrolledWindow->new();
my $tView = Gtk3::TextView->new();
my $provider = Gtk3::CssProvider->new();

$provider->load_from_path(q<the.css>);
my $style = $tView->get_style_context();
$style->add_provider($provider, 600);

my $str = qx(perldoc -T -t -f split 2>&1);

my $buf = $tView->get_buffer();
$buf->set_text($str);
my $sIter = $buf->get_start_iter();
$buf->place_cursor($sIter);
$tView->set_editable(FALSE);

$window->add_events(q<GDK_KEY_PRESS_MASK>);
$window->add_events(q<GDK_SCROLL_MASK>);


$window->signal_connect(delete_event => sub{Gtk3->main_quit; FALSE});
$window->signal_connect(key_press_event => \&killKey);
$window->signal_connect(
    scroll_event => 
        \&catchScroll, 
        [$style, $provider, $scrWin->get_vadjustment()]
);

$window->set_border_width(0);
$window->set_position(q<center>);
$window->fullscreen();
$window->set_decorated(FALSE);

$scrWin->add($tView);
$window->add($scrWin);
$window->show_all();

Gtk3->main;

.css

text {
    background-color: rgb(0, 0, 0); 
    color: rgb(0, 255, 0);
}

textview {
    font-size: 40px;
}

Answer 1

目前我也无法使 Pango 字体描述正常工作。似乎很难找到一个很好的文档来说明它应该如何工作:)

无论如何，作为解决方法，可以使用 CSS 提供程序:

sub setFontSize {
    my ($tView, $font_size) = @_;

    state $provider;

    my $context = $tView->get_style_context();
    if ( $provider ) {
         $context->remove_provider( $provider );
    }
    $provider = Gtk3::CssProvider->new();
    my $css = sprintf "textview {font-size: %spx;}", $font_size;
    $provider->load_from_data($css);
    $context->add_provider($provider, Gtk3::STYLE_PROVIDER_PRIORITY_APPLICATION);
}