--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/interps/clc-intercal/CLC-INTERCAL-Base-1.-94.-2/INTERCAL/Charset/Baudot.pm	Sun Dec 09 19:30:08 2012 +0000
@@ -0,0 +1,167 @@
+package Language::INTERCAL::Charset::Baudot;
+
+# Convert between Baudot and ASCII
+
+# This file is part of CLC-INTERCAL.
+
+# Copyright (C) 1999, 2000, 2002, 2006-2008 Claudio Calvelli, all rights reserved
+
+# CLC-INTERCAL is copyrighted software. However, permission to use, modify,
+# and distribute it is granted provided that the conditions set out in the
+# licence agreement are met. See files README and COPYING in the distribution.
+
+use strict;
+use vars qw($VERSION $PERVERSION);
+($VERSION) = ($PERVERSION = "CLC-INTERCAL/Base INTERCAL/Charset/Baudot.pm 1.-94.-2") =~ /\s(\S+)$/;
+
+use Carp;
+use Language::INTERCAL::Exporter '1.-94.-2';
+use Language::INTERCAL::Splats '1.-94.-2', qw(:SP);
+use vars qw(@EXPORT @EXPORT_OK);
+@EXPORT = ();
+@EXPORT_OK = qw(ascii2baudot baudot2ascii);
+
+my @charset = (
+	"\000E\nA SIU\rDRJNFCKTZWLHYPQOBG2MXV1",
+	"\000e\na siu\rdrjnfcktzwlhypqobg2mxv1",
+	"\0003\n- \a87\r\$4',!:(5\")2 6019?&3./;0",
+	"\000\242\n+\t\\#=\r*{~\245|^<[}>]\b@\253\243\254\377\2613%_\2730",
+);
+
+my $charset = join('', map { "\000" . substr($_, 1, 26) .
+			     "\000" . substr($_, 28, 3) . "\000" }
+		           @charset);
+push @charset, '';
+
+sub baudot2ascii {
+    @_ == 1 or croak "Usage: baudot2ascii(STRING)";
+    my $string = shift;
+    my $set = 0;
+    my $result = '';
+    while ($string ne '') {
+    	my $chr = ord($string) & 037;
+	$string = substr($string, 1);
+	if ($chr == 033 || $chr == 037) {
+	    $set = ord(substr($charset[$set], $chr, 1)) & 03;
+	} else {
+	    $result .= substr($charset[$set], $chr, 1);
+	}
+    }
+    $result;
+}
+
+sub ascii2baudot {
+    @_ == 1 or @_ == 2 or croak "Usage: ascii2baudot(STRING)";
+    my $string = shift;
+    my $faint = @_ ? shift : 1;
+    my $set = 4;
+    my $result = '';
+    while ($string ne '') {
+    	my $chr = substr($string, 0, 1);
+	$string = substr($string, 1);
+	my $pos = index($charset[$set], $chr);
+	if ($pos < 0 || $pos == 033 || $pos == 037) {
+	    $pos = index($charset, $chr);
+	    if ($pos < 0 || $chr eq "\000") {
+		faint(SP_NOSUCHCHAR, ord($chr), "Baudot") if $faint;
+		$string = sprintf("\\%03o", ord($chr)) . $string;
+		next;
+	    }
+	    my $s = $pos >> 5;
+	    $pos = $pos & 037;
+	    if ($set > 3) {
+		$result .= ['[_', '__', '_[', '[[']->[$s];
+	    } else {
+		$result .= ['', '_', '[', '[[',
+			    '[_', '', '[', '[[',
+			    '_', '__', '', '[[',
+			    '_', '__', '_[', '',
+			   ]->[($set << 2) | $s];
+	    }
+	    $set = $s;
+	}
+	$result .= sprintf("%c", 0x40 + $pos);
+    }
+    $result;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Charset::Baudot - allows to use Baudot string constants in ASCII programs (and v.v.)
+
+=head1 SYNOPSIS
+
+    use Charset::Baudot 'baudot2ascii';
+
+    my $a = baudot2ascii"(Baudot text)";
+
+=head1 DESCRIPTION
+
+I<Charset::Baudot> defines functions to convert between a subset of ASCII and a
+subset of nonstandard Baudot - the original Baudot allows only letters,
+numbers, and some punctuation. We assume that a "Shift to letters" code
+while already in letters mode means "Shift to lowercase" and "Shift to
+figures" while already in figures mode means "Shift to symbols". This allows
+to use up to 120 characters. However, for simplicity some characters are
+available in multiple sets, so the total is less than that.
+
+Two functions, I<baudot2ascii> and I<ascii2baudot>, are exportable (but
+not exported by default). They do the obvious thing to their first argument
+and return the transformed string.
+
+=head1 BAUDOT CHARACTER TABLE
+
+The following are the characters recognised. As described, the "shift"
+characters have nonstandard meaning.
+
+     set   Letters     Lowercase    Figures    Symbols
+  code
+    00       N/A          N/A         N/A        N/A
+    01        E            e           3        Cents
+    02       L/F          L/F         L/F        L/F    (line feed)
+    03        A            a           -          +
+    04      Space        Space       Space       Tab
+    05        S            s          BELL        \
+    06        I            i           8          #
+    07        U            u           7          =
+    08       C/R          C/R         C/R        C/R    (carriage return)
+    09        D            d           $          *
+    10        R            r           4          {
+    11        J            j           '          ~
+    12        N            n           ,         XOR
+    13        F            f           !          |
+    14        C            c           :          ^
+    15        K            k           (          <
+    16        T            t           5          [
+    17        Z            z           "          }
+    18        W            w           )          >
+    19        L            l           2          ]
+    20        H            h          N/A     backspace
+    21        Y            y           6          @
+    22        P            p           0         N/A
+    23        Q            q           1        POUND
+    24        O            o           9         NOT
+    25        B            b           ?        delete
+    26        G            g           &         N/A
+    27     Figures      Figures     Symbols    Symbols
+    28        M            m           .          %
+    29        X            x           /          _
+    30        V            v           ;         N/A
+    31    Lowercase    Lowercase    Letters    Letters
+
+=head1 COPYRIGHT
+
+This module is part of CLC-INTERCAL.
+
+Copyright (C) 1999, 2000, 2002, 2006, 2007 Claudio Calvelli, all rights reserved
+
+See files README and COPYING in the distribution for information.
+
+=head1 SEE ALSO
+
+A qualified psychiatrist.
+