rasterman

   1 #!/usr/bin/perl
   2
   3 $row = "!qwertyuiop!asdfghjkl!zxcvbnm!";
   4 @row_array = split(//, $row);
   5
   6 while (<>) {
   7         chomp;
   8         y/A-Z/a-z/;
   9         s/\byou\b/u/gi;
  10         s/\bpeople\b/ppl/gi;
  11         s/\bthrough\b/thru/gi;
  12         s/\bthough\b/tho/gi;
  13         s/\bnope\b/nup/gi;
  14         s/\baustralia\b/oz/gi;
  15         s/\bsucks\b/sux/gi;
  16         s/\benough\b/enuff/gi;
  17         s/\ba lot\b/a shitload/gi;
  18         s/\bstuff\b/shit/gi;
  19         s/, /.. /g;
  20         s/\.$/.../g;
  21
  22         @lets = split(//);
  23
  24         $strlen = $#lets;
  25
  26         for ($x = 0; $x < $strlen; $x++) {
  27                 if (rand() < 0.01) {
  28                     swap(\@lets, $x, $x + 1);
  29                     next;
  30                 }
  31
  32                 if (rand() < 0.10 && $lets[$x] eq " ") {
  33                     swap(\@lets, $x - 1, $x - 2);
  34                     next;
  35                 }
  36
  37                 if(rand() < 0.01) {
  38                     $i = insert_adjacent(\@lets, $x, $lets[$x]);
  39                     $strlen += $i;
  40                     next;
  41                 }
  42
  43                 if(rand() < 0.01) {
  44                     splice(@lets, $x, 1);
  45                     $strlen--;
  46                     next;
  47                 }
  48         }
  49
  50         print join("", @lets) . "\n";
  51 }
  52
  53 sub insert_adjacent {
  54     my($aref, $pos, $let) = @_;
  55
  56
  57     $newlet = get_adjacent($let);
  58
  59     if( !$newlet ) {
  60         return 0;
  61     }
  62
  63     splice(@$aref, $pos + 1, 0, $newlet);
  64     return 1;
  65 }
  66
  67
  68 sub get_adjacent {
  69     my($let) = @_;
  70
  71     return 0 if $let !~ /[a-zA-Z]/;
  72
  73     $i = index($row, $let);
  74     $before = $row_array[$i - 1];
  75     $after = $row_array[$i + 1];
  76
  77
  78
  79     if( $before eq "!" || (rand() < rand() && $after ne "!"))  {
  80         return $after;
  81     } else {
  82         return $before;
  83     }
  84 }
  85
  86 sub swap {
  87     my($aref, $n, $m) = @_;
  88     my($tmp);
  89
  90     if(defined($$aref[$n]) && defined($$aref[$m])) {
  91         if(! (($$aref[$n] =~ /[A-Z ]/ && $$aref[$m] =~ /[A-Z ]/) ||
  92               ($$aref[$n] =~ /[a-z ]/ && $$aref[$m] =~ /[a-z ]/) )) {
  93             return;
  94         }
  95         $tmp = $$aref[$n];
  96         $$aref[$n] = $$aref[$m];
  97         $$aref[$m] = $tmp;
  98     }
  99 }
 100