+#!/usr/bin/perl -w
+# Fake scottish (dwarven) accent filter, by Adam Borowski, inspired by the
+# character "Durkon" from Order of the Stick by Rich Burlew. GPL, 2007.
+use strict;
+
+my @repl=qw(
+ ^yes$:aye there:thar eir$:ar
+ about:aboot ^he$:'e them:'em
+ ^him:'im out_of$:outta of_course:'course
+ ^of$:o' ^and$:an' to$:ta
+ tog:tag that:tha the:tha
+ wouldn't:wouldn'ta cannot:cannae can't:cannae
+ don't:dinnae 're$:r for$:fer
+ ver$:'er ber$:b'r every$:ev'ry
+ en$:'n ^if$:if'n enl:'nl
+ eng:'ng ing:in' ment:mn't
+ ^es:'s ^ex:'s ^not$:na
+ ^no$:nay n't_have:n'tve ^is$:be
+ ^are$:be have:haf abl:'bl
+ ^you$:ye ^your:yer ^you':ye'
+ noth:nuth ^this$:'tis ^here:'ere
+ doesn't:don't at_a$:atta ith$:it'
+ ered$:'red into$:inta ^before:'fore
+ wit'_':wit_' wit'_t:wit_t wit'_w:wit_w
+ wit'_y:wit_y get_a:git_a ally$:'lly$
+ ^my:me ^i_think$:methinks nay_w:na_w
+ ^one$:'un ^'un_a:one_a at_ta$:atta
+ ot_ta$:otta ^isn't$:ain't ^so_th:s'th
+ ned$:n'd ^because:'cause
+), my @r;
+
+sub firstu($) {
+ $_[0]=~s/^([^a-z]*)([a-z])/$1\u$2/;
+ return $_[0];
+}
+
+for(@repl) {
+ s/_/ /g;
+ my ($l,$r)=split(/:/,$_);
+ for([$l,$r], [firstu $l, firstu $r], ["\U$l","\U$r"]) {
+ ($l,$r)=@$_;
+ $l=~s/^\^/\\b/;
+ $l=~s/\$$/\\b/;
+ push @r, [qr/$l/, $r];
+ }
+}
+
+while(my $txt=<>) {
+ $txt=~s/$$_[0]/$$_[1]/g for @r;
+ print $txt;
+}
projects / filters.git / commitdiff