1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
|
#!/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;
}
|
