source: projects/schriften/neue-schrift.pl @ 7

Last change on this file since 7 was 1, checked in by sven, 16 years ago

Erstimport

File size: 7.4 KB
Line 
1#!/usr/bin/perl
2#
3# Neue Schrift. Besseres Programm ;)
4# 05.04.2008
5#
6# nimmt Zeichen per Parameter oder (wenn keine angegeben sind)
7# per STDIN an (NLs werden dann zu Leerzeichen).
8#
9# Wenn eingebunden von anderem Perl-Script, dann laeuft das Script
10# nicht sofort los, sondern stellt die Funktion
11#
12#   check_string($string);
13#      checkt $string auf nicht-druckbare Zeichen und gibt, wenn es
14#      welche gibt false zurück, sonst true.
15#
16#   label($string);
17#      Gibt einen Byte-String (Bytearray) mit dem "kompilierten"
18#      $string als Zeichenkette zurueck.
19#
20
21use strict;
22
23my $run_as_library = ($0 ne __FILE__);
24my $debug = 0;
25
26my %letters = (# 12345
27          ' ' => ['     ',
28                  '     ',
29                  '     '],
30
31          'a' => ['++++ ',
32                  '  + +',
33                  '  + +',
34                  '++++ '],
35          'b' => ['+++++',
36                  '+ + +',
37                  '+ + +',
38                  ' +++ '],
39          'c' => [' +++ ',
40                  '+   +',
41                  '+   +',
42                  '+   +'],
43          'd' => ['+++++',
44                  '+   +',
45                  '+   +',
46                  ' +++ '],
47          'e' => ['+++++',
48                  '+ + +',
49                  '+ + +',
50                  '+ + +'],
51          'f' => ['+++++',
52                  '  + +',
53                  '  + +',
54                  '  + +'],
55          'g' => [' +++ ',
56                  '+   +',
57                  '+ + +',
58                  ' ++ +'],
59          'h' => ['+++++',
60                  '  +  ',
61                  '  +  ',
62                  '+++++'],
63          'i' => ['+   +',
64                  '+++++',
65                  '+   +'],
66          'j' => [' +  +',
67                  '+   +',
68                  '+   +',
69                  ' ++++'],
70          'k' => ['+++++',
71                  '  +  ',
72                  ' + + ',
73                  '+   +'],
74          'l' => ['+++++',
75                  '+    ',
76                  '+    ',
77                  '+    '],
78          'm' => ['+++++',
79                  '   + ',
80                  '  +  ',
81                  '   + ',
82                  '+++++'],
83          'n' => ['+++++',
84                  '   + ',
85                  '  +  ',
86                  ' +   ',
87                  '+++++'],
88          'o' => [' +++ ',
89                  '+   +',
90                  '+   +',
91                  ' +++ '],
92          'p' => ['+++++',
93                  ' +  +',
94                  ' +  +',
95                  '  ++ '],
96          'q' => [' +++ ',
97                  '+   +',
98                  '++  +',
99                  '++++ '],
100          'r' => ['+++++',
101                  '  + +',
102                  ' ++ +',
103                  '+  + '],
104          's' => ['+  + ',
105                  '+ + +',
106                  ' +  +'],
107          't' => ['    +',
108                  '+++++',
109                  '    +'],
110          'u' => [' ++++',
111                  '+    ',
112                  '+    ',
113                  ' ++++'],
114          'v' => [' ++++',
115                  '+    ',
116                  ' ++++'],
117          'w' => [' ++++',
118                  '+    ',
119                  ' +   ',
120                  '+    ',
121                  ' ++++'],
122          'x' => ['+   +',
123                  ' + + ',
124                  '  +  ',
125                  ' + + ',
126                  '+   +'],
127          'y' => ['    +',
128                  '   + ',
129                  '+++  ',
130                  '   + ',
131                  '    +'],
132          'z' => ['+   +',
133                  '++  +',
134                  '+ + +',
135                  '+  ++',
136                  '+   +'],
137
138          '0' => ['+++++',
139                  '+   +',
140                  '+++++'],
141          '1' => ['     ',
142                  '     ',
143                  '+++++'],
144          '2' => ['+++ +',
145                  '+ + +',
146                  '+ +++'],
147          '3' => ['+ + +',
148                  '+ + +',
149                  '+++++'],
150          '4' => ['  +++',
151                  '  +  ',
152                  '+++++'],
153          '5' => ['+ +++',
154                  '+ + +',
155                  '+++ +'],
156          '6' => ['+++++',
157                  '+ + +',
158                  '+++ +'],
159          '7' => ['    +',
160                  '    +',
161                  '+++++'],
162          '8' => ['+++++',
163                  '+ + +',
164                  '+++++'],
165          '9' => ['+ +++',
166                  '+ + +',
167                  '+++++'],
168          '(' => ['  +  ',
169                  ' + + ',
170                  '+   +'],
171          '<' => ['  +  ',
172                  ' + + ',
173                  '+   +'],
174          ')' => ['+   +',
175                  ' + + ',
176                  '  +  '],
177          '>' => ['+   +',
178                  ' + + ',
179                  '  +  '],
180          '.' => ['++   ',
181                  '++   '],
182          '!' => ['   ++',
183                  '+ +++',
184                  '   ++'],
185          '?' => ['    +',
186                  '+ + +',
187                  '   ++'],
188          ':' => ['++ ++',
189                  '++ ++'],
190          '-' => ['  +  ',
191                  '  +  ',
192                  '  +  ']
193);
194
195# String kriegen
196my $string; # gut, eigentlich nur fuer !$run_as_library, aber use strict will's so.
197unless($run_as_library) {
198    if(@ARGV) {
199        my $x=0; # ARGV-Counter
200        $string .= ($x++ == 0 ? '' : ' ').$_ for(@ARGV);
201    } else {
202        $string = join(' ', <STDIN>);
203    }
204    $string =~ s/\s+|\n+/ /g; # immer nur ein Leerzeichen!
205    chomp $string;
206}
207
208# Funktion fuer Library, benutzen wir hier so nicht.
209sub check_string {
210    #my $string = lc shift;
211    #$string =~ s/\s+|\n+/ /g; # immer nur ein Leerzeichen!
212    # durchgehen und Zeicen checken
213    #my $out;
214    my $r = 1;
215    for (split //, $string) {
216        unless(exists $letters{$_}) {
217            print STDERR "Buchstabe $_ kann nicht gedruckt werden!\n";
218            $r = 0;
219        }# else {
220         #   $out .= $_;
221        #}
222    }
223    return $r;
224    #return $out;
225}
226
227unless($run_as_library) {
228    print STDERR "String: $string\n" if $debug;
229    print label($string);
230}
231
232sub label {
233    my $string = shift;
234    my $bytes = '';
235
236    # Zeichen durchgehen.
237    my @s = map(lc, split(//, $string));
238    #for(my $x=0, my $c; $c = $s[x], $x < length(@s); $x++) { # sowas wie foreach(@s)
239    my $x=0;
240    for (@s) {
241        print STDERR "Zeichen $_ ($x/",scalar(@s)-1,")\n" if $debug;
242   
243        unless(exists $letters{$_}) {
244            print STDERR "Buchstabe $_ kann nicht gedruckt werden!\n";
245            next;
246        }
247   
248        # schauen was wir vor dem Zeichen tun
249        if($x) { # beim ersten noch nichts
250            $bytes .= pack("C", 0); # eine Reihe Abstand.
251        }
252   
253        # Byte generieren:
254        # anonymes Array einlesen und jeweils string zu octett formen
255        for (@{$letters{$_}}) {
256            my $byte = 0;
257            #$byte +=   1 if(isPunched($_, 0)); # die ersten drei
258            #$byte +=   2 if(isPunched($_, 1)); # Bit sind bei dieser
259            #$byte +=   4 if(isPunched($_, 2)); # Schrift immer 0
260            $byte +=   8 if(isPunched($_, 0));
261            $byte +=  16 if(isPunched($_, 1));
262            $byte +=  32 if(isPunched($_, 2));
263            $byte +=  64 if(isPunched($_, 3));
264            $byte += 128 if(isPunched($_, 4));
265            my $pack = pack("C", $byte);
266            #printf STDERR "$_: Zahl = $byte = $pack = %d\n", $pack if $debug;
267            $bytes .= $pack;
268        } # for octett
269    } continue { $x++ } # for @s
270    return $bytes;
271} # sub label
272
273sub isPunched { return substr($_[0], $_[1], 1) ne ' '; }
274
Note: See TracBrowser for help on using the repository browser.
© 2008 - 2013 technikum29 • Sven Köppel • Some rights reserved
Powered by Trac
Expect where otherwise noted, content on this site is licensed under a Creative Commons 3.0 License