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

Question

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

因此，例如：

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

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

字体不需要特别漂亮，用线段来近似就不需要支持曲线了

如果能接受TTF就更好了！

想法？

Answer 1

您可以使用 Font::FreeType 模块将字形的轮廓作为一系列线段和贝塞尔弧线获取。这是一个示例，我使用 Image::Magick:

将大纲保存到新的 .png 文件

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
此示例基于来自 Font::FreeType CPAN 分发版的示例脚本 magick.pl。

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

Is there a Perl library to draw fonts as polygons?

perl

fonts

graphics

polygon

draw