Peter
Peter Campbell Smith

Slicing and dicing
a double century

Weekly challenge 200 — 16 January 2023

Week 200 - 16 Jan 2023

Task 2

Task — Seven segment 200

A seven segment display is an electronic component, usually used to display digits. The segments are labeled 'a' through 'g' as shown:

The encoding of each digit can thus be represented compactly as a truth table:

my @truth = qw<abcdef bc abdeg abcdg bcfg acdfg acdefg abc abcdefg abcfg>;

For example, $truth[1] = ‘bc’. The digit 1 would have segments ‘b’ and ‘c’ enabled.

Write a program that accepts any decimal number and draws that number as a horizontal sequence of ASCII seven segment displays similar to the one shown below.

To qualify as a seven segment display, each segment must be drawn (or not drawn) according to your @truth table. The number "200" was of course chosen to celebrate our 200th week!

Examples


-------  -------  -------
      |  |     |  |     |
      |  |     |  |     |
-------
|        |     |  |     |
|        |     |  |     |
-------  -------  -------

Analysis

Given a digit to display, the truth table tells us which segments to 'light up', for example 'abdeg' for 2. We need to start with a blank 7x7 matrix and populate the appropriate positions with a symbol: either | or —. I decided to do that using another lookup table, which I created like this:

$digit[ord('a')] = '-00 -01 -02 -03 -04 -05 -06';
$digit[ord('b')] = '|16 |26';
$digit[ord('c')] = '|46 |56';
$digit[ord('d')] = '-60 -61 -62 -63 -64 -65 -66';
$digit[ord('e')] = '|40 |50';
$digit[ord('f')] = '|10 |20';
$digit[ord('g')] = '-30 -31 -32 -33 -34 -35 -36';

For each letter, a to g, I can then determine the symbol and the positions needed, for example 'a' needs a '-' in row 0, column 0; in row 0 column 1 and so on.

I build up the display in an 2-dimensional array @display, which is 7 rows high and 10n characters wide, where n is the number of digits to be displayed (10 rather than 7 to allow three blanks between successive digits). And this is how I do it:

$segments = $truth[$1];
while ($segments =~ m|(.)|g) {
    $points = $digit[ord($1)];
    while ($points =~ m|(.)(\d)(\d)|g) {
        $display[$2][$3 + $offset] = $1;
    }
}

Then it's just a case of printing @display with a \n after each row.

Try it 

Try running the script with any input:



example: 1066

Script


#!/usr/bin/perl

# Peter Campbell Smith - 2023-01-16
# PWC 200 task 2

use v5.28;
use utf8;
use warnings;
binmode STDOUT, ':utf8';

# Task: Write a program that accepts any positive integer and draws that number as a horizontal sequence of
# ASCII seven segment displays.

my (@tests, @truth, $test, @digit, @display, $offset, $points, $row, $column, $segments, $segment);

@truth = qw[abcdef bc abdeg abcdg bcfg acdfg acdefg abc abcdefg abcfg];

@tests = (200, 31415926535, 9876543210);

# each digit is 7 lines high and 7 characters wide
# each digit starts 10 characters further right than the previous one

# create digits => character . row . column
$digit[ord('a')] = '—00 —01 —02 —03 —04 —05 —06';
$digit[ord('b')] = '│16 │26';
$digit[ord('c')] = '│46 │56';
$digit[ord('d')] = '—60 —61 —62 —63 —64 —65 —66';
$digit[ord('e')] = '│40 │50';
$digit[ord('f')] = '│10 │20';
$digit[ord('g')] = '—30 —31 —32 —33 —34 —35 —36';

# loop over tests
for $test (@tests) {
    @display = ();
    $offset = 0;
    
    # blank display
    for $row (0 .. 6) {
        for $column (0 .. length($test) * 10) {
            $display[$row][$column] = ' ';
        }
    }
    
    # loop over digits in $test and blank area of display
    while ($test =~ m|(.)|g) {   # digit
        
        # loop over segments for this digit
        $segments = $truth[$1];
        
        # draw these segments in $display
        while ($segments =~ m|(.)|g) {
            $points = $digit[ord($1)];
            while ($points =~ m|(.)(\d)(\d)|g) {
                $display[$2][$3 + $offset] = $1;
            }
        }
        
        # move right 10 characters width (7 for digit plus 3 blank)
        $offset += 10;
    }
    
    # show the display
    say qq[\nInput:  $test\nOutput:];
    for $row (0 .. 6) {
        for $column (0 .. $offset - 2) {
            print $display[$row][$column];
        }
        say '';
    }
}   


Output


Input:  200
Output:
———————   ———————   ———————
      │   │     │   │     │
      │   │     │   │     │
———————
│         │     │   │     │
│         │     │   │     │
———————   ———————   ———————

Input:  31415926535
Output:
———————                                 ———————   ———————   ———————   ———————   ———————   ———————   ———————
      │         │   │     │         │   │         │     │         │   │         │               │   │
      │         │   │     │         │   │         │     │         │   │         │               │   │
———————             ———————             ———————   ———————   ———————   ———————   ———————   ———————   ———————
      │         │         │         │         │         │   │         │     │         │         │         │
      │         │         │         │         │         │   │         │     │         │         │         │
———————                                 ———————             ———————   ———————   ———————   ———————   ———————

Input:  9876543210
Output:
———————   ———————   ———————   ———————   ———————             ———————   ———————             ———————
│     │   │     │         │   │         │         │     │         │         │         │   │     │
│     │   │     │         │   │         │         │     │         │         │         │   │     │
———————   ———————             ———————   ———————   ———————   ———————   ———————
      │   │     │         │   │     │         │         │         │   │               │   │     │
      │   │     │         │   │     │         │         │         │   │               │   │     │
          ———————             ———————   ———————             ———————   ———————             ———————