Scale ascii images by a factor

Question

I stumbled upon this code golf challenge: https://codegolf.stackexchange.com/questions/19196/transform-number-into-7-segment-display-pattern

and attempted my own solution, I was able to solve it with a scale of 1 pretty easily; but I cannot figure out how to scale the image properly here is what I have so far. The locations a - f refer to this image, which I how I laid out the display mappings:

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];
}

when I run it for scale = 1:

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

Any thoughts as to how I could get these to scale up by a factor? So when I run:

archer@mac$ perl print_as_led.pl 0123456789 2

I would see:

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

Any tips/help would be appreciated. I am not trying to create a golfed solution, just a regular one.

Answer 1

To expand horizontally, you'll want to reprint segments a, g, and d. To expand vertically, you'll want to reprint segments f with b, and e with c on several lines, and with space in between them. It will work if the last part of your program looks like:

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";

Answer 2

Overkill

I found this post of interest and decided to expand on the concept of "7 segment display patterns". I ended up writing a group of packages which give me finer control over the display. The modular design was rushed, but it works pretty well.

As the title infers, it would have taken me much less time to have written the hash lookup input_char => ascii_image. Although is useful if many displays with varying styles is required or the displays style is regularly updated.

There are five core pieces of information I need to provide a newly instantiated object with:

• string - string of characters supplied as input.
• image template - string that represents an individual image and the position of each segment within the image.
• input char to segment ids lookup table - hash used to lookup which segments to fill in for a particular input character.
• segment id to segment char lookup table - hash used to lookup which character to use to fill in a particular segment.
• display format - format string or format handler to control the orientation of the display.

By providing different variations of the above, I can control many aspects of the displays style.

Because I decided to use the image template approach, its not as straight forward to fulfill the original query of "scale up by a factor". Instead I provide the image template in the desired scale. If I wanted to incorporate a factor, then I could possibly create a routine that deciphers the pattern between two+ image templates then automatically generates the desired image template.

Note that conflicts when searching and replacing may become an issue if I use the same characters in segment ids and segment characters.

$perl display.pl 0123456789ABCDE

Code:

#!/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__

Output:

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


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