src/Modules/upsidedown.pl

   1 #upsidedown.pl: display a string in pseudo-upsidedown utf-8 characters
   2 #       Author: Tim Riker
   3 #    Licensing: Artistic License
   4 #      Version: v0.1 (20080425)
   5 #
   6 # taken from http://www.xs4all.nl/~johnpc/uniud/uniud-0.14.tar.gz
   7 #
   8 # NOTICE: This source contains UTF-8 unicode characters, but only in the
   9 # comments. You can safely remove them if your editor barfs on them.
  10
  11 use strict;
  12 use utf8;
  13 use PerlIO;
  14 use Getopt::Long qw(:config nopermute bundling auto_help);
  15 use Pod::Usage;
  16 use vars qw($VERSION);
  17
  18 $VERSION = 0.14;
  19
  20 package upsidedown;
  21
  22 #die "huh?" unless ${^UNICODE} == 127; # force -CSDAL
  23
  24 my %updown = (
  25     ' ' => ' ',
  26     '!' => "\x{00a1}",          # ¡
  27     '"' => "\x{201e}",          # „
  28     '#' => '#',
  29     '$' => '$',
  30     '%' => '%',
  31     '&' => "\x{214b}",          # ⅋
  32     "'" => "\x{0375}",          # ͵
  33     '(' => ')',
  34     ')' => '(',
  35     '*' => '*',
  36     '+' => '+',
  37     ',' => "\x{2018}",          # ‘
  38     '-' => '-',
  39     '.' => "\x{02d9}",          # ˙
  40     '/' => '/',
  41     '0' => '0',
  42     '1' => "\x{002c}\x{20d3}",  # ,⃓ can be improved
  43     '2' => "\x{10f7}",          # ჷ
  44     '3' => "\x{03b5}",          # ε
  45     '4' => "\x{21c1}\x{20d3}",  # ⇁⃓ can be improved
  46     '5' => "\x{1515}",          # ᔕ or maybe just "S"
  47     '6' => '9',
  48     '7' => "\x{005f}\x{0338}",  # _̸
  49     '8' => '8',
  50     '9' => '6',
  51     ':' => ':',
  52     ';' => "\x{22c5}\x{0315}",  # ⋅̕ sloppy, should be improved
  53     '<' => '>',
  54     '=' => '=',
  55     '>' => '<',
  56     '?' => "\x{00bf}",          # ¿
  57     '@' => '@',                 # can be improved
  58     'A' => "\x{13cc}",          # Ꮜ
  59     'B' => "\x{03f4}",          # ϴ can be improved
  60     'C' => "\x{0186}",          # Ɔ
  61     'D' => 'p',                 # should be an uppercase D!!
  62     'E' => "\x{018e}",          # Ǝ
  63     'F' => "\x{2132}",          # Ⅎ
  64     'G' => "\x{2141}",          # ⅁
  65     'H' => 'H',
  66     'I' => 'I',
  67     'J' => "\x{017f}\x{0332}",  # ſ̲
  68     'K' => "\x{029e}",          # ʞ should be an uppercase K!!
  69     'L' => "\x{2142}",          # ⅂
  70     'M' => "\x{019c}",          # Ɯ or maybe just "W"
  71     'N' => 'N',
  72     'O' => 'O',
  73     'P' => 'd',                 # should be uppercase P
  74     'Q' => "\x{053e}",          # Ծ can be improved
  75     'R' => "\x{0222}",          # Ȣ can be improved
  76     'S' => 'S',
  77     'T' => "\x{22a5}",          # ⊥
  78     'U' => "\x{144e}",          # ᑎ
  79     'V' => "\x{039b}",          # Λ
  80     'W' => 'M',
  81     'X' => 'X',
  82     'Y' => "\x{2144}",          # ⅄
  83     'Z' => 'Z',
  84     '[' => ']',
  85     '\\' => '\\',
  86     ']' => '[',
  87     '^' => "\x{203f}",          # ‿
  88     '_' => "\x{203e}",          # ‾
  89     '`' => "\x{0020}\x{0316}",  #  ̖
  90     'a' => "\x{0250}",          # ɐ
  91     'b' => 'q',
  92     'c' => "\x{0254}",          # ɔ
  93     'd' => 'p',
  94     'e' => "\x{01dd}",          # ǝ
  95     'f' => "\x{025f}",          # ɟ
  96     'g' => "\x{0253}",          # ɓ
  97     'h' => "\x{0265}",          # ɥ
  98     'i' => "\x{0131}\x{0323}",  # ı̣
  99     'j' => "\x{017f}\x{0323}",  # ſ̣
 100     'k' => "\x{029e}",          # ʞ
 101     'l' => "\x{01ae}",          # Ʈ can be improved
 102     'm' => "\x{026f}",          # ɯ
 103     'n' => 'u',
 104     'o' => 'o',
 105     'p' => 'd',
 106     'q' => 'b',
 107     'r' => "\x{0279}",          # ɹ
 108     's' => 's',
 109     't' => "\x{0287}",          # ʇ
 110     'u' => 'n',
 111     'v' => "\x{028c}",          # ʌ
 112     'w' => "\x{028d}",          # ʍ
 113     'x' => 'x',
 114     'y' => "\x{028e}",          # ʎ
 115     'z' => 'z',
 116     '{' => '}',
 117     '|' => '|',
 118     '}' => '{',
 119     '~' => "\x{223c}",          # ∼
 120 );
 121 my $missing = "\x{fffd}";       # � replacement character
 122
 123 # turnedstr - handle turning one string
 124 sub turnedstr {
 125     my $str = shift;
 126     my $turned = '';
 127     my $tlength = 0;
 128
 129     for my $char ( $str =~ /(\X)/g ) {
 130         if ( exists $updown{$char} ) {
 131             my $t = $updown{$char};
 132             $t = $missing if !length($t);
 133             $turned = $t . $turned;
 134             $tlength++;
 135         }
 136         elsif ( $char eq "\t" ) {
 137             my $tablen = 8 - $tlength % 8;
 138             $turned = " " x $tablen . $turned;
 139             $tlength += $tablen;
 140         }
 141         elsif ( ord($char) >= 32 ) {
 142             ### other chars copied literally
 143             $turned = $char . $turned;
 144             $tlength++;
 145         }
 146     }
 147
 148     return $turned;
 149 }
 150
 151 sub upsidedown {
 152     my ($message) = @_;
 153     &::performStrictReply( turnedstr( $message ) );
 154 }
 155
 156 1;
 157
 158 # vim:ts=4:sw=4:expandtab:tw=80