Also close bug

[filters.git] / scottish

#!/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;
}