perl - 是否有一个 Perl 库可以将字体绘制为多边形？

Question

我想将文本绘制为多边形，并获得一个包含 (x1,y1)-(x2,y2) 对的线段数组，我可以在矢量绘图应用程序中进行缩放和使用。一种应用可能是用 CNC 编写文本。

因此，例如：

$f = PolyFont->new("Hello World");
@lines = $f->get_lines();

这可能会提供@lines = ([x1,y1],[x2,y2]) 值或类似内容的列表。

字体不必特别漂亮，用线段逼近的话，甚至不需要支持曲线。

如果它会接受一个TTF，那就更好了！

想法？

标签： perlfontsgraphicspolygondraw

Answer 1

您可以使用该Font::FreeType模块将字形的轮廓作为一系列线段和贝塞尔弧来获取。这是一个示例，我使用以下方法将大纲保存到新.png文件中Image::Magick：

use feature qw(say);
use strict;
use warnings;
use Font::FreeType;
use Image::Magick;

my $size = 72;
my $dpi = 600;
my $font_filename = 'Vera.ttf';
my $char = 'A';
my $output_filename = $char . '-outline.png';
my $face = Font::FreeType->new->face($font_filename);
$face->set_char_size($size, $size, $dpi, $dpi);
my $glyph = $face->glyph_from_char($char);
my $width = $glyph->horizontal_advance;
my $height = $glyph->vertical_advance;
my $img = Image::Magick->new(size => "${width}x$height");
$img->Read('xc:#ffffff');
$img->Set(stroke => '#8888ff');

my $curr_pos;
$glyph->outline_decompose(
    move_to => sub {
        my ($x, $y) = @_;
        $y = $height - $y;
        $curr_pos = "$x,$y";
    },
    line_to => sub {
        my ($x, $y) = @_;
        $y = $height - $y;
        $img->Draw(primitive => 'line', linewidth => 5, points => "$curr_pos $x,$y");
        $curr_pos = "$x,$y";
    },
    cubic_to => sub {
        my ($x, $y, $cx1, $cy1, $cx2, $cy2) = @_;
        $y = $height - $y;
        $cy1 = $height - $cy1;
        $cy2 = $height - $cy2;
        $img->Draw(primitive => 'bezier',
                   points => "$curr_pos $cx1,$cy1 $cx2,$cy2 $x,$y");
        $curr_pos = "$x,$y";
    },
);

$img->Write($output_filename);

输出：

备注：

• 您可以Vera.ttf从这里下载字体文件：https ://www.dafont.com/bitstream_vera_sans.font
• 此示例基于CPAN 发行版中的示例脚本magick.pl 。Font::FreeType