| 1 | #!/usr/bin/perl -w |
| 2 | # Fake scottish (dwarven) accent filter, by Adam Borowski, inspired by the |
| 3 | # character "Durkon" from Order of the Stick by Rich Burlew. GPL, 2007. |
| 4 | use strict; |
| 5 | |
| 6 | my @repl=qw( |
| 7 | ^yes$:aye there:thar eir$:ar |
| 8 | about:aboot ^he$:'e them:'em |
| 9 | ^him:'im out_of$:outta of_course:'course |
| 10 | ^of$:o' ^and$:an' to$:ta |
| 11 | tog:tag that:tha the:tha |
| 12 | wouldn't:wouldn'ta cannot:cannae can't:cannae |
| 13 | don't:dinnae 're$:r for$:fer |
| 14 | ver$:'er ber$:b'r every$:ev'ry |
| 15 | en$:'n ^if$:if'n enl:'nl |
| 16 | eng:'ng ing:in' ment:mn't |
| 17 | ^es:'s ^ex:'s ^not$:na |
| 18 | ^no$:nay n't_have:n'tve ^is$:be |
| 19 | ^are$:be have:haf abl:'bl |
| 20 | ^you$:ye ^your:yer ^you':ye' |
| 21 | noth:nuth ^this$:'tis ^here:'ere |
| 22 | doesn't:don't at_a$:atta ith$:it' |
| 23 | ered$:'red into$:inta ^before:'fore |
| 24 | wit'_':wit_' wit'_t:wit_t wit'_w:wit_w |
| 25 | wit'_y:wit_y get_a:git_a ally$:'lly |
| 26 | ^my:me ^i_think$:methinks nay_w:na_w |
| 27 | ^one$:'un ^'un_a:one_a at_ta$:atta |
| 28 | ot_ta$:otta ^isn't$:ain't ^so_th:s'th |
| 29 | ned$:n'd ^because:'cause |
| 30 | ), my @r; |
| 31 | |
| 32 | sub firstu($) { |
| 33 | $_[0]=~s/^([^a-z]*)([a-z])/$1\u$2/; |
| 34 | return $_[0]; |
| 35 | } |
| 36 | |
| 37 | for(@repl) { |
| 38 | s/_/ /g; |
| 39 | my ($l,$r)=split(/:/,$_); |
| 40 | for([$l,$r], [firstu $l, firstu $r], ["\U$l","\U$r"]) { |
| 41 | ($l,$r)=@$_; |
| 42 | $l=~s/^\^/\\b/; |
| 43 | $l=~s/\$$/\\b/; |
| 44 | push @r, [qr/$l/, $r]; |
| 45 | } |
| 46 | } |
| 47 | |
| 48 | while(my $txt=<>) { |
| 49 | $txt=~s/$$_[0]/$$_[1]/g for @r; |
| 50 | print $txt; |
| 51 | } |