~ubuntu-branches/ubuntu/trusty/clc-intercal/trusty-proposed

« back to all changes in this revision

Viewing changes to INTERCAL/Charset/Baudot.pm

  • Committer: Bazaar Package Importer
  • Author(s): Mark Brown
  • Date: 2006-10-08 13:30:54 UTC
  • mfrom: (1.1.1 upstream) (3.1.1 dapper)
  • Revision ID: james.westby@ubuntu.com-20061008133054-fto70u71yoyltr3m
Tags: 1:1.0~2pre1.-94.-4.1-1
* New upstream release.
* Change to dh_installman.

Show diffs side-by-side

added added

removed removed

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