|
996
|
1 package Language::INTERCAL::Charset::Baudot;
|
|
|
2
|
|
|
3 # Convert between Baudot and ASCII
|
|
|
4
|
|
|
5 # This file is part of CLC-INTERCAL.
|
|
|
6
|
|
|
7 # Copyright (C) 1999, 2000, 2002, 2006-2008 Claudio Calvelli, all rights reserved
|
|
|
8
|
|
|
9 # CLC-INTERCAL is copyrighted software. However, permission to use, modify,
|
|
|
10 # and distribute it is granted provided that the conditions set out in the
|
|
|
11 # licence agreement are met. See files README and COPYING in the distribution.
|
|
|
12
|
|
|
13 use strict;
|
|
|
14 use vars qw($VERSION $PERVERSION);
|
|
|
15 ($VERSION) = ($PERVERSION = "CLC-INTERCAL/Base INTERCAL/Charset/Baudot.pm 1.-94.-2") =~ /\s(\S+)$/;
|
|
|
16
|
|
|
17 use Carp;
|
|
|
18 use Language::INTERCAL::Exporter '1.-94.-2';
|
|
|
19 use Language::INTERCAL::Splats '1.-94.-2', qw(:SP);
|
|
|
20 use vars qw(@EXPORT @EXPORT_OK);
|
|
|
21 @EXPORT = ();
|
|
|
22 @EXPORT_OK = qw(ascii2baudot baudot2ascii);
|
|
|
23
|
|
|
24 my @charset = (
|
|
|
25 "\000E\nA SIU\rDRJNFCKTZWLHYPQOBG2MXV1",
|
|
|
26 "\000e\na siu\rdrjnfcktzwlhypqobg2mxv1",
|
|
|
27 "\0003\n- \a87\r\$4',!:(5\")2 6019?&3./;0",
|
|
|
28 "\000\242\n+\t\\#=\r*{~\245|^<[}>]\b@\253\243\254\377\2613%_\2730",
|
|
|
29 );
|
|
|
30
|
|
|
31 my $charset = join('', map { "\000" . substr($_, 1, 26) .
|
|
|
32 "\000" . substr($_, 28, 3) . "\000" }
|
|
|
33 @charset);
|
|
|
34 push @charset, '';
|
|
|
35
|
|
|
36 sub baudot2ascii {
|
|
|
37 @_ == 1 or croak "Usage: baudot2ascii(STRING)";
|
|
|
38 my $string = shift;
|
|
|
39 my $set = 0;
|
|
|
40 my $result = '';
|
|
|
41 while ($string ne '') {
|
|
|
42 my $chr = ord($string) & 037;
|
|
|
43 $string = substr($string, 1);
|
|
|
44 if ($chr == 033 || $chr == 037) {
|
|
|
45 $set = ord(substr($charset[$set], $chr, 1)) & 03;
|
|
|
46 } else {
|
|
|
47 $result .= substr($charset[$set], $chr, 1);
|
|
|
48 }
|
|
|
49 }
|
|
|
50 $result;
|
|
|
51 }
|
|
|
52
|
|
|
53 sub ascii2baudot {
|
|
|
54 @_ == 1 or @_ == 2 or croak "Usage: ascii2baudot(STRING)";
|
|
|
55 my $string = shift;
|
|
|
56 my $faint = @_ ? shift : 1;
|
|
|
57 my $set = 4;
|
|
|
58 my $result = '';
|
|
|
59 while ($string ne '') {
|
|
|
60 my $chr = substr($string, 0, 1);
|
|
|
61 $string = substr($string, 1);
|
|
|
62 my $pos = index($charset[$set], $chr);
|
|
|
63 if ($pos < 0 || $pos == 033 || $pos == 037) {
|
|
|
64 $pos = index($charset, $chr);
|
|
|
65 if ($pos < 0 || $chr eq "\000") {
|
|
|
66 faint(SP_NOSUCHCHAR, ord($chr), "Baudot") if $faint;
|
|
|
67 $string = sprintf("\\%03o", ord($chr)) . $string;
|
|
|
68 next;
|
|
|
69 }
|
|
|
70 my $s = $pos >> 5;
|
|
|
71 $pos = $pos & 037;
|
|
|
72 if ($set > 3) {
|
|
|
73 $result .= ['[_', '__', '_[', '[[']->[$s];
|
|
|
74 } else {
|
|
|
75 $result .= ['', '_', '[', '[[',
|
|
|
76 '[_', '', '[', '[[',
|
|
|
77 '_', '__', '', '[[',
|
|
|
78 '_', '__', '_[', '',
|
|
|
79 ]->[($set << 2) | $s];
|
|
|
80 }
|
|
|
81 $set = $s;
|
|
|
82 }
|
|
|
83 $result .= sprintf("%c", 0x40 + $pos);
|
|
|
84 }
|
|
|
85 $result;
|
|
|
86 }
|
|
|
87
|
|
|
88 1;
|
|
|
89
|
|
|
90 __END__
|
|
|
91
|
|
|
92 =head1 NAME
|
|
|
93
|
|
|
94 Charset::Baudot - allows to use Baudot string constants in ASCII programs (and v.v.)
|
|
|
95
|
|
|
96 =head1 SYNOPSIS
|
|
|
97
|
|
|
98 use Charset::Baudot 'baudot2ascii';
|
|
|
99
|
|
|
100 my $a = baudot2ascii"(Baudot text)";
|
|
|
101
|
|
|
102 =head1 DESCRIPTION
|
|
|
103
|
|
|
104 I<Charset::Baudot> defines functions to convert between a subset of ASCII and a
|
|
|
105 subset of nonstandard Baudot - the original Baudot allows only letters,
|
|
|
106 numbers, and some punctuation. We assume that a "Shift to letters" code
|
|
|
107 while already in letters mode means "Shift to lowercase" and "Shift to
|
|
|
108 figures" while already in figures mode means "Shift to symbols". This allows
|
|
|
109 to use up to 120 characters. However, for simplicity some characters are
|
|
|
110 available in multiple sets, so the total is less than that.
|
|
|
111
|
|
|
112 Two functions, I<baudot2ascii> and I<ascii2baudot>, are exportable (but
|
|
|
113 not exported by default). They do the obvious thing to their first argument
|
|
|
114 and return the transformed string.
|
|
|
115
|
|
|
116 =head1 BAUDOT CHARACTER TABLE
|
|
|
117
|
|
|
118 The following are the characters recognised. As described, the "shift"
|
|
|
119 characters have nonstandard meaning.
|
|
|
120
|
|
|
121 set Letters Lowercase Figures Symbols
|
|
|
122 code
|
|
|
123 00 N/A N/A N/A N/A
|
|
|
124 01 E e 3 Cents
|
|
|
125 02 L/F L/F L/F L/F (line feed)
|
|
|
126 03 A a - +
|
|
|
127 04 Space Space Space Tab
|
|
|
128 05 S s BELL \
|
|
|
129 06 I i 8 #
|
|
|
130 07 U u 7 =
|
|
|
131 08 C/R C/R C/R C/R (carriage return)
|
|
|
132 09 D d $ *
|
|
|
133 10 R r 4 {
|
|
|
134 11 J j ' ~
|
|
|
135 12 N n , XOR
|
|
|
136 13 F f ! |
|
|
|
137 14 C c : ^
|
|
|
138 15 K k ( <
|
|
|
139 16 T t 5 [
|
|
|
140 17 Z z " }
|
|
|
141 18 W w ) >
|
|
|
142 19 L l 2 ]
|
|
|
143 20 H h N/A backspace
|
|
|
144 21 Y y 6 @
|
|
|
145 22 P p 0 N/A
|
|
|
146 23 Q q 1 POUND
|
|
|
147 24 O o 9 NOT
|
|
|
148 25 B b ? delete
|
|
|
149 26 G g & N/A
|
|
|
150 27 Figures Figures Symbols Symbols
|
|
|
151 28 M m . %
|
|
|
152 29 X x / _
|
|
|
153 30 V v ; N/A
|
|
|
154 31 Lowercase Lowercase Letters Letters
|
|
|
155
|
|
|
156 =head1 COPYRIGHT
|
|
|
157
|
|
|
158 This module is part of CLC-INTERCAL.
|
|
|
159
|
|
|
160 Copyright (C) 1999, 2000, 2002, 2006, 2007 Claudio Calvelli, all rights reserved
|
|
|
161
|
|
|
162 See files README and COPYING in the distribution for information.
|
|
|
163
|
|
|
164 =head1 SEE ALSO
|
|
|
165
|
|
|
166 A qualified psychiatrist.
|
|
|
167
|
