perl - 按一个因子缩放 ascii 图像

Question

我偶然发现了这个代码高尔夫挑战：https ://codegolf.stackexchange.com/questions/19196/transform-number-into-7-segment-display-pattern

并尝试了我自己的解决方案，我能够很容易地以 1 的比例解决它；但我无法弄清楚如何正确缩放图像，这是我目前所拥有的。位置 a - f 指的是这个图像，我是如何布置显示映射的：

use strict;
use warnings; 

my $charmap = 
    {   a => [split //, '_ __ _____'], 
        b => [split //, '|||||  |||'],
        c => [split //, '|| |||||||'],    
        d => [split //, '_ __ __ _ '],     
        e => [split //, '| |   | | '],     
        f => [split //, '|   ||| ||'],     
        g => [split //, '  _____ __']     
    };

my @nums  = split //, shift; 
my $scale = shift; 

print ' ';
foreach ( @nums ) {
  print fill('a', $_) . '  '
}
print "\n";
foreach ( @nums ) {
  print fill('f', $_) . fill('g', $_) . fill('b', $_)
}  
print "\n";
foreach ( @nums ) {
  print fill('e', $_) . fill('d', $_) . fill('c', $_)
} 
print "\n";

sub fill {
    my ($k, $n) = @_;  

    return $charmap->{$k}->[$n];
}

当我为 scale = 1 运行它时：

archer@mac$ perl print_as_led.pl 0123456789 1
 _     _  _     _  _  _  _  _  
| |  | _| _||_||_ |_   ||_||_|
|_|  ||_  _|  | _||_|  ||_|  |

关于如何让这些按比例放大的任何想法？所以当我运行时：

archer@mac$ perl print_as_led.pl 0123456789 2

我会看见：

 __      __  __      __  __  __  __  __
|  |   |   |   ||  ||   |      ||  ||  |
|  |   | __| __||__||__ |__    ||__||__|
|  |   ||      |   |   ||  |   ||  |   |
|__|   ||__  __|   | __||__|   ||__|   |

任何提示/帮助将不胜感激。我不是想创建一个高尔夫解决方案，只是一个普通的解决方案。

score 1 · Accepted Answer

要水平扩展，您需要重新打印段a、g和d。要垂直扩展，您需要在多行上使用和 with 重新打印段f，b并e在c它们之间留有空格。如果程序的最后一部分如下所示，它将起作用：

print ' ';
foreach ( @nums ) {
    print fill('a', $_) x $scale . '  ';
}
print "\n";
foreach (2..$scale) {
    foreach ( @nums ) {
        print fill('f', $_) . ' ' x $scale . fill('b', $_)
    }
    print "\n";
}
foreach ( @nums ) {
  print fill('f', $_) . fill('g', $_) x $scale . fill('b', $_)
}  
print "\n";
foreach (2..$scale) {
    foreach ( @nums ) {
        print fill('e', $_) . ' ' x $scale . fill('c', $_)
    }
    print "\n";
}
foreach ( @nums ) {
  print fill('e', $_) . fill('d', $_) x $scale . fill('c', $_)
} 
print "\n";

score 0 · Accepted Answer

矫枉过正

我发现了这篇感兴趣的帖子，并决定扩展“7 段显示模式”的概念。我最终编写了一组包，让我可以更好地控制显示。模块化设计很仓促，但效果很好。

正如标题所暗示的那样，编写 hash lookup 所花费的时间要少得多input_char => ascii_image。如果需要许多具有不同样式的显示器或定期更新显示器样式，则很有用。

我需要五个核心信息来提供一个新实例化的对象：

string - 作为输入提供的字符串。
图像模板- 表示单个图像的字符串以及图像中每个片段的位置。
输入 char 到段 ids 查找表- 用于查找要为特定输入字符填充哪些段的哈希。
段 id 到段 char 查找表- 用于查找用于填充特定段的字符的散列。
显示格式- 用于控制显示方向的格式字符串或格式处理程序。

通过提供上述不同的变体，我可以控制显示风格的许多方面。

因为我决定使用图像模板方法，所以它不能直接完成“按比例放大”的原始查询。相反，我提供所需比例的图像模板。如果我想加入一个因素，那么我可以创建一个例程来破译两个以上图像模板之间的模式，然后自动生成所需的图像模板。

请注意，如果我在段 id 和段字符中使用相同的字符，则搜索和替换时的冲突可能会成为问题。

$perl display.pl 0123456789ABCDE

代码：

#!/usr/bin/perl
use strict;
use warnings FATAL => qw/ all /;

##################################################

package display::image_template;

our $roman_small = <<'template';
00000 
0 1 0 
06720 
05430 
00000 
template

our $roman_medium = <<'template';
000000 
0 11 0 
06  20 
067720 
05  30 
054430 
000000 
template

our $roman_large = <<'template';
0000000 
0 111 0 
06   20 
06   20 
0677720 
05   30 
05   30 
0544430 
0000000 
template

our $italic_small = <<'template';
000000 
0   10 
0 6720 
0543 0 
000000 
template

our $italic_medium = <<'template';
000000000 
0     110 
0   6  20 
0  6772 0 
0 5  3  0 
05443   0 
000000000 
template

our $italic_large = <<'template';
000000000000 
0       1110 
0     6   20 
0    6   2 0 
0   67772  0 
0  5   3   0 
0 5   3    0 
054443     0 
000000000000 
template

our $roman_roman_shadow_small = <<'template';
00000 
0 1 0 
06720 
05430 
05730 
06120 
00000 
template

our $roman_italic_shadow_small = <<'template';
000000 
0 1  0 
0672 0 
0543 0 
0D7A 0 
0 C1B0 
000000 
template

##################################################

package display::input_char_to_segment_ids;

our $alphanumeric =
{
    # input_char => segment_ids

    ' ' => [ ],
    0   => [ 0, 1, 2, 3, 4, 5, 6    ],
    1   => [ 0,    2, 3             ],
    2   => [ 0, 1, 2,    4, 5,    7 ],
    3   => [ 0, 1, 2, 3, 4,       7 ],
    4   => [ 0,    2, 3,       6, 7 ],
    5   => [ 0, 1,    3, 4,    6, 7 ],
    6   => [ 0, 1,    3, 4, 5, 6, 7 ],
    7   => [ 0, 1, 2, 3,            ],
    8   => [ 0, 1, 2, 3, 4, 5, 6, 7 ],
    9   => [ 0, 1, 2, 3, 4,    6, 7 ],
    A   => [ 0, 1, 2, 3,    5, 6, 7 ], 
    B   => [ 0, 1, 2, 3, 4, 5, 6, 7 ],
    C   => [ 0, 1,       4, 5, 6,   ],
    D   => [ 0, 1, 2, 3, 4, 5, 6    ],
    E   => [ 0, 1,       4, 5, 6, 7 ],

    # etc
};

our $alphanumeric_shadow = expand_segment_ids( { %$alphanumeric }, { 3 => 'A', 2 => 'B', 6 => 'C', 5 => 'D' } );

sub expand_segment_ids
{
    my ( $input_char_to_segment_ids, $old_segment_id_to_new_segment_id ) = @_;

    while ( my ( $input_char, $segment_ids ) = each %$input_char_to_segment_ids )
    {
       while ( my ( $old_segment_id, $new_segment_id ) = each %$old_segment_id_to_new_segment_id )
       {
          push @$segment_ids, $new_segment_id if grep { $_ eq $old_segment_id } @$segment_ids;
       }
    }

    return $input_char_to_segment_ids;
}

##################################################

package display::segment_id_to_segment_char;

our $roman = 
{
    # segment_id => segment_char

    0 => ' ', # border

    1 => '_',
    2 => '|',
    3 => '|',
    4 => '_',
    5 => '|',
    6 => '|',
    7 => '_',
};

our $italic = 
{
    # segment_id => segment_char

    0 => ' ', # border

    1 => '_',
    2 => '/',
    3 => '/',
    4 => '_',
    5 => '/',
    6 => '/',
    7 => '_',
};

our $roman_italic_shadow = 
{
    # segment_id => segment_char

    0 => ' ', # border

    1 => '_',
    2 => '|',
    3 => '|',
    4 => '_',
    5 => '|',
    6 => '|',
    7 => '_',

    A => '\\',
    B => '\\',
    C => '\\',
    D => '\\',
};

##################################################

package display::display_format;

our $vertical     = undef;

our $horizontal   = sub { return '~~' . '^*' x $_[0] . " \n"; };

our $horizontal_b = sub { formline( '~~' . '^*' x @{$_[1]} . " \n", @{$_[1]} ); return $^A; };

#our $diagonal     = sub { };

##################################################

package display;

# hacky way to generate accessor subroutines.
eval 'sub ' . $_ . ' { if ( $#_ ) { $_[0]->{' . $_ . '} = $_[1]; return $_[0] } else { return $_[0]->{' . $_ . '}; } }' for qw/ string image_template input_char_to_segment_ids segment_id_to_segment_char blank_segment_char images display_format /;

sub new
{
    return bless { }, $_[0];
}

sub execute
{
    my ( $self ) = @_;

    my $string                     = $self->string                     // die 'string required';
    my $image_template             = $self->image_template             // die 'image_template required';
    my $input_char_to_segment_ids  = $self->input_char_to_segment_ids  // die 'input_char_to_segment_ids required';
    my $segment_id_to_segment_char = $self->segment_id_to_segment_char // die 'segment_id_to_segment_char required';
    my $blank_segment_char         = $self->blank_segment_char         // ' ';

    my @images;

    my @input_chars = split //, $string;

    for my $input_char ( @input_chars )
    {
        my $image_template_copy = $image_template;

        my $input_char_segment_ids_list = $input_char_to_segment_ids->{$input_char} // die "cannot retrieve segment ids for input char '$input_char'";
        my %input_char_segment_ids_hash = map { $_ => 1 } @$input_char_segment_ids_list; # instead of repeatedly using grep below.

        while ( my ( $segment_id, $segment_char ) = ( each %$segment_id_to_segment_char ) )
        {
            $segment_char = $blank_segment_char unless exists $input_char_segment_ids_hash{$segment_id};

            $image_template_copy =~ s/$segment_id/$segment_char/eg;
        }

        push @images, $image_template_copy;
    }

    $self->images( \@images );

    return $self;
}

sub display
{
    my ( $self ) = @_;

    my $images         = $self->images         // die 'execute before display in order to construct images';
    my $display_format = $self->display_format;

    my $display;

    if ( defined $display_format )
    {
        $^A = '';

        if ( ref $display_format eq ref sub { } )
        {
            $display = $display_format->( $self, $images );
        }
        else
        {
            formline( $display_format, @$images );
            $display = $^A;
        }
    }
    else
    {
        local $" = "\n";
        $display = "@$images";
    }

    return $display;
}

##################################################

package main;

my $string = shift // '';

my $display = display->new
                     ->string                    ( $string )
                     ->image_template            ( $display::image_template::roman_large )
                     ->input_char_to_segment_ids ( $display::input_char_to_segment_ids::alphanumeric )
                     ->segment_id_to_segment_char( $display::segment_id_to_segment_char::roman )
                     ->display_format            ( $display::display_format::horizontal_b );

print $display->execute->display;

$display->image_template            ( $display::image_template::roman_italic_shadow_small );
$display->segment_id_to_segment_char( $display::segment_id_to_segment_char::roman_italic_shadow );

print $display->execute->display;

##################################################

__END__

输出：

 ___             ___     ___             ___     ___     ___     ___     ___     ___     ___     ___     ___     ___
|   |       |       |       |   |   |   |       |           |   |   |   |   |   |   |   |   |   |       |   |   |
|   |       |       |       |   |   |   |       |           |   |   |   |   |   |   |   |   |   |       |   |   |
|   |       |    ___|    ___|   |___|   |___    |___        |   |___|   |___|   |___|   |___|   |       |   |   |___
|   |       |   |           |       |       |   |   |       |   |   |       |   |   |   |   |   |       |   |   |
|   |       |   |           |       |       |   |   |       |   |   |       |   |   |   |   |   |       |   |   |
|___|       |   |___     ___|       |    ___|   |___|       |   |___|    ___|   |   |   |___|   |___    |___|   |___


 _             _      _             _      _      _      _      _      _      _      _      _      _
| |      |     _|     _|    |_|    |_     |_       |    |_|    |_|    |_|    |_|    |      | |    |_
|_|      |    |_      _|      |     _|    |_|      |    |_|     _|    | |    |_|    |_     |_|    |_
\ \      \    \_      _\     _\     _\    \_\      \    \_\     _\    \_\    \_\    \      \ \    \_
 \_\      \     _\     _\    \ \    \_     \_      _\    \_\    \_\    \_\    \_\    \_     \_\    \_

perl - 按一个因子缩放 ascii 图像

2 回答 2

矫枉过正

Related

Reference