root/paper-tape-project/trunk/perl-tools/label-it

#!/usr/bin/perl
#
# Gibt alle Parameter als "Schrift" auf Lochstreifen (stdout) aus.
#

my $debug = 0;

my %letters = (# 12345678
    'a' => ['********',
            '   *   *',
            '   *   *',
            '********'],
    'b' => ['********',
            '*  *   *',
            '*  *   *',
            '******* '],
    'c' => ['********',
            '*      *',
            '*      *'],
    'd' => ['********',
            '*      *',
            '*      *',
            ' ****** '],
    'e' => ['********',
            '*   *  *',
            '*   *  *'],
    'f' => ['********',
            '    *  *',
            '    *  *'],
    'g' => ['********',
            '*      *',
            '*   *  *',
            '*****  *'],
    'h' => ['********',
            '    *   ',
            '********'],
    'i' => ['*      *',
            '********',
            '*      *'],
    'j' => ['***    *',
            '*      *',
            '********'],
    'k' => ['********',
            '   **   ',
            '***   **'],
    'l' => ['********',
            '*       ',
            '*       '],
    'm' => ['********',
            '       *',
            '     ** ',
            '       *',
            '********'],
    'n' => ['********',
            '      * ',
            '  ****  ',
            ' *      ',
            '********'],
    'o' => ['********',
            '*      *',
            '********'],
    'p' => ['********',
            '   *   *',
            '   *****'],
    'q' => ['********',
            '*      *',
            '**     *',
            '********'],
    'r' => ['********',
            '   *   *',
            '*** ****'],
    's' => ['    ****',
            '*   *  *',
            '*****  *'],
    't' => ['       *',
            '********',
            '       *'],
    'u' => ['********',
            '*       ',
            '********'],
    'v' => ['  ******',
            '*       ',
            '  ******'],
    'w' => ['  ******',
            '*       ',
            ' *      ',
            '*       ',
            '  ******'],
    'x' => ['***   **',
            '   ***  ',
            '***   **'],
    'y' => ['    ****',
            '*   *   ',
            ' *******'],
    'z' => ['**     *',
            '*  *** *',
            '*     **'],
    '1' => ['      * ',
            '********'],
    '2' => ['**    * ',
            '*  **  *',
            '*    ***'],
    '3' => ['*  *   *',
            '*  *   *',
            '********'],
    '4' => ['    ****',
            '    *   ',
            '********',
            '    *   '],
    '5' => ['*  *****',
            '*  *   *',
            '*  *   *',
            '****   *'],
    '6' => ['  ****  ',
            '***   * ',
            '*  *   *',
            '****  * '],
    '7' => ['       *',
            '   *   *',
            '********'],
    '8' => ['********',
            '*  *   *',
            '********'],
    '9' => ['   *****',
            '   *   *',
            '********'],
    '0' => ['*********',
            '*       *',
            '*  ***  *',
            '*       *',
            '*********']
);

$x = 0; # ARGV-Counter
foreach (@ARGV) {
    # vor wort ein Leerzeichen lassen wenns nicht das erste ist
    print pack("C", 0) x 2 unless($x++ == 0);

    #print STDERR "Parameter $_:\n" if $debug;
    foreach(my $cpos=0; $cpos < length; $cpos++) {
        my $char = lc substr $_, $cpos, 1;
        print STDERR "Zeichen $char:\n" if $debug;
        unless(exists $letters{$char}) {
            print STDERR "Buchstabe $char kann nicht gedruckt werden\n";
            next;
        }

        # anonymes Array einlesen und jeweils string zu octett formen
        foreach (@{$letters{$char}}) {
            my $byte = 0;
            $byte +=   1 if(isPunched($_, 0));
            $byte +=   2 if(isPunched($_, 1));
            $byte +=   4 if(isPunched($_, 2));
            $byte +=   8 if(isPunched($_, 3));
            $byte +=  16 if(isPunched($_, 4));
            $byte +=  32 if(isPunched($_, 5));
            $byte +=  64 if(isPunched($_, 6));
            $byte += 128 if(isPunched($_, 7));
            my $pack = pack("C", $byte);
            printf STDERR "$_: Zahl = $byte = $pack = %d\n", $pack if $debug;
            print $pack;
        } # foreach zeichenreihe
        # Nach Zeichen eine Reihe Platz lassen:
        print pack("C", 0);
    } # foreach zeichen
} # foreach parameter

sub isPunched { return substr($_[0], $_[1], 1) eq '*'; }